extra/rosetta-code/bitmap-line/bitmap-line.factor

   1 ! Copyright (c) 2012 Anonymous
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays kernel locals math math.functions
   4 math.ranges math.vectors rosetta-code.bitmap sequences
   5 ui.gadgets ;
   6 IN: rosetta-code.bitmap-line
   7
   8 ! http://rosettacode.org/wiki/Bitmap/Bresenham%27s_line_algorithm
   9
  10 ! Using the data storage type defined on this page for raster
  11 ! graphics images, draw a line given 2 points with the Bresenham's
  12 ! algorithm.
  13
  14 :: line-points ( pt1 pt2 -- points )
  15     pt1 first2 :> y0! :> x0!
  16     pt2 first2 :> y1! :> x1!
  17     y1 y0 - abs x1 x0 - abs > :> steep
  18     steep [
  19         y0 x0 y0! x0!
  20         y1 x1 y1! x1!
  21     ] when
  22     x0 x1 > [
  23         x0 x1 x0! x1!
  24         y0 y1 y0! y1!
  25     ] when
  26     x1 x0 - :> deltax
  27     y1 y0 - abs :> deltay
  28     0 :> current-error!
  29     deltay deltax / abs :> deltaerr
  30     0 :> ystep!
  31     y0 :> y!
  32     y0 y1 < [ 1 ystep! ] [ -1 ystep! ] if
  33     x0 x1 1 <range> [
  34         y steep [ swap ] when 2array
  35         current-error deltaerr + current-error!
  36         current-error 0.5 >= [
  37             ystep y + y!
  38             current-error 1 - current-error!
  39         ] when
  40     ] { } map-as ;
  41
  42 ! Needs rosetta-code.bitmap for the set-pixel function and to create the image
  43 : draw-line ( {R,G,B} pt1 pt2 image -- )
  44     [ line-points ] dip
  45     [ set-pixel ] curry with each ;