46 lines
		
	
	
		
			1.3 KiB
		
	
	
	
		
			Factor
		
	
	
		
		
			
		
	
	
			46 lines
		
	
	
		
			1.3 KiB
		
	
	
	
		
			Factor
		
	
	
|  | ! Copyright (c) 2012 Anonymous | ||
|  | ! See http://factorcode.org/license.txt for BSD license. | ||
|  | USING: accessors arrays kernel locals math math.functions | ||
|  | math.ranges math.vectors rosetta-code.bitmap sequences | ||
|  | ui.gadgets ;
 | ||
|  | IN: rosetta-code.bitmap-line | ||
|  | 
 | ||
|  | ! http://rosettacode.org/wiki/Bitmap/Bresenham%27s_line_algorithm | ||
|  | 
 | ||
|  | ! Using the data storage type defined on this page for raster | ||
|  | ! graphics images, draw a line given 2 points with the Bresenham's | ||
|  | ! algorithm. | ||
|  | 
 | ||
|  | :: line-points ( pt1 pt2 -- points )
 | ||
|  |     pt1 first2 :> y0! :> x0! | ||
|  |     pt2 first2 :> y1! :> x1! | ||
|  |     y1 y0 - abs x1 x0 - abs > :> steep | ||
|  |     steep [ | ||
|  |         y0 x0 y0! x0! | ||
|  |         y1 x1 y1! x1! | ||
|  |     ] when
 | ||
|  |     x0 x1 > [ | ||
|  |         x0 x1 x0! x1! | ||
|  |         y0 y1 y0! y1! | ||
|  |     ] when
 | ||
|  |     x1 x0 - :> deltax | ||
|  |     y1 y0 - abs :> deltay | ||
|  |     0 :> current-error! | ||
|  |     deltay deltax / abs :> deltaerr | ||
|  |     0 :> ystep! | ||
|  |     y0 :> y! | ||
|  |     y0 y1 < [ 1 ystep! ] [ -1 ystep! ] if
 | ||
|  |     x0 x1 1 <range> [ | ||
|  |         y steep [ swap ] when 2array   | ||
|  |         current-error deltaerr + current-error!  | ||
|  |         current-error 0.5 >= [ | ||
|  |             ystep y + y! | ||
|  |             current-error 1 - current-error! | ||
|  |         ] when
 | ||
|  |     ] { } map-as ;
 | ||
|  | 
 | ||
|  | ! Needs rosetta-code.bitmap for the set-pixel function and to create the image | ||
|  | : draw-line ( {R,G,B} pt1 pt2 image -- )
 | ||
|  |     [ line-points ] dip
 | ||
|  |     [ set-pixel ] curry with each ;
 |