extra/benchmark/mandel/mandel.factor

   1 IN: benchmark.mandel
   2 USING: arrays io kernel math math.order namespaces sequences
   3 byte-arrays byte-vectors math.functions math.parser io.files
   4 colors.hsv io.encodings.binary ;
   5
   6 : max-color 360 ; inline
   7 : zoom-fact 0.8 ; inline
   8 : width 640 ; inline
   9 : height 480 ; inline
  10 : nb-iter 40 ; inline
  11 : center -0.65 ; inline
  12
  13 : scale 255 * >fixnum ; inline
  14
  15 : scale-rgb ( r g b -- n )
  16     rot scale rot scale rot scale 3array ;
  17
  18 : sat 0.85 ; inline
  19 : val 0.85 ; inline
  20
  21 : <color-map> ( nb-cols -- map )
  22     dup [
  23         360 * swap 1+ / sat val
  24         3array hsv>rgb first3 scale-rgb
  25     ] with map ;
  26
  27 : iter ( c z nb-iter -- x )
  28     over absq 4.0 >= over zero? or
  29     [ 2nip ] [ 1- >r sq dupd + r> iter ] if ; inline
  30
  31 SYMBOL: cols
  32
  33 : x-inc width 200000 zoom-fact * / ; inline
  34 : y-inc height 150000 zoom-fact * / ; inline
  35
  36 : c ( i j -- c )
  37     >r
  38     x-inc * center real-part x-inc width 2 / * - + >float
  39     r>
  40     y-inc * center imaginary-part y-inc height 2 / * - + >float
  41     rect> ; inline
  42
  43 : render ( -- )
  44     height [
  45         width swap [
  46             c 0 nb-iter iter dup zero? [
  47                 drop "\0\0\0"
  48             ] [
  49                 cols get [ length mod ] keep nth
  50             ] if %
  51         ] curry each
  52     ] each ;
  53
  54 : ppm-header ( w h -- )
  55     "P6\n" % swap # " " % # "\n255\n" % ;
  56
  57 : buf-size ( -- n ) width height * 3 * 100 + ;
  58
  59 : mandel ( -- data )
  60     [
  61         buf-size <byte-vector> building set
  62         width height ppm-header
  63         nb-iter max-color min <color-map> cols set
  64         render
  65         building get >byte-array
  66     ] with-scope ;
  67
  68 : mandel-main ( -- )
  69     mandel "mandel.ppm" temp-file binary set-file-contents ;
  70
  71 MAIN: mandel-main