source: trunk/MultiChannelUSB/UserInterface.tcl@ 161

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

add multiplexers for spectrum and rate histograms

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