10 set pq {} ;# unset: cdu charged and waiting
11 # unset pointpos($point)
12 # unset segdetect($seg) ;# unset: shown D0; {}: shown D1; or: after id, D1->0
19 global watchdog polarity segdetect
23 if {[info exists watchdog]} { gui "P 1" }
24 if {![regexp {^90} $polarity]} { gui_polarity }
25 foreach seg [array names segdetect] {
38 set b [binary format H* $m]
44 global errorInfo errorCode
45 puts stderr "$m\n$errorCode\n$errorInfo"
55 fconfigure $p -blocking yes
63 catch { after cancel $watchdog; unset watchdog }
67 fileevent $p readable {}
70 proc gui_polarity {} {
91 if {[string compare $m $polarity]} {
96 proc polarity_l {} { polarity 908000 }
97 proc polarity_x {} { polarity 97ff7f }
99 proc pt_now {how point pos xtra} {
100 set msg a0[lindex $point $pos]
101 debug "$how point $point pos=$pos msg=$msg$xtra"
102 gui "M [lindex $point 2] [expr {!$pos}]"
105 proc pt_must {point newpos} {
106 upvar #0 pointpos($point) pos
108 if {[info exists pos] && $pos == $newpos} return
110 if {[info exists pq]} {
111 lappend pq [list $point $pos]
112 debug "queue point $point pos=$pos l=[llength $pq]"
115 pt_now immed $point $pos {}
123 set pq [lrange $pq 1 end]
124 pt_now nowdo [lindex $v 0] [lindex $v 1] " l=[llength $pq]"
131 proc pt_maybe {point} {
133 if {[info exists always]} {
136 set c [read $rand 1]; if {![string length $c]} { error "eof on rand" }
138 set pos [expr [regexp {^[89a-f]} $x] ? 1 : 0]
139 debug "chose point $point pos=$pos (x=$x)"
145 upvar #0 segdetect($seg) segd
146 if {![info exists segd]} {
147 debug "segment $seg = already"
148 } elseif {[string length $segd]} {
149 debug "segment $seg = pending already"
151 debug "segment $seg = soon"
152 set segd [after 100 s0t $seg]
156 upvar #0 segdetect($seg) segd
157 debug "segment $seg = now"
162 upvar #0 segdetect($seg) segd
163 if {![info exists segd]} {
164 debug "segment $seg ! (overwrites =)"
165 } elseif {[string length $segd]} {
166 debug "segment $seg ! (cancels =)"
169 debug "segment $seg ! already"
176 proc pm_maydetect {d seg} {
197 proc pm_detect {seg} {
200 07 - 06 { polarity_l }
201 16 - 1c - 1a - 10 - 03 - 05 - 08 - 0b { polarity_x }
204 14 - 20 { pt_must "02 03 A5" 1; pt_must "42 43 A6" 1 }
205 04 - 0a { pt_must "00 01 X7" 1; pt_must "40 41 X8" 1 }
206 03 - 05 { pt_must "00 01 X7" 0 }
207 08 - 0b { pt_must "40 41 X8" 0 }
208 16 - 1c { pt_must "02 03 A5" 0 }
209 1a - 10 { pt_must "42 43 A6" 0 }
211 if {[lsearch -exact $segs $seg] < 0} {
212 set segs [list [lindex $segs end] $seg]
214 switch -exact [join $segs -] {
215 07-02 { pt_maybe "00 01 X7" }
216 02-07 { pt_maybe "02 03 A5" }
217 06-09 { pt_maybe "40 41 X8" }
218 09-06 { pt_maybe "42 43 A6" }
223 global watchdog testonly
224 if {$testonly} return
225 catch { after cancel $watchdog }
226 set watchdog [after 50 watchdog]
227 tellpic 9808 ;# 128ms
231 debug "got hello, starting up"
239 switch -glob [lindex $m 0] {
242 9[0-7] { pm_maydetect 0 [lindex $m 1] }
243 9? { pm_detect [lindex $m 1]; pm_maydetect 1 [lindex $m 1] }
244 0a - [234567]? { puts "pic debug $m" }
245 * { fail "pic unknown $m" }
249 proc onreadp_test {} {
250 if {![gets stdin m]} { return }
258 if {![string llength $c]} {
259 if {[eof $p]} { error "eof on device" }
264 if {[regexp {^[89a-f]} $x]} {
265 if {![regexp {^x} $m]} {
274 global port p rand testonly
276 set p [open $port {RDWR NONBLOCK} 0]
278 exec stty -F $port min 1 time 0 -istrip -ocrnl -onlcr -onocr -opost \
279 -ctlecho -echo -echoe -echok -echonl -iexten -isig \
281 9600 clocal cread crtscts -hup -parenb cs8 -cstopb \
282 -ixoff bs0 cr0 ff0 nl0 -ofill -olcuc
284 fconfigure $p -encoding binary -translation binary \
285 -blocking false -buffering none
287 fileevent $p readable onreadp
290 fconfigure stdin -blocking false
291 fileevent stdin readable onreadp_test
294 set rand [open /dev/urandom {RDONLY} 0]
295 fconfigure $rand -encoding binary -translation binary