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

L-system: Add rotating pedestal

db4
Eduardo Cavazos 2009-01-07 16:24:56 -06:00
parent 7c6b3e6278
commit 589e509469
1 changed files with 44 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
extra/L-system/L-system.factor
View File

@ -1,9 +1,9 @@
USING: accessors arrays assocs colors combinators.short-circuit
kernel locals math math.functions math.matrices math.order
math.parser math.trig math.vectors opengl opengl.demo-support
opengl.gl sbufs sequences strings ui.gadgets ui.gadgets.worlds
ui.gestures ui.render ;
USING: accessors arrays assocs calendar colors
combinators.short-circuit kernel locals math math.functions
math.matrices math.order math.parser math.trig math.vectors
opengl opengl.demo-support opengl.gl sbufs sequences strings
threads ui.gadgets ui.gadgets.worlds ui.gestures ui.render ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -254,7 +254,27 @@ DEFER: default-L-parser-values
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
TUPLE: <L-system> < gadget camera display-list commands axiom rules string ;
TUPLE: <L-system> < gadget
camera display-list pedestal paused commands axiom rules string ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
:: iterate-system ( GADGET -- ) GADGET pedestal>> 0.5 + GADGET (>>pedestal) ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
:: start-rotation-thread ( GADGET -- )
GADGET f >>paused drop
[
[
GADGET paused>>
[ f ]
[ GADGET iterate-system GADGET relayout-1 25 milliseconds sleep t ]
if
]
loop
]
in-thread ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -385,6 +405,10 @@ M:: <L-system> draw-gadget* ( L-SYSTEM -- )
! draw axis
white gl-color GL_LINES glBegin { 0 0 0 } gl-vertex { 0 0 1 } gl-vertex glEnd
! rotate pedestal
L-SYSTEM pedestal>> 0 0 1 glRotated
L-SYSTEM display-list>> glCallList ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -417,6 +441,11 @@ H{
{ T{ key-down f f "a" } [ [ 1 step-turtle ] with-camera ] }
{ T{ key-down f f "z" } [ [ -1 step-turtle ] with-camera ] }
{ T{ key-down f f "q" } [ [ 5 roll-left ] with-camera ] }
{ T{ key-down f f "w" } [ [ 5 roll-right ] with-camera ] }
{ T{ key-down f f "r" } [ start-rotation-thread ] }
{
T{ key-down f f "x" }
[
@ -435,8 +464,16 @@ set-gestures
: L-system ( -- L-system )
<L-system> new-gadget
0 >>pedestal
turtle 45 turn-left 45 pitch-up 5 step-turtle 180 turn-left >>camera ;
! turtle 45 turn-left 45 pitch-up 5 step-turtle 180 turn-left >>camera ;
turtle 90 pitch-down -5 step-turtle 2 strafe-up >>camera
dup start-rotation-thread
;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!