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 : ( nb-cols -- map ) [ iota ] keep '[ 360 * _ 1 + / sat val 1 >rgba scale-rgb ] map ; VALUE: color-map : compute-color-map ( -- map ) max-iterations max-color min ; 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