scripts/signalsource.itcl

   1 # vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4
   2
   3 class tlc::Signalsource {
   4         constructor {} {}
   5         destructor {}
   6
   7         public {
   8                 method signal_ref {signal}
   9                 method signal_state {signal}
  10                 method waitfor {signal {timeout 0}}
  11                 method signals_available {}
  12         }
  13
  14         protected {
  15                 variable signals
  16         }
  17
  18         private {
  19                 variable signotify
  20                 variable afters
  21
  22                 method signotify {signame newstate}
  23         }
  24 }
  25
  26
  27 body tlc::Signalsource::constructor {} { #<<<1
  28         array set signals       {}
  29         array set signotify     {}
  30         array set afters        {}
  31 }
  32
  33
  34 body tlc::Signalsource::destructor {} { #<<<1
  35         tlc::try {
  36                 foreach afterid [array names afters] {
  37                         after cancel $afterid
  38                         array unset afters $afterid
  39                 }
  40         } onerr {
  41                 default {STDMSG}
  42         }
  43 }
  44
  45
  46 body tlc::Signalsource::signal_ref {signal} { #<<<1
  47         if {![info exists signals($signal)]} {
  48                 error "Invalid signal ($signal)"
  49         }
  50         return $signals($signal)
  51 }
  52
  53
  54 body tlc::Signalsource::signal_state {signal} { #<<<1
  55         if {![info exists signals($signal)]} {
  56                 error "Invalid signal ($signal)"
  57         }
  58         return [$signals($signal) state]
  59 }
  60
  61
  62 body tlc::Signalsource::waitfor {signame {timeout 0}} { #<<<1
  63         if {![info exists signals($signame)]} {
  64                 error "Invalid signal: ($signame)"
  65         }
  66         if {![$signals($signame) state]} {
  67                 $signals($signame) attach_output [code $this signotify $signame]
  68                 if {$timeout != 0} {
  69                         set afterid     [after $timeout [list set [scope signotify($signame)] 0]]
  70                         set afters($afterid)    1
  71                 }
  72                 vwait [scope signotify($signame)]
  73                 if {[info exists afterid]} {
  74                         after cancel $afterid
  75                         array unset afters $afterid
  76                         unset afterid
  77                 }
  78                 set res $signotify($signame)
  79                 array unset signotify($signame)
  80                 if {$res != 1} {
  81                         error "Timeout waiting for signal \"$signame\"" "" \
  82                                         [list timeout $signame]
  83                 }
  84                 #puts stderr "${this}::waitfor got ($signame) true, proceeding"
  85         }
  86         return
  87 }
  88
  89
  90 body tlc::Signalsource::signotify {signame newstate} { #<<<1
  91         if {$newstate} {
  92                 set signotify($signame) 1
  93         }
  94 }
  95
  96
  97 body tlc::Signalsource::signals_available {} { #<<<1
  98         set build       {}
  99         foreach signame [lsort -dictionary [array names signals]] {
 100                 lappend build   $signame $signals($signame)
 101         }
 102         return $build
 103 }
 104
 105