L-system: resurrect from unmaintained to extra
Alexander Iljin
John Benediktsson
parent
8a3d7a9d7f
commit
28bdbf8a2c
|
|
@ -0,0 +1,511 @@
|
|||
|
||||
USING: accessors arrays assocs calendar colors
|
||||
combinators.short-circuit help.markup help.syntax 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 ui.tools.workspace ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
IN: L-system
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
TUPLE: <turtle> pos ori angle length thickness color vertices saved ;
|
||||
|
||||
DEFER: default-L-parser-values
|
||||
|
||||
: reset-turtle ( turtle -- turtle )
|
||||
{ 0 0 0 } clone >>pos
|
||||
3 identity-matrix >>ori
|
||||
V{ } clone >>vertices
|
||||
V{ } clone >>saved
|
||||
|
||||
default-L-parser-values ;
|
||||
|
||||
: turtle ( -- turtle ) <turtle> new reset-turtle ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
:: step-turtle ( TURTLE LENGTH -- turtle )
|
||||
|
||||
TURTLE
|
||||
TURTLE pos>> TURTLE ori>> { 0 0 LENGTH } m.v v+
|
||||
>>pos ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
:: Rx ( ANGLE -- Rx )
|
||||
|
||||
[let | ANGLE [ ANGLE deg>rad ] |
|
||||
|
||||
[let | A [ ANGLE cos ]
|
||||
B [ ANGLE sin neg ]
|
||||
C [ ANGLE sin ]
|
||||
D [ ANGLE cos ] |
|
||||
|
||||
{ { 1 0 0 }
|
||||
{ 0 A B }
|
||||
{ 0 C D } }
|
||||
|
||||
] ] ;
|
||||
|
||||
:: Ry ( ANGLE -- Ry )
|
||||
|
||||
[let | ANGLE [ ANGLE deg>rad ] |
|
||||
|
||||
[let | A [ ANGLE cos ]
|
||||
B [ ANGLE sin ]
|
||||
C [ ANGLE sin neg ]
|
||||
D [ ANGLE cos ] |
|
||||
|
||||
{ { A 0 B }
|
||||
{ 0 1 0 }
|
||||
{ C 0 D } }
|
||||
|
||||
] ] ;
|
||||
|
||||
:: Rz ( ANGLE -- Rz )
|
||||
|
||||
[let | ANGLE [ ANGLE deg>rad ] |
|
||||
|
||||
[let | A [ ANGLE cos ]
|
||||
B [ ANGLE sin neg ]
|
||||
C [ ANGLE sin ]
|
||||
D [ ANGLE cos ] |
|
||||
|
||||
{ { A B 0 }
|
||||
{ C D 0 }
|
||||
{ 0 0 1 } }
|
||||
|
||||
] ] ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
:: apply-rotation ( TURTLE ROTATION -- turtle )
|
||||
|
||||
TURTLE TURTLE ori>> ROTATION m. >>ori ;
|
||||
|
||||
: rotate-x ( turtle angle -- turtle ) Rx apply-rotation ;
|
||||
: rotate-y ( turtle angle -- turtle ) Ry apply-rotation ;
|
||||
: rotate-z ( turtle angle -- turtle ) Rz apply-rotation ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: pitch-up ( turtle angle -- turtle ) neg rotate-x ;
|
||||
: pitch-down ( turtle angle -- turtle ) rotate-x ;
|
||||
|
||||
: turn-left ( turtle angle -- turtle ) rotate-y ;
|
||||
: turn-right ( turtle angle -- turtle ) neg rotate-y ;
|
||||
|
||||
: roll-left ( turtle angle -- turtle ) neg rotate-z ;
|
||||
: roll-right ( turtle angle -- turtle ) rotate-z ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: V ( -- V ) { 0 1 0 } ;
|
||||
|
||||
: X ( turtle -- 3array ) ori>> [ first ] map ;
|
||||
: Y ( turtle -- 3array ) ori>> [ second ] map ;
|
||||
: Z ( turtle -- 3array ) ori>> [ third ] map ;
|
||||
|
||||
: set-X ( turtle seq -- turtle ) over ori>> [ set-first ] 2each ;
|
||||
: set-Y ( turtle seq -- turtle ) over ori>> [ set-second ] 2each ;
|
||||
: set-Z ( turtle seq -- turtle ) over ori>> [ set-third ] 2each ;
|
||||
|
||||
:: roll-until-horizontal ( TURTLE -- turtle )
|
||||
|
||||
TURTLE
|
||||
|
||||
V TURTLE Z cross normalize set-X
|
||||
|
||||
TURTLE Z TURTLE X cross normalize set-Y ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
:: strafe-up ( TURTLE LENGTH -- turtle )
|
||||
TURTLE 90 pitch-up LENGTH step-turtle 90 pitch-down ;
|
||||
|
||||
:: strafe-down ( TURTLE LENGTH -- turtle )
|
||||
TURTLE 90 pitch-down LENGTH step-turtle 90 pitch-up ;
|
||||
|
||||
:: strafe-left ( TURTLE LENGTH -- turtle )
|
||||
TURTLE 90 turn-left LENGTH step-turtle 90 turn-right ;
|
||||
|
||||
:: strafe-right ( TURTLE LENGTH -- turtle )
|
||||
TURTLE 90 turn-right LENGTH step-turtle 90 turn-left ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: polygon ( vertices -- ) GL_POLYGON glBegin [ first3 glVertex3d ] each glEnd ;
|
||||
|
||||
: start-polygon ( turtle -- turtle ) dup vertices>> delete-all ;
|
||||
|
||||
: finish-polygon ( turtle -- turtle ) dup vertices>> polygon ;
|
||||
|
||||
: polygon-vertex ( turtle -- turtle ) dup [ pos>> ] [ vertices>> ] bi push ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: record-vertex ( turtle -- turtle ) dup pos>> first3 glVertex3d ;
|
||||
|
||||
: draw-forward ( turtle length -- turtle )
|
||||
GL_LINES glBegin [ record-vertex ] dip step-turtle record-vertex glEnd ;
|
||||
|
||||
: move-forward ( turtle length -- turtle ) step-turtle polygon-vertex ;
|
||||
|
||||
: sneak-forward ( turtle length -- turtle ) step-turtle ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: scale-length ( turtle m -- turtle ) over length>> * >>length ;
|
||||
: scale-angle ( turtle m -- turtle ) over angle>> * >>angle ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: set-thickness ( turtle i -- turtle ) dup glLineWidth >>thickness ;
|
||||
|
||||
: scale-thickness ( turtle m -- turtle )
|
||||
over thickness>> * 0.5 max set-thickness ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: color-table ( -- colors )
|
||||
{
|
||||
T{ rgba f 0 0 0 1 } ! black
|
||||
T{ rgba f 0.5 0.5 0.5 1 } ! grey
|
||||
T{ rgba f 1 0 0 1 } ! red
|
||||
T{ rgba f 1 1 0 1 } ! yellow
|
||||
T{ rgba f 0 1 0 1 } ! green
|
||||
T{ rgba f 0.25 0.88 0.82 1 } ! turquoise
|
||||
T{ rgba f 0 0 1 1 } ! blue
|
||||
T{ rgba f 0.63 0.13 0.94 1 } ! purple
|
||||
T{ rgba f 0.00 0.50 0.00 1 } ! dark green
|
||||
T{ rgba f 0.00 0.82 0.82 1 } ! dark turquoise
|
||||
T{ rgba f 0.00 0.00 0.50 1 } ! dark blue
|
||||
T{ rgba f 0.58 0.00 0.82 1 } ! dark purple
|
||||
T{ rgba f 0.50 0.00 0.00 1 } ! dark red
|
||||
T{ rgba f 0.25 0.25 0.25 1 } ! dark grey
|
||||
T{ rgba f 0.75 0.75 0.75 1 } ! medium grey
|
||||
T{ rgba f 1 1 1 1 } ! white
|
||||
} ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
! : material-color ( color -- )
|
||||
! GL_FRONT_AND_BACK GL_AMBIENT_AND_DIFFUSE rot gl-material ;
|
||||
|
||||
: material-color ( color -- )
|
||||
GL_FRONT_AND_BACK GL_AMBIENT_AND_DIFFUSE rot color>raw 4array gl-material ;
|
||||
|
||||
: set-color ( turtle i -- turtle )
|
||||
dup color-table nth dup gl-color material-color >>color ;
|
||||
|
||||
: inc-color ( turtle -- turtle ) dup color>> 1 + set-color ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: save-turtle ( turtle -- turtle ) dup clone over saved>> push ;
|
||||
|
||||
: restore-turtle ( turtle -- turtle ) saved>> pop dup color>> set-color ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: default-L-parser-values ( turtle -- turtle )
|
||||
1 >>length 45 >>angle 1 >>thickness 2 >>color ;
|
||||
|
||||
: L-parser-dialect ( -- commands )
|
||||
|
||||
{
|
||||
{ "+" [ dup angle>> turn-left ] }
|
||||
{ "-" [ dup angle>> turn-right ] }
|
||||
{ "&" [ dup angle>> pitch-down ] }
|
||||
{ "^" [ dup angle>> pitch-up ] }
|
||||
{ "<" [ dup angle>> roll-left ] }
|
||||
{ ">" [ dup angle>> roll-right ] }
|
||||
|
||||
{ "|" [ 180.0 rotate-y ] }
|
||||
{ "%" [ 180.0 rotate-z ] }
|
||||
{ "$" [ roll-until-horizontal ] }
|
||||
|
||||
{ "F" [ dup length>> draw-forward ] }
|
||||
{ "Z" [ dup length>> 2 / draw-forward ] }
|
||||
{ "f" [ dup length>> move-forward ] }
|
||||
{ "z" [ dup length>> 2 / move-forward ] }
|
||||
{ "g" [ dup length>> sneak-forward ] }
|
||||
{ "." [ polygon-vertex ] }
|
||||
|
||||
{ "[" [ save-turtle ] }
|
||||
{ "]" [ restore-turtle ] }
|
||||
|
||||
{ "{" [ start-polygon ] }
|
||||
{ "}" [ finish-polygon ] }
|
||||
|
||||
{ "/" [ 1.1 scale-length ] } ! double quote command in lparser
|
||||
{ "'" [ 0.9 scale-length ] }
|
||||
{ ";" [ 1.1 scale-angle ] }
|
||||
{ ":" [ 0.9 scale-angle ] }
|
||||
{ "?" [ 1.4 scale-thickness ] }
|
||||
{ "!" [ 0.7 scale-thickness ] }
|
||||
|
||||
{ "c" [ dup color>> 1 + color-table length mod set-color ] }
|
||||
|
||||
}
|
||||
;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
TUPLE: <L-system> < gadget
|
||||
camera display-list pedestal paused
|
||||
turtle-values
|
||||
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 ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: open-paren ( -- ch ) CHAR: ( ;
|
||||
: close-paren ( -- ch ) CHAR: ) ;
|
||||
|
||||
: open-paren? ( obj -- ? ) open-paren = ;
|
||||
: close-paren? ( obj -- ? ) close-paren = ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
:: read-instruction ( STRING -- next rest )
|
||||
|
||||
{ [ STRING length 1 > ] [ STRING second open-paren? ] } 0&&
|
||||
[ STRING close-paren STRING index 1 + cut ]
|
||||
[ STRING 1 cut ]
|
||||
if ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
:: iterate-string-loop ( STRING RULES ACCUM -- )
|
||||
STRING empty? not
|
||||
[
|
||||
STRING read-instruction
|
||||
|
||||
[let | REST [ ] NEXT [ ] |
|
||||
|
||||
NEXT 1 head RULES at NEXT or ACCUM push-all
|
||||
|
||||
REST RULES ACCUM iterate-string-loop ]
|
||||
]
|
||||
when ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
:: iterate-string ( STRING RULES -- string )
|
||||
|
||||
[let | ACCUM [ STRING length 10 * <sbuf> ] |
|
||||
|
||||
STRING RULES ACCUM iterate-string-loop
|
||||
|
||||
ACCUM >string ] ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
:: interpret-string ( STRING COMMANDS -- )
|
||||
|
||||
STRING empty? not
|
||||
[
|
||||
STRING read-instruction
|
||||
|
||||
[let | REST [ ] NEXT [ ] |
|
||||
|
||||
[let | COMMAND [ NEXT 1 head COMMANDS at ] |
|
||||
|
||||
COMMAND
|
||||
[
|
||||
NEXT length 1 =
|
||||
[ COMMAND call ]
|
||||
[
|
||||
NEXT 2 tail 1 head* string>number
|
||||
COMMAND 1 tail*
|
||||
call
|
||||
]
|
||||
if
|
||||
]
|
||||
when ]
|
||||
|
||||
REST COMMANDS interpret-string ]
|
||||
]
|
||||
when ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
:: iterate-L-system-string ( L-SYSTEM -- )
|
||||
L-SYSTEM string>> L-SYSTEM axiom>> or
|
||||
L-SYSTEM rules>>
|
||||
iterate-string
|
||||
L-SYSTEM string<< ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
:: do-camera-look-at ( CAMERA -- )
|
||||
|
||||
[let | EYE [ CAMERA pos>> ]
|
||||
FOCUS [ CAMERA clone 1 step-turtle pos>> ]
|
||||
UP [ CAMERA clone 90 pitch-up 1 step-turtle pos>> CAMERA pos>> v- ]
|
||||
|
|
||||
|
||||
EYE FOCUS UP gl-look-at ] ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
:: generate-display-list ( L-SYSTEM -- )
|
||||
|
||||
L-SYSTEM find-gl-context
|
||||
|
||||
L-SYSTEM display-list>> GL_COMPILE glNewList
|
||||
|
||||
turtle
|
||||
L-SYSTEM turtle-values>> [ ] or call
|
||||
L-SYSTEM string>> L-SYSTEM axiom>> or
|
||||
L-SYSTEM commands>>
|
||||
interpret-string
|
||||
drop
|
||||
|
||||
glEndList ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
M:: <L-system> draw-gadget* ( L-SYSTEM -- )
|
||||
|
||||
black gl-clear
|
||||
|
||||
GL_FLAT glShadeModel
|
||||
|
||||
GL_PROJECTION glMatrixMode
|
||||
glLoadIdentity
|
||||
-1 1 -1 1 1.5 200 glFrustum
|
||||
|
||||
GL_MODELVIEW glMatrixMode
|
||||
|
||||
glLoadIdentity
|
||||
|
||||
L-SYSTEM camera>> do-camera-look-at
|
||||
|
||||
GL_FRONT_AND_BACK GL_LINE glPolygonMode
|
||||
|
||||
! 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 ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
M:: <L-system> graft* ( L-SYSTEM -- )
|
||||
|
||||
L-SYSTEM find-gl-context
|
||||
|
||||
1 glGenLists L-SYSTEM display-list<< ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
M:: <L-system> pref-dim* ( L-SYSTEM -- dim ) { 400 400 } ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
:: with-camera ( L-SYSTEM QUOT -- )
|
||||
L-SYSTEM camera>> QUOT call drop
|
||||
L-SYSTEM relayout-1 ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
<L-system>
|
||||
H{
|
||||
{ T{ key-down f f "LEFT" } [ [ 5 turn-left ] with-camera ] }
|
||||
{ T{ key-down f f "RIGHT" } [ [ 5 turn-right ] with-camera ] }
|
||||
{ T{ key-down f f "UP" } [ [ 5 pitch-down ] with-camera ] }
|
||||
{ T{ key-down f f "DOWN" } [ [ 5 pitch-up ] with-camera ] }
|
||||
|
||||
{ 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 { A+ } "LEFT" } [ [ 1 strafe-left ] with-camera ] }
|
||||
{ T{ key-down f { A+ } "RIGHT" } [ [ 1 strafe-right ] with-camera ] }
|
||||
{ T{ key-down f { A+ } "UP" } [ [ 1 strafe-up ] with-camera ] }
|
||||
{ T{ key-down f { A+ } "DOWN" } [ [ 1 strafe-down ] with-camera ] }
|
||||
|
||||
{ T{ key-down f f "r" } [ start-rotation-thread ] }
|
||||
|
||||
{
|
||||
T{ key-down f f "x" }
|
||||
[
|
||||
dup iterate-L-system-string
|
||||
dup generate-display-list
|
||||
dup relayout-1
|
||||
drop
|
||||
]
|
||||
}
|
||||
|
||||
{ T{ key-down f f "F1" } [ drop "L-system" help-window ] }
|
||||
|
||||
}
|
||||
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 90 pitch-down -5 step-turtle 2 strafe-up >>camera
|
||||
|
||||
dup start-rotation-thread
|
||||
|
||||
;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
ARTICLE: "L-system" "L-system"
|
||||
|
||||
"Press 'x' to iterate the L-system." $nl
|
||||
|
||||
"Camera control:"
|
||||
|
||||
{ $table
|
||||
|
||||
{ "a" "Forward" }
|
||||
{ "z" "Backward" }
|
||||
|
||||
{ "LEFT" "Turn left" }
|
||||
{ "RIGHT" "Turn right" }
|
||||
{ "UP" "Pitch down" }
|
||||
{ "DOWN" "Pitch up" }
|
||||
|
||||
{ "q" "Roll left" }
|
||||
{ "w" "Roll right" } } ;
|
||||
|
||||
ABOUT: "L-system"
|
||||
|
|
@ -0,0 +1,27 @@
|
|||
|
||||
USING: accessors ui L-system ;
|
||||
|
||||
IN: L-system.models.abop-1
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: abop-1 ( <L-system> -- <L-system> )
|
||||
|
||||
L-parser-dialect >>commands
|
||||
|
||||
"c(12)FFAL" >>axiom
|
||||
|
||||
{
|
||||
{ "A" "F [ & '(.8) ! B L ] >(137) ' !(.9) A" }
|
||||
{ "B" "F [ - '(.8) !(.9) $ C L ] ' !(.9) C" }
|
||||
{ "C" "F [ + '(.8) !(.9) $ B L ] ' !(.9) B" }
|
||||
|
||||
{ "L" " ~ c(8) { +(30) f -(120) f -(120) f }" }
|
||||
}
|
||||
>>rules ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: main ( -- ) [ L-system abop-1 "L-system" open-window ] with-ui ;
|
||||
|
||||
MAIN: main
|
||||
|
|
@ -0,0 +1,31 @@
|
|||
|
||||
USING: accessors ui L-system ;
|
||||
|
||||
IN: L-system.models.abop-2
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: abop-2 ( <L-system> -- <L-system> )
|
||||
|
||||
L-parser-dialect >>commands
|
||||
|
||||
[ 30 >>angle ] >>turtle-values
|
||||
|
||||
"c(12)FAL" >>axiom
|
||||
|
||||
{
|
||||
{ "A" "F [&'(.7)!BL] >(137) [&'(.6)!BL] >(137) '(.9) !(.9) A" }
|
||||
|
||||
{ "B" "F [- '(.7) !(.9) $ C L] '(.9) !(.9) C" }
|
||||
{ "C" "F [+ '(.7) !(.9) $ B L] '(.9) !(.9) B" }
|
||||
|
||||
{ "L" "~c(8){+f(.1)-f(.1)-f(.1)+|+f(.1)-f(.1)-f(.1)}" }
|
||||
|
||||
} >>rules ;
|
||||
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: main ( -- ) [ L-system abop-2 "L-system" open-window ] with-ui ;
|
||||
|
||||
MAIN: main
|
||||
|
|
@ -0,0 +1,27 @@
|
|||
|
||||
USING: accessors ui L-system ;
|
||||
|
||||
IN: L-system.models.abop-3
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: abop-3 ( <L-system> -- <L-system> )
|
||||
|
||||
L-parser-dialect >>commands
|
||||
|
||||
[ 30 >>angle ] >>turtle-values
|
||||
|
||||
"c(12)FA" >>axiom
|
||||
|
||||
{
|
||||
{ "A" "!(.9)t(.4)FB>(94)B>(132)B" }
|
||||
{ "B" "[&t(.4)F$A]" }
|
||||
{ "F" "'(1.25)F'(.8)" }
|
||||
}
|
||||
>>rules ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: main ( -- ) [ L-system abop-3 "L-system" open-window ] with-ui ;
|
||||
|
||||
MAIN: main
|
||||
|
|
@ -0,0 +1,56 @@
|
|||
|
||||
USING: accessors ui L-system ;
|
||||
|
||||
IN: L-system.models.abop-4
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: abop-4 ( <L-system> -- <L-system> )
|
||||
|
||||
L-parser-dialect >>commands
|
||||
|
||||
[ 18 >>angle ] >>turtle-values
|
||||
|
||||
"c(12)&(20)N" >>axiom
|
||||
|
||||
{
|
||||
{
|
||||
"N"
|
||||
"FII[&(60)rY]>(90)[&(45)'(0.8)rA]>(90)[&(60)rY]>(90)[&(45)'(0.8)rD]!FIK"
|
||||
}
|
||||
{ "Y" "[c(4){++l.--l.--l.++|++l.--l.--l.}]" }
|
||||
{ "l" "g(.2)l" }
|
||||
{ "K" "[!c(2)FF>w>(72)w>(72)w>(72)w>(72)w]" }
|
||||
{ "w" "[c(2)^!F][c(5)&(72){-(54)f(3)+(54)f(3)|-(54)f(3)+(54)f(3)}]" }
|
||||
{ "f" "_" }
|
||||
|
||||
{ "A" "B" }
|
||||
{ "B" "C" }
|
||||
{ "C" "D" }
|
||||
{ "D" "E" }
|
||||
{ "E" "G" }
|
||||
{ "G" "H" }
|
||||
{ "H" "N" }
|
||||
|
||||
{ "I" "FoO" }
|
||||
{ "O" "FoP" }
|
||||
{ "P" "FoQ" }
|
||||
{ "Q" "FoR" }
|
||||
{ "R" "FoS" }
|
||||
{ "S" "FoT" }
|
||||
{ "T" "FoU" }
|
||||
{ "U" "FoV" }
|
||||
{ "V" "FoW" }
|
||||
{ "W" "FoX" }
|
||||
{ "X" "_" }
|
||||
|
||||
{ "o" "$t(-0.03)" }
|
||||
{ "r" "~(30)" }
|
||||
}
|
||||
>>rules ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: main ( -- ) [ L-system abop-4 "L-system" open-window ] with-ui ;
|
||||
|
||||
MAIN: main
|
||||
|
|
@ -0,0 +1,33 @@
|
|||
|
||||
USING: accessors ui L-system ;
|
||||
|
||||
IN: L-system.models.abop-5-angular
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: abop-5-angular ( <L-system> -- <L-system> )
|
||||
|
||||
L-parser-dialect >>commands
|
||||
|
||||
"&(90)+(90)a" >>axiom
|
||||
|
||||
{
|
||||
{ "a" "F[+(45)l][-(45)l]^;ca" }
|
||||
|
||||
{ "l" "j" }
|
||||
{ "j" "h" }
|
||||
{ "h" "s" }
|
||||
{ "s" "d" }
|
||||
{ "d" "x" }
|
||||
{ "x" "a" }
|
||||
|
||||
{ "F" "'(1.17)F'(.855)" }
|
||||
}
|
||||
>>rules ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: main ( -- ) [ L-system abop-5-angular "L-system" open-window ] with-ui ;
|
||||
|
||||
MAIN: main
|
||||
|
||||
|
|
@ -0,0 +1,35 @@
|
|||
|
||||
USING: accessors ui L-system ;
|
||||
|
||||
IN: L-system.models.abop-5
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: abop-5 ( <L-system> -- <L-system> )
|
||||
|
||||
L-parser-dialect >>commands
|
||||
|
||||
[ 5 >>angle ] >>turtle-values
|
||||
|
||||
"a" >>axiom
|
||||
|
||||
{
|
||||
{ "a" "F[+(45)l][-(45)l]^;ca" }
|
||||
|
||||
{ "l" "j" }
|
||||
{ "j" "h" }
|
||||
{ "h" "s" }
|
||||
{ "s" "d" }
|
||||
{ "d" "x" }
|
||||
{ "x" "a" }
|
||||
|
||||
{ "F" "'(1.17)F'(.855)" }
|
||||
}
|
||||
>>rules ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: main ( -- ) [ L-system abop-5 "L-system" open-window ] with-ui ;
|
||||
|
||||
MAIN: main
|
||||
|
||||
|
|
@ -0,0 +1,34 @@
|
|||
|
||||
USING: accessors ui L-system ;
|
||||
|
||||
IN: L-system.models.abop-6
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: abop-6 ( <L-system> -- <L-system> )
|
||||
|
||||
L-parser-dialect >>commands
|
||||
|
||||
[ 5 >>angle ] >>turtle-values
|
||||
|
||||
! "&(90)+(90)FFF[-(120)'(.6)x][-(60)'(.8)x][+(120)'(.6)x][+(60)'(.8)x]x"
|
||||
"FFF[-(120)'(.6)x][-(60)'(.8)x][+(120)'(.6)x][+(60)'(.8)x]x"
|
||||
>>axiom
|
||||
|
||||
{
|
||||
{ "a" "F[cdx][cex]F!(.9)a" }
|
||||
{ "x" "a" }
|
||||
|
||||
{ "d" "+d" }
|
||||
{ "e" "-e" }
|
||||
|
||||
{ "F" "'(1.25)F'(.8)" }
|
||||
}
|
||||
>>rules ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: main ( -- ) [ L-system abop-6 "L-system" open-window ] with-ui ;
|
||||
|
||||
MAIN: main
|
||||
|
||||
|
|
@ -0,0 +1,52 @@
|
|||
|
||||
USING: accessors ui L-system ;
|
||||
|
||||
IN: L-system.models.airhorse
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: airhorse ( <L-system> -- <L-system> )
|
||||
|
||||
L-parser-dialect >>commands
|
||||
|
||||
[ 10 >>angle ] >>turtle-values
|
||||
|
||||
"C" >>axiom
|
||||
|
||||
{
|
||||
{ "C" "LBW" }
|
||||
|
||||
{ "B" "[[''aH]|[g]]" }
|
||||
{ "a" "Fs+;'a" }
|
||||
{ "g" "Ft+;'g" }
|
||||
{ "s" "[::cc!!!!&&[FFcccZ]^^^^FFcccZ]" }
|
||||
{ "t" "[c!!!!&[FF]^^FF]" }
|
||||
|
||||
{ "L" "O" }
|
||||
{ "O" "P" }
|
||||
{ "P" "Q" }
|
||||
{ "Q" "R" }
|
||||
{ "R" "U" }
|
||||
{ "U" "X" }
|
||||
{ "X" "Y" }
|
||||
{ "Y" "V" }
|
||||
{ "V" "[cc!!!&(90)[Zp]|[Zp]]" }
|
||||
{ "p" "h>(120)h>(120)h" }
|
||||
{ "h" "[+(40)!F'''p]" }
|
||||
|
||||
{ "H" "[cccci[>(50)dcFFF][<(50)ecFFF]]" }
|
||||
{ "d" "Z!&Z!&:'d" }
|
||||
{ "e" "Z!^Z!^:'e" }
|
||||
{ "i" "-:/i" }
|
||||
|
||||
{ "W" "[%[!!cb][<<<!!cb][>>>!!cb]]" }
|
||||
{ "b" "Fl!+Fl+;'b" }
|
||||
{ "l" "[-cc{--z++z++z--|--z++z++z}]" }
|
||||
}
|
||||
>>rules ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: main ( -- ) [ L-system airhorse "L-system" open-window ] with-ui ;
|
||||
|
||||
MAIN: main
|
||||
|
|
@ -0,0 +1,36 @@
|
|||
|
||||
USING: accessors ui L-system ;
|
||||
|
||||
IN: L-system.models.tree-5
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: tree-5 ( <L-system> -- <L-system> )
|
||||
|
||||
L-parser-dialect >>commands
|
||||
|
||||
[ 5 >>angle ] >>turtle-values
|
||||
|
||||
"c(4)FFS" >>axiom
|
||||
|
||||
{
|
||||
{ "S" "FFR>(60)R>(60)R>(60)R>(60)R>(60)R>(30)S" }
|
||||
{ "R" "[Ba]" }
|
||||
{ "a" "$tF[Cx]Fb" }
|
||||
{ "b" "$tF[Dy]Fa" }
|
||||
{ "B" "&B" }
|
||||
{ "C" "+C" }
|
||||
{ "D" "-D" }
|
||||
|
||||
{ "x" "a" }
|
||||
{ "y" "b" }
|
||||
|
||||
{ "F" "'(1.25)F'(.8)" }
|
||||
}
|
||||
>>rules ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: main ( -- ) [ L-system tree-5 "L-system" open-window ] with-ui ;
|
||||
|
||||
MAIN: main
|
||||
Loading…
Reference in New Issue