source: trunk/MultiChannelUSB/UserInterface.tcl@ 168

Last change on this file since 168 was 168, checked in by demin, 12 years ago

add "Read file" button to histogram and counter views

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