Refactor lsys string rewriting and interpretation

release
Eduardo Cavazos 2007-10-11 14:14:12 -05:00
parent b7be5d1750
commit 03a01984dd
4 changed files with 81 additions and 53 deletions

View File

@ -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) ;

View File

@ -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 ;

View File

@ -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 ;

View File

@ -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