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

db4
Slava Pestov 2008-08-06 20:01:39 -05:00
commit 3eb1c75855
2 changed files with 32 additions and 40 deletions

View File

@ -6,29 +6,35 @@ IN: cfdg.models.game1-turn6
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: f-triangles ( -- ) iterate? [ : f-triangles ( -- )
[ 0.1 x 0.1 y -0.33 alpha 20 hue 0.7 sat 0.8 b triangle ] do {
[ 10 hue 0.9 sat 0.33 b triangle ] do [ 0.1 x 0.1 y -0.33 alpha 20 hue 0.7 sat 0.80 b triangle ]
[ 0.9 s 10 hue 0.5 sat 1 b triangle ] do [ 10 hue 0.9 sat 0.33 b triangle ]
[ 0.8 s 5 r f-triangles ] do [ 0.9 s 10 hue 0.5 sat 1.00 b triangle ]
] when ; [ 0.8 s 5 r f-triangles ]
}
rule ;
: f-squares ( -- ) iterate? [ : f-squares ( -- )
[ 0.1 x 0.1 y -0.33 alpha 250 hue 0.7 sat 0.8 b square ] do {
[ 220 hue 0.9 sat 0.33 b square ] do [ 0.1 x 0.1 y -0.33 alpha 250 hue 0.70 sat 0.80 b square ]
[ 0.9 s 220 hue 0.25 sat 1 b square ] do [ 220 hue 0.90 sat 0.33 b square ]
[ 0.8 s 5 r f-squares ] do [ 0.9 s 220 hue 0.25 sat 1.00 b square ]
] when ; [ 0.8 s 5 r f-squares ]
}
rule ;
DEFER: start DEFER: start
: spiral ( -- ) iterate? [ : spiral ( -- )
{ { 1 [ f-squares {
[ 0.5 x 0.5 y 45 r f-triangles ] do { 1 [ f-squares ]
[ 1 y 25 r 0.9 s spiral ] do ] } [ 0.5 x 0.5 y 45 r f-triangles ]
{ 0.022 [ [ 90 flip 50 hue start ] do ] } } [ 1 y 25 r 0.9 s spiral ] }
call-random-weighted
] when ; { 0.022 [ 90 flip 50 hue start ] }
}
rules ;
: start ( -- ) : start ( -- )
[ spiral ] do [ spiral ] do

View File

@ -7,33 +7,19 @@ DEFER: line
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: block ( -- ) : block ( -- ) { [ circle ] [ 0.3 s 60 flip line ] } rule ;
[
[ circle ] do
[ 0.3 s 60 flip line ] do
]
recursive ;
: a1 ( -- ) : a1 ( -- ) { [ 0.95 s 2 x 12 r 0.5 b 10 hue 1.5 sat a1 ] [ block ] } rule ;
[
[ 0.95 s 2 x 12 r 0.5 b 10 hue 1.5 sat a1 ] do
[ block ] do
]
recursive ;
: line ( -- ) : line ( -- ) -0.3 a { [ 0 r a1 ] [ 120 r a1 ] [ 240 r a1 ] } rule ;
-0.3 a
[ 0 rotate a1 ] do
[ 120 rotate a1 ] do
[ 240 rotate a1 ] do ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: init ( -- ) : init ( -- )
[ -1 b ] >background [ -1 b ] >background
{ -20 40 -20 40 } viewport set { -20 40 -20 40 } >viewport
[ line ] >start-shape [ line ] >start-shape
0.03 >threshold ; 0.04 >threshold ;
: run ( -- ) [ init ] cfdg-window. ; : run ( -- ) [ init ] cfdg-window. ;