source: trunk/MultiChannelUSB/UserInterface.tcl@ 167

Last change on this file since 167 was 167, checked in by demin, 13 years ago

multiple GUI fixes

File size: 60.7 KB
RevLine 
[73]1package require XOTcl
2
3package require BLT
4package require swt
5package require usb
6
[85]7package require zlib
[73]8
[161]9wm minsize . 990 660
[85]10
[73]11namespace eval ::mca {
12 namespace import ::xotcl::*
13
14 namespace import ::blt::vector
15 namespace import ::blt::graph
16 namespace import ::blt::tabnotebook
17
[159]18# -------------------------------------------------------------------------
19
20 variable oscCodes
21 array set oscCodes {
22 1 {Channel 1}
23 2 {Channel 2}
24 3 {Channel 3}
25 4 {Channel 4}
26 5 {Channel 5}
27 6 {Trigger}
28 }
29
30# -------------------------------------------------------------------------
31
32 variable adcCodes
33 array set adcCodes {
34 1 {ADC 1}
35 2 {ADC 2}
36 3 {ADC 3}
37 }
38
39# -------------------------------------------------------------------------
40
41 variable inpCodes
42 array set inpCodes {
43 0 {raw data}
44 1 {filtered}
45 2 {amplitude}
46 3 {amp flag}
47 }
48
49# -------------------------------------------------------------------------
50
51 proc validate {max size value} {
[85]52 if {![regexp {^[0-9]*$} $value]} {
[73]53 return 0
[159]54 } elseif {[regexp {^0[0-9]+$} $value]} {
55 return 0
[85]56 } elseif {$value > $max} {
[73]57 return 0
[159]58 } elseif {[string length $value] > $size} {
[73]59 return 0
60 } else {
61 return 1
62 }
63 }
64
65# -------------------------------------------------------------------------
66
[159]67 proc doublevalidate {max value} {
68 if {![regexp {^[0-9]{0,2}\.?[0-9]{0,3}$} $value]} {
69 return 0
70 } elseif {[regexp {^0[0-9]+$} $value]} {
71 return 0
72 } elseif {$value > $max} {
73 return 0
74 } else {
75 return 1
76 }
77 }
[85]78
79# -------------------------------------------------------------------------
80
[159]81 proc legendLabel {master row key title} {
82 label ${master}.${key}_label -anchor w -text ${title}
83 label ${master}.${key}_value -width 10 -anchor e -text {}
[85]84
[159]85 grid ${master}.${key}_label -row ${row} -column 1 -sticky w
86 grid ${master}.${key}_value -row ${row} -column 2 -sticky ew
87 }
88
89# -------------------------------------------------------------------------
90
91 proc legendButton {master row key title var bg {fg black}} {
92 checkbutton ${master}.${key}_check -variable $var
93 label ${master}.${key}_label -anchor w -text ${title} -bg ${bg} -fg $fg
94 label ${master}.${key}_value -width 10 -anchor e -text {} -bg ${bg} -fg $fg
95
96 grid ${master}.${key}_check -row ${row} -column 0 -sticky w
97 grid ${master}.${key}_label -row ${row} -column 1 -sticky w
98 grid ${master}.${key}_value -row ${row} -column 2 -sticky ew
99 }
100
101# -------------------------------------------------------------------------
102
103 Class UsbController
104
105# -------------------------------------------------------------------------
106
107 UsbController instproc usbConnect {} {
108 my instvar handle
109
110 puts usbConnect
111
112 if {[my exists handle]} {
113 $handle disconnect
114 unset handle
[85]115 }
[159]116if {1} {
117 while {[catch {usb::connect 0x09FB 0x6001 1 1 0} result]} {
118 set answer [tk_messageBox -icon error -type retrycancel \
119 -message {Cannot access USB device} -detail $result]
120# puts $result
121 if {[string equal $answer cancel]} exit
122 }
123
124 set handle $result
125
126}
[85]127 }
128
129# -------------------------------------------------------------------------
130
[159]131 UsbController instproc usbHandle {} {
132 my instvar handle
[85]133
[159]134 if {[my exists handle]} {
135 return $handle
136 } else {
137 my usbConnect
138 }
139 }
[85]140
[159]141# -------------------------------------------------------------------------
142
143 UsbController instproc usbCmd {command} {
144 set code [catch {[my usbHandle] writeRaw [usb::convert $command]} result]
145 switch -- $code {
146 1 {
147# puts $result
148 my usbConnect
149 }
[85]150 }
151
152 }
153
154# -------------------------------------------------------------------------
155
[159]156 UsbController instproc usbCmdReadRaw {command size data} {
157 my usbCmd $command
[85]158
[159]159 set code [catch {[my usbHandle] readRaw $size} result]
160 switch -- $code {
161 0 {
162 set $data $result
163 }
164 1 {
165# puts $result
166 my usbConnect
167 }
168 5 {
169# puts Busy
170 }
171 }
172 }
173
174# -------------------------------------------------------------------------
175
176 UsbController instproc usbCmdReadRaw {command size data} {
[85]177 my usbCmd $command
178
[159]179 set code [catch {[my usbHandle] readRaw $size} result]
180 switch -- $code {
181 0 {
182 set $data $result
183 }
184 1 {
185# puts $result
186 my usbConnect
187 }
188 5 {
189# puts Busy
190 }
[85]191 }
[159]192 }
[85]193
[159]194# -------------------------------------------------------------------------
195
196 UsbController instproc usbCmdReadHex {command width size data} {
197 my usbCmd $command
198
199 set code [catch {[my usbHandle] readHex $width $size} result]
200 switch -- $code {
201 0 {
202 set $data $result
203 }
204 1 {
205# puts $result
206 my usbConnect
207 }
208 5 {
209# puts Busy
210 }
211 }
[85]212 }
213
214# -------------------------------------------------------------------------
215
[159]216 Class MuxDisplay -parameter {
[77]217 {master}
[159]218 {controller}
[77]219 }
220
221# -------------------------------------------------------------------------
222
[159]223 MuxDisplay instproc init {} {
[77]224
225 my setup
226
227 next
228 }
229
230# -------------------------------------------------------------------------
231
[159]232 MuxDisplay instproc destroy {} {
[77]233 next
234 }
235
236# -------------------------------------------------------------------------
237
[159]238 MuxDisplay instproc start {} {
[161]239 my instvar config chan_val hstmux
[77]240
[159]241 set chan_val(1) 0
242 set chan_val(2) 0
243 set chan_val(3) 0
244 set chan_val(4) 0
245 set chan_val(5) 0
246 set chan_val(6) 0
[77]247
[161]248 set hstmux(1) 0
249 set hstmux(2) 0
[162]250 set hstmux(3) 0
[161]251
[159]252 trace add variable [myvar chan_val] write [myproc chan_val_update]
[77]253 trace add variable [myvar polar] write [myproc polar_update]
[161]254 trace add variable [myvar hstmux] write [myproc hstmux_update]
[77]255
[159]256 $config(1).chan_1_1 select
257 $config(2).chan_1_2 select
258 $config(3).chan_1_3 select
259 $config(4).chan_1_1 select
260 $config(5).chan_3_1 select
261 $config(6).chan_3_1 select
[77]262
[162]263 $config(7).hstmux_1_1 select
264 $config(8).hstmux_2_2 select
265 $config(9).hstmux_3_1 select
266
[159]267 for {set i 1} {$i <= 3} {incr i} {
[162]268 $config(10).polar_$i select
[159]269 }
[77]270 }
271
272# -------------------------------------------------------------------------
273
[159]274 MuxDisplay instproc setup {} {
275 variable oscCodes
276 variable adcCodes
277 variable inpCodes
278 my instvar master
[77]279 my instvar config
280
[159]281 set size [array size inpCodes]
282 set oscList [array get oscCodes]
283 set adcList [array get adcCodes]
284 set inpList [array get inpCodes]
[77]285
[159]286 foreach {osc title} $oscList {
[161]287 set config($osc) [labelframe ${master}.mux_$osc -borderwidth 1 -relief sunken -text $title -font {-weight bold}]
[77]288
[159]289 foreach {ch dummy} $adcList {
290 label $config($osc).chan_${ch} -text "#$ch "
291 grid $config($osc).chan_${ch} -row 0 -column $ch -sticky w
292 }
293 foreach {code input} $inpList {
294 set row [expr {$code + 1}]
295 set last 0
296 foreach {ch dummy} $adcList {
297 set value [expr {$size * ($ch - 1) + $code}]
298 radiobutton $config($osc).chan_${code}_${ch} -variable [myvar chan_val($osc)] -value ${value}
299 grid $config($osc).chan_${code}_${ch} -row ${row} -column $ch -sticky w
300 set last $ch
301 }
302 $config($osc).chan_${code}_${last} configure -text $input
303 }
304 set column [expr {($osc - 1) % 3}]
[161]305 set row [expr {($osc - 1) / 3 + 1}]
306 grid $config($osc) -row $row -column $column -sticky news -padx 10 -pady 10
[159]307 }
[77]308
[162]309 set config(7) [labelframe ${master}.mux_7 -borderwidth 1 -relief sunken -text {Spectrum histogram 1} -font {-weight bold}]
310 set config(8) [labelframe ${master}.mux_8 -borderwidth 1 -relief sunken -text {Spectrum histogram 2} -font {-weight bold}]
[161]311 set config(9) [labelframe ${master}.mux_9 -borderwidth 1 -relief sunken -text {Rate histogram} -font {-weight bold}]
[162]312
313 set config(10) [labelframe ${master}.mux_10 -borderwidth 1 -relief sunken -text {Polarity inversion} -font {-weight bold}]
314
[159]315 for {set i 1} {$i <= 3} {incr i} {
[161]316 set value [expr {$i - 1}]
317
[162]318 radiobutton $config(7).hstmux_1_$i -text "ADC $i" -variable [myvar hstmux(1)] -value $value
319 grid ${config(7)}.hstmux_1_$i
[161]320
[162]321 radiobutton $config(8).hstmux_2_$i -text "ADC $i" -variable [myvar hstmux(2)] -value $value
322 grid ${config(8)}.hstmux_2_$i
[161]323
[162]324 radiobutton $config(9).hstmux_3_$i -text "ADC $i" -variable [myvar hstmux(3)] -value $value
325 grid ${config(9)}.hstmux_3_$i
326
327 checkbutton $config(10).polar_$i -text "ADC $i" -variable [myvar polar($i)]
328 grid ${config(10)}.polar_$i
[159]329 }
[162]330 grid $config(7) -row 3 -column 0 -sticky news -padx 10 -pady 30
331 grid $config(8) -row 3 -column 1 -sticky news -padx 10 -pady 30
332 grid $config(9) -row 3 -column 2 -sticky news -padx 10 -pady 30
[77]333
[162]334 grid $config(10) -row 4 -column 0 -sticky news -padx 10 -pady 10
335
[159]336 grid columnconfigure ${master} 0 -weight 1
337 grid columnconfigure ${master} 1 -weight 1
338 grid columnconfigure ${master} 2 -weight 1
[77]339
[159]340 grid rowconfigure ${master} 0 -weight 1
341 grid rowconfigure ${master} 1 -weight 0
342 grid rowconfigure ${master} 2 -weight 0
343 grid rowconfigure ${master} 3 -weight 0
[162]344 grid rowconfigure ${master} 4 -weight 0
345 grid rowconfigure ${master} 5 -weight 1
[77]346
347 }
348
349
[159]350# ------------------------------------------------------------------------
[77]351
[159]352 MuxDisplay instproc chan_val_update args {
353 my instvar controller chan_val
[77]354
[159]355 set byte1 [format {%02x%02x} $chan_val(2) $chan_val(1)]
356 set byte2 [format {%02x%02x} $chan_val(4) $chan_val(3)]
357 set byte3 [format {%02x%02x} $chan_val(6) $chan_val(5)]
[77]358
[159]359 $controller usbCmd 000200020004${byte1}000200030004${byte2}000200040004${byte3}
[77]360 }
361
362# -------------------------------------------------------------------------
363
[159]364 MuxDisplay instproc polar_update args {
365 my instvar controller polar
[77]366
[159]367 set value [format {%x%x%x} $polar(3) $polar(2) $polar(1)]
[77]368
[159]369 $controller usbCmd 0002000100040${value}
[77]370 }
371
372# -------------------------------------------------------------------------
373
[161]374 MuxDisplay instproc hstmux_update args {
375 my instvar controller hstmux
376
[162]377 set value [format {%x%x%x} $hstmux(3) $hstmux(2) $hstmux(1)]
[161]378
[162]379 $controller usbCmd 0002000600040${value}
[161]380 }
381
382# -------------------------------------------------------------------------
383
[159]384 Class HstDisplay -parameter {
[73]385 {number}
386 {master}
[159]387 {controller}
[73]388 }
389
390# -------------------------------------------------------------------------
391
[159]392 HstDisplay instproc init {} {
[73]393
[159]394 my set data {}
[73]395
[159]396 vector create [myvar xvec](4096)
397 vector create [myvar yvec](4096)
[73]398
[159]399 # fill one vector for the x axis with 4096 points
400 [myvar xvec] seq -0.5 4095.5
401
[73]402 my setup
403
404 next
405 }
406
407# -------------------------------------------------------------------------
408
[159]409 HstDisplay instproc destroy {} {
[73]410 next
411 }
412
413# -------------------------------------------------------------------------
414
[159]415 HstDisplay instproc start {} {
416 my instvar config
[73]417
[159]418 trace add variable [myvar data] write [myproc data_update]
419 trace add variable [myvar cntr_val] write [myproc cntr_val_update]
420 trace add variable [myvar rate_val] write [myproc rate_val_update]
[73]421
[159]422 trace add variable [myvar axis] write [myproc axis_update]
423 trace add variable [myvar thrs] write [myproc thrs_update]
424 trace add variable [myvar thrs_val] write [myproc thrs_update]
[73]425
[159]426 ${config}.axis_check select
[73]427
[159]428 ${config}.thrs_check select
429 ${config}.thrs_field set 25
[74]430
[159]431 set cntr_tmp 1200000000
432 my set cntr_val $cntr_tmp
433 my set cntr_bak $cntr_tmp
434 my set cntr_old $cntr_tmp
435 my set yvec_bak 0.0
436 my set yvec_old 0.0
[74]437
[159]438 my set rate_val(inst) 0.0
439 my set rate_val(mean) 0.0
[167]440
441 ${config}.chan_frame.entr_value configure -text 0.0
[73]442
[167]443 ${config}.chan_frame.axisy_value configure -text 0.0
444 ${config}.chan_frame.axisx_value configure -text 0.0
445
[159]446# my cntr_reset
[73]447 }
448
449# -------------------------------------------------------------------------
450
[159]451 HstDisplay instproc setup {} {
[73]452 my instvar number master
[159]453 my instvar xvec yvec graph
454 my instvar config thrs thrs_val
455 my instvar cntr_h cntr_m cntr_s
[73]456
457 # create a graph widget and show a grid
458 set graph [graph ${master}.graph -height 250 -leftmargin 80]
[159]459 $graph crosshairs configure -hide no -linewidth 1 -color darkblue -dashes {2 2}
[73]460 $graph grid configure -hide no
461 $graph legend configure -hide yes
462
[159]463 set config [frame ${master}.config -width 170]
[73]464
[159]465 checkbutton ${config}.axis_check -text {log scale} -variable [myvar axis]
[73]466
[159]467 frame ${config}.spc1 -width 170 -height 30
[73]468
[159]469 frame ${config}.rate_frame -borderwidth 0 -width 170
470 legendLabel ${config}.rate_frame 0 inst {Inst. rate, 1/s}
471 legendLabel ${config}.rate_frame 1 mean {Avg. rate, 1/s}
472
473 frame ${config}.spc2 -width 170 -height 30
474
475 frame ${config}.chan_frame -borderwidth 0 -width 170
476 legendLabel ${config}.chan_frame 0 entr {Total entries}
477 legendLabel ${config}.chan_frame 1 empty {}
478 legendLabel ${config}.chan_frame 2 axisy {Bin entries}
479 legendLabel ${config}.chan_frame 3 axisx {Bin number}
480
481 frame ${config}.spc3 -width 170 -height 30
482
483 checkbutton ${config}.thrs_check -text {amplitude threshold} -variable [myvar thrs]
[73]484 spinbox ${config}.thrs_field -from 1 -to 4095 \
485 -increment 5 -width 10 -textvariable [myvar thrs_val] \
[159]486 -validate all -vcmd {::mca::validate 4095 4 %P}
[73]487
[159]488 frame ${config}.spc4 -width 170 -height 30
[73]489
[159]490 label ${config}.cntr -text {time of exposure}
491 frame ${config}.cntr_frame -borderwidth 0 -width 170
[73]492
[159]493 label ${config}.cntr_frame.h -width 3 -anchor w -text {h}
494 entry ${config}.cntr_frame.h_field -width 3 -textvariable [myvar cntr_h] \
495 -validate all -vcmd {::mca::validate 999 3 %P}
496 label ${config}.cntr_frame.m -width 3 -anchor w -text {m}
497 entry ${config}.cntr_frame.m_field -width 3 -textvariable [myvar cntr_m] \
498 -validate all -vcmd {::mca::validate 59 2 %P}
499 label ${config}.cntr_frame.s -width 3 -anchor w -text {s}
500 entry ${config}.cntr_frame.s_field -width 6 -textvariable [myvar cntr_s] \
501 -validate all -vcmd {::mca::doublevalidate 59.999 %P}
[73]502
[159]503 grid ${config}.cntr_frame.h_field ${config}.cntr_frame.h \
504 ${config}.cntr_frame.m_field ${config}.cntr_frame.m ${config}.cntr_frame.s_field ${config}.cntr_frame.s
[74]505
[159]506 frame ${config}.spc5 -width 170 -height 10
[74]507
[159]508 button ${config}.start -text Start \
509 -bg yellow -activebackground yellow -command [myproc cntr_start]
510 button ${config}.reset -text Reset \
511 -bg red -activebackground red -command [myproc cntr_reset]
512
513 frame ${config}.spc6 -width 170 -height 30
514
515
[73]516 button ${config}.register -text Register \
517 -bg lightblue -activebackground lightblue -command [myproc register]
518
[159]519 grid ${config}.axis_check -sticky w
[73]520 grid ${config}.spc1
[159]521 grid ${config}.rate_frame -sticky ew -padx 5
522 grid ${config}.spc2
523 grid ${config}.chan_frame -sticky ew -padx 5
524 grid ${config}.spc3
[73]525 grid ${config}.thrs_check -sticky w
526 grid ${config}.thrs_field -sticky ew -pady 1 -padx 5
[74]527 grid ${config}.spc4
[159]528 grid ${config}.cntr -sticky w -pady 1 -padx 3
529 grid ${config}.cntr_frame -sticky ew -padx 5
530 grid ${config}.spc5
531 grid ${config}.start -sticky ew -pady 3 -padx 5
532 grid ${config}.reset -sticky ew -pady 3 -padx 5
533 grid ${config}.spc6
[73]534 grid ${config}.register -sticky ew -pady 3 -padx 5
535
536 grid ${graph} -row 0 -column 0 -sticky news
537 grid ${config} -row 0 -column 1
538
[77]539 grid rowconfigure ${master} 0 -weight 1
540 grid columnconfigure ${master} 0 -weight 1
541 grid columnconfigure ${master} 1 -weight 0 -minsize 80
542
[159]543 grid columnconfigure ${config}.rate_frame 1 -weight 1
544 grid columnconfigure ${config}.chan_frame 1 -weight 1
545
546 my crosshairs $graph
547
[73]548 #bind .graph <Motion> {%W crosshairs configure -position @%x,%y}
549
550 # create one element with data for the x and y axis, no dots
[159]551 $graph element create Spectrum1 -color blue -linewidth 2 -symbol none -smooth step -xdata [myvar xvec] -ydata [myvar yvec]
[73]552 }
553
554# -------------------------------------------------------------------------
555
[159]556 HstDisplay instproc coor_update {W x y} {
557 my instvar config graph
558
559 $W crosshairs configure -position @${x},${y}
560
561 set index [$W axis invtransform x $x]
562 set index [::tcl::mathfunc::round $index]
563 catch {
564 ${config}.chan_frame.axisy_value configure -text [[myvar yvec] index $index]
565 ${config}.chan_frame.axisx_value configure -text ${index}.0
566 }
[85]567 }
568# -------------------------------------------------------------------------
569
[159]570 HstDisplay instproc crosshairs {graph} {
571 set method [myproc coor_update]
572 bind $graph <Motion> [list [self] coor_update %W %x %y]
573 bind $graph <Leave> {
574 %W crosshairs off
575 }
576 bind $graph <Enter> {
577 %W crosshairs on
578 }
579 }
[73]580
[159]581# -------------------------------------------------------------------------
[73]582
[159]583 HstDisplay instproc axis_update args {
584 my instvar axis graph
[167]585 $graph axis configure x -min 0 -max 4096
586 Blt_ZoomStack $graph
[159]587 if {$axis} {
588 $graph axis configure y -min 1 -max 1E10 -logscale yes
[73]589 } else {
[159]590 $graph axis configure y -min {} -max {} -logscale no
[73]591 }
592 }
593
594# -------------------------------------------------------------------------
595
[159]596 HstDisplay instproc thrs_update args {
597 my instvar controller config number thrs thrs_val
[74]598
[159]599 if {[string equal $thrs_val {}]} {
600 set thrs_val 0
601 }
[74]602
[162]603 set val_addr [format %02x [expr {7 + ${number}}]]
[159]604
[73]605 if {$thrs} {
606 ${config}.thrs_field configure -state normal
[159]607 set value [format %03x $thrs_val]
[73]608 } else {
609 ${config}.thrs_field configure -state disabled
[159]610 set value 000
[73]611 }
[159]612
613 $controller usbCmd 000200${val_addr}00040${value}
[73]614 }
615
616# -------------------------------------------------------------------------
617
[159]618 HstDisplay instproc rate_val_update {name key op} {
619 my instvar config rate_val
[74]620
[159]621 ${config}.rate_frame.${key}_value configure -text [format {%.2e} $rate_val(${key})]
622 }
[85]623
[159]624# -------------------------------------------------------------------------
[74]625
[159]626 HstDisplay instproc cntr_val_update args {
627 my instvar cntr_val cntr_h cntr_m cntr_s
628
629 set cntr_tmp [expr {${cntr_val}/20000}]
630 set cntr_h [expr {${cntr_tmp}/3600000}]
631 set cntr_m [expr {${cntr_tmp}%3600000/60000}]
632 set cntr_s [expr {${cntr_tmp}%3600000%60000/1000.0}]
[73]633 }
634
635# -------------------------------------------------------------------------
636
[159]637 HstDisplay instproc cntr_setup {} {
638 my instvar controller number cntr_val
[74]639
[159]640 set word0 [format %08x [expr {${cntr_val} & 0xFFFFFFFF}]]
641 set word1 [format %08x [expr {${cntr_val} >> 32}]]
642
643 set prefix [format %x [expr {5 + ${number}}]]
644
645 set command {}
646 append command 0001${prefix}000000200000004[string range $word0 4 7]
647 append command 0001${prefix}000000200010004[string range $word0 0 3]
648 append command 0001${prefix}000000200020004[string range $word1 4 7]
649 append command 0001${prefix}000000200030004[string range $word1 0 3]
650
651 # send counter value
652 $controller usbCmd $command
653
654 # load counter value
655# set val_addr [format %02x [expr {12 + ${number}}]]
656# $controller usbCmd 000200${val_addr}00040001000200${val_addr}00040000
[74]657 }
658
[159]659# -------------------------------------------------------------------------
[74]660
[159]661 HstDisplay instproc cntr_reset {} {
[167]662 my instvar controller config number after_handle
663 my instvar cntr_val cntr_bak cntr_old yvec_bak yvec_old rate_val
[74]664
[159]665 my cntr_stop
[74]666
[159]667 set value [format %04x [expr {1 << (5 + ${number})}]]
668 $controller usbCmd 000200000004${value}0002000000040000
669
670 set cntr_val $cntr_bak
671 my cntr_setup
672
673 set cntr_old $cntr_bak
674 set yvec_bak 0.0
675 set yvec_old 0.0
676
[167]677 set rate_val(inst) 0.0
678 set rate_val(mean) 0.0
679 ${config}.chan_frame.entr_value configure -text 0.0
680
[159]681 my acquire
682
683 my cntr_ready
[74]684 }
685
[159]686# -------------------------------------------------------------------------
[74]687
[159]688 HstDisplay instproc cntr_ready {} {
689 my instvar config cntr_val cntr_bak
[74]690
[159]691 set cntr_val $cntr_bak
[74]692
[159]693 ${config}.start configure -text Start -command [myproc cntr_start]
694 ${config}.reset configure -state active
695
696 ${config}.cntr_frame.h_field configure -state normal
697 ${config}.cntr_frame.m_field configure -state normal
698 ${config}.cntr_frame.s_field configure -state normal
[74]699 }
700
701# -------------------------------------------------------------------------
702
[159]703 HstDisplay instproc cntr_start {} {
704 my instvar config
705 my instvar cntr_h cntr_m cntr_s
706 my instvar cntr_val cntr_bak cntr_old yvec_bak yvec_old
707
708 set h $cntr_h
709 set m $cntr_m
710 set s $cntr_s
711
712 if {[string equal $h {}]} {
713 set h 0
[73]714 }
[159]715 if {[string equal $m {}]} {
716 set m 0
717 }
718 if {[string equal $s {}]} {
719 set s 0
720 }
[73]721
[159]722 set cntr_tmp [expr {${h}*3600000 + ${m}*60000 + ${s}*1000}]
723 set cntr_tmp [expr {entier(20000 * ${cntr_tmp})}]
[73]724
[159]725 if {$cntr_tmp > 0} {
726 ${config}.cntr_frame.h_field configure -state disabled
727 ${config}.cntr_frame.m_field configure -state disabled
728 ${config}.cntr_frame.s_field configure -state disabled
729
730 set cntr_val $cntr_tmp
731 set cntr_bak $cntr_tmp
732 set cntr_old $cntr_tmp
733 set yvec_bak [usb::integrateBlt [myvar yvec] 0]
734 set yvec_old $yvec_bak
735
736 my cntr_setup
737
738 my cntr_resume
[73]739 }
740 }
741
742# -------------------------------------------------------------------------
743
[159]744 HstDisplay instproc cntr_pause {} {
745 my instvar config
[73]746
[159]747 my cntr_stop
748
749 ${config}.start configure -text Resume -command [myproc cntr_resume]
750# ${config}.reset configure -state active
751
752 }
753
[73]754# -------------------------------------------------------------------------
755
[159]756 HstDisplay instproc cntr_resume {} {
757 my instvar controller config number auto
758
759 set val_addr [format %02x [expr {13 + ${number}}]]
760
761 ${config}.start configure -text Pause -command [myproc cntr_pause]
762# ${config}.reset configure -state disabled
763
764 $controller usbCmd 000200${val_addr}00040002
765
766 set auto 1
767
768 after 100 [myproc acquire_loop]
[73]769 }
770
771# -------------------------------------------------------------------------
772
[159]773 HstDisplay instproc cntr_stop {} {
774 my instvar controller config number auto
775
776 set val_addr [format %02x [expr {13 + ${number}}]]
777
778 $controller usbCmd 000200${val_addr}00040000
779
780 set auto 0
[73]781 }
782
783# -------------------------------------------------------------------------
784
[159]785 HstDisplay instproc data_update args {
786 my instvar data
787 usb::convertBlt $data 4 [myvar yvec]
788 }
[73]789
[159]790# -------------------------------------------------------------------------
791
792 HstDisplay instproc acquire_loop {} {
793 my instvar cntr_val auto
794
[73]795 my acquire
796
[159]797 if {$cntr_val == 0} {
798 my cntr_stop
799 my cntr_ready
800 } elseif {$auto} {
801 after 1000 [myproc acquire_loop]
802 }
[73]803 }
804
805# -------------------------------------------------------------------------
806
[159]807 HstDisplay instproc acquire {} {
808 my instvar controller config number
809 my instvar cntr_val cntr_bak cntr_old yvec_bak yvec_old rate_val
[73]810
[159]811 set size 4096
812
[162]813 set prefix [format {%x} [expr {2 + ${number}}]]
[159]814
815 set value [format {%08x} [expr {$size * 2}]]
816
817 set command 0001${prefix}000000200000001[string range $value 0 3]0003[string range $value 4 7]00050000
818
819 $controller usbCmdReadRaw $command [expr {$size * 4}] [myvar data]
820 set yvec_new [usb::integrateBlt [myvar yvec] 0]
821
[162]822 set prefix [format {%x} [expr {5 + ${number}}]]
[159]823 set command 0001${prefix}000000200000003000400050000
824
825 $controller usbCmdReadHex $command 8 1 [myvar cntr_val]
826 set cntr_new $cntr_val
827
828 if {$cntr_new < $cntr_old} {
829 set rate_val(inst) [expr {($yvec_new - $yvec_old)*20000000/($cntr_old - $cntr_new)}]
830 set rate_val(mean) [expr {($yvec_new - $yvec_bak)*20000000/($cntr_bak - $cntr_new)}]
831 ${config}.chan_frame.entr_value configure -text $yvec_new
832
833 set yvec_old $yvec_new
834 set cntr_old $cntr_new
835 }
836 }
837
[73]838# -------------------------------------------------------------------------
839
[159]840 HstDisplay instproc save_data {data} {
841 my instvar number
[73]842
[159]843 set types {
844 {{Data Files} {.dat} }
845 {{All Files} * }
846 }
[73]847
[159]848 set stamp [clock format [clock seconds] -format %Y%m%d_%H%M%S]
849 set fname spectrum_[expr {$number + 1}]_${stamp}.dat
[73]850
[159]851 set fname [tk_getSaveFile -filetypes $types -initialfile $fname]
852 if {[string equal $fname {}]} {
853 return
854 }
[73]855
[159]856 set x [catch {
857 set fid [open $fname w+]
858 puts $fid $data
859 close $fid
860 }]
861
862 if { $x || ![file exists $fname] || ![file isfile $fname] || ![file readable $fname] } {
863 tk_messageBox -icon error \
864 -message "An error occurred while writing to \"$fname\""
865 } else {
866 tk_messageBox -icon info \
867 -message "File \"$fname\" written successfully"
868 }
[73]869 }
870
871# -------------------------------------------------------------------------
872
[159]873 HstDisplay instproc register {} {
874 my save_data [join [[myvar yvec] range 0 4095] \n]
[73]875 }
876
877# -------------------------------------------------------------------------
878
[159]879 Class CntDisplay -parameter {
880 {master}
881 {controller}
882 }
[73]883
[159]884# -------------------------------------------------------------------------
[73]885
[159]886 CntDisplay instproc init {} {
887
888 my set data {}
889 my set cntr 0
890 my set recs 0
891
[165]892 vector create [myvar xvec](10000)
893 vector create [myvar yvec](10000)
[159]894
[165]895 # fill one vector for the x axis with 10000 points
896 [myvar xvec] seq -0.5 9999.5
[159]897
898 my setup
899
900 next
[73]901 }
902
903# -------------------------------------------------------------------------
904
[159]905 CntDisplay instproc destroy {} {
906 next
907 }
[73]908
[159]909# -------------------------------------------------------------------------
[73]910
[159]911 CntDisplay instproc start {} {
912 my instvar config
913
[85]914 trace add variable [myvar data] write [myproc data_update]
[159]915
[73]916 trace add variable [myvar thrs] write [myproc thrs_update]
[159]917 trace add variable [myvar thrs_val] write [myproc thrs_update]
[73]918
[159]919 trace add variable [myvar cntr] write [myproc cntr_update]
920 trace add variable [myvar recs] write [myproc recs_update]
[85]921
[159]922 trace add variable [myvar axis] write [myproc axis_update]
923
924 ${config}.axis_check select
925
[73]926 ${config}.thrs_check select
[159]927 ${config}.thrs_field set 25
[85]928
[159]929 my set cntr_val 100
930 my set cntr_bak 100
931 my set recs_val 100
932 my set recs_bak 100
[167]933
934 ${config}.chan_frame.mean_value configure -text [format {%.2e} 0.0]
935 ${config}.chan_frame.entr_value configure -text 0.0
936
937 ${config}.chan_frame.axisy_value configure -text 0.0
938 ${config}.chan_frame.axisx_value configure -text 0.0
[159]939
940# my cntr_reset
[73]941 }
942
943# -------------------------------------------------------------------------
944
[159]945 CntDisplay instproc setup {} {
946 my instvar master
947 my instvar xvec yvec graph
948 my instvar config
949 my instvar cntr_ms
[73]950
951 # create a graph widget and show a grid
952 set graph [graph ${master}.graph -height 250 -leftmargin 80]
[159]953 $graph crosshairs configure -hide no -linewidth 1 -color darkblue -dashes {2 2}
[73]954 $graph grid configure -hide no
955 $graph legend configure -hide yes
956
[159]957 set config [frame ${master}.config -width 170]
[73]958
[85]959 checkbutton ${config}.axis_check -text {log scale} -variable [myvar axis]
[73]960
[159]961 frame ${config}.spc1 -width 170 -height 30
[73]962
[159]963 frame ${config}.chan_frame -borderwidth 0 -width 170
964 legendLabel ${config}.chan_frame 0 mean {Mean value}
965 legendLabel ${config}.chan_frame 1 entr {Total entries}
966 legendLabel ${config}.chan_frame 2 empty {}
967 legendLabel ${config}.chan_frame 3 axisy {Bin entries}
968 legendLabel ${config}.chan_frame 4 axisx {Bin number}
[73]969
[159]970 frame ${config}.spc3 -width 170 -height 30
[73]971
[159]972 checkbutton ${config}.thrs_check -text {amplitude threshold} -variable [myvar thrs]
[73]973 spinbox ${config}.thrs_field -from 1 -to 4095 \
974 -increment 5 -width 10 -textvariable [myvar thrs_val] \
[159]975 -validate all -vcmd {::mca::validate 4095 4 %P}
[73]976
[159]977 frame ${config}.spc4 -width 170 -height 30
[73]978
[159]979 label ${config}.cntr -text {time of exposure (ms)}
980 spinbox ${config}.cntr_field -from 0 -to 9999 \
981 -increment 10 -width 10 -textvariable [myvar cntr_val] \
982 -validate all -vcmd {::mca::validate 9999 4 %P}
[73]983
[159]984 frame ${config}.spc5 -width 170 -height 10
[73]985
[159]986 label ${config}.recs -text {number of exposures}
987 spinbox ${config}.recs_field -from 0 -to 99999 \
988 -increment 10 -width 10 -textvariable [myvar recs_val] \
989 -validate all -vcmd {::mca::validate 99999 5 %P}
990
991 frame ${config}.spc6 -width 170 -height 10
992
993 button ${config}.start -text {Start} \
994 -bg yellow -activebackground yellow -command [myproc recs_start]
995
996 button ${config}.reset -text Reset \
997 -bg red -activebackground red -command [myproc cntr_reset]
998
999 frame ${config}.spc7 -width 170 -height 30
1000
[73]1001 button ${config}.register -text Register \
1002 -bg lightblue -activebackground lightblue -command [myproc register]
1003
[85]1004 grid ${config}.axis_check -sticky w
1005 grid ${config}.spc1
[159]1006 grid ${config}.chan_frame -sticky ew -padx 5
[85]1007 grid ${config}.spc3
[73]1008 grid ${config}.thrs_check -sticky w
1009 grid ${config}.thrs_field -sticky ew -pady 1 -padx 5
[85]1010 grid ${config}.spc4
[159]1011 grid ${config}.cntr -sticky w -pady 1 -padx 3
1012 grid ${config}.cntr_field -sticky ew -pady 1 -padx 5
[85]1013 grid ${config}.spc5
[159]1014 grid ${config}.recs -sticky w -pady 1 -padx 3
1015 grid ${config}.recs_field -sticky ew -pady 1 -padx 5
1016 grid ${config}.spc6
1017 grid ${config}.start -sticky ew -pady 3 -padx 5
1018 grid ${config}.reset -sticky ew -pady 3 -padx 5
1019 grid ${config}.spc7
[73]1020 grid ${config}.register -sticky ew -pady 3 -padx 5
1021
1022 grid ${graph} -row 0 -column 0 -sticky news
1023 grid ${config} -row 0 -column 1
1024
[77]1025 grid rowconfigure ${master} 0 -weight 1
1026 grid columnconfigure ${master} 0 -weight 1
1027 grid columnconfigure ${master} 1 -weight 0 -minsize 80
1028
[159]1029 grid columnconfigure ${config}.chan_frame 1 -weight 1
1030
1031 my crosshairs $graph
1032
[73]1033 #bind .graph <Motion> {%W crosshairs configure -position @%x,%y}
1034
1035 # create one element with data for the x and y axis, no dots
[159]1036 $graph element create Spectrum1 -color blue -linewidth 2 -symbol none -smooth step -xdata [myvar xvec] -ydata [myvar yvec]
[73]1037 }
1038
1039# -------------------------------------------------------------------------
1040
[159]1041 CntDisplay instproc coor_update {W x y} {
1042 my instvar config graph
1043
1044 $W crosshairs configure -position @${x},${y}
1045
1046 set index [$W axis invtransform x $x]
1047 set index [::tcl::mathfunc::round $index]
1048 catch {
1049 ${config}.chan_frame.axisy_value configure -text [[myvar yvec] index $index]
1050 ${config}.chan_frame.axisx_value configure -text ${index}.0
[85]1051 }
1052 }
1053# -------------------------------------------------------------------------
1054
[159]1055 CntDisplay instproc crosshairs {graph} {
1056 set method [myproc coor_update]
1057 bind $graph <Motion> [list [self] coor_update %W %x %y]
1058 bind $graph <Leave> {
1059 %W crosshairs off
1060 }
1061 bind $graph <Enter> {
1062 %W crosshairs on
1063 }
[85]1064 }
1065
1066# -------------------------------------------------------------------------
1067
[159]1068 CntDisplay instproc thrs_update args {
1069 my instvar controller config thrs thrs_val
[73]1070
[159]1071 if {[string equal $thrs_val {}]} {
1072 set thrs_val 0
1073 }
1074
1075 set number 0
[162]1076 set val_addr [format %02x [expr {9 + ${number}}]]
[159]1077
1078 if {$thrs} {
1079 ${config}.thrs_field configure -state normal
1080 set value [format %03x $thrs_val]
[73]1081 } else {
[159]1082 ${config}.thrs_field configure -state disabled
1083 set value 000
[73]1084 }
[159]1085
1086 $controller usbCmd 000200${val_addr}00040${value}
[73]1087 }
1088
1089# -------------------------------------------------------------------------
1090
[159]1091 CntDisplay instproc cntr_update args {
1092 my instvar cntr cntr_val
1093 set cntr_val [expr {${cntr}/20000}]
[73]1094
1095 }
1096
1097# -------------------------------------------------------------------------
1098
[159]1099 CntDisplay instproc recs_update args {
1100 my instvar recs recs_val
1101 set recs_val [expr {${recs}*1}]
1102 }
[73]1103
[159]1104# -------------------------------------------------------------------------
[73]1105
[159]1106 CntDisplay instproc cntr_setup {} {
1107 my instvar controller cntr_val
1108
1109 set cntr_tmp [expr {${cntr_val} * 20000}]
1110 set word0 [format {%08x} [expr {${cntr_tmp} & 0xFFFFFFFF}]]
1111 set word1 [format {%08x} [expr {${cntr_tmp} >> 32}]]
1112
1113 set prefix [format {%x} 9]
1114
1115 set command {}
1116 append command 0001${prefix}000000200000004[string range $word0 4 7]
1117 append command 0001${prefix}000000200010004[string range $word0 0 3]
1118 append command 0001${prefix}000000200020004[string range $word1 4 7]
1119 append command 0001${prefix}000000200030004[string range $word1 0 3]
1120
1121 # send counter value
1122 $controller usbCmd $command
[73]1123 }
1124
1125# -------------------------------------------------------------------------
1126
[159]1127 CntDisplay instproc recs_setup {} {
1128 my instvar controller recs_val
[73]1129
[159]1130 set word0 [format {%08x} [expr {${recs_val} & 0xFFFFFFFF}]]
1131 set word1 [format {%08x} [expr {${recs_val} >> 32}]]
[73]1132
[159]1133 set prefix [format {%x} 10]
1134
1135 set command {}
1136 append command 0001${prefix}000000200000004[string range $word0 4 7]
1137 append command 0001${prefix}000000200010004[string range $word0 0 3]
1138 append command 0001${prefix}000000200020004[string range $word1 4 7]
1139 append command 0001${prefix}000000200030004[string range $word1 0 3]
1140
1141 # send counter value
1142 $controller usbCmd $command
[73]1143 }
1144
1145# -------------------------------------------------------------------------
1146
[159]1147 CntDisplay instproc cntr_reset {} {
1148 my instvar controller after_handle
1149 my instvar cntr_val cntr_bak recs_val recs_bak
[73]1150
[159]1151 my cntr_stop
[85]1152
[159]1153 set value [format {%04x} [expr {1 << 11}]]
1154 $controller usbCmd 000200000004${value}0002000000040000
[73]1155
[159]1156 my recs_stop
[73]1157 }
1158
1159# -------------------------------------------------------------------------
1160
[159]1161 CntDisplay instproc cntr_ready {} {
1162 my instvar config cntr_val cntr_bak recs_val recs_bak
[73]1163
[159]1164 set cntr_val $cntr_bak
1165 set recs_val $recs_bak
[73]1166
[159]1167 ${config}.start configure -text Start -command [myproc recs_start]
1168 ${config}.reset configure -state active
1169
1170 ${config}.cntr_field configure -state normal
1171 ${config}.recs_field configure -state normal
[73]1172 }
1173
1174# -------------------------------------------------------------------------
1175
[159]1176 CntDisplay instproc recs_start {} {
1177 my instvar controller config auto
1178 my instvar cntr_val cntr_bak recs_val recs_bak
[73]1179
[159]1180 if {$cntr_val > 0 && $recs_val > 0} {
1181 ${config}.start configure -text {Stop} -command [myproc recs_stop]
1182 ${config}.cntr_field configure -state disabled
1183 ${config}.recs_field configure -state disabled
[73]1184
[159]1185 set cntr_bak $cntr_val
1186 set recs_bak $recs_val
1187
1188 my cntr_setup
1189 my recs_setup
1190
1191 set val_addr [format {%02x} 16]
1192
1193 $controller usbCmd 000200${val_addr}00040002
1194
1195 set auto 1
1196
1197 after 100 [myproc acquire_loop]
[73]1198 }
1199 }
1200
1201# -------------------------------------------------------------------------
1202
[159]1203 CntDisplay instproc recs_stop {} {
1204 my instvar cntr_val cntr_bak recs_val recs_bak
[73]1205
[159]1206 my cntr_stop
[85]1207
[159]1208 set cntr_val $cntr_bak
1209 my cntr_setup
[73]1210
[159]1211 set recs_val $recs_bak
1212 my recs_setup
1213
1214 my acquire
1215
1216 my cntr_ready
[73]1217 }
1218
1219# -------------------------------------------------------------------------
1220
[159]1221 CntDisplay instproc cntr_stop {} {
1222 my instvar controller config auto
[85]1223
[159]1224 set val_addr [format {%02x} 16]
[85]1225
[159]1226 $controller usbCmd 000200${val_addr}00040000
1227
1228 set auto 0
[85]1229 }
1230
1231# -------------------------------------------------------------------------
1232
[159]1233 CntDisplay instproc acquire_loop {} {
1234 my instvar recs_val auto
1235
1236 my acquire
1237
1238 if {$recs_val == 0} {
1239 my cntr_stop
1240 my cntr_ready
1241 } elseif {$auto} {
1242 after 1000 [myproc acquire_loop]
[73]1243 }
[159]1244 }
[73]1245
[159]1246# -------------------------------------------------------------------------
[73]1247
[159]1248 CntDisplay instproc data_update args {
1249 my instvar config data
1250 usb::convertBlt $data 2 [myvar yvec]
1251
1252 ${config}.chan_frame.mean_value configure \
1253 -text [format {%.2e} [usb::integrateBlt [myvar yvec] 1]]
1254 ${config}.chan_frame.entr_value configure \
1255 -text [usb::integrateBlt [myvar yvec] 0]
1256
1257 }
1258
1259# -------------------------------------------------------------------------
1260
1261 CntDisplay instproc axis_update args {
1262 my instvar axis graph
[167]1263 $graph axis configure x -min 0 -max 10000
1264 Blt_ZoomStack $graph
[159]1265 if {$axis} {
1266 $graph axis configure y -min 1 -max 1E5 -logscale yes
[73]1267 } else {
[159]1268 $graph axis configure y -min {} -max {} -logscale no
[73]1269 }
1270 }
1271
1272# -------------------------------------------------------------------------
1273
[159]1274 CntDisplay instproc acquire {} {
1275 my instvar controller config
1276 my instvar cntr cntr_val recs recs_val
[73]1277
[165]1278 set size 10000
[159]1279
1280 set prefix [format {%x} 8]
1281
1282 set value [format {%08x} $size]
1283
1284 set command 0001${prefix}000000200000001[string range $value 0 3]0003[string range $value 4 7]00050000
1285
1286 $controller usbCmdReadRaw $command [expr {$size * 2}] [myvar data]
1287
1288 set prefix [format {%x} 9]
1289 set command 0001${prefix}000000200000003000400050000
1290
1291 $controller usbCmdReadHex $command 8 1 [myvar cntr]
1292
1293 set prefix [format {%x} 10]
1294 set command 0001${prefix}000000200000003000400050000
1295
1296 $controller usbCmdReadHex $command 8 1 [myvar recs]
1297 }
1298
[73]1299# -------------------------------------------------------------------------
1300
[159]1301 CntDisplay instproc save_data {data} {
[73]1302
[159]1303 set types {
1304 {{Data Files} {.dat} }
1305 {{All Files} * }
1306 }
[85]1307
[159]1308 set stamp [clock format [clock seconds] -format %Y%m%d_%H%M%S]
1309 set fname counts_${stamp}.dat
1310
1311 set fname [tk_getSaveFile -filetypes $types -initialfile $fname]
1312 if {[string equal $fname {}]} {
1313 return
1314 }
1315
1316 set x [catch {
1317 set fid [open $fname w+]
1318 puts $fid $data
1319 close $fid
1320 }]
1321
1322 if { $x || ![file exists $fname] || ![file isfile $fname] || ![file readable $fname] } {
1323 tk_messageBox -icon error \
1324 -message "An error occurred while writing to \"$fname\""
1325 } else {
1326 tk_messageBox -icon info \
1327 -message "File \"$fname\" written successfully"
1328 }
[85]1329 }
1330
1331# -------------------------------------------------------------------------
1332
[159]1333 CntDisplay instproc register {} {
[165]1334 my save_data [join [[myvar yvec] range 0 9999] \n]
[159]1335 }
1336
1337# -------------------------------------------------------------------------
1338
1339 Class OscDisplay -parameter {
[85]1340 {master}
[159]1341 {controller}
[85]1342 }
1343
1344# -------------------------------------------------------------------------
1345
[159]1346 OscDisplay instproc init {} {
1347 my instvar sequence data xvec yvec
[85]1348
[159]1349 set data {}
1350
1351 set sequence 0
[85]1352
[159]1353# set xvec [vector create #auto(262144)]
1354 set xvec [vector create #auto(10000)]
1355
1356 for {set i 1} {$i <= 9} {incr i} {
1357# dict set yvec $i [vector create #auto(262144)]
1358 dict set yvec $i [vector create #auto(10000)]
[73]1359 }
[85]1360
1361 # fill one vector for the x axis
[159]1362# $xvec seq 0 262143
[85]1363 $xvec seq 0 10000
1364
1365 my setup
1366
1367 next
[73]1368 }
1369
1370# -------------------------------------------------------------------------
1371
[159]1372 OscDisplay instproc destroy {} {
[85]1373 next
[73]1374 }
1375
1376# -------------------------------------------------------------------------
1377
[159]1378 OscDisplay instproc start {} {
1379 my instvar config
1380 my instvar recs_val directory
[73]1381
[85]1382 set directory $::env(HOMEPATH)
[159]1383 set recs_val 100
[85]1384
[159]1385 trace add variable [myvar chan] write [myproc chan_update]
[73]1386
[159]1387 trace add variable [myvar data] write [myproc data_update]
[73]1388
[159]1389 trace add variable [myvar auto] write [myproc auto_update]
[85]1390
[159]1391 trace add variable [myvar thrs] write [myproc thrs_update 0]
1392 trace add variable [myvar thrs_val] write [myproc thrs_update 0]
1393
[85]1394 trace add variable [myvar recs_val] write [myproc recs_val_update]
1395
[159]1396 trace add variable [myvar last] write [myproc last_update]
1397
[167]1398 for {set i 1} {$i <= 6} {incr i} {
1399 ${config}.chan_frame.chan${i}_check select
1400 ${config}.chan_frame.chan${i}_value configure -text 0.0
1401 }
1402 ${config}.chan_frame.axisx_value configure -text 0.0
[159]1403
1404 ${config}.thrs_check select
1405 ${config}.thrs_field set 100
[73]1406 }
1407
1408# -------------------------------------------------------------------------
1409
[159]1410 OscDisplay instproc setup {} {
[85]1411 my instvar master
[159]1412 my instvar xvec yvec graph
1413 my instvar config
[85]1414
1415 # create a graph widget and show a grid
[159]1416 set graph [graph ${master}.graph -height 250 -leftmargin 80]
1417 $graph crosshairs configure -hide no -linewidth 1 -color darkblue -dashes {2 2}
1418 $graph grid configure -hide no
1419 $graph legend configure -hide yes
1420 $graph axis configure x -min 0 -max 10000
1421 $graph axis configure y -min 0 -max 4100
[85]1422
[159]1423# scale ${master}.last -orient horizontal -from 1 -to 27 -tickinterval 0 -showvalue no -variable [myvar last]
[85]1424
[159]1425 set config [frame ${master}.config -width 170]
[85]1426
[159]1427 frame ${config}.chan_frame -width 170
1428 legendButton ${config}.chan_frame 0 chan1 {Channel 1} [myvar chan(1)] turquoise2
1429 legendButton ${config}.chan_frame 1 chan2 {Channel 2} [myvar chan(2)] SpringGreen2
1430 legendButton ${config}.chan_frame 2 chan3 {Channel 3} [myvar chan(3)] orchid2
1431 legendButton ${config}.chan_frame 3 chan4 {Channel 4} [myvar chan(4)] orange2
1432 legendButton ${config}.chan_frame 4 chan5 {Channel 5} [myvar chan(5)] blue1 white
1433 legendButton ${config}.chan_frame 5 chan6 {Channel 6} [myvar chan(6)] gray65 white
1434 legendLabel ${config}.chan_frame 6 axisx {Time axis}
[85]1435
[159]1436 frame ${config}.spc1 -width 170 -height 30
[85]1437
[159]1438 checkbutton ${config}.auto_check -text {auto update} -variable [myvar auto]
[85]1439
[159]1440 frame ${config}.spc2 -width 170 -height 30
[85]1441
[159]1442 checkbutton ${config}.thrs_check -text threshold -variable [myvar thrs]
1443 spinbox ${config}.thrs_field -from 1 -to 4095 \
1444 -increment 5 -width 10 -textvariable [myvar thrs_val] \
1445 -validate all -vcmd {::mca::validate 4095 4 %P}
[85]1446
[159]1447 frame ${config}.spc3 -width 170 -height 30
[85]1448
[159]1449 button ${config}.acquire -text Acquire \
1450 -bg green -activebackground green -command [myproc acquire_start]
1451 button ${config}.register -text Register \
1452 -bg lightblue -activebackground lightblue -command [myproc register]
[85]1453
[159]1454 frame ${config}.spc4 -width 170 -height 30
[85]1455
[159]1456 label ${config}.recs -text {number of records}
1457 spinbox ${config}.recs_field -from 0 -to 10000 \
1458 -increment 10 -width 10 -textvariable [myvar recs_val] \
1459 -validate all -vcmd {::mca::validate 10000 5 %P}
[85]1460
[159]1461 frame ${config}.spc5 -width 170 -height 10
[85]1462
[159]1463 button ${config}.sequence -text {Start Recording} -command [myproc sequence_start] \
1464 -bg yellow -activebackground yellow
[85]1465
[159]1466 frame ${config}.spc6 -width 170 -height 10
[85]1467
[159]1468 button ${config}.recover -text {Read file} \
1469 -bg lightblue -activebackground lightblue -command [myproc recover]
1470
1471 grid ${config}.chan_frame -sticky ew
[85]1472 grid ${config}.spc1
[159]1473 grid ${config}.auto_check -sticky w
[85]1474 grid ${config}.spc2
[159]1475 grid ${config}.thrs_check -sticky w
1476 grid ${config}.thrs_field -sticky ew -pady 1 -padx 5
[85]1477 grid ${config}.spc3
1478 grid ${config}.acquire -sticky ew -pady 3 -padx 5
1479 grid ${config}.register -sticky ew -pady 3 -padx 5
[159]1480 grid ${config}.spc4
1481 grid ${config}.recs -sticky w -pady 1 -padx 3
1482 grid ${config}.recs_field -sticky ew -pady 1 -padx 5
1483 grid ${config}.spc5
1484 grid ${config}.sequence -sticky ew -pady 3 -padx 5
1485 grid ${config}.spc6
1486 grid ${config}.recover -sticky ew -pady 3 -padx 5
[85]1487
[159]1488 grid ${graph} -row 0 -column 0 -sticky news
[85]1489 grid ${config} -row 0 -column 1
1490
[159]1491# grid ${master}.last -row 1 -column 0 -columnspan 2 -sticky ew
[85]1492
1493 grid rowconfigure ${master} 0 -weight 1
1494 grid columnconfigure ${master} 0 -weight 1
1495 grid columnconfigure ${master} 1 -weight 0 -minsize 120
1496
[159]1497 grid columnconfigure ${config}.chan_frame 2 -weight 1
[85]1498
1499 # enable zooming
[159]1500 Blt_ZoomStack $graph
[85]1501
[159]1502 my crosshairs $graph
[85]1503
1504 # create one element with data for the x and y axis, no dots
[159]1505 $graph pen create pen1 -color turquoise3 -linewidth 2 -symbol none
1506 $graph pen create pen2 -color SpringGreen3 -linewidth 2 -symbol none
1507 $graph pen create pen3 -color orchid3 -linewidth 2 -symbol none
1508 $graph pen create pen4 -color orange3 -linewidth 2 -symbol none
1509 $graph pen create pen5 -color blue2 -linewidth 2 -symbol none
1510 $graph pen create pen6 -color gray55 -linewidth 2 -symbol none
1511
1512 $graph element create Spectrum1 -pen pen1 -xdata $xvec -ydata [dict get $yvec 1]
1513 $graph element create Spectrum2 -pen pen2 -xdata $xvec -ydata [dict get $yvec 2]
1514 $graph element create Spectrum3 -pen pen3 -xdata $xvec -ydata [dict get $yvec 3]
1515 $graph element create Spectrum4 -pen pen4 -xdata $xvec -ydata [dict get $yvec 4]
1516 $graph element create Spectrum5 -pen pen5 -xdata $xvec -ydata [dict get $yvec 5]
1517 $graph element create Spectrum6 -pen pen6 -xdata $xvec -ydata [dict get $yvec 6]
[85]1518 }
1519
1520# -------------------------------------------------------------------------
1521
[159]1522 OscDisplay instproc coor_update {W x y} {
1523 my instvar xvec yvec graph
1524 my instvar config
1525
1526 $W crosshairs configure -position @${x},${y}
1527
1528 set index [$W axis invtransform x $x]
1529 set index [::tcl::mathfunc::round $index]
1530 catch {
1531 ${config}.chan_frame.chan1_value configure -text [[dict get $yvec 1] index $index]
1532 ${config}.chan_frame.chan2_value configure -text [[dict get $yvec 2] index $index]
1533 ${config}.chan_frame.chan3_value configure -text [[dict get $yvec 3] index $index]
1534 ${config}.chan_frame.chan4_value configure -text [[dict get $yvec 4] index $index]
1535 ${config}.chan_frame.chan5_value configure -text [[dict get $yvec 5] index $index]
1536 ${config}.chan_frame.chan6_value configure -text [[dict get $yvec 6] index $index]
1537 ${config}.chan_frame.axisx_value configure -text ${index}.0
[85]1538 }
1539 }
1540# -------------------------------------------------------------------------
1541
[159]1542 OscDisplay instproc crosshairs {graph} {
1543 set method [myproc coor_update]
1544 bind $graph <Motion> [list [self] coor_update %W %x %y]
1545 bind $graph <Leave> {
1546 %W crosshairs off
[85]1547 }
[159]1548 bind $graph <Enter> {
1549 %W crosshairs on
[85]1550 }
1551 }
1552
1553# -------------------------------------------------------------------------
1554
[159]1555 OscDisplay instproc chan_update {name key op} {
1556 my instvar config graph chan
[85]1557
[159]1558 if {$chan(${key})} {
1559 $graph pen configure pen${key} -linewidth 2
[85]1560 } else {
[159]1561 $graph pen configure pen${key} -linewidth 0
[85]1562 }
1563 }
1564
1565# -------------------------------------------------------------------------
1566
[159]1567 OscDisplay instproc recs_val_update args {
1568 my instvar recs_val
1569 if {[string equal $recs_val {}]} {
1570 set recs_val 0
1571 }
1572 }
[85]1573
1574# -------------------------------------------------------------------------
1575
[159]1576 OscDisplay instproc last_update args {
1577 my instvar graph last
1578
1579 set first [expr {$last - 1}]
1580
1581 $graph axis configure x -min ${first}0000 -max ${last}0000
[85]1582 }
1583
1584# -------------------------------------------------------------------------
1585
[159]1586 OscDisplay instproc thrs_update {reset args} {
1587 my instvar controller config thrs thrs_val
[85]1588
[159]1589 if {[string equal $thrs_val {}]} {
1590 set thrs_val 0
1591 }
[85]1592
[159]1593 if {$thrs} {
1594 ${config}.thrs_field configure -state normal
1595 set value [format %03x $thrs_val]
1596 } else {
1597 ${config}.thrs_field configure -state disabled
1598 set value 000
[85]1599 }
1600
[159]1601 set command {}
1602 if {$reset} {
1603 append command 0002000500041${value}
[85]1604 }
[159]1605 append command 0002000500040${value}
1606
1607 $controller usbCmd $command
[85]1608 }
1609
1610# -------------------------------------------------------------------------
1611
[159]1612 OscDisplay instproc data_update args {
1613 my instvar data yvec
1614 my instvar graph chan waiting sequence auto
[73]1615
[159]1616 usb::convertOsc $data $yvec
[73]1617
[159]1618 foreach {key value} [array get chan] {
1619 $graph pen configure pen${key} -dashes 0
1620 }
[85]1621
[159]1622 set waiting 0
[85]1623
[159]1624 if {$sequence} {
1625 my sequence_register
1626 } elseif {$auto} {
1627 after 1000 [myproc acquire_start]
1628 }
1629 }
[85]1630
[159]1631# -------------------------------------------------------------------------
[85]1632
[159]1633 OscDisplay instproc acquire_start {} {
1634 my instvar graph chan controller waiting
[85]1635
[159]1636 foreach {key value} [array get chan] {
1637 $graph pen configure pen${key} -dashes dot
[85]1638 }
1639
[159]1640 # restart
1641 my thrs_update 1
[73]1642
[159]1643 set waiting 1
[73]1644
[159]1645 after 200 [myproc acquire_loop]
[85]1646 }
1647
1648# -------------------------------------------------------------------------
1649
[159]1650 OscDisplay instproc acquire_loop {} {
1651 my instvar controller waiting
[85]1652
[159]1653# set size 262144
1654 set size 10000
[85]1655
[159]1656 set value [format {%08x} [expr {$size * 4}]]
[85]1657
[159]1658 set command 00011000000200000001[string range $value 0 3]0003[string range $value 4 7]00050000
1659
1660 $controller usbCmdReadRaw $command [expr {$size * 8}] [myvar data]
[85]1661
[159]1662 if {$waiting} {
1663 after 200 [myproc acquire_loop]
1664 }
[85]1665 }
1666
1667# -------------------------------------------------------------------------
1668
[159]1669 OscDisplay instproc auto_update args {
1670 my instvar config auto
1671
1672 if {$auto} {
1673 ${config}.recs_field configure -state disabled
1674 ${config}.sequence configure -state disabled
1675 ${config}.acquire configure -state disabled
1676 ${config}.register configure -state disabled
1677 ${config}.recover configure -state disabled
1678
1679 my acquire_start
1680 } else {
1681 ${config}.recs_field configure -state normal
1682 ${config}.sequence configure -state active
1683 ${config}.acquire configure -state active
1684 ${config}.register configure -state active
1685 ${config}.recover configure -state active
1686 }
[85]1687 }
1688
1689# -------------------------------------------------------------------------
1690
[159]1691 OscDisplay instproc save_data {fname} {
1692 my instvar data
[85]1693
[159]1694 set fid [open $fname w+]
1695 fconfigure $fid -translation binary -encoding binary
[85]1696
[159]1697# puts -nonewline $fid [binary format "H*iH*" "1f8b0800" [clock seconds] "0003"]
1698# puts -nonewline $fid [zlib deflate $data]
1699 puts -nonewline $fid $data
1700# puts -nonewline $fid [binary format i [zlib crc32 $data]]
1701# puts -nonewline $fid [binary format i [string length $data]]
1702
1703 close $fid
[85]1704 }
1705
1706# -------------------------------------------------------------------------
1707
[159]1708 OscDisplay instproc open_data {} {
1709 set types {
1710 {{Data Files} {.dat} }
1711 {{All Files} * }
1712 }
[85]1713
[159]1714 set fname [tk_getOpenFile -filetypes $types]
1715 if {[string equal $fname {}]} {
1716 return
1717 }
1718
1719 set x [catch {
1720 set fid [open $fname r+]
1721 fconfigure $fid -translation binary -encoding binary
1722# set size [file size $fname]
1723# seek $fid 10
1724# my set data [zlib inflate [read $fid [expr {$size - 18}]]]
1725 my set data [read $fid]
1726 close $fid
1727 }]
1728
1729 if { $x || ![file exists $fname] || ![file isfile $fname] || ![file readable $fname] } {
1730 tk_messageBox -icon error \
1731 -message "An error occurred while reading \"$fname\""
1732 } else {
1733 tk_messageBox -icon info \
1734 -message "File \"$fname\" read successfully"
1735 }
[85]1736 }
1737
1738# -------------------------------------------------------------------------
1739
[159]1740 OscDisplay instproc register {} {
1741 set types {
1742 {{Data Files} {.dat} }
1743 {{All Files} * }
1744 }
[85]1745
[159]1746 set stamp [clock format [clock seconds] -format %Y%m%d_%H%M%S]
1747 set fname oscillogram_${stamp}.dat
[85]1748
[159]1749 set fname [tk_getSaveFile -filetypes $types -initialfile $fname]
1750 if {[string equal $fname {}]} {
1751 return
1752 }
1753
1754 if {[catch {my save_data $fname} result]} {
1755 tk_messageBox -icon error \
1756 -message "An error occurred while writing to \"$fname\""
1757 } else {
1758 tk_messageBox -icon info \
1759 -message "File \"$fname\" written successfully"
1760 }
1761 }
[85]1762
[159]1763# -------------------------------------------------------------------------
[85]1764
[159]1765 OscDisplay instproc recover {} {
1766 my open_data
1767 }
[85]1768
[159]1769# -------------------------------------------------------------------------
[85]1770
[159]1771 OscDisplay instproc sequence_start {} {
1772 my instvar config recs_val recs_bak directory counter sequence
[85]1773
[159]1774 set counter 1
1775 if {$counter > $recs_val} {
1776 return
1777 }
[85]1778
[159]1779 set directory [tk_chooseDirectory -initialdir $directory -title {Choose a directory}]
[85]1780
[159]1781 if {[string equal $directory {}]} {
1782 return
1783 }
[85]1784
[159]1785 ${config}.recs_field configure -state disabled
1786 ${config}.sequence configure -text {Stop Recording} -command [myproc sequence_stop]
1787 ${config}.acquire configure -state disabled
1788 ${config}.register configure -state disabled
1789 ${config}.recover configure -state disabled
1790
1791 set recs_bak $recs_val
[85]1792
[159]1793 set sequence 1
1794
1795 my acquire_start
[85]1796 }
1797
1798# -------------------------------------------------------------------------
1799
[159]1800 OscDisplay instproc sequence_register {} {
1801 my instvar config recs_val recs_bak directory counter
[85]1802
[159]1803 set fname [file join $directory oscillogram_$counter.dat]
[85]1804
[159]1805 my incr counter
[85]1806
[159]1807 if {[catch {my save_data $fname} result]} {
1808 tk_messageBox -icon error \
1809 -message "An error occurred while writing to \"$fname\""
1810 } elseif {$counter <= $recs_bak} {
1811 set recs_val [expr {$recs_bak - $counter}]
1812 my acquire_start
[85]1813 return
1814 }
[159]1815
1816 my sequence_stop
[85]1817 }
1818
1819# -------------------------------------------------------------------------
1820
[159]1821 OscDisplay instproc sequence_stop {} {
1822 my instvar config recs_val recs_bak sequence
[85]1823
[159]1824 set sequence 0
1825
1826 set recs_val $recs_bak
[85]1827
[159]1828 ${config}.recs_field configure -state normal
1829 ${config}.sequence configure -text {Start Recording} -command [myproc sequence_start]
1830 ${config}.acquire configure -state active
1831 ${config}.register configure -state active
1832 ${config}.recover configure -state active
[85]1833 }
1834
1835# -------------------------------------------------------------------------
1836
[159]1837 namespace export MuxDisplay
[73]1838 namespace export HstDisplay
[159]1839 namespace export CntDisplay
[73]1840 namespace export OscDisplay
1841}
1842
[78]1843set notebook [::blt::tabnotebook .notebook -borderwidth 1 -selectforeground black -side bottom]
[73]1844
[159]1845grid ${notebook} -row 0 -column 0 -sticky news -pady 5
[73]1846
[78]1847grid rowconfigure . 0 -weight 1
[159]1848grid columnconfigure . 0 -weight 1
[78]1849
[159]1850::mca::UsbController usb
[73]1851
[159]1852set window [frame ${notebook}.hst_0]
[162]1853$notebook insert end -text "Spectrum histogram 1" -window $window -fill both
[159]1854::mca::HstDisplay hst_0 -number 0 -master $window -controller usb
[73]1855
[162]1856set window [frame ${notebook}.hst_1]
1857$notebook insert end -text "Spectrum histogram 2" -window $window -fill both
1858::mca::HstDisplay hst_1 -number 1 -master $window -controller usb
1859
[159]1860set window [frame ${notebook}.cnt_0]
1861$notebook insert end -text "Rate histogram" -window $window -fill both
1862::mca::CntDisplay cnt_0 -master $window -controller usb
[73]1863
[159]1864set window [frame ${notebook}.mux]
1865$notebook insert end -text "Interconnect" -window $window -fill both
1866::mca::MuxDisplay mux -master $window -controller usb
[73]1867
[85]1868set window [frame ${notebook}.ept]
[159]1869$notebook insert end -text "Oscilloscope" -window $window -fill both
1870::mca::OscDisplay osc -master $window -controller usb
[85]1871
[159]1872update
[85]1873
[159]1874usb usbCmd 00000000
[73]1875
[159]1876hst_0 start
[73]1877
[162]1878hst_1 start
1879
[159]1880cnt_0 start
[73]1881
[159]1882mux start
[77]1883
[159]1884osc start
Note: See TracBrowser for help on using the repository browser.