1 # vim: foldmarker=<<<,>>>
3 class tlc
::Stategate_target {
9 itk_option define
-stategate stateGate StateGate
""
10 itk_option define
-explain explain Explain
0
13 method attach_signal
{signal
{a_sense normal
}}
14 method detach_signal
{signal
}
16 method stategate_ref
{}
20 variable statechange_cb
{}
27 variable old_stategate
""
28 variable stategate_state
1
30 method stategate_update
{{newstate
""}}
31 method nasty_hack
{depth
}
36 configbody tlc
::Stategate_target::stategate { #<<<1
37 # puts stderr "$this -stategate: ($itk_option(-stategate))"
38 if {$old_stategate != ""} {
39 catch {$sg_gate detach_input
$old_stategate}
40 # catch {$itk_option(-stategate) detach_output [code $this stategate_update]}
43 if {$itk_option(-stategate) != ""} {
44 if {![$itk_option(-stategate) isa tlc
::Signal]} {
45 error "$itk_option(-stategate) is not a tlc::Gate"
48 $sg_gate attach_input
$itk_option(-stategate)
49 # $itk_option(-stategate) attach_output [code $this stategate_update]
52 set old_stategate
$itk_option(-stategate)
56 body tlc
::Stategate_target::constructor {} { #<<<1
59 tlc
::Gate #auto sg_gate -mode "and" -name "Stategate_target internal $itk_interior" -default 1
61 $sg_gate attach_output
[code
$this stategate_update
]
63 ttk
::frame $itk_interior.wf
64 pack $itk_interior.wf
-fill both
-expand true
65 set itk_interior
$itk_interior.wf
69 body tlc
::Stategate_target::destructor {} { #<<<1
70 if {$old_stategate != ""} {
71 # Our Gate dies, from going out of scope,
72 # so this should be taken care of by the Gate
73 # catch {$itk_option(-stategate) detach_output [code $this stategate_update]}
78 body tlc
::Stategate_target::stategate_update {{newstate
""}} { #<<<1
79 if {$newstate != ""} {
80 set stategate_state
$newstate
82 # puts stderr "$this stategate_update ($stategate_state)"
83 if {$itk_option(-explain)} {
84 puts stderr
[$sg_gate explain_txt
]
87 if {$stategate_state} {
88 configure
-state normal
89 foreach t
$bg_change {
90 $t configure
-background $::tlc::config(enabledbackground
)
92 foreach t
$fg_change {
93 $t configure
-foreground $::tlc::config(enabledforeground
)
96 configure
-state disabled
97 foreach t
$bg_change {
98 $t configure
-background $::tlc::config(disabledbackground
)
100 foreach t
$fg_change {
101 $t configure
-foreground $::tlc::config(disabledforeground
)
105 if {$statechange_cb != {}} {
106 uplevel #0 $statechange_cb [list $stategate_state]
111 body tlc
::Stategate_target::attach_signal {signal
{a_sense normal
}} { #<<<1
112 puts "Stategate_target::attach_signal: ($a_sense)"
113 $sg_gate attach_input
$signal $a_sense
117 body tlc
::Stategate_target::detach_signal {signal
} { #<<<1
118 $sg_gate detach_input
$signal
122 body tlc
::Stategate_target::explaingate {} { #<<<1
123 return [$sg_gate explain_txt
]
127 body tlc
::Stategate_target::stategate_ref {} { #<<<1
132 body tlc
::Stategate_target::nasty_hack {depth
} { #<<<1
135 stategate_update
[$sg_gate state
]
137 after idle
[code
$this nasty_hack
$depth]