| 
									
										
										
										
											2012-08-03 18:17:50 -04:00
										 |  |  | ! Copyright (c) 2012 Anonymous | 
					
						
							|  |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							| 
									
										
										
										
											2014-11-11 21:00:44 -05:00
										 |  |  | USING: arrays fry kernel math.matrices sequences ;
 | 
					
						
							| 
									
										
										
										
											2012-08-03 18:17:50 -04:00
										 |  |  | IN: rosetta-code.bitmap | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | ! http://rosettacode.org/wiki/Basic_bitmap_storage | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | ! Show a basic storage type to handle a simple RGB raster | 
					
						
							|  |  |  | ! graphics image, and some primitive associated functions. | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | ! If possible provide a function to allocate an uninitialised | 
					
						
							|  |  |  | ! image, given its width and height, and provide 3 additional | 
					
						
							|  |  |  | ! functions: | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | ! * one to fill an image with a plain RGB color, | 
					
						
							|  |  |  | ! * one to set a given pixel with a color, | 
					
						
							|  |  |  | ! * one to get the color of a pixel. | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | ! (If there are specificities about the storage or the | 
					
						
							|  |  |  | ! allocation, explain those.) | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | ! Various utilities | 
					
						
							|  |  |  | : meach ( matrix quot -- ) [ each ] curry each ; inline
 | 
					
						
							| 
									
										
										
										
											2015-06-29 19:43:15 -04:00
										 |  |  | : meach-index ( matrix quot -- )
 | 
					
						
							| 
									
										
										
										
											2012-08-03 18:17:50 -04:00
										 |  |  |     [ swap 2array ] prepose
 | 
					
						
							|  |  |  |     [ curry each-index ] curry each-index ; inline
 | 
					
						
							|  |  |  | : mmap ( matrix quot -- matrix' ) [ map ] curry map ; inline
 | 
					
						
							|  |  |  | : mmap! ( matrix quot -- matrix' ) [ map! ] curry map! ; inline
 | 
					
						
							| 
									
										
										
										
											2015-06-29 19:43:15 -04:00
										 |  |  | : mmap-index ( matrix quot -- matrix' )
 | 
					
						
							| 
									
										
										
										
											2012-08-03 18:17:50 -04:00
										 |  |  |     [ swap 2array ] prepose
 | 
					
						
							|  |  |  |     [ curry map-index ] curry map-index ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : matrix-dim ( matrix -- i j ) [ length ] [ first length ] bi ;
 | 
					
						
							|  |  |  | : set-Mi,j ( elt {i,j} matrix -- ) [ first2 swap ] dip nth set-nth ;
 | 
					
						
							|  |  |  | : Mi,j ( {i,j} matrix -- elt ) [ first2 swap ] dip nth nth ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | ! The storage functions | 
					
						
							| 
									
										
										
										
											2015-06-29 19:43:15 -04:00
										 |  |  | : <raster-image> ( width height -- image )
 | 
					
						
							| 
									
										
										
										
											2012-08-03 18:17:50 -04:00
										 |  |  |     zero-matrix [ drop { 0 0 0 } ] mmap ;
 | 
					
						
							| 
									
										
										
										
											2015-06-29 19:43:15 -04:00
										 |  |  | : fill-image ( {R,G,B} image -- image )
 | 
					
						
							| 
									
										
										
										
											2012-08-03 18:17:50 -04:00
										 |  |  |     swap '[ drop _ ] mmap! ;
 | 
					
						
							|  |  |  | : set-pixel ( {R,G,B} {i,j} image -- ) set-Mi,j ; inline
 | 
					
						
							|  |  |  | : get-pixel ( {i,j} image -- pixel ) Mi,j ; inline
 |