scripts/stategate_target.itcl

   1 # vim: foldmarker=<<<,>>>
   2
   3 class tlc::Stategate_target {
   4         inherit tlc::TLCWidget
   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         ttk::frame $itk_interior.wf
  64         pack $itk_interior.wf -fill both -expand true
  65         set itk_interior $itk_interior.wf
  66 }
  67
  68
  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]}
  74         }
  75 }
  76
  77
  78 body tlc::Stategate_target::stategate_update {{newstate ""}} { #<<<1
  79         if {$newstate != ""} {
  80                 set stategate_state     $newstate
  81         }
  82 #       puts stderr "$this stategate_update ($stategate_state)"
  83         if {$itk_option(-explain)} {
  84                 puts stderr [$sg_gate explain_txt]
  85         }
  86         catch {
  87                 if {$stategate_state} {
  88                         configure -state normal
  89                         foreach t $bg_change {
  90                                 $t configure -background $::tlc::config(enabledbackground)
  91                         }
  92                         foreach t $fg_change {
  93                                 $t configure -foreground $::tlc::config(enabledforeground)
  94                         }
  95                 } else {
  96                         configure -state disabled
  97                         foreach t $bg_change {
  98                                 $t configure -background $::tlc::config(disabledbackground)
  99                         }
 100                         foreach t $fg_change {
 101                                 $t configure -foreground $::tlc::config(disabledforeground)
 102                         }
 103                 }
 104         }
 105         if {$statechange_cb != {}} {
 106                 uplevel #0 $statechange_cb [list $stategate_state]
 107         }
 108 }
 109
 110
 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
 114 }
 115
 116
 117 body tlc::Stategate_target::detach_signal {signal} { #<<<1
 118         $sg_gate detach_input $signal
 119 }
 120
 121
 122 body tlc::Stategate_target::explaingate {} { #<<<1
 123         return [$sg_gate explain_txt]
 124 }
 125
 126
 127 body tlc::Stategate_target::stategate_ref {} { #<<<1
 128         return $sg_gate
 129 }
 130
 131
 132 body tlc::Stategate_target::nasty_hack {depth} { #<<<1
 133         incr depth -1
 134         if {$depth <= 0} {
 135                 stategate_update [$sg_gate state]
 136         } else {
 137                 after idle [code $this nasty_hack $depth]
 138         }
 139 }
 140
 141