# Author: Malcolm Kesson (2007) proc getArrayValueOf { arrname param } { upvar $arrname arr if {[array exists arr] == 0} { return "" } else { return [lindex [array get arr $param] 1] } } proc generate { script } { upvar $script Script set gen [getArrayValueOf Script generations] set gen [expr int($gen)] set axiom [getArrayValueOf Script axiom] set rlist [getArrayValueOf Script rule] array set Rules $rlist set lstr $axiom # Loop over the generations_____________________ for {set j 0} {$j < $gen} {incr j} { set temp "" # Loop over each character in the sting_____________ for {set i 0} {$i < [string length $lstr]} {incr i} { set char [string index $lstr $i] set arrdata [array get Rules $char] # No rule, therefore, copy the char if {$arrdata == ""} { append temp $char } else { # arrdata example "G {1 ABC DEF}" # rchar is "G" # rdata is "1 ABC DEF" # rcode is "1" # rstr is "ABC DEF" or simply "ABC" if rcode is 0 set rchar [lindex $arrdata 0] set rdata [lindex $arrdata 1] set rcode [lindex $rdata 0] set rstr [lrange $rdata 1 end] if {$rcode == 0} { ;# regular append temp $rstr } elseif {$rcode == 1} { ;# random set count [llength $rstr] set rand_item [expr floor(rand() * $count)] set rand_item [expr int($rand_item)] append temp [lindex $rstr $rand_item] } elseif {$rcode == 2} { # use on last rewrite if {$j == $gen - 1} { #puts "last gen $rstr" append temp $rstr } } elseif {$rcode == 3} { # ignore on last rewrite if {$j < $gen - 1} { append temp $rstr } } } } set lstr $temp } return $lstr }