steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

db4
Doug Coleman 2008-09-10 18:24:38 -05:00
parent 9e82c69489 5d474e1859
commit d2f0ee3d1c
3 changed files with 26 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/benchmark/mandel/colors/colors.factor
View File

@ -16,4 +16,4 @@ IN: benchmark.mandel.colors
] with map ; ] with map ;
: color-map ( -- map ) : color-map ( -- map )
nb-iter max-color min <color-map> ; foldable max-iterations max-color min <color-map> ; foldable

43
extra/benchmark/mandel/mandel.factor
View File

@ -1,16 +1,11 @@
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays io kernel math math.functions math.order USING: arrays io kernel math math.functions math.order
math.parser sequences locals byte-arrays byte-vectors io.files math.parser sequences byte-arrays byte-vectors io.files
io.encodings.binary benchmark.mandel.params io.encodings.binary fry namespaces benchmark.mandel.params
benchmark.mandel.colors ; benchmark.mandel.colors ;
IN: benchmark.mandel IN: benchmark.mandel
: iter ( c z nb-iter -- x )
dup 0 <= [ 2nip ] [
over absq 4.0 >= [ 2nip ] [
>r sq dupd + r> 1- iter
] if
] if ; inline recursive
: x-inc width 200000 zoom-fact * / ; inline : x-inc width 200000 zoom-fact * / ; inline
: y-inc height 150000 zoom-fact * / ; inline : y-inc height 150000 zoom-fact * / ; inline
@ -19,27 +14,27 @@ IN: benchmark.mandel
[ y-inc * center imaginary-part y-inc height 2 / * - + >float ] bi* [ y-inc * center imaginary-part y-inc height 2 / * - + >float ] bi*
rect> ; inline rect> ; inline
:: render ( accum -- ) : count-iterations ( z max-iterations step-quot test-quot -- #iters )
height [ '[ drop @ dup @ ] find-last-integer nip ; inline
width swap [
c C{ 0.0 0.0 } nb-iter iter dup zero?
[ drop B{ 0 0 0 } ] [ color-map [ length mod ] keep nth ] if
accum push-all
] curry each
] each ; inline
:: ppm-header ( accum -- ) : pixel ( c -- iterations )
"P6\n" accum push-all [ C{ 0.0 0.0 } max-iterations ] dip
width number>string accum push-all '[ sq , + ] [ absq 4.0 >= ] count-iterations ; inline
" " accum push-all
height number>string accum push-all : color ( iterations -- color )
"\n255\n" accum push-all ; inline [ color-map [ length mod ] keep nth ] [ B{ 0 0 0 } ] if* ; inline
: render ( -- )
height [ width swap '[ , c pixel color % ] each ] each ; inline
: ppm-header ( -- )
"P6\n" % width # " " % height # "\n255\n" % ; inline
: buf-size ( -- n ) width height * 3 * 100 + ; inline : buf-size ( -- n ) width height * 3 * 100 + ; inline
: mandel ( -- data ) : mandel ( -- data )
buf-size <byte-vector> buf-size <byte-vector>
[ ppm-header ] [ render ] [ B{ } like ] tri ; [ building [ ppm-header render ] with-variable ] [ B{ } like ] bi ;
: mandel-main ( -- ) : mandel-main ( -- )
mandel "mandel.ppm" temp-file binary set-file-contents ; mandel "mandel.ppm" temp-file binary set-file-contents ;

12
extra/benchmark/mandel/params/params.factor
View File

@ -1,8 +1,8 @@
IN: benchmark.mandel.params IN: benchmark.mandel.params
: max-color 360 ; inline : max-color 360 ; inline
: zoom-fact 0.8 ; inline : zoom-fact 0.8 ; inline
: width 640 ; inline : width 640 ; inline
: height 480 ; inline : height 480 ; inline
: nb-iter 40 ; inline : max-iterations 40 ; inline
: center -0.65 ; inline : center -0.65 ; inline