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

   1 ! Copyright (c) 2012 Anonymous
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: assocs kernel math math.functions math.vectors
   4 rosetta-code.bitmap-line sequences ;
   5 IN: rosetta-code.bitmap-bezier
   6
   7 ! http://rosettacode.org/wiki/Bitmap/Bézier_curves/Cubic
   8
   9 ! Using the data storage type defined on this page for raster
  10 ! images, and the draw_line function defined in this other one,
  11 ! draw a cubic bezier curves (definition on Wikipedia).
  12
  13 :: (cubic-bezier) ( P0 P1 P2 P3 -- bezier )
  14     [ :> x
  15         1 x - 3 ^ P0 n*v
  16         1 x - sq 3 * x * P1 n*v
  17         1 x - 3 * x sq * P2 n*v
  18         x 3 ^ P3 n*v
  19         v+ v+ v+ ] ; inline
  20
  21 ! gives an interval of x from 0 to 1 to map the bezier function
  22 : t-interval ( x -- interval )
  23     [ <iota> ] keep 1 - [ / ] curry map ;
  24
  25 ! turns a list of points into the list of lines between them
  26 : points-to-lines ( seq -- seq )
  27     dup rest zip ;
  28
  29 : draw-lines ( {R,G,B} points image -- )
  30     [ [ first2 ] dip draw-line ] curry with each ;
  31
  32 :: bezier-lines ( {R,G,B} P0 P1 P2 P3 image -- )
  33     ! 100 is an arbitrary value.. could be given as a parameter..
  34     100 t-interval P0 P1 P2 P3 (cubic-bezier) map
  35     points-to-lines
  36     {R,G,B} swap image draw-lines ;