Refactor lsys string rewriting and interpretation
Eduardo Cavazos
parent
b7be5d1750
commit
03a01984dd
|
|
@ -0,0 +1,35 @@
|
|||
|
||||
USING: kernel sequences quotations assocs math math.parser
|
||||
combinators.lib vars lsys.strings ;
|
||||
|
||||
IN: lsys.strings.interpret
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
VAR: command-table
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: exec-command ( string -- ) command-table> at >quotation call ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: command ( string -- command ) 1 head ;
|
||||
|
||||
: parameter ( string -- parameter )
|
||||
[ drop 2 ] [ length 1- ] [ ] tri subseq string>number ;
|
||||
|
||||
: exec-command* ( string -- )
|
||||
[ parameter ] [ command ] bi
|
||||
command-table> at dup
|
||||
[ 1 tail* call ] [ 3drop ] if ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: (interpret) ( slice -- )
|
||||
{ { [ empty? ] [ drop ] }
|
||||
{ [ has-param? ] [ next+rest* [ exec-command* ] [ (interpret) ] bi* ] }
|
||||
{ [ t ] [ next+rest [ exec-command ] [ (interpret) ] bi* ] } }
|
||||
switch ;
|
||||
|
||||
: interpret ( string -- ) <flat-slice> (interpret) ;
|
||||
|
|
@ -0,0 +1,36 @@
|
|||
|
||||
USING: kernel sbufs strings sequences assocs math
|
||||
combinators.lib vars lsys.strings ;
|
||||
|
||||
IN: lsys.strings.rewrite
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
VAR: rules
|
||||
|
||||
: lookup ( str -- str ) [ 1 head rules> at ] [ ] bi or ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
VAR: accum
|
||||
|
||||
: push-next ( next -- ) lookup accum> push-all ;
|
||||
|
||||
: (rewrite) ( slice -- )
|
||||
{ { [ empty? ] [ drop ] }
|
||||
{ [ has-param? ] [ next+rest* [ push-next ] [ (rewrite) ] bi* ] }
|
||||
{ [ t ] [ next+rest [ push-next ] [ (rewrite) ] bi* ] } }
|
||||
switch ;
|
||||
|
||||
: rewrite ( string -- string )
|
||||
dup length 10 * <sbuf> >accum
|
||||
<flat-slice> (rewrite)
|
||||
accum> >string ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
VAR: result
|
||||
|
||||
: iterate ( -- ) result> rewrite >result ;
|
||||
|
||||
: iterations ( n -- ) [ iterate ] times ;
|
||||
|
|
@ -1,60 +1,14 @@
|
|||
|
||||
USING: kernel combinators math math.parser assocs sequences quotations vars ;
|
||||
USING: kernel sequences math combinators.lib ;
|
||||
|
||||
IN: lsys.strings
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
! Lindenmayer string rewriting
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
! Maybe use an array instead of a quot in the work of segment
|
||||
: has-param? ( slice -- ? ) { [ length 1 > ] [ second CHAR: ( = ] } <-&& ;
|
||||
|
||||
VAR: rules
|
||||
: next+rest ( slice -- next rest ) [ 1 head ] [ 1 tail-slice ] bi ;
|
||||
|
||||
: segment ( str -- seq )
|
||||
{ { [ dup "" = ] [ drop [ ] ] }
|
||||
{ [ dup length 1 = ] [ 1quotation ] }
|
||||
{ [ 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 ;
|
||||
: index-rest ( slice -- i ) CHAR: ) swap index 1+ ;
|
||||
|
||||
: lookup ( str -- str ) dup 1 head rules> at dup [ nip ] [ drop ] if ;
|
||||
|
||||
: rewrite ( str -- str ) segment [ lookup ] map concat ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
VAR: result
|
||||
|
||||
: iterate ( -- ) result> rewrite >result ;
|
||||
|
||||
: iterations ( n -- ) [ iterate ] times ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
! Lindenmayer string interpretation
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
VAR: command-table
|
||||
|
||||
: segment-command ( seg -- command ) 1 head ;
|
||||
|
||||
: segment-parameter ( seg -- parameter )
|
||||
dup length 1 - 2 swap rot subseq string>number ;
|
||||
|
||||
: segment-parts ( seg -- param command )
|
||||
dup segment-parameter swap segment-command ;
|
||||
|
||||
: exec-command ( str -- ) command-table> at dup [ call ] [ drop ] if ;
|
||||
|
||||
: exec-command-with-param ( param command -- )
|
||||
command-table> at dup [ peek 1quotation call ] [ 2drop ] if ;
|
||||
|
||||
: (interpret) ( seg -- )
|
||||
dup length 1 =
|
||||
[ exec-command ] [ segment-parts exec-command-with-param ] if ;
|
||||
|
||||
: interpret ( str -- ) segment [ (interpret) ] each ;
|
||||
: next+rest* ( slice -- next rest ) dup index-rest [ head ] [ tail-slice ] 2bi ;
|
||||
|
|
|
|||
|
|
@ -1,7 +1,10 @@
|
|||
|
||||
USING: kernel math vectors sequences opengl.gl math.vectors
|
||||
math.matrices vars opengl self pos ori turtle lsys.tortoise
|
||||
lsys.strings ;
|
||||
math.matrices vars opengl self pos ori turtle lsys.tortoise
|
||||
|
||||
lsys.strings.interpret ;
|
||||
|
||||
! lsys.strings
|
||||
|
||||
IN: lsys.tortoise.graphics
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue