diff --git a/contrib/x11/examples/lindenmayer/README b/contrib/x11/examples/lindenmayer/README deleted file mode 100644 index 56ceaf57e3..0000000000 --- a/contrib/x11/examples/lindenmayer/README +++ /dev/null @@ -1,74 +0,0 @@ - ----------------------------------------------------------------------- -Install ----------------------------------------------------------------------- - -Load, compile and save your image: - - "load.factor" run-file save - ----------------------------------------------------------------------- -Usage ----------------------------------------------------------------------- - - USE: lindenmayer setup-window - -Towards the end of the "lindenmayer.factor" file, there are words for -various L-systems. Let's pick abop-1, which is an example from the -book The Algorithmic Beauty of Plants - - abop-1 - -Look at the axiom - - axiom get . - -And the productions - - rules get . - -The string to be interpreted is stored in the result variable. Start -off by calling init to copy the axiom to result - - init - -Look at result - - result get . - -It's just the axiom. Now iterate the string - - iterate - -You should see a branch and a leaf. Look at the result again: - - result get . - -Call iterate as many times as you want. :-) After about 4 iterations -the tree starts to grow beyond the edge of the window. Change the -point that the camera is looking at: - - { 0 0 3 } camera-focus set-global display - -You can also change where the camera is located: - - { 0 0 10 } camera-position set-global display - -Happy gardening - ----------------------------------------------------------------------- -See also ----------------------------------------------------------------------- - -The Algorithmic Beauty of Plants -by Przemyslaw Prusinkiewicz and Aristid Lindenmayer -Available online: http://algorithmicbotany.org/papers/abop/abop.pdf - -The Computational Beauty of Nature -Gary William Flake - -Algorithmic Botany at the University of Calgary -http://algorithmicbotany.org/ - -Laurens Lapre's Lparser -http://home.wanadoo.nl/laurens.lapre/lparser.html \ No newline at end of file diff --git a/contrib/x11/examples/lindenmayer/lindenmayer.factor b/contrib/x11/examples/lindenmayer/lindenmayer.factor deleted file mode 100644 index 769adc8d15..0000000000 --- a/contrib/x11/examples/lindenmayer/lindenmayer.factor +++ /dev/null @@ -1,610 +0,0 @@ -! Eduardo Cavazos - wayo.cavazos@gmail.com - -REQUIRES: contrib/math contrib/vars contrib/slate ; - -USING: kernel alien namespaces arrays vectors math opengl math-contrib - parser sequences hashtables strings vars slate ; - -IN: lindenmayer - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: make-matrix >r { } make r> group ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: RU ( angle -- RU ) deg>rad -[ dup cos , dup sin , 0 , - dup sin neg , dup cos , 0 , - 0 , 0 , 1 , ] 3 make-matrix nip ; - -: RL ( angle -- RL ) deg>rad -[ dup cos , 0 , dup sin neg , - 0 , 1 , 0 , - dup sin , 0 , dup cos , ] 3 make-matrix nip ; - -: RH ( angle -- RH ) deg>rad -[ 1 , 0 , 0 , - 0 , dup cos , dup sin neg , - 0 , dup sin , dup cos , ] 3 make-matrix nip ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYMBOL: position -SYMBOL: orientation - -: rotate-U ( angle -- ) RU orientation get swap m. orientation set ; -: rotate-L ( angle -- ) RL orientation get swap m. orientation set ; -: rotate-H ( angle -- ) RH orientation get swap m. orientation set ; - -: step ( length -- ) ->r position get orientation get 0 0 r> 3array m.v v+ position set ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! : record-vertex ( -- ) position get first3 glVertex3f ; - -: record-vertex ( -- ) position get gl-vertex ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: rotate-z rotate-U ; -: rotate-y neg rotate-L ; -: rotate-x neg rotate-H ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: reset ( -- ) { 0 0 0 } position set 3 identity-matrix orientation set ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -USE: sequences : length* length ; USE: lindenmayer - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -DEFER: polygon-vertex - -! : draw-forward ( length -- ) -! GL_LINES glBegin record-vertex step record-vertex glEnd ; - -: draw-forward ( length -- ) -GL_LINES gl-begin -record-vertex -step -record-vertex -gl-end ; - -: move-forward ( length -- ) step polygon-vertex ; - -: sneak-forward ( length -- ) step ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! (v0 - v1) x (v1 - v2) - -: polygon-normal ( { v0 v1 v2 } -- normal ) -0 over nth over 1 swap nth v- swap -1 over nth swap 2 swap nth v- cross ; - -! Test and replace with: -! -! : v0-v1 ( { v0 v1 v2 } -- vec ) first2 v- ; -! -! : v1-v2 ( { v0 v1 v2 } -- vec ) first3 v- nip ; -! -! : polygon-normal ( { v0 v1 v2 } -- normal ) dup v0-v1 swap v1-v2 cross ; - -! : polygon ( vertices -- ) -! GL_POLYGON glBegin dup polygon-normal first3 glNormal3f -! [ first3 glVertex3f ] each glEnd ; - -! : polygon ( vertices -- ) -! dup length* 3 >= -! [ GL_POLYGON glBegin dup polygon-normal first3 glNormal3f -! [ first3 glVertex3f ] each glEnd ] -! [ drop ] -! if ; - -: (polygon) ( vertices -- ) -GL_POLYGON gl-begin -dup polygon-normal gl-normal -[ gl-vertex ] each -gl-end ; - -: polygon ( vertices -- ) dup length* 3 >= [ (polygon) ] [ drop ] if ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! Maybe use an array instead of a vector - -SYMBOL: vertices - -! V{ } vertices set-global - -: start-polygon ( -- ) 0 vertices set ; - -: finish-polygon ( -- ) vertices get polygon ; - -: polygon-vertex ( -- ) position get vertices get push ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! : setup-variables ( -- ) -! V{ } vertices set ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! How $ works: - -! V x H -! L = ------- -! |V x H| - -! V : direction opposite to gravity - -: V ( -- ) { 0 1 0 } ; - -: H ( -- ) orientation get [ first ] map ; -: L ( -- ) orientation get [ second ] map ; -: U ( -- ) orientation get [ third ] map ; - -: set-H ( { a b c } -- ) orientation get [ 0 swap set-nth ] 2each ; -: set-L ( { a b c } -- ) orientation get [ 1 swap set-nth ] 2each ; -: set-U ( { a b c } -- ) orientation get [ 2 swap set-nth ] 2each ; - -: roll-until-horizontal ( -- ) V H cross dup norm v/n set-L ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! Lindenmayer string rewriting -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! Maybe use an array instead of a quot in the work of segment - -SYMBOL: rules - -: segment ( str -- seq ) -{ { [ dup "" = ] [ drop [ ] ] } - { [ dup length* 1 = ] [ unit ] } - { [ 1 over nth CHAR: ( = ] - [ CHAR: ) over index 1 + ! str i - 2dup head ! str i head - -rot tail ! head tail - segment swap add* ] } - { [ t ] [ dup 1 head swap 1 tail segment swap add* ] } } -cond ; - -: lookup ( str -- str ) dup 1 head rules get hash dup [ nip ] [ drop ] if ; - -: rewrite ( str -- str ) segment [ lookup ] map concat ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! Lindenmayer string interpretation -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! peek is the same as last - -: last ( seq -- [ last-item ] ) dup length* 1- tail ; - -SYMBOL: command-table - -: segment-command ( seg -- command ) 1 head ; - -: segment-parameter ( seg -- parameter ) -dup length* 1 - 2 swap rot subseq parse call ; - -: segment-parts ( seg -- param command ) -dup segment-parameter swap segment-command ; - -: exec-command ( str -- ) command-table get hash dup [ call ] [ drop ] if ; - -: exec-command-with-param ( param command -- ) -command-table get hash dup [ last call ] [ 2drop ] if ; - -: (interpret) ( seg -- ) -dup length* 1 = -[ exec-command ] [ segment-parts exec-command-with-param ] if ; - -: interpret ( str -- ) segment [ (interpret) ] each ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! Lparser dialect -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYMBOL: angle -SYMBOL: length -SYMBOL: thickness -VAR: color-index - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -DEFER: set-thickness -DEFER: set-color-index - -TUPLE: state position orientation angle length thickness color-index ; - -! SYMBOL: states V{ } states set-global - -SYMBOL: states - -: save-state ( -- ) -position get orientation get angle get length get thickness get -color-index get -states get push ; - -: restore-state ( -- ) -states get pop -dup state-position position set -dup state-orientation orientation set -dup state-length length set -dup state-angle angle set -dup state-color-index set-color-index -dup state-thickness set-thickness -drop ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: scale-length ( m -- ) length get * length set ; - -: scale-angle ( m -- ) angle get * angle set ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -VAR: color-table - -! : setup-color-table ( -- ) -! { { 0 0 0 } ! black -! { 0.5 0.5 0.5 } ! grey -! { 1 0 0 } ! red -! { 1 1 0 } ! yellow -! { 0 1 0 } ! green -! { 0.25 0.88 0.82 } ! turquoise -! { 0 0 1 } ! blue -! { 0.63 0.13 0.94 } ! purple -! { 0.00 0.50 0.00 } ! dark green -! { 0.00 0.82 0.82 } ! dark turquoise -! { 0.00 0.00 0.50 } ! dark blue -! { 0.58 0.00 0.82 } ! dark purple -! { 0.50 0.00 0.00 } ! dark red -! { 0.25 0.25 0.25 } ! dark grey -! { 0.75 0.75 0.75 } ! medium grey -! { 1 1 1 } ! white -! } color-table set ; - -: setup-color-table ( -- ) -{ { 0 0 0 } ! black - { 0.5 0.5 0.5 } ! grey - { 1 0 0 } ! red - { 1 1 0 } ! yellow - { 0 1 0 } ! green - { 0.25 0.88 0.82 } ! turquoise - { 0 0 1 } ! blue - { 0.63 0.13 0.94 } ! purple - { 0.00 0.50 0.00 } ! dark green - { 0.00 0.82 0.82 } ! dark turquoise - { 0.00 0.00 0.50 } ! dark blue - { 0.58 0.00 0.82 } ! dark purple - { 0.50 0.00 0.00 } ! dark red - { 0.25 0.25 0.25 } ! dark grey - { 0.75 0.75 0.75 } ! medium grey - { 1 1 1 } ! white -} [ 1 set-color-alpha ] map color-table set ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! Use the one in contrib/alien - -USE: sequences - -: >float-array ( seq -- ) -dup length "float" swap dup length >array -[ pick set-float-nth ] 2each ; - -USE: lindenmayer - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! : material-color ( r g b -- ) -! 3array 1.0 add >float-array -! GL_FRONT_AND_BACK GL_AMBIENT_AND_DIFFUSE rot glMaterialfv ; - -! : set-color-index ( i -- ) -! dup color-index set color-table get nth dup -! first3 glColor3f first3 material-color ; - -: material-color ( color -- ) -GL_FRONT_AND_BACK GL_AMBIENT_AND_DIFFUSE rot gl-material-fv ; - -: set-color-index ( i -- ) -dup >color-index color-table> nth dup gl-color material-color ; - -: inc-color-index ( -- ) color-index get 1 + set-color-index ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! : set-thickness ( i -- ) dup thickness set glLineWidth ; - -: set-thickness ( i -- ) dup thickness set gl-line-width ; - -: scale-thickness ( m -- ) thickness get * 0.5 max set-thickness ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: -rotate-y neg rotate-y ; -: -rotate-x neg rotate-x ; -: -rotate-z neg rotate-z ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: setup-variables ( -- ) -V{ } clone vertices set V{ } clone states set setup-color-table ; - -! The call to setup-variables in lparser-dialect should probably go -! somewhere else. The variables that setup-variables sets up are -! related to interpretation of lsystem strings as opposed to the -! lsystem itself. - -: lparser-dialect ( -- ) - -setup-variables - -1 length set 45 angle set 1 thickness set 2 set-color-index - -H{ { "+" [ angle get rotate-y ] } - { "-" [ angle get -rotate-y ] } - { "&" [ angle get rotate-x ] } - { "^" [ angle get -rotate-x ] } - { "<" [ angle get rotate-z ] } - { ">" [ angle get -rotate-z ] } - - { "|" [ 180.0 rotate-y ] } - { "%" [ 180.0 rotate-z ] } - { "$" [ roll-until-horizontal ] } - - { "F" [ length get draw-forward ] } - { "Z" [ length get 2 / draw-forward ] } - { "f" [ length get move-forward ] } - { "z" [ length get 2 / move-forward ] } - { "g" [ length get sneak-forward ] } - { "." [ polygon-vertex ] } - - { "[" [ save-state ] } - { "]" [ restore-state ] } - { "{" [ 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" [ color-index get 1 + color-table get length* mod set-color-index ] } - -} command-table set ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! Examples -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYMBOL: axiom -SYMBOL: result - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: koch ( -- ) lparser-dialect 90 angle set - -H{ { "K" "[[a|b] '(0.41)f'(2.439) |<(60) [a|b]]" } - { "k" "[ c'(0.5) K]" } - { "a" "[d <(120) d <(120) d ]" } - { "b" "e" } - { "e" "[^ '(.2887)f'(3.4758) &(180) +z{.-(120)f-(120)f}]" } - { "d" "[^ '(.2887)f'(3.4758) &(109.5111) +zk{.-(120)f-(120)f}]" } -} rules set - -"K" axiom set ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: spiral-0 ( -- ) lparser-dialect 10 angle set 5 thickness set - -"[P]|[P]" axiom set - -H{ { "P" "[A]>>>>>>>>>[cB]>>>>>>>>>[ccC]>>>>>>>>>[cccD]" } - { "A" "F+;'A" } - { "B" "F!+F+;'B" } - { "C" "F!^+F^+;'C" } - { "D" "F!>^+F>^+;'D" } -} rules set ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: tree-5 ( -- ) lparser-dialect 5 angle set 1 thickness set - -"c(4)FFS" axiom set - -H{ { "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 set ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: abop-1 ( -- ) lparser-dialect 45 angle set 5 set-thickness - -H{ { "A" "F[&'(.8)!BL]>(137)'!(.9)A" } - { "B" "F[-'(.8)!(.9)$CL]'!(.9)C" } - { "C" "F[+'(.8)!(.9)$BL]'!(.9)B" } - - { "L" "~c(8){+(30)f-(120)f-(120)f}" } -} rules set - -"c(12)FFAL" axiom set ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: abop-2 ( -- ) lparser-dialect 30 angle set 5 thickness set - -H{ { "A" "F[&'(.7)!BL]>(137)[&'(.6)!BL]>(137)'(.9)!(.9)A" } - { "B" "F[-'(.7)!(.9)$CL]'(.9)!(.9)C" } - { "C" "F[+'(.7)!(.9)$BL]'(.9)!(.9)B" } - - { "L" "~c(8){+(45)f(.1)-(45)f(.1)-(45)f(.1)+(45)|+(45)f(.1)-(45)f(.1)-(45)f(.1)}" } - -} rules set - -"c(12)FAL" axiom set ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: abop-3 ( -- ) lparser-dialect 30 angle set 5 thickness set - -H{ { "A" "!(.9)t(.4)FB>(94)B>(132)B" } - { "B" "[&t(.4)F$A]" } - { "F" "'(1.25)F'(.8)" } -} rules set - -"c(12)FA" axiom set ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: abop-4 ( -- ) lparser-dialect 18 angle set 5 thickness set - -H{ { "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 set - -"c(12)&(20)N" axiom set ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: abop-5 ( -- ) lparser-dialect 5 angle set 5 thickness set - -H{ { "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 set - -"&(90)+(90)a" axiom set ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: abop-6 ( -- ) lparser-dialect 5 angle set 5 thickness set - -"&(90)+(90)FFF[-(120)'(.6)x][-(60)'(.8)x][+(120)'(.6)x][+(60)'(.8)x]x" -axiom set - -H{ { "a" "F[cdx][cex]F!(.9)a" } - { "x" "a" } - - { "d" "+d" } - { "e" "-e" } - - { "F" "'(1.25)F'(.8)" } -} rules set ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: airhorse ( -- ) lparser-dialect 10 angle set 5 thickness set - -"C" axiom set - -H{ { "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 set ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! These should be moved into a separate file. They are used to pretty -! print matricies and vectors. - -USING: styles prettyprint io ; - -: decimal-places ( n d -- n ) -10 swap ^ tuck * >fixnum swap /f ; - -! : .mat ( matrix -- ) [ [ 2 decimal-places ] map ] map . ; - -: .mat ( matrix -- ) -H{ { table-gap 4 } { table-border 4 } } -[ 2 decimal-places pprint ] -tabular-output ; - -: .vec ( vector -- ) [ 2 decimal-places ] map . ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -PROVIDE: lindenmayer ; - -! USING: slate lindenmayer ; - -! new-slate drop reset \ No newline at end of file diff --git a/contrib/x11/examples/lindenmayer/load.factor b/contrib/x11/examples/lindenmayer/load.factor deleted file mode 100644 index 21917362e1..0000000000 --- a/contrib/x11/examples/lindenmayer/load.factor +++ /dev/null @@ -1,6 +0,0 @@ -USING: parser modules ; - -{ - "resource:contrib/x11/examples/lindenmayer/lindenmayer.factor" - "resource:contrib/x11/examples/lindenmayer/viewer.factor" -} run-files \ No newline at end of file diff --git a/contrib/x11/examples/lindenmayer/viewer.factor b/contrib/x11/examples/lindenmayer/viewer.factor deleted file mode 100644 index c738e85292..0000000000 --- a/contrib/x11/examples/lindenmayer/viewer.factor +++ /dev/null @@ -1,74 +0,0 @@ -USING: kernel alien math arrays sequences opengl namespaces concurrency -x11 x gl concurrent-widgets lindenmayer ; - -IN: lindenmayer - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -USE: sequences - -: >float-array ( seq -- ) -dup length "float" swap dup length >array -[ pick set-float-nth ] 2each ; - -USE: lindenmayer - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -SYMBOL: camera-position { 5 5 5 } camera-position set-global -SYMBOL: camera-focus { 0 0 0 } camera-focus set-global -SYMBOL: camera-up { 0 1 0 } camera-up set-global - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -lparser-dialect "" result set-global - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: display ( -- ) -GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear -glLoadIdentity -camera-position get first3 camera-focus get first3 camera-up get first3 -gluLookAt -reset result get save-state interpret restore-state glFlush ; - -: reshape ( { width height } -- ) ->r 0 0 r> [ ] each glViewport -GL_PROJECTION glMatrixMode -glLoadIdentity -1.0 1.0 -1.0 1.0 1.5 200.0 glFrustum -GL_MODELVIEW glMatrixMode -display ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: init ( -- ) axiom get result set display ; - -: iterate ( -- ) result [ rewrite ] change display ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: setup-window ( -- ) - -f initialize-x - -create-pwindow -[ drop reshape ] over set-pwindow-resize-action -[ 2drop display ] over set-pwindow-expose-action -window-id win set -ExposureMask StructureNotifyMask bitor select-input -{ 500 500 } resize-window { 0 0 } move-window map-window - -[ GLX_RGBA ] choose-visual create-context make-current - -0.0 0.0 0.0 0.0 glClearColor -GL_SMOOTH glShadeModel - -GL_FRONT_AND_BACK GL_SPECULAR { 1.0 1.0 1.0 1.0 } >float-array glMaterialfv -GL_FRONT_AND_BACK GL_SHININESS { 50.0 } >float-array glMaterialfv -GL_LIGHT0 GL_POSITION { 1.0 1.0 1.0 0.0 } >float-array glLightfv - -GL_LIGHTING glEnable -GL_LIGHT0 glEnable -GL_DEPTH_TEST glEnable - -[ concurrent-event-loop ] spawn ; \ No newline at end of file