From 28bdbf8a2c7367e29bfcaa2c7f97a92b501a5837 Mon Sep 17 00:00:00 2001 From: Alexander Iljin Date: Tue, 4 Aug 2020 09:42:12 +0200 Subject: [PATCH] L-system: resurrect from unmaintained to extra --- extra/L-system/L-system.factor | 511 ++++++++++++++++++ extra/L-system/models/abop-1/abop-1.factor | 27 + extra/L-system/models/abop-2/abop-2.factor | 31 ++ extra/L-system/models/abop-3/abop-3.factor | 27 + extra/L-system/models/abop-4/abop-4.factor | 56 ++ .../abop-5-angular/abop-5-angular.factor | 33 ++ extra/L-system/models/abop-5/abop-5.factor | 35 ++ extra/L-system/models/abop-6/abop-6.factor | 34 ++ .../L-system/models/airhorse/airhorse.factor | 52 ++ extra/L-system/models/tree-5/tree-5.factor | 36 ++ 10 files changed, 842 insertions(+) create mode 100644 extra/L-system/L-system.factor create mode 100644 extra/L-system/models/abop-1/abop-1.factor create mode 100644 extra/L-system/models/abop-2/abop-2.factor create mode 100644 extra/L-system/models/abop-3/abop-3.factor create mode 100644 extra/L-system/models/abop-4/abop-4.factor create mode 100644 extra/L-system/models/abop-5-angular/abop-5-angular.factor create mode 100644 extra/L-system/models/abop-5/abop-5.factor create mode 100644 extra/L-system/models/abop-6/abop-6.factor create mode 100644 extra/L-system/models/airhorse/airhorse.factor create mode 100644 extra/L-system/models/tree-5/tree-5.factor diff --git a/extra/L-system/L-system.factor b/extra/L-system/L-system.factor new file mode 100644 index 0000000000..cc91042d21 --- /dev/null +++ b/extra/L-system/L-system.factor @@ -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: 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 ) 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: < 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 * ] | + + 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:: 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:: graft* ( L-SYSTEM -- ) + + L-SYSTEM find-gl-context + + 1 glGenLists L-SYSTEM display-list<< ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +M:: pref-dim* ( L-SYSTEM -- dim ) { 400 400 } ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: with-camera ( L-SYSTEM QUOT -- ) + L-SYSTEM camera>> QUOT call drop + L-SYSTEM relayout-1 ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + +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 ) + + 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" diff --git a/extra/L-system/models/abop-1/abop-1.factor b/extra/L-system/models/abop-1/abop-1.factor new file mode 100644 index 0000000000..34f1d4777a --- /dev/null +++ b/extra/L-system/models/abop-1/abop-1.factor @@ -0,0 +1,27 @@ + +USING: accessors ui L-system ; + +IN: L-system.models.abop-1 + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: abop-1 ( -- ) + + 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 diff --git a/extra/L-system/models/abop-2/abop-2.factor b/extra/L-system/models/abop-2/abop-2.factor new file mode 100644 index 0000000000..1168780300 --- /dev/null +++ b/extra/L-system/models/abop-2/abop-2.factor @@ -0,0 +1,31 @@ + +USING: accessors ui L-system ; + +IN: L-system.models.abop-2 + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: abop-2 ( -- ) + + 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 diff --git a/extra/L-system/models/abop-3/abop-3.factor b/extra/L-system/models/abop-3/abop-3.factor new file mode 100644 index 0000000000..f594cafcd3 --- /dev/null +++ b/extra/L-system/models/abop-3/abop-3.factor @@ -0,0 +1,27 @@ + +USING: accessors ui L-system ; + +IN: L-system.models.abop-3 + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: abop-3 ( -- ) + + 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 diff --git a/extra/L-system/models/abop-4/abop-4.factor b/extra/L-system/models/abop-4/abop-4.factor new file mode 100644 index 0000000000..71cf32d4d7 --- /dev/null +++ b/extra/L-system/models/abop-4/abop-4.factor @@ -0,0 +1,56 @@ + +USING: accessors ui L-system ; + +IN: L-system.models.abop-4 + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: abop-4 ( -- ) + + 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 diff --git a/extra/L-system/models/abop-5-angular/abop-5-angular.factor b/extra/L-system/models/abop-5-angular/abop-5-angular.factor new file mode 100644 index 0000000000..9e78258d89 --- /dev/null +++ b/extra/L-system/models/abop-5-angular/abop-5-angular.factor @@ -0,0 +1,33 @@ + +USING: accessors ui L-system ; + +IN: L-system.models.abop-5-angular + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: abop-5-angular ( -- ) + + 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 + diff --git a/extra/L-system/models/abop-5/abop-5.factor b/extra/L-system/models/abop-5/abop-5.factor new file mode 100644 index 0000000000..73dc13d44e --- /dev/null +++ b/extra/L-system/models/abop-5/abop-5.factor @@ -0,0 +1,35 @@ + +USING: accessors ui L-system ; + +IN: L-system.models.abop-5 + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: abop-5 ( -- ) + + 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 + diff --git a/extra/L-system/models/abop-6/abop-6.factor b/extra/L-system/models/abop-6/abop-6.factor new file mode 100644 index 0000000000..79680bdbe4 --- /dev/null +++ b/extra/L-system/models/abop-6/abop-6.factor @@ -0,0 +1,34 @@ + +USING: accessors ui L-system ; + +IN: L-system.models.abop-6 + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: abop-6 ( -- ) + + 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 + diff --git a/extra/L-system/models/airhorse/airhorse.factor b/extra/L-system/models/airhorse/airhorse.factor new file mode 100644 index 0000000000..07f4224155 --- /dev/null +++ b/extra/L-system/models/airhorse/airhorse.factor @@ -0,0 +1,52 @@ + +USING: accessors ui L-system ; + +IN: L-system.models.airhorse + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: airhorse ( -- ) + + 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]]" } + { "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 diff --git a/extra/L-system/models/tree-5/tree-5.factor b/extra/L-system/models/tree-5/tree-5.factor new file mode 100644 index 0000000000..d4026ef069 --- /dev/null +++ b/extra/L-system/models/tree-5/tree-5.factor @@ -0,0 +1,36 @@ + +USING: accessors ui L-system ; + +IN: L-system.models.tree-5 + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: tree-5 ( -- ) + + 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