Paste: mandel.factor

USING: accessors byte-arrays colors colors.hsv fry io
io.encodings io.encodings.ascii io.encodings.binary io.files
io.files.temp kernel math math.functions math.order prettyprint
sequences tools.time values ;
IN: mandel

CONSTANT: max-color       360
CONSTANT: zoom-fact       0.8
CONSTANT: width           640
CONSTANT: height          480
CONSTANT: max-iterations  40
CONSTANT: center         -0.65

: scale-component ( x -- y ) 255 * >fixnum ; inline

: scale-rgb ( rgba -- n )
    [ red>> scale-component ]
    [ green>> scale-component ]
    [ blue>> scale-component ] tri 3byte-array ;

CONSTANT: sat 0.85
CONSTANT: val 0.85

: <color-map> ( nb-cols -- map )
    [ iota ] keep '[
        360 * _ 1 + / sat val
        1 <hsva> >rgba scale-rgb
    ] map ;

VALUE: color-map

: compute-color-map ( -- map ) max-iterations max-color min <color-map> ;

compute-color-map to: color-map

: x-scale ( -- x ) width  200000 zoom-fact * / ; inline
: y-scale ( -- y ) height 150000 zoom-fact * / ; inline

: scale ( x y -- z ) [ x-scale * ] [ y-scale * ] bi* rect> ; inline

: c ( i j -- c ) scale center width height scale 2 / - + ; inline

: count-iterations ( z max-iterations step-quot test-quot -- #iters )
    '[ drop @ dup @ ] find-last-integer nip ; inline

: pixel ( c -- iterations )
    [ C{ 0.0 0.0 } max-iterations ] dip
    '[ sq _ + ] [ absq 4.0 >= ] count-iterations ; inline

: color ( iterations -- color )
    [ color-map [ length mod ] keep nth ] [ B{ 0 0 0 } ] if* ; inline

: render ( -- )
    height iota [ width iota swap '[ _ c pixel color write ] each ] each ;

: ppm-header ( -- )
    ascii encode-output
    "P6\n" write width pprint " " write height pprint "\n255\n" write
    binary encode-output ;

: mandel-main ( -- )
    "mandel.ppm" temp-file binary [ ppm-header render ] with-file-writer ;

[ mandel-main ] time