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