factor/extra/benchmark/mandel/mandel.factor

39 lines
1.2 KiB
Factor
Raw Normal View History

2008-09-10 19:22:50 -04:00
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
2008-09-11 21:01:10 -04:00
USING: io kernel math math.functions sequences prettyprint
io.files io.files.temp io.encodings io.encodings.ascii
io.encodings.binary fry benchmark.mandel.params
benchmark.mandel.colors ;
2008-07-04 11:52:50 -04:00
IN: benchmark.mandel
2007-09-20 18:09:08 -04:00
2008-07-04 11:52:50 -04:00
: x-inc width 200000 zoom-fact * / ; inline
2007-09-20 18:09:08 -04:00
: y-inc height 150000 zoom-fact * / ; inline
: c ( i j -- c )
2008-09-01 19:28:24 -04:00
[ x-inc * center real-part x-inc width 2 / * - + >float ]
[ y-inc * center imaginary-part y-inc height 2 / * - + >float ] bi*
2007-09-20 18:09:08 -04:00
rect> ; inline
2008-09-10 19:22:50 -04:00
: 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
2008-09-10 23:11:40 -04:00
'[ sq _ + ] [ absq 4.0 >= ] count-iterations ; inline
2008-09-10 19:22:50 -04:00
: color ( iterations -- color )
[ color-map [ length mod ] keep nth ] [ B{ 0 0 0 } ] if* ; inline
: render ( -- )
2008-09-11 21:01:10 -04:00
height [ width swap '[ _ c pixel color write ] each ] each ; inline
2008-09-10 19:22:50 -04:00
: ppm-header ( -- )
2008-09-11 21:01:10 -04:00
ascii encode-output
"P6\n" write width pprint " " write height pprint "\n255\n" write
binary encode-output ; inline
2007-09-20 18:09:08 -04:00
2007-11-25 00:50:12 -05:00
: mandel-main ( -- )
2008-09-11 21:01:10 -04:00
"mandel.ppm" temp-file binary [ ppm-header render ] with-file-writer ;
2007-09-20 18:09:08 -04:00
MAIN: mandel-main