extra/benchmark/mandel/mandel.factor

   1 ! Copyright (C) 2005, 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: arrays io kernel math math.functions math.order
   4 math.parser sequences byte-arrays byte-vectors io.files
   5 io.encodings.binary fry namespaces benchmark.mandel.params
   6 benchmark.mandel.colors ;
   7 IN: benchmark.mandel
   8
   9 : x-inc width  200000 zoom-fact * / ; inline
  10 : y-inc height 150000 zoom-fact * / ; inline
  11
  12 : c ( i j -- c )
  13     [ x-inc * center real-part x-inc width 2 / * - + >float ]
  14     [ y-inc * center imaginary-part y-inc height 2 / * - + >float ] bi*
  15     rect> ; inline
  16
  17 : count-iterations ( z max-iterations step-quot test-quot -- #iters )
  18     '[ drop @ dup @ ] find-last-integer nip ; inline
  19
  20 : pixel ( c -- iterations )
  21     [ C{ 0.0 0.0 } max-iterations ] dip
  22     '[ sq , + ] [ absq 4.0 >= ] count-iterations ; inline
  23
  24 : color ( iterations -- color )
  25     [ color-map [ length mod ] keep nth ] [ B{ 0 0 0 } ] if* ; inline
  26
  27 : render ( -- )
  28     height [ width swap '[ , c pixel color % ] each ] each ; inline
  29
  30 : ppm-header ( -- )
  31     "P6\n" % width # " " % height # "\n255\n" % ; inline
  32
  33 : buf-size ( -- n ) width height * 3 * 100 + ; inline
  34
  35 : mandel ( -- data )
  36     buf-size <byte-vector>
  37     [ building [ ppm-header render ] with-variable ] [ B{ } like ] bi ;
  38
  39 : mandel-main ( -- )
  40     mandel "mandel.ppm" temp-file binary set-file-contents ;
  41
  42 MAIN: mandel-main