scripts/stategate_target.itcl

   1 # vim: foldmarker=<<<,>>>
   2
   3 class tlc::Stategate_target {
   4         inherit itk::Widget
   5
   6         constructor {} {}
   7         destructor {}
   8
   9         itk_option define -stategate stateGate StateGate ""
  10         itk_option define -explain explain Explain 0
  11
  12         public {
  13                 method attach_signal {signal {a_sense normal}}
  14                 method detach_signal {signal}
  15                 method explaingate {}
  16                 method stategate_ref {}
  17         }
  18
  19         protected {
  20                 variable statechange_cb {}
  21                 variable bg_change {}
  22                 variable fg_change {}
  23         }
  24
  25         private {
  26                 variable sg_gate
  27                 variable old_stategate          ""
  28                 variable stategate_state        1
  29
  30                 method stategate_update {{newstate ""}}
  31                 method nasty_hack {depth}
  32         }
  33 }
  34
  35
  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]}
  41         }
  42
  43         if {$itk_option(-stategate) != ""} {
  44                 if {![$itk_option(-stategate) isa tlc::Signal]} {
  45                         error "$itk_option(-stategate) is not a tlc::Gate"
  46                 }
  47
  48                 $sg_gate attach_input $itk_option(-stategate)
  49 #               $itk_option(-stategate) attach_output [code $this stategate_update]
  50         }
  51
  52         set old_stategate       $itk_option(-stategate)
  53 }
  54
  55
  56 body tlc::Stategate_target::constructor {} { #<<<1
  57         itk_initialize
  58
  59         tlc::Gate #auto sg_gate -mode "and" -name "Stategate_target internal $itk_interior" -default 1
  60
  61         $sg_gate attach_output [code $this stategate_update]
  62         #nasty_hack 2
  63 }
  64
  65
  66 body tlc::Stategate_target::destructor {} { #<<<1
  67         if {$old_stategate != ""} {
  68                 # Our Gate dies, from going out of scope,
  69                 # so this should be taken care of by the Gate
  70 #               catch {$itk_option(-stategate) detach_output [code $this stategate_update]}
  71         }
  72 }
  73
  74
  75 body tlc::Stategate_target::stategate_update {{newstate ""}} { #<<<1
  76         if {$newstate != ""} {
  77                 set stategate_state     $newstate
  78         }
  79 #       puts stderr "$this stategate_update ($stategate_state)"
  80         if {$itk_option(-explain)} {
  81                 puts stderr [$sg_gate explain_txt]
  82         }
  83         catch {
  84                 if {$stategate_state} {
  85                         configure -state normal
  86                         foreach t $bg_change {
  87                                 $t configure -background $::tlc::config(enabledbackground)
  88                         }
  89                         foreach t $fg_change {
  90                                 $t configure -foreground $::tlc::config(enabledforeground)
  91                         }
  92                 } else {
  93                         configure -state disabled
  94                         foreach t $bg_change {
  95                                 $t configure -background $::tlc::config(disabledbackground)
  96                         }
  97                         foreach t $fg_change {
  98                                 $t configure -foreground $::tlc::config(disabledforeground)
  99                         }
 100                 }
 101         }
 102         if {$statechange_cb != {}} {
 103                 uplevel #0 $statechange_cb [list $stategate_state]
 104         }
 105 }
 106
 107
 108 body tlc::Stategate_target::attach_signal {signal {a_sense normal}} { #<<<1
 109         puts "Stategate_target::attach_signal: ($a_sense)"
 110         $sg_gate attach_input $signal $a_sense
 111 }
 112
 113
 114 body tlc::Stategate_target::detach_signal {signal} { #<<<1
 115         $sg_gate detach_input $signal
 116 }
 117
 118
 119 body tlc::Stategate_target::explaingate {} { #<<<1
 120         return [$sg_gate explain_txt]
 121 }
 122
 123
 124 body tlc::Stategate_target::stategate_ref {} { #<<<1
 125         return $sg_gate
 126 }
 127
 128
 129 body tlc::Stategate_target::nasty_hack {depth} { #<<<1
 130         incr depth -1
 131         if {$depth <= 0} {
 132                 stategate_update [$sg_gate state]
 133         } else {
 134                 after idle [code $this nasty_hack $depth]
 135         }
 136 }
 137
 138