Originally by Danny Dulai
http://www.ishiboo.com/~nirva/Projects/phasemachines/
. I've found phasemachines to be very useful. --
dnm #
# Commands added while inside phase machine:
#
# phase_go_cb <num>
# Returns a callback to the phase given by the number in the
# argument. The first phase is 0, the second is 1, etc...
#
# phase_prev_cb
# Just like phase_go_cb, but it always returns the callback
# to the previous phase
#
# phase_same_cb
# Just like phase_go_cb, but it always returns the callback
# to the current phase
#
# phase_next_cb
# Just like phase_go_cb, but it always returns the callback
# to the next phase
#
# phase_go <num> <args>
# equiv of doing: eval [phase_go_cb <num>] <args>
#
# phase_next <args>
# equiv of doing: eval [phase_next_cb] <args>
#
# phase_exit
# cleanup resources used by phase machine
#
#------------------------------------------------------------
#
# Simple Example:
#
# proc foo { name nextphase } {
# puts helu
# after 1000 "$nextphase yay$name"
# }
#
# phasemachine test { name } {
# foo $name [phase_next_cb]
# } { str } {
# puts $str
# phase_exit
# }
#
# test hrm
# vwait done
#
# Looping example:
#
# proc foo { name nextphase } {
# puts helu
# after 1000 "$nextphase yay$name"
# }
#
# phasemachine test { name num } {
# puts --inphase0:$name:$num
# foo $name [phase_next_cb]
#
# } { str } {
# puts --inphase1:$str
# foo $str [phase_next_cb]
#
# } { str } {
# puts --inphase2:$str
# puts helu
# after 1000
# phase_go 0 bar [expr $num + 1]
# }
#
#test hrm 0
#vwait done
#
#
#------------------------------------------------------------------------------
namespace eval ::phasemachine { set _id 0 }
proc ::phasemachine::fixvar { v } {
regsub {([^(]*)\(.*\)} $v {\1} var
return $var
}
proc ::phasemachine::__set { id arg } {
upvar ::phasemachine::${id}::funcs funcs
upvar ::phasemachine::${id}::state state
if {[llength $arg] < 1 || [llength $arg] > 2} {
error "wrong # args: should be \"set varName ?newValue?\""
return
}
namespace eval ::phasemachine::$id [list variable [fixvar [lindex $arg 0]]]
if {[llength $arg] == 1} {
namespace eval ::phasemachine::$id [list ::set [lindex $arg 0]]
} else {
namespace eval ::phasemachine::$id [list ::set [lindex $arg 0] [lindex $arg 1]]
}
}
proc ::phasemachine::__go_phase { id num args } {
upvar ::phasemachine::${id}::funcs funcs
upvar ::phasemachine::${id}::state state
set state $num
set num [expr $num * 2]
set a [lindex $funcs $num]
incr num
set f [lindex $funcs $num]
set i 0
foreach a2 $a {
set def 0
if {[llength $a2] != 1} {
set def 1
set a3 [lindex $a2 1]
set a2 [lindex $a2 0]
}
namespace eval ::phasemachine::$id [list variable [fixvar $a2]]
if {$def && $i >= [llength $args]} {
namespace eval ::phasemachine::$id [list ::set $a2 $a3]
} else {
namespace eval ::phasemachine::$id [list ::set $a2 [lindex $args $i]]
}
incr i
}
namespace eval ::phasemachine::$id [list eval $f]
}
proc phasemachine { funcname args } {
if {[llength $args] < 2 || [expr [llength $args] % 2] != 0} {
error {wrong # args: should be "phasemachine name args body [args body..]"}
}
proc $funcname args "
upvar ::phasemachine::_id id
incr id
namespace eval ::phasemachine::\$id {set state -1}
namespace eval ::phasemachine::\$id {set funcs [list $args]}
proc ::phasemachine::\${id}::phase_get_current { } \"return \\\$::phasemachine::\${id}::state\"
proc ::phasemachine::\${id}::phase_go { num args } \"eval \\\[phase_go_cb \\\$num\\\] \\\$args\"
proc ::phasemachine::\${id}::phase_next { args } \"eval \\\[phase_next_cb\\\] \\\$args\"
proc ::phasemachine::\${id}::phase_go_cb { num } \"return \\\[list ::phasemachine::__go_phase \$id \\\$num\\\]\"
proc ::phasemachine::\${id}::phase_prev_cb { } \"return \\\[list ::phasemachine::__go_phase \$id \\\[expr \\\$::phasemachine::\${id}::state - 1\\\]\\\]\"
proc ::phasemachine::\${id}::phase_same_cb { } \"return \\\[list ::phasemachine::__go_phase \$id \\\$::phasemachine::\${id}::state\\\]\"
proc ::phasemachine::\${id}::phase_next_cb { } \"return \\\[list ::phasemachine::__go_phase \$id \\\[expr \\\$::phasemachine::\${id}::state + 1\\\]\\\]\"
proc ::phasemachine::\${id}::set { args } \"return \\\[::phasemachine::__set \$id \\\$args\\\]\"
proc ::phasemachine::\${id}::phase_exit { } \"namespace delete ::phasemachine::\$id\"
eval \[::phasemachine::\${id}::phase_next_cb\] \$args
"
}
