source: trunk/MultiChannelUSB/UserInterface.tcl@ 160

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

adapt to paella v2

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