source: trunk/MultiChannelUSB/UserInterface.tcl@ 164

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

add spectrum histogram 2

File size: 60.2 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
[73]440
[159]441# my cntr_reset
[73]442 }
443
444# -------------------------------------------------------------------------
445
[159]446 HstDisplay instproc setup {} {
[73]447 my instvar number master
[159]448 my instvar xvec yvec graph
449 my instvar config thrs thrs_val
450 my instvar cntr_h cntr_m cntr_s
[73]451
452 # create a graph widget and show a grid
453 set graph [graph ${master}.graph -height 250 -leftmargin 80]
[159]454 $graph crosshairs configure -hide no -linewidth 1 -color darkblue -dashes {2 2}
[73]455 $graph grid configure -hide no
456 $graph legend configure -hide yes
[159]457 $graph axis configure x -min 0 -max 4096
[73]458
[159]459 set config [frame ${master}.config -width 170]
[73]460
[159]461 checkbutton ${config}.axis_check -text {log scale} -variable [myvar axis]
[73]462
[159]463 frame ${config}.spc1 -width 170 -height 30
[73]464
[159]465 frame ${config}.rate_frame -borderwidth 0 -width 170
466 legendLabel ${config}.rate_frame 0 inst {Inst. rate, 1/s}
467 legendLabel ${config}.rate_frame 1 mean {Avg. rate, 1/s}
468
469 frame ${config}.spc2 -width 170 -height 30
470
471 frame ${config}.chan_frame -borderwidth 0 -width 170
472 legendLabel ${config}.chan_frame 0 entr {Total entries}
473 legendLabel ${config}.chan_frame 1 empty {}
474 legendLabel ${config}.chan_frame 2 axisy {Bin entries}
475 legendLabel ${config}.chan_frame 3 axisx {Bin number}
476
477 frame ${config}.spc3 -width 170 -height 30
478
479 checkbutton ${config}.thrs_check -text {amplitude threshold} -variable [myvar thrs]
[73]480 spinbox ${config}.thrs_field -from 1 -to 4095 \
481 -increment 5 -width 10 -textvariable [myvar thrs_val] \
[159]482 -validate all -vcmd {::mca::validate 4095 4 %P}
[73]483
[159]484 frame ${config}.spc4 -width 170 -height 30
[73]485
[159]486 label ${config}.cntr -text {time of exposure}
487 frame ${config}.cntr_frame -borderwidth 0 -width 170
[73]488
[159]489 label ${config}.cntr_frame.h -width 3 -anchor w -text {h}
490 entry ${config}.cntr_frame.h_field -width 3 -textvariable [myvar cntr_h] \
491 -validate all -vcmd {::mca::validate 999 3 %P}
492 label ${config}.cntr_frame.m -width 3 -anchor w -text {m}
493 entry ${config}.cntr_frame.m_field -width 3 -textvariable [myvar cntr_m] \
494 -validate all -vcmd {::mca::validate 59 2 %P}
495 label ${config}.cntr_frame.s -width 3 -anchor w -text {s}
496 entry ${config}.cntr_frame.s_field -width 6 -textvariable [myvar cntr_s] \
497 -validate all -vcmd {::mca::doublevalidate 59.999 %P}
[73]498
[159]499 grid ${config}.cntr_frame.h_field ${config}.cntr_frame.h \
500 ${config}.cntr_frame.m_field ${config}.cntr_frame.m ${config}.cntr_frame.s_field ${config}.cntr_frame.s
[74]501
[159]502 frame ${config}.spc5 -width 170 -height 10
[74]503
[159]504 button ${config}.start -text Start \
505 -bg yellow -activebackground yellow -command [myproc cntr_start]
506 button ${config}.reset -text Reset \
507 -bg red -activebackground red -command [myproc cntr_reset]
508
509 frame ${config}.spc6 -width 170 -height 30
510
511
[73]512 button ${config}.register -text Register \
513 -bg lightblue -activebackground lightblue -command [myproc register]
514
[159]515 grid ${config}.axis_check -sticky w
[73]516 grid ${config}.spc1
[159]517 grid ${config}.rate_frame -sticky ew -padx 5
518 grid ${config}.spc2
519 grid ${config}.chan_frame -sticky ew -padx 5
520 grid ${config}.spc3
[73]521 grid ${config}.thrs_check -sticky w
522 grid ${config}.thrs_field -sticky ew -pady 1 -padx 5
[74]523 grid ${config}.spc4
[159]524 grid ${config}.cntr -sticky w -pady 1 -padx 3
525 grid ${config}.cntr_frame -sticky ew -padx 5
526 grid ${config}.spc5
527 grid ${config}.start -sticky ew -pady 3 -padx 5
528 grid ${config}.reset -sticky ew -pady 3 -padx 5
529 grid ${config}.spc6
[73]530 grid ${config}.register -sticky ew -pady 3 -padx 5
531
532 grid ${graph} -row 0 -column 0 -sticky news
533 grid ${config} -row 0 -column 1
534
[77]535 grid rowconfigure ${master} 0 -weight 1
536 grid columnconfigure ${master} 0 -weight 1
537 grid columnconfigure ${master} 1 -weight 0 -minsize 80
538
[159]539 grid columnconfigure ${config}.rate_frame 1 -weight 1
540 grid columnconfigure ${config}.chan_frame 1 -weight 1
541
[73]542 # enable zooming
543 Blt_ZoomStack $graph
544
[159]545 my crosshairs $graph
546
[73]547 #bind .graph <Motion> {%W crosshairs configure -position @%x,%y}
548
549 # create one element with data for the x and y axis, no dots
[159]550 $graph element create Spectrum1 -color blue -linewidth 2 -symbol none -smooth step -xdata [myvar xvec] -ydata [myvar yvec]
[73]551 }
552
553# -------------------------------------------------------------------------
554
[159]555 HstDisplay instproc coor_update {W x y} {
556 my instvar config graph
557
558 $W crosshairs configure -position @${x},${y}
559
560 set index [$W axis invtransform x $x]
561 set index [::tcl::mathfunc::round $index]
562 catch {
563 ${config}.chan_frame.axisy_value configure -text [[myvar yvec] index $index]
564 ${config}.chan_frame.axisx_value configure -text ${index}.0
565 }
[85]566 }
567# -------------------------------------------------------------------------
568
[159]569 HstDisplay instproc crosshairs {graph} {
570 set method [myproc coor_update]
571 bind $graph <Motion> [list [self] coor_update %W %x %y]
572 bind $graph <Leave> {
573 %W crosshairs off
574 }
575 bind $graph <Enter> {
576 %W crosshairs on
577 }
578 }
[73]579
[159]580# -------------------------------------------------------------------------
[73]581
[159]582 HstDisplay instproc axis_update args {
583 my instvar axis graph
584 if {$axis} {
585 $graph axis configure y -min 1 -max 1E10 -logscale yes
[73]586 } else {
[159]587 $graph axis configure y -min {} -max {} -logscale no
[73]588 }
589 }
590
591# -------------------------------------------------------------------------
592
[159]593 HstDisplay instproc thrs_update args {
594 my instvar controller config number thrs thrs_val
[74]595
[159]596 if {[string equal $thrs_val {}]} {
597 set thrs_val 0
598 }
[74]599
[162]600 set val_addr [format %02x [expr {7 + ${number}}]]
[159]601
[73]602 if {$thrs} {
603 ${config}.thrs_field configure -state normal
[159]604 set value [format %03x $thrs_val]
[73]605 } else {
606 ${config}.thrs_field configure -state disabled
[159]607 set value 000
[73]608 }
[159]609
610 $controller usbCmd 000200${val_addr}00040${value}
[73]611 }
612
613# -------------------------------------------------------------------------
614
[159]615 HstDisplay instproc rate_val_update {name key op} {
616 my instvar config rate_val
[74]617
[159]618 ${config}.rate_frame.${key}_value configure -text [format {%.2e} $rate_val(${key})]
619 }
[85]620
[159]621# -------------------------------------------------------------------------
[74]622
[159]623 HstDisplay instproc cntr_val_update args {
624 my instvar cntr_val cntr_h cntr_m cntr_s
625
626 set cntr_tmp [expr {${cntr_val}/20000}]
627 set cntr_h [expr {${cntr_tmp}/3600000}]
628 set cntr_m [expr {${cntr_tmp}%3600000/60000}]
629 set cntr_s [expr {${cntr_tmp}%3600000%60000/1000.0}]
[73]630 }
631
632# -------------------------------------------------------------------------
633
[159]634 HstDisplay instproc cntr_setup {} {
635 my instvar controller number cntr_val
[74]636
[159]637 set word0 [format %08x [expr {${cntr_val} & 0xFFFFFFFF}]]
638 set word1 [format %08x [expr {${cntr_val} >> 32}]]
639
640 set prefix [format %x [expr {5 + ${number}}]]
641
642 set command {}
643 append command 0001${prefix}000000200000004[string range $word0 4 7]
644 append command 0001${prefix}000000200010004[string range $word0 0 3]
645 append command 0001${prefix}000000200020004[string range $word1 4 7]
646 append command 0001${prefix}000000200030004[string range $word1 0 3]
647
648 # send counter value
649 $controller usbCmd $command
650
651 # load counter value
652# set val_addr [format %02x [expr {12 + ${number}}]]
653# $controller usbCmd 000200${val_addr}00040001000200${val_addr}00040000
[74]654 }
655
[159]656# -------------------------------------------------------------------------
[74]657
[159]658 HstDisplay instproc cntr_reset {} {
659 my instvar controller number after_handle
660 my instvar cntr_val cntr_bak cntr_old yvec_bak yvec_old
[74]661
[159]662 my cntr_stop
[74]663
[159]664 set value [format %04x [expr {1 << (5 + ${number})}]]
665 $controller usbCmd 000200000004${value}0002000000040000
666
667 set cntr_val $cntr_bak
668 my cntr_setup
669
670 set cntr_old $cntr_bak
671 set yvec_bak 0.0
672 set yvec_old 0.0
673
674 my acquire
675
676 my cntr_ready
[74]677 }
678
[159]679# -------------------------------------------------------------------------
[74]680
[159]681 HstDisplay instproc cntr_ready {} {
682 my instvar config cntr_val cntr_bak
[74]683
[159]684 set cntr_val $cntr_bak
[74]685
[159]686 ${config}.start configure -text Start -command [myproc cntr_start]
687 ${config}.reset configure -state active
688
689 ${config}.cntr_frame.h_field configure -state normal
690 ${config}.cntr_frame.m_field configure -state normal
691 ${config}.cntr_frame.s_field configure -state normal
[74]692 }
693
694# -------------------------------------------------------------------------
695
[159]696 HstDisplay instproc cntr_start {} {
697 my instvar config
698 my instvar cntr_h cntr_m cntr_s
699 my instvar cntr_val cntr_bak cntr_old yvec_bak yvec_old
700
701 set h $cntr_h
702 set m $cntr_m
703 set s $cntr_s
704
705 if {[string equal $h {}]} {
706 set h 0
[73]707 }
[159]708 if {[string equal $m {}]} {
709 set m 0
710 }
711 if {[string equal $s {}]} {
712 set s 0
713 }
[73]714
[159]715 set cntr_tmp [expr {${h}*3600000 + ${m}*60000 + ${s}*1000}]
716 set cntr_tmp [expr {entier(20000 * ${cntr_tmp})}]
[73]717
[159]718 if {$cntr_tmp > 0} {
719 ${config}.cntr_frame.h_field configure -state disabled
720 ${config}.cntr_frame.m_field configure -state disabled
721 ${config}.cntr_frame.s_field configure -state disabled
722
723 set cntr_val $cntr_tmp
724 set cntr_bak $cntr_tmp
725 set cntr_old $cntr_tmp
726 set yvec_bak [usb::integrateBlt [myvar yvec] 0]
727 set yvec_old $yvec_bak
728
729 my cntr_setup
730
731 my cntr_resume
[73]732 }
733 }
734
735# -------------------------------------------------------------------------
736
[159]737 HstDisplay instproc cntr_pause {} {
738 my instvar config
[73]739
[159]740 my cntr_stop
741
742 ${config}.start configure -text Resume -command [myproc cntr_resume]
743# ${config}.reset configure -state active
744
745 }
746
[73]747# -------------------------------------------------------------------------
748
[159]749 HstDisplay instproc cntr_resume {} {
750 my instvar controller config number auto
751
752 set val_addr [format %02x [expr {13 + ${number}}]]
753
754 ${config}.start configure -text Pause -command [myproc cntr_pause]
755# ${config}.reset configure -state disabled
756
757 $controller usbCmd 000200${val_addr}00040002
758
759 set auto 1
760
761 after 100 [myproc acquire_loop]
[73]762 }
763
764# -------------------------------------------------------------------------
765
[159]766 HstDisplay instproc cntr_stop {} {
767 my instvar controller config number auto
768
769 set val_addr [format %02x [expr {13 + ${number}}]]
770
771 $controller usbCmd 000200${val_addr}00040000
772
773 set auto 0
[73]774 }
775
776# -------------------------------------------------------------------------
777
[159]778 HstDisplay instproc data_update args {
779 my instvar data
780 usb::convertBlt $data 4 [myvar yvec]
781 }
[73]782
[159]783# -------------------------------------------------------------------------
784
785 HstDisplay instproc acquire_loop {} {
786 my instvar cntr_val auto
787
[73]788 my acquire
789
[159]790 if {$cntr_val == 0} {
791 my cntr_stop
792 my cntr_ready
793 } elseif {$auto} {
794 after 1000 [myproc acquire_loop]
795 }
[73]796 }
797
798# -------------------------------------------------------------------------
799
[159]800 HstDisplay instproc acquire {} {
801 my instvar controller config number
802 my instvar cntr_val cntr_bak cntr_old yvec_bak yvec_old rate_val
[73]803
[159]804 set size 4096
805
[162]806 set prefix [format {%x} [expr {2 + ${number}}]]
[159]807
808 set value [format {%08x} [expr {$size * 2}]]
809
810 set command 0001${prefix}000000200000001[string range $value 0 3]0003[string range $value 4 7]00050000
811
812 $controller usbCmdReadRaw $command [expr {$size * 4}] [myvar data]
813 set yvec_new [usb::integrateBlt [myvar yvec] 0]
814
[162]815 set prefix [format {%x} [expr {5 + ${number}}]]
[159]816 set command 0001${prefix}000000200000003000400050000
817
818 $controller usbCmdReadHex $command 8 1 [myvar cntr_val]
819 set cntr_new $cntr_val
820
821 if {$cntr_new < $cntr_old} {
822 set rate_val(inst) [expr {($yvec_new - $yvec_old)*20000000/($cntr_old - $cntr_new)}]
823 set rate_val(mean) [expr {($yvec_new - $yvec_bak)*20000000/($cntr_bak - $cntr_new)}]
824 ${config}.chan_frame.entr_value configure -text $yvec_new
825
826 set yvec_old $yvec_new
827 set cntr_old $cntr_new
828 }
829 }
830
[73]831# -------------------------------------------------------------------------
832
[159]833 HstDisplay instproc save_data {data} {
834 my instvar number
[73]835
[159]836 set types {
837 {{Data Files} {.dat} }
838 {{All Files} * }
839 }
[73]840
[159]841 set stamp [clock format [clock seconds] -format %Y%m%d_%H%M%S]
842 set fname spectrum_[expr {$number + 1}]_${stamp}.dat
[73]843
[159]844 set fname [tk_getSaveFile -filetypes $types -initialfile $fname]
845 if {[string equal $fname {}]} {
846 return
847 }
[73]848
[159]849 set x [catch {
850 set fid [open $fname w+]
851 puts $fid $data
852 close $fid
853 }]
854
855 if { $x || ![file exists $fname] || ![file isfile $fname] || ![file readable $fname] } {
856 tk_messageBox -icon error \
857 -message "An error occurred while writing to \"$fname\""
858 } else {
859 tk_messageBox -icon info \
860 -message "File \"$fname\" written successfully"
861 }
[73]862 }
863
864# -------------------------------------------------------------------------
865
[159]866 HstDisplay instproc register {} {
867 my save_data [join [[myvar yvec] range 0 4095] \n]
[73]868 }
869
870# -------------------------------------------------------------------------
871
[159]872 Class CntDisplay -parameter {
873 {master}
874 {controller}
875 }
[73]876
[159]877# -------------------------------------------------------------------------
[73]878
[159]879 CntDisplay instproc init {} {
880
881 my set data {}
882 my set cntr 0
883 my set recs 0
884
[162]885 vector create [myvar xvec](4096)
886 vector create [myvar yvec](4096)
[159]887
[162]888 # fill one vector for the x axis with 4096 points
889 [myvar xvec] seq -0.5 4095.5
[159]890
891 my setup
892
893 next
[73]894 }
895
896# -------------------------------------------------------------------------
897
[159]898 CntDisplay instproc destroy {} {
899 next
900 }
[73]901
[159]902# -------------------------------------------------------------------------
[73]903
[159]904 CntDisplay instproc start {} {
905 my instvar config
906
[85]907 trace add variable [myvar data] write [myproc data_update]
[159]908
[73]909 trace add variable [myvar thrs] write [myproc thrs_update]
[159]910 trace add variable [myvar thrs_val] write [myproc thrs_update]
[73]911
[159]912 trace add variable [myvar cntr] write [myproc cntr_update]
913 trace add variable [myvar recs] write [myproc recs_update]
[85]914
[159]915 trace add variable [myvar axis] write [myproc axis_update]
916
917 ${config}.axis_check select
918
[73]919 ${config}.thrs_check select
[159]920 ${config}.thrs_field set 25
[85]921
[159]922 my set cntr_val 100
923 my set cntr_bak 100
924 my set recs_val 100
925 my set recs_bak 100
926
927# my cntr_reset
[73]928 }
929
930# -------------------------------------------------------------------------
931
[159]932 CntDisplay instproc setup {} {
933 my instvar master
934 my instvar xvec yvec graph
935 my instvar config
936 my instvar cntr_ms
[73]937
938 # create a graph widget and show a grid
939 set graph [graph ${master}.graph -height 250 -leftmargin 80]
[159]940 $graph crosshairs configure -hide no -linewidth 1 -color darkblue -dashes {2 2}
[73]941 $graph grid configure -hide no
942 $graph legend configure -hide yes
[162]943 $graph axis configure x -min 0 -max 4096
[73]944
[159]945 set config [frame ${master}.config -width 170]
[73]946
[85]947 checkbutton ${config}.axis_check -text {log scale} -variable [myvar axis]
[73]948
[159]949 frame ${config}.spc1 -width 170 -height 30
[73]950
[159]951 frame ${config}.chan_frame -borderwidth 0 -width 170
952 legendLabel ${config}.chan_frame 0 mean {Mean value}
953 legendLabel ${config}.chan_frame 1 entr {Total entries}
954 legendLabel ${config}.chan_frame 2 empty {}
955 legendLabel ${config}.chan_frame 3 axisy {Bin entries}
956 legendLabel ${config}.chan_frame 4 axisx {Bin number}
[73]957
[159]958 frame ${config}.spc3 -width 170 -height 30
[73]959
[159]960 checkbutton ${config}.thrs_check -text {amplitude threshold} -variable [myvar thrs]
[73]961 spinbox ${config}.thrs_field -from 1 -to 4095 \
962 -increment 5 -width 10 -textvariable [myvar thrs_val] \
[159]963 -validate all -vcmd {::mca::validate 4095 4 %P}
[73]964
[159]965 frame ${config}.spc4 -width 170 -height 30
[73]966
[159]967 label ${config}.cntr -text {time of exposure (ms)}
968 spinbox ${config}.cntr_field -from 0 -to 9999 \
969 -increment 10 -width 10 -textvariable [myvar cntr_val] \
970 -validate all -vcmd {::mca::validate 9999 4 %P}
[73]971
[159]972 frame ${config}.spc5 -width 170 -height 10
[73]973
[159]974 label ${config}.recs -text {number of exposures}
975 spinbox ${config}.recs_field -from 0 -to 99999 \
976 -increment 10 -width 10 -textvariable [myvar recs_val] \
977 -validate all -vcmd {::mca::validate 99999 5 %P}
978
979 frame ${config}.spc6 -width 170 -height 10
980
981 button ${config}.start -text {Start} \
982 -bg yellow -activebackground yellow -command [myproc recs_start]
983
984 button ${config}.reset -text Reset \
985 -bg red -activebackground red -command [myproc cntr_reset]
986
987 frame ${config}.spc7 -width 170 -height 30
988
[73]989 button ${config}.register -text Register \
990 -bg lightblue -activebackground lightblue -command [myproc register]
991
[85]992 grid ${config}.axis_check -sticky w
993 grid ${config}.spc1
[159]994 grid ${config}.chan_frame -sticky ew -padx 5
[85]995 grid ${config}.spc3
[73]996 grid ${config}.thrs_check -sticky w
997 grid ${config}.thrs_field -sticky ew -pady 1 -padx 5
[85]998 grid ${config}.spc4
[159]999 grid ${config}.cntr -sticky w -pady 1 -padx 3
1000 grid ${config}.cntr_field -sticky ew -pady 1 -padx 5
[85]1001 grid ${config}.spc5
[159]1002 grid ${config}.recs -sticky w -pady 1 -padx 3
1003 grid ${config}.recs_field -sticky ew -pady 1 -padx 5
1004 grid ${config}.spc6
1005 grid ${config}.start -sticky ew -pady 3 -padx 5
1006 grid ${config}.reset -sticky ew -pady 3 -padx 5
1007 grid ${config}.spc7
[73]1008 grid ${config}.register -sticky ew -pady 3 -padx 5
1009
1010 grid ${graph} -row 0 -column 0 -sticky news
1011 grid ${config} -row 0 -column 1
1012
[77]1013 grid rowconfigure ${master} 0 -weight 1
1014 grid columnconfigure ${master} 0 -weight 1
1015 grid columnconfigure ${master} 1 -weight 0 -minsize 80
1016
[159]1017 grid columnconfigure ${config}.chan_frame 1 -weight 1
1018
[73]1019 # enable zooming
1020 Blt_ZoomStack $graph
1021
[159]1022 my crosshairs $graph
1023
[73]1024 #bind .graph <Motion> {%W crosshairs configure -position @%x,%y}
1025
1026 # create one element with data for the x and y axis, no dots
[159]1027 $graph element create Spectrum1 -color blue -linewidth 2 -symbol none -smooth step -xdata [myvar xvec] -ydata [myvar yvec]
[73]1028 }
1029
1030# -------------------------------------------------------------------------
1031
[159]1032 CntDisplay instproc coor_update {W x y} {
1033 my instvar config graph
1034
1035 $W crosshairs configure -position @${x},${y}
1036
1037 set index [$W axis invtransform x $x]
1038 set index [::tcl::mathfunc::round $index]
1039 catch {
1040 ${config}.chan_frame.axisy_value configure -text [[myvar yvec] index $index]
1041 ${config}.chan_frame.axisx_value configure -text ${index}.0
[85]1042 }
1043 }
1044# -------------------------------------------------------------------------
1045
[159]1046 CntDisplay instproc crosshairs {graph} {
1047 set method [myproc coor_update]
1048 bind $graph <Motion> [list [self] coor_update %W %x %y]
1049 bind $graph <Leave> {
1050 %W crosshairs off
1051 }
1052 bind $graph <Enter> {
1053 %W crosshairs on
1054 }
[85]1055 }
1056
1057# -------------------------------------------------------------------------
1058
[159]1059 CntDisplay instproc thrs_update args {
1060 my instvar controller config thrs thrs_val
[73]1061
[159]1062 if {[string equal $thrs_val {}]} {
1063 set thrs_val 0
1064 }
1065
1066 set number 0
[162]1067 set val_addr [format %02x [expr {9 + ${number}}]]
[159]1068
1069 if {$thrs} {
1070 ${config}.thrs_field configure -state normal
1071 set value [format %03x $thrs_val]
[73]1072 } else {
[159]1073 ${config}.thrs_field configure -state disabled
1074 set value 000
[73]1075 }
[159]1076
1077 $controller usbCmd 000200${val_addr}00040${value}
[73]1078 }
1079
1080# -------------------------------------------------------------------------
1081
[159]1082 CntDisplay instproc cntr_update args {
1083 my instvar cntr cntr_val
1084 set cntr_val [expr {${cntr}/20000}]
[73]1085
1086 }
1087
1088# -------------------------------------------------------------------------
1089
[159]1090 CntDisplay instproc recs_update args {
1091 my instvar recs recs_val
1092 set recs_val [expr {${recs}*1}]
1093 }
[73]1094
[159]1095# -------------------------------------------------------------------------
[73]1096
[159]1097 CntDisplay instproc cntr_setup {} {
1098 my instvar controller cntr_val
1099
1100 set cntr_tmp [expr {${cntr_val} * 20000}]
1101 set word0 [format {%08x} [expr {${cntr_tmp} & 0xFFFFFFFF}]]
1102 set word1 [format {%08x} [expr {${cntr_tmp} >> 32}]]
1103
1104 set prefix [format {%x} 9]
1105
1106 set command {}
1107 append command 0001${prefix}000000200000004[string range $word0 4 7]
1108 append command 0001${prefix}000000200010004[string range $word0 0 3]
1109 append command 0001${prefix}000000200020004[string range $word1 4 7]
1110 append command 0001${prefix}000000200030004[string range $word1 0 3]
1111
1112 # send counter value
1113 $controller usbCmd $command
[73]1114 }
1115
1116# -------------------------------------------------------------------------
1117
[159]1118 CntDisplay instproc recs_setup {} {
1119 my instvar controller recs_val
[73]1120
[159]1121 set word0 [format {%08x} [expr {${recs_val} & 0xFFFFFFFF}]]
1122 set word1 [format {%08x} [expr {${recs_val} >> 32}]]
[73]1123
[159]1124 set prefix [format {%x} 10]
1125
1126 set command {}
1127 append command 0001${prefix}000000200000004[string range $word0 4 7]
1128 append command 0001${prefix}000000200010004[string range $word0 0 3]
1129 append command 0001${prefix}000000200020004[string range $word1 4 7]
1130 append command 0001${prefix}000000200030004[string range $word1 0 3]
1131
1132 # send counter value
1133 $controller usbCmd $command
[73]1134 }
1135
1136# -------------------------------------------------------------------------
1137
[159]1138 CntDisplay instproc cntr_reset {} {
1139 my instvar controller after_handle
1140 my instvar cntr_val cntr_bak recs_val recs_bak
[73]1141
[159]1142 my cntr_stop
[85]1143
[159]1144 set value [format {%04x} [expr {1 << 11}]]
1145 $controller usbCmd 000200000004${value}0002000000040000
[73]1146
[159]1147 my recs_stop
[73]1148 }
1149
1150# -------------------------------------------------------------------------
1151
[159]1152 CntDisplay instproc cntr_ready {} {
1153 my instvar config cntr_val cntr_bak recs_val recs_bak
[73]1154
[159]1155 set cntr_val $cntr_bak
1156 set recs_val $recs_bak
[73]1157
[159]1158 ${config}.start configure -text Start -command [myproc recs_start]
1159 ${config}.reset configure -state active
1160
1161 ${config}.start configure -state active
1162 ${config}.cntr_field configure -state normal
1163 ${config}.recs_field configure -state normal
[73]1164 }
1165
1166# -------------------------------------------------------------------------
1167
[159]1168 CntDisplay instproc recs_start {} {
1169 my instvar controller config auto
1170 my instvar cntr_val cntr_bak recs_val recs_bak
[73]1171
[159]1172 if {$cntr_val > 0 && $recs_val > 0} {
1173 ${config}.start configure -text {Stop} -command [myproc recs_stop]
1174 ${config}.cntr_field configure -state disabled
1175 ${config}.recs_field configure -state disabled
[73]1176
[159]1177 set cntr_bak $cntr_val
1178 set recs_bak $recs_val
1179
1180 my cntr_setup
1181 my recs_setup
1182
1183 set val_addr [format {%02x} 16]
1184
1185 $controller usbCmd 000200${val_addr}00040002
1186
1187 set auto 1
1188
1189 after 100 [myproc acquire_loop]
[73]1190 }
1191 }
1192
1193# -------------------------------------------------------------------------
1194
[159]1195 CntDisplay instproc recs_stop {} {
1196 my instvar cntr_val cntr_bak recs_val recs_bak
[73]1197
[159]1198 my cntr_stop
[85]1199
[159]1200 set cntr_val $cntr_bak
1201 my cntr_setup
[73]1202
[159]1203 set recs_val $recs_bak
1204 my recs_setup
1205
1206 my acquire
1207
1208 my cntr_ready
[73]1209 }
1210
1211# -------------------------------------------------------------------------
1212
[159]1213 CntDisplay instproc cntr_stop {} {
1214 my instvar controller config auto
[85]1215
[159]1216 set val_addr [format {%02x} 16]
[85]1217
[159]1218 $controller usbCmd 000200${val_addr}00040000
1219
1220 set auto 0
[85]1221 }
1222
1223# -------------------------------------------------------------------------
1224
[159]1225 CntDisplay instproc acquire_loop {} {
1226 my instvar recs_val auto
1227
1228 my acquire
1229
1230 if {$recs_val == 0} {
1231 my cntr_stop
1232 my cntr_ready
1233 } elseif {$auto} {
1234 after 1000 [myproc acquire_loop]
[73]1235 }
[159]1236 }
[73]1237
[159]1238# -------------------------------------------------------------------------
[73]1239
[159]1240 CntDisplay instproc data_update args {
1241 my instvar config data
1242 usb::convertBlt $data 2 [myvar yvec]
1243
1244 ${config}.chan_frame.mean_value configure \
1245 -text [format {%.2e} [usb::integrateBlt [myvar yvec] 1]]
1246 ${config}.chan_frame.entr_value configure \
1247 -text [usb::integrateBlt [myvar yvec] 0]
1248
1249 }
1250
1251# -------------------------------------------------------------------------
1252
1253 CntDisplay instproc axis_update args {
1254 my instvar axis graph
1255 if {$axis} {
1256 $graph axis configure y -min 1 -max 1E5 -logscale yes
[73]1257 } else {
[159]1258 $graph axis configure y -min {} -max {} -logscale no
[73]1259 }
1260 }
1261
1262# -------------------------------------------------------------------------
1263
[159]1264 CntDisplay instproc acquire {} {
1265 my instvar controller config
1266 my instvar cntr cntr_val recs recs_val
[73]1267
[162]1268 set size 4096
[159]1269
1270 set prefix [format {%x} 8]
1271
1272 set value [format {%08x} $size]
1273
1274 set command 0001${prefix}000000200000001[string range $value 0 3]0003[string range $value 4 7]00050000
1275
1276 $controller usbCmdReadRaw $command [expr {$size * 2}] [myvar data]
1277
1278 set prefix [format {%x} 9]
1279 set command 0001${prefix}000000200000003000400050000
1280
1281 $controller usbCmdReadHex $command 8 1 [myvar cntr]
1282
1283 set prefix [format {%x} 10]
1284 set command 0001${prefix}000000200000003000400050000
1285
1286 $controller usbCmdReadHex $command 8 1 [myvar recs]
1287 }
1288
[73]1289# -------------------------------------------------------------------------
1290
[159]1291 CntDisplay instproc save_data {data} {
[73]1292
[159]1293 set types {
1294 {{Data Files} {.dat} }
1295 {{All Files} * }
1296 }
[85]1297
[159]1298 set stamp [clock format [clock seconds] -format %Y%m%d_%H%M%S]
1299 set fname counts_${stamp}.dat
1300
1301 set fname [tk_getSaveFile -filetypes $types -initialfile $fname]
1302 if {[string equal $fname {}]} {
1303 return
1304 }
1305
1306 set x [catch {
1307 set fid [open $fname w+]
1308 puts $fid $data
1309 close $fid
1310 }]
1311
1312 if { $x || ![file exists $fname] || ![file isfile $fname] || ![file readable $fname] } {
1313 tk_messageBox -icon error \
1314 -message "An error occurred while writing to \"$fname\""
1315 } else {
1316 tk_messageBox -icon info \
1317 -message "File \"$fname\" written successfully"
1318 }
[85]1319 }
1320
1321# -------------------------------------------------------------------------
1322
[159]1323 CntDisplay instproc register {} {
[162]1324 my save_data [join [[myvar yvec] range 0 4095] \n]
[159]1325 }
1326
1327# -------------------------------------------------------------------------
1328
1329 Class OscDisplay -parameter {
[85]1330 {master}
[159]1331 {controller}
[85]1332 }
1333
1334# -------------------------------------------------------------------------
1335
[159]1336 OscDisplay instproc init {} {
1337 my instvar sequence data xvec yvec
[85]1338
[159]1339 set data {}
1340
1341 set sequence 0
[85]1342
[159]1343# set xvec [vector create #auto(262144)]
1344 set xvec [vector create #auto(10000)]
1345
1346 for {set i 1} {$i <= 9} {incr i} {
1347# dict set yvec $i [vector create #auto(262144)]
1348 dict set yvec $i [vector create #auto(10000)]
[73]1349 }
[85]1350
1351 # fill one vector for the x axis
[159]1352# $xvec seq 0 262143
[85]1353 $xvec seq 0 10000
1354
1355 my setup
1356
1357 next
[73]1358 }
1359
1360# -------------------------------------------------------------------------
1361
[159]1362 OscDisplay instproc destroy {} {
[85]1363 next
[73]1364 }
1365
1366# -------------------------------------------------------------------------
1367
[159]1368 OscDisplay instproc start {} {
1369 my instvar config
1370 my instvar recs_val directory
[73]1371
[85]1372 set directory $::env(HOMEPATH)
[159]1373 set recs_val 100
[85]1374
[159]1375 trace add variable [myvar chan] write [myproc chan_update]
[73]1376
[159]1377 trace add variable [myvar data] write [myproc data_update]
[73]1378
[159]1379 trace add variable [myvar auto] write [myproc auto_update]
[85]1380
[159]1381 trace add variable [myvar thrs] write [myproc thrs_update 0]
1382 trace add variable [myvar thrs_val] write [myproc thrs_update 0]
1383
[85]1384 trace add variable [myvar recs_val] write [myproc recs_val_update]
1385
[159]1386 trace add variable [myvar last] write [myproc last_update]
1387
1388 ${config}.chan_frame.chan1_check select
1389 ${config}.chan_frame.chan2_check select
1390 ${config}.chan_frame.chan3_check select
1391 ${config}.chan_frame.chan4_check select
1392 ${config}.chan_frame.chan5_check select
1393 ${config}.chan_frame.chan6_check select
1394
1395 ${config}.thrs_check select
1396 ${config}.thrs_field set 100
[73]1397 }
1398
1399# -------------------------------------------------------------------------
1400
[159]1401 OscDisplay instproc setup {} {
[85]1402 my instvar master
[159]1403 my instvar xvec yvec graph
1404 my instvar config
[85]1405
1406 # create a graph widget and show a grid
[159]1407 set graph [graph ${master}.graph -height 250 -leftmargin 80]
1408 $graph crosshairs configure -hide no -linewidth 1 -color darkblue -dashes {2 2}
1409 $graph grid configure -hide no
1410 $graph legend configure -hide yes
1411 $graph axis configure x -min 0 -max 10000
1412 $graph axis configure y -min 0 -max 4100
[85]1413
[159]1414# scale ${master}.last -orient horizontal -from 1 -to 27 -tickinterval 0 -showvalue no -variable [myvar last]
[85]1415
[159]1416 set config [frame ${master}.config -width 170]
[85]1417
[159]1418 frame ${config}.chan_frame -width 170
1419 legendButton ${config}.chan_frame 0 chan1 {Channel 1} [myvar chan(1)] turquoise2
1420 legendButton ${config}.chan_frame 1 chan2 {Channel 2} [myvar chan(2)] SpringGreen2
1421 legendButton ${config}.chan_frame 2 chan3 {Channel 3} [myvar chan(3)] orchid2
1422 legendButton ${config}.chan_frame 3 chan4 {Channel 4} [myvar chan(4)] orange2
1423 legendButton ${config}.chan_frame 4 chan5 {Channel 5} [myvar chan(5)] blue1 white
1424 legendButton ${config}.chan_frame 5 chan6 {Channel 6} [myvar chan(6)] gray65 white
1425 legendLabel ${config}.chan_frame 6 axisx {Time axis}
[85]1426
[159]1427 frame ${config}.spc1 -width 170 -height 30
[85]1428
[159]1429 checkbutton ${config}.auto_check -text {auto update} -variable [myvar auto]
[85]1430
[159]1431 frame ${config}.spc2 -width 170 -height 30
[85]1432
[159]1433 checkbutton ${config}.thrs_check -text threshold -variable [myvar thrs]
1434 spinbox ${config}.thrs_field -from 1 -to 4095 \
1435 -increment 5 -width 10 -textvariable [myvar thrs_val] \
1436 -validate all -vcmd {::mca::validate 4095 4 %P}
[85]1437
[159]1438 frame ${config}.spc3 -width 170 -height 30
[85]1439
[159]1440 button ${config}.acquire -text Acquire \
1441 -bg green -activebackground green -command [myproc acquire_start]
1442 button ${config}.register -text Register \
1443 -bg lightblue -activebackground lightblue -command [myproc register]
[85]1444
[159]1445 frame ${config}.spc4 -width 170 -height 30
[85]1446
[159]1447 label ${config}.recs -text {number of records}
1448 spinbox ${config}.recs_field -from 0 -to 10000 \
1449 -increment 10 -width 10 -textvariable [myvar recs_val] \
1450 -validate all -vcmd {::mca::validate 10000 5 %P}
[85]1451
[159]1452 frame ${config}.spc5 -width 170 -height 10
[85]1453
[159]1454 button ${config}.sequence -text {Start Recording} -command [myproc sequence_start] \
1455 -bg yellow -activebackground yellow
[85]1456
[159]1457 frame ${config}.spc6 -width 170 -height 10
[85]1458
[159]1459 button ${config}.recover -text {Read file} \
1460 -bg lightblue -activebackground lightblue -command [myproc recover]
1461
1462 grid ${config}.chan_frame -sticky ew
[85]1463 grid ${config}.spc1
[159]1464 grid ${config}.auto_check -sticky w
[85]1465 grid ${config}.spc2
[159]1466 grid ${config}.thrs_check -sticky w
1467 grid ${config}.thrs_field -sticky ew -pady 1 -padx 5
[85]1468 grid ${config}.spc3
1469 grid ${config}.acquire -sticky ew -pady 3 -padx 5
1470 grid ${config}.register -sticky ew -pady 3 -padx 5
[159]1471 grid ${config}.spc4
1472 grid ${config}.recs -sticky w -pady 1 -padx 3
1473 grid ${config}.recs_field -sticky ew -pady 1 -padx 5
1474 grid ${config}.spc5
1475 grid ${config}.sequence -sticky ew -pady 3 -padx 5
1476 grid ${config}.spc6
1477 grid ${config}.recover -sticky ew -pady 3 -padx 5
[85]1478
[159]1479 grid ${graph} -row 0 -column 0 -sticky news
[85]1480 grid ${config} -row 0 -column 1
1481
[159]1482# grid ${master}.last -row 1 -column 0 -columnspan 2 -sticky ew
[85]1483
1484 grid rowconfigure ${master} 0 -weight 1
1485 grid columnconfigure ${master} 0 -weight 1
1486 grid columnconfigure ${master} 1 -weight 0 -minsize 120
1487
[159]1488 grid columnconfigure ${config}.chan_frame 2 -weight 1
[85]1489
1490 # enable zooming
[159]1491 Blt_ZoomStack $graph
[85]1492
[159]1493 my crosshairs $graph
[85]1494
1495 # create one element with data for the x and y axis, no dots
[159]1496 $graph pen create pen1 -color turquoise3 -linewidth 2 -symbol none
1497 $graph pen create pen2 -color SpringGreen3 -linewidth 2 -symbol none
1498 $graph pen create pen3 -color orchid3 -linewidth 2 -symbol none
1499 $graph pen create pen4 -color orange3 -linewidth 2 -symbol none
1500 $graph pen create pen5 -color blue2 -linewidth 2 -symbol none
1501 $graph pen create pen6 -color gray55 -linewidth 2 -symbol none
1502
1503 $graph element create Spectrum1 -pen pen1 -xdata $xvec -ydata [dict get $yvec 1]
1504 $graph element create Spectrum2 -pen pen2 -xdata $xvec -ydata [dict get $yvec 2]
1505 $graph element create Spectrum3 -pen pen3 -xdata $xvec -ydata [dict get $yvec 3]
1506 $graph element create Spectrum4 -pen pen4 -xdata $xvec -ydata [dict get $yvec 4]
1507 $graph element create Spectrum5 -pen pen5 -xdata $xvec -ydata [dict get $yvec 5]
1508 $graph element create Spectrum6 -pen pen6 -xdata $xvec -ydata [dict get $yvec 6]
[85]1509 }
1510
1511# -------------------------------------------------------------------------
1512
[159]1513 OscDisplay instproc coor_update {W x y} {
1514 my instvar xvec yvec graph
1515 my instvar config
1516
1517 $W crosshairs configure -position @${x},${y}
1518
1519 set index [$W axis invtransform x $x]
1520 set index [::tcl::mathfunc::round $index]
1521 catch {
1522 ${config}.chan_frame.chan1_value configure -text [[dict get $yvec 1] index $index]
1523 ${config}.chan_frame.chan2_value configure -text [[dict get $yvec 2] index $index]
1524 ${config}.chan_frame.chan3_value configure -text [[dict get $yvec 3] index $index]
1525 ${config}.chan_frame.chan4_value configure -text [[dict get $yvec 4] index $index]
1526 ${config}.chan_frame.chan5_value configure -text [[dict get $yvec 5] index $index]
1527 ${config}.chan_frame.chan6_value configure -text [[dict get $yvec 6] index $index]
1528 ${config}.chan_frame.axisx_value configure -text ${index}.0
[85]1529 }
1530 }
1531# -------------------------------------------------------------------------
1532
[159]1533 OscDisplay instproc crosshairs {graph} {
1534 set method [myproc coor_update]
1535 bind $graph <Motion> [list [self] coor_update %W %x %y]
1536 bind $graph <Leave> {
1537 %W crosshairs off
[85]1538 }
[159]1539 bind $graph <Enter> {
1540 %W crosshairs on
[85]1541 }
1542 }
1543
1544# -------------------------------------------------------------------------
1545
[159]1546 OscDisplay instproc chan_update {name key op} {
1547 my instvar config graph chan
[85]1548
[159]1549 if {$chan(${key})} {
1550 $graph pen configure pen${key} -linewidth 2
[85]1551 } else {
[159]1552 $graph pen configure pen${key} -linewidth 0
[85]1553 }
1554 }
1555
1556# -------------------------------------------------------------------------
1557
[159]1558 OscDisplay instproc recs_val_update args {
1559 my instvar recs_val
1560 if {[string equal $recs_val {}]} {
1561 set recs_val 0
1562 }
1563 }
[85]1564
1565# -------------------------------------------------------------------------
1566
[159]1567 OscDisplay instproc last_update args {
1568 my instvar graph last
1569
1570 set first [expr {$last - 1}]
1571
1572 $graph axis configure x -min ${first}0000 -max ${last}0000
[85]1573 }
1574
1575# -------------------------------------------------------------------------
1576
[159]1577 OscDisplay instproc thrs_update {reset args} {
1578 my instvar controller config thrs thrs_val
[85]1579
[159]1580 if {[string equal $thrs_val {}]} {
1581 set thrs_val 0
1582 }
[85]1583
[159]1584 if {$thrs} {
1585 ${config}.thrs_field configure -state normal
1586 set value [format %03x $thrs_val]
1587 } else {
1588 ${config}.thrs_field configure -state disabled
1589 set value 000
[85]1590 }
1591
[159]1592 set command {}
1593 if {$reset} {
1594 append command 0002000500041${value}
[85]1595 }
[159]1596 append command 0002000500040${value}
1597
1598 $controller usbCmd $command
[85]1599 }
1600
1601# -------------------------------------------------------------------------
1602
[159]1603 OscDisplay instproc data_update args {
1604 my instvar data yvec
1605 my instvar graph chan waiting sequence auto
[73]1606
[159]1607 usb::convertOsc $data $yvec
[73]1608
[159]1609 foreach {key value} [array get chan] {
1610 $graph pen configure pen${key} -dashes 0
1611 }
[85]1612
[159]1613 set waiting 0
[85]1614
[159]1615 if {$sequence} {
1616 my sequence_register
1617 } elseif {$auto} {
1618 after 1000 [myproc acquire_start]
1619 }
1620 }
[85]1621
[159]1622# -------------------------------------------------------------------------
[85]1623
[159]1624 OscDisplay instproc acquire_start {} {
1625 my instvar graph chan controller waiting
[85]1626
[159]1627 foreach {key value} [array get chan] {
1628 $graph pen configure pen${key} -dashes dot
[85]1629 }
1630
[159]1631 # restart
1632 my thrs_update 1
[73]1633
[159]1634 set waiting 1
[73]1635
[159]1636 after 200 [myproc acquire_loop]
[85]1637 }
1638
1639# -------------------------------------------------------------------------
1640
[159]1641 OscDisplay instproc acquire_loop {} {
1642 my instvar controller waiting
[85]1643
[159]1644# set size 262144
1645 set size 10000
[85]1646
[159]1647 set value [format {%08x} [expr {$size * 4}]]
[85]1648
[159]1649 set command 00011000000200000001[string range $value 0 3]0003[string range $value 4 7]00050000
1650
1651 $controller usbCmdReadRaw $command [expr {$size * 8}] [myvar data]
[85]1652
[159]1653 if {$waiting} {
1654 after 200 [myproc acquire_loop]
1655 }
[85]1656 }
1657
1658# -------------------------------------------------------------------------
1659
[159]1660 OscDisplay instproc auto_update args {
1661 my instvar config auto
1662
1663 if {$auto} {
1664 ${config}.recs_field configure -state disabled
1665 ${config}.sequence configure -state disabled
1666 ${config}.acquire configure -state disabled
1667 ${config}.register configure -state disabled
1668 ${config}.recover configure -state disabled
1669
1670 my acquire_start
1671 } else {
1672 ${config}.recs_field configure -state normal
1673 ${config}.sequence configure -state active
1674 ${config}.acquire configure -state active
1675 ${config}.register configure -state active
1676 ${config}.recover configure -state active
1677 }
[85]1678 }
1679
1680# -------------------------------------------------------------------------
1681
[159]1682 OscDisplay instproc save_data {fname} {
1683 my instvar data
[85]1684
[159]1685 set fid [open $fname w+]
1686 fconfigure $fid -translation binary -encoding binary
[85]1687
[159]1688# puts -nonewline $fid [binary format "H*iH*" "1f8b0800" [clock seconds] "0003"]
1689# puts -nonewline $fid [zlib deflate $data]
1690 puts -nonewline $fid $data
1691# puts -nonewline $fid [binary format i [zlib crc32 $data]]
1692# puts -nonewline $fid [binary format i [string length $data]]
1693
1694 close $fid
[85]1695 }
1696
1697# -------------------------------------------------------------------------
1698
[159]1699 OscDisplay instproc open_data {} {
1700 set types {
1701 {{Data Files} {.dat} }
1702 {{All Files} * }
1703 }
[85]1704
[159]1705 set fname [tk_getOpenFile -filetypes $types]
1706 if {[string equal $fname {}]} {
1707 return
1708 }
1709
1710 set x [catch {
1711 set fid [open $fname r+]
1712 fconfigure $fid -translation binary -encoding binary
1713# set size [file size $fname]
1714# seek $fid 10
1715# my set data [zlib inflate [read $fid [expr {$size - 18}]]]
1716 my set data [read $fid]
1717 close $fid
1718 }]
1719
1720 if { $x || ![file exists $fname] || ![file isfile $fname] || ![file readable $fname] } {
1721 tk_messageBox -icon error \
1722 -message "An error occurred while reading \"$fname\""
1723 } else {
1724 tk_messageBox -icon info \
1725 -message "File \"$fname\" read successfully"
1726 }
[85]1727 }
1728
1729# -------------------------------------------------------------------------
1730
[159]1731 OscDisplay instproc register {} {
1732 set types {
1733 {{Data Files} {.dat} }
1734 {{All Files} * }
1735 }
[85]1736
[159]1737 set stamp [clock format [clock seconds] -format %Y%m%d_%H%M%S]
1738 set fname oscillogram_${stamp}.dat
[85]1739
[159]1740 set fname [tk_getSaveFile -filetypes $types -initialfile $fname]
1741 if {[string equal $fname {}]} {
1742 return
1743 }
1744
1745 if {[catch {my save_data $fname} result]} {
1746 tk_messageBox -icon error \
1747 -message "An error occurred while writing to \"$fname\""
1748 } else {
1749 tk_messageBox -icon info \
1750 -message "File \"$fname\" written successfully"
1751 }
1752 }
[85]1753
[159]1754# -------------------------------------------------------------------------
[85]1755
[159]1756 OscDisplay instproc recover {} {
1757 my open_data
1758 }
[85]1759
[159]1760# -------------------------------------------------------------------------
[85]1761
[159]1762 OscDisplay instproc sequence_start {} {
1763 my instvar config recs_val recs_bak directory counter sequence
[85]1764
[159]1765 set counter 1
1766 if {$counter > $recs_val} {
1767 return
1768 }
[85]1769
[159]1770 set directory [tk_chooseDirectory -initialdir $directory -title {Choose a directory}]
[85]1771
[159]1772 if {[string equal $directory {}]} {
1773 return
1774 }
[85]1775
[159]1776 ${config}.recs_field configure -state disabled
1777 ${config}.sequence configure -text {Stop Recording} -command [myproc sequence_stop]
1778 ${config}.acquire configure -state disabled
1779 ${config}.register configure -state disabled
1780 ${config}.recover configure -state disabled
1781
1782 set recs_bak $recs_val
[85]1783
[159]1784 set sequence 1
1785
1786 my acquire_start
[85]1787 }
1788
1789# -------------------------------------------------------------------------
1790
[159]1791 OscDisplay instproc sequence_register {} {
1792 my instvar config recs_val recs_bak directory counter
[85]1793
[159]1794 set fname [file join $directory oscillogram_$counter.dat]
[85]1795
[159]1796 my incr counter
[85]1797
[159]1798 if {[catch {my save_data $fname} result]} {
1799 tk_messageBox -icon error \
1800 -message "An error occurred while writing to \"$fname\""
1801 } elseif {$counter <= $recs_bak} {
1802 set recs_val [expr {$recs_bak - $counter}]
1803 my acquire_start
[85]1804 return
1805 }
[159]1806
1807 my sequence_stop
[85]1808 }
1809
1810# -------------------------------------------------------------------------
1811
[159]1812 OscDisplay instproc sequence_stop {} {
1813 my instvar config recs_val recs_bak sequence
[85]1814
[159]1815 set sequence 0
1816
1817 set recs_val $recs_bak
[85]1818
[159]1819 ${config}.recs_field configure -state normal
1820 ${config}.sequence configure -text {Start Recording} -command [myproc sequence_start]
1821 ${config}.acquire configure -state active
1822 ${config}.register configure -state active
1823 ${config}.recover configure -state active
[85]1824 }
1825
1826# -------------------------------------------------------------------------
1827
[159]1828 namespace export MuxDisplay
[73]1829 namespace export HstDisplay
[159]1830 namespace export CntDisplay
[73]1831 namespace export OscDisplay
1832}
1833
[78]1834set notebook [::blt::tabnotebook .notebook -borderwidth 1 -selectforeground black -side bottom]
[73]1835
[159]1836grid ${notebook} -row 0 -column 0 -sticky news -pady 5
[73]1837
[78]1838grid rowconfigure . 0 -weight 1
[159]1839grid columnconfigure . 0 -weight 1
[78]1840
[159]1841::mca::UsbController usb
[73]1842
[159]1843set window [frame ${notebook}.hst_0]
[162]1844$notebook insert end -text "Spectrum histogram 1" -window $window -fill both
[159]1845::mca::HstDisplay hst_0 -number 0 -master $window -controller usb
[73]1846
[162]1847set window [frame ${notebook}.hst_1]
1848$notebook insert end -text "Spectrum histogram 2" -window $window -fill both
1849::mca::HstDisplay hst_1 -number 1 -master $window -controller usb
1850
[159]1851set window [frame ${notebook}.cnt_0]
1852$notebook insert end -text "Rate histogram" -window $window -fill both
1853::mca::CntDisplay cnt_0 -master $window -controller usb
[73]1854
[159]1855set window [frame ${notebook}.mux]
1856$notebook insert end -text "Interconnect" -window $window -fill both
1857::mca::MuxDisplay mux -master $window -controller usb
[73]1858
[85]1859set window [frame ${notebook}.ept]
[159]1860$notebook insert end -text "Oscilloscope" -window $window -fill both
1861::mca::OscDisplay osc -master $window -controller usb
[85]1862
[159]1863update
[85]1864
[159]1865usb usbCmd 00000000
[73]1866
[159]1867hst_0 start
[73]1868
[162]1869hst_1 start
1870
[159]1871cnt_0 start
[73]1872
[159]1873mux start
[77]1874
[159]1875osc start
Note: See TracBrowser for help on using the repository browser.