scripts/gate.itcl

   1 # vim: foldmarker=<<<,>>>
   2
   3 class tlc::Gate {
   4         inherit tlc::Signal
   5
   6         constructor {accessvar args} {
   7                 upvar $accessvar scopevar
   8                 eval tlc::Signal::constructor scopevar
   9         } {}
  10         destructor {}
  11
  12         public {
  13                 variable mode           "or"
  14                 variable default        0
  15
  16                 method attach_input {gate_obj {a_sense normal}}
  17                 method detach_input {gate_obj}
  18                 method detach_all_inputs {}
  19
  20                 method attach_var_input {varname {a_sense normal}}
  21                 method detach_var_input {varname}
  22
  23                 method explain_state {}
  24                 method explain_txt {{depth 0}}
  25         }
  26
  27         protected {
  28                 variable inputs
  29                 variable sense
  30                 variable var_inputs             {}
  31                 variable isvar
  32
  33                 method calc_o_state {}
  34                 method input_update {gate_obj state}
  35                 method var_input_update {varname n1 n2 op}
  36                 method cleanup {gate_obj}
  37         }
  38 }
  39
  40
  41 configbody tlc::Gate::default { #<<<1
  42         calc_o_state
  43 }
  44
  45
  46 configbody tlc::Gate::mode { #<<<1
  47         switch [string tolower $mode] {
  48                 "and" -
  49                 "nand" -
  50                 "nor" -
  51                 "or" {
  52                         calc_o_state
  53                 }
  54
  55                 default {
  56                         error "Invalid mode specified.  Must be one of and, or"
  57                 }
  58         }
  59 }
  60
  61
  62 body tlc::Gate::constructor {accessvar args} { #<<<1
  63         array set inputs {}
  64         array set sense {}
  65         array set isvar {}
  66
  67         eval configure $args
  68 }
  69
  70
  71 body tlc::Gate::destructor {} { #<<<1
  72         foreach var_input $var_inputs {
  73                 detach_var_input $var_input
  74         }
  75         foreach input [array names inputs] {
  76                 catch {
  77                         if {[$input isa tlc::Signal]} {
  78                                 $input detach_output [code $this input_update $input]
  79                         }
  80                 }
  81         }
  82 }
  83
  84
  85 body tlc::Gate::attach_input {gate_obj {a_sense normal}} { #<<<1
  86         if {![$gate_obj isa tlc::Signal]} {
  87                 error "$gate_obj isn't a tlc::Gate"
  88         }
  89
  90         #$gate_obj register_handler debug [code $this debug]
  91         set sense($gate_obj)    [expr {$a_sense != "normal"}]
  92
  93         return [$gate_obj attach_output [code $this input_update $gate_obj] \
  94                         [code $this cleanup $gate_obj]]
  95 }
  96
  97
  98 body tlc::Gate::detach_input {gate_obj} { #<<<1
  99         if {![$gate_obj isa tlc::Signal]} {
 100                 error "$gate_obj isn't a tlc::Gate"
 101         }
 102
 103         debug debug "tlc::Gate::detach_input ($this): ($gate_obj)"
 104
 105         set ok  [catch {unset inputs($gate_obj)} msg]
 106         catch {unset sense($gate_obj)}
 107
 108         $gate_obj detach_output [code $this input_update $gate_obj]
 109
 110         calc_o_state
 111 }
 112
 113
 114 body tlc::Gate::detach_all_inputs {} { #<<<1
 115         foreach vinput $var_inputs {
 116                 detach_var_input $vinput
 117         }
 118         foreach gate_obj [array names inputs] {
 119                 detach_input $gate_obj
 120         }
 121 }
 122
 123
 124 body tlc::Gate::attach_var_input {varname {a_sense normal}} { #<<<1
 125         set idx         [lsearch $var_inputs $varname]
 126         if {$idx == -1} {
 127                 lappend var_inputs      $varname
 128         }
 129         set isvar(${this}::$varname)    $varname
 130         set sense(${this}::$varname)    [expr {$a_sense == "inverted"}]
 131         trace variable $varname wu [code $this var_input_update $varname]
 132
 133         var_input_update $varname $varname "" w
 134 #       tlc::Watchvar $this::$varname -varname $varname \
 135 #                       -state_cb [code $this input_update $this::$varname]
 136 }
 137
 138
 139 body tlc::Gate::detach_var_input {varname} { #<<<1
 140         set idx                 [lsearch $var_inputs $varname]
 141         set var_inputs  [lreplace $var_inputs $idx $idx]
 142         trace vdelete $varname wu [code $this var_input_update $varname]
 143
 144         catch {unset inputs(${this}::$varname)}
 145         catch {unset sense(${this}::$varname)}
 146         catch {unset isvar(${this}::$varname)}
 147
 148         calc_o_state
 149 }
 150
 151
 152 body tlc::Gate::input_update {gate_obj state} { #<<<1
 153         if {$sense($gate_obj)} {
 154                 set state       [expr {!$state}]
 155         }
 156         debug debug "tlc::Gate::input_update ($this) ($name): ($gate_obj) ($state)"
 157         set inputs($gate_obj)   $state
 158
 159         calc_o_state
 160 }
 161
 162
 163 body tlc::Gate::var_input_update {varname n1 n2 op} { #<<<1
 164         upvar $varname value
 165         switch $op {
 166                 w {
 167                         if {![info exists value]} {
 168                                 error "var doesn't exist!  ($varname)"
 169                         }
 170                         set state       [expr {
 171                                 [string is boolean $value] && $value
 172                         }]
 173                         if {$sense(${this}::$varname)} {
 174                                 set state       [expr {!$state}]
 175                         }
 176                         set inputs(${this}::$varname) $state
 177
 178                         calc_o_state
 179                 }
 180
 181                 u {
 182                         detach_var_input $varname
 183                 }
 184         }
 185 }
 186
 187
 188 body tlc::Gate::calc_o_state {} { #<<<1
 189         set inputlist   [array names inputs]
 190
 191         if {[llength $inputlist] == 0} {
 192                 set new_o_state         $default
 193         } else {
 194                 switch [string tolower $mode] {
 195                         "and" - "nor"   {set assume     1}
 196                         "nand" - "or"   {set assume     0}
 197                 }
 198
 199                 foreach input $inputlist {
 200                         switch [string tolower $mode] {
 201                                 "and" - "nand"  {
 202                                         if {!$inputs($input)} {
 203                                                 set assume      [expr {!($assume)}]
 204                                                 break
 205                                         }
 206                                 }
 207
 208                                 "or" - "nor"    {
 209                                         if {$inputs($input)} {
 210                                                 set assume      [expr {!($assume)}]
 211                                                 break
 212                                         }
 213                                 }
 214                         }
 215                 }
 216
 217                 set new_o_state         $assume
 218         }
 219
 220         set_state $new_o_state
 221 }
 222
 223
 224 body tlc::Gate::cleanup {gate_obj} { #<<<1
 225         detach_input $gate_obj
 226 }
 227
 228
 229 body tlc::Gate::explain_state {} { #<<<1
 230         return [array get inputs]
 231 }
 232
 233
 234 body tlc::Gate::explain_txt {{depth 0}} { #<<<1
 235         set txt ""
 236         set firstdepth  [expr {($depth > 0) ? $depth-1 : 0}]
 237         append txt "$this \"[$this name]\": [$this state]\[$default\] [string toupper [$this cget -mode]] (\n"
 238         foreach key [array names inputs] {
 239 #               append txt "[string repeat {  } $firstdepth]"
 240                 append txt "[string repeat {  } $depth]"
 241                 append txt $inputs($key)
 242                 append txt [expr {$sense($key) ? "i" : " "}]
 243                 if {[info exists isvar($key)]} {
 244                         append txt "$this var_input: $isvar($key) ($inputs($key))\n"
 245                 } else {
 246                         append txt [$key explain_txt [expr {$depth + 1}]]
 247                 }
 248         }
 249         append txt "[string repeat {  } $depth])\n"
 250
 251         return $txt
 252 }
 253
 254