# 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
}