source: trunk/MultiChannelUSB/UserInterface.tcl@ 186

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

replace HOMEPATH with HOME

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