source: trunk/3DEES/UserInterface.tcl@ 199

Last change on this file since 199 was 188, checked in by demin, 11 years ago

fix bin numbers

File size: 46.7 KB
Line 
1package require XOTcl
2
3package require BLT
4package require swt
5package require usb
6
7package require zlib
8
9wm minsize . 1000 700
10
11namespace eval ::mca {
12 namespace import ::xotcl::*
13
14 namespace import ::blt::vector
15 namespace import ::blt::graph
16 namespace import ::blt::tabnotebook
17
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 {S1_F}
35 2 {S1_S}
36 3 {S2}
37 4 {D1}
38 5 {D2}
39 6 {D3}
40 }
41
42# -------------------------------------------------------------------------
43
44 variable cfgCodes
45 array set cfgCodes {
46 {1_0} 0
47 {1_1} 6
48 {1_2} 7
49 {1_3} 8
50 {2_0} 1
51 {2_1} 9
52 {2_2} 10
53 {2_3} 11
54 {3_0} 2
55 {3_1} 12
56 {3_2} 13
57 {3_3} 14
58 {3_4} 15
59 {4_0} 3
60 {4_1} 16
61 {4_2} 17
62 {4_3} 18
63 {4_4} 19
64 {5_0} 4
65 {5_1} 20
66 {5_2} 21
67 {5_3} 22
68 {5_4} 23
69 {6_0} 5
70 {6_1} 24
71 {6_2} 25
72 {6_3} 26
73 {6_4} 27
74 }
75# -------------------------------------------------------------------------
76
77 variable cfgThrs
78 array set cfgThrs {
79 0 8
80 6 150
81 7 200
82 8 3000
83 1 8
84 9 150
85 10 200
86 11 3000
87 2 10
88 12 10
89 13 31
90 14 52
91 15 79
92 3 10
93 16 60
94 17 135
95 18 171
96 19 233
97 4 10
98 20 249
99 21 348
100 22 495
101 23 693
102 5 10
103 24 505
104 25 606
105 26 707
106 27 808
107 }
108
109
110# -------------------------------------------------------------------------
111
112 variable inpCodes
113 array set inpCodes {
114 0 {rs}
115 1 {cs}
116 2 {av}
117 3 {af}
118 4 {bn}
119 5 {bf}
120 }
121
122# -------------------------------------------------------------------------
123
124 proc validate {max size value} {
125 if {![regexp {^[0-9]*$} $value]} {
126 return 0
127 } elseif {[regexp {^0[0-9]+$} $value]} {
128 return 0
129 } elseif {$value > $max} {
130 return 0
131 } elseif {[string length $value] > $size} {
132 return 0
133 } else {
134 return 1
135 }
136 }
137
138# -------------------------------------------------------------------------
139
140 proc doublevalidate {max value} {
141 if {![regexp {^[0-9]{0,2}\.?[0-9]{0,3}$} $value]} {
142 return 0
143 } elseif {[regexp {^0[0-9]+$} $value]} {
144 return 0
145 } elseif {$value > $max} {
146 return 0
147 } else {
148 return 1
149 }
150 }
151
152# -------------------------------------------------------------------------
153
154 proc legendLabel {master row key title} {
155 label ${master}.${key}_label -anchor w -text ${title}
156 label ${master}.${key}_value -width 10 -anchor e -text {}
157
158 grid ${master}.${key}_label -row ${row} -column 1 -sticky w
159 grid ${master}.${key}_value -row ${row} -column 2 -sticky ew
160 }
161
162# -------------------------------------------------------------------------
163
164 proc legendButton {master row key title var bg {fg black}} {
165 checkbutton ${master}.${key}_check -variable $var
166 label ${master}.${key}_label -anchor w -text ${title} -bg ${bg} -fg $fg
167 label ${master}.${key}_value -width 10 -anchor e -text {} -bg ${bg} -fg $fg
168
169 grid ${master}.${key}_check -row ${row} -column 0 -sticky w
170 grid ${master}.${key}_label -row ${row} -column 1 -sticky w
171 grid ${master}.${key}_value -row ${row} -column 2 -sticky ew
172 }
173
174# -------------------------------------------------------------------------
175
176 Class UsbController
177
178# -------------------------------------------------------------------------
179
180 UsbController instproc init {} {
181
182 my set ignore false
183
184 next
185 }
186
187# -------------------------------------------------------------------------
188
189 UsbController instproc usbConnect {} {
190 my instvar handle ignore
191
192 puts usbConnect
193
194 if {[my exists handle]} {
195 $handle disconnect
196 unset handle
197 }
198 if {!$ignore} {
199 while {[catch {usb::connect 0x09FB 0x6001 1 1 0} result]} {
200 set answer [tk_messageBox -icon error -type abortretryignore \
201 -message {Cannot access USB device} -detail $result]
202 if {[string equal $answer abort]} exit
203 if {[string equal $answer ignore]} {
204 set ignore true
205 return
206 }
207 }
208
209 set handle $result
210
211 }
212 }
213
214# -------------------------------------------------------------------------
215
216 UsbController instproc usbHandle {} {
217 my instvar handle ignore
218
219 if {[my exists handle]} {
220 return $handle
221 } elseif {!$ignore} {
222 my usbConnect
223 }
224 }
225
226# -------------------------------------------------------------------------
227
228 UsbController instproc usbCmd {command} {
229 set code [catch {[my usbHandle] writeRaw [usb::convert $command]} result]
230 switch -- $code {
231 1 {
232# puts $result
233 my usbConnect
234 }
235 }
236
237 }
238
239# -------------------------------------------------------------------------
240
241 UsbController instproc usbCmdReadRaw {command size data} {
242 my usbCmd $command
243
244 set code [catch {[my usbHandle] readRaw $size} result]
245 switch -- $code {
246 0 {
247 set $data $result
248 }
249 1 {
250# puts $result
251 my usbConnect
252 }
253 5 {
254# puts Busy
255 }
256 }
257 }
258
259# -------------------------------------------------------------------------
260
261 UsbController instproc usbCmdReadRaw {command size data} {
262 my usbCmd $command
263
264 set code [catch {[my usbHandle] readRaw $size} result]
265 switch -- $code {
266 0 {
267 set $data $result
268 }
269 1 {
270# puts $result
271 my usbConnect
272 }
273 5 {
274# puts Busy
275 }
276 }
277 }
278
279# -------------------------------------------------------------------------
280
281 UsbController instproc usbCmdReadHex {command width size data} {
282 my usbCmd $command
283
284 set code [catch {[my usbHandle] readHex $width $size} result]
285 switch -- $code {
286 0 {
287 set $data $result
288 }
289 1 {
290# puts $result
291 my usbConnect
292 }
293 5 {
294# puts Busy
295 }
296 }
297 }
298
299# -------------------------------------------------------------------------
300
301 Class CfgDisplay -parameter {
302 {master}
303 {controller}
304 }
305
306# -------------------------------------------------------------------------
307
308 CfgDisplay instproc init {} {
309
310 my setup
311
312 next
313 }
314
315# -------------------------------------------------------------------------
316
317 CfgDisplay instproc destroy {} {
318 next
319 }
320
321# -------------------------------------------------------------------------
322
323 CfgDisplay instproc start {} {
324 variable adcCodes
325 variable cfgThrs
326
327 foreach {ch id} [array get adcCodes] {
328 my set delay($ch) 32
329 my set decay($ch) 1000
330 }
331
332 foreach {i value} [array get cfgThrs] {
333 my set thrs($i) $value
334 }
335
336 trace add variable [myvar decay] write [myproc decay_update]
337 trace add variable [myvar delay] write [myproc delay_update]
338 trace add variable [myvar thrs] write [myproc thrs_update]
339
340 my delay_update
341 my thrs_update
342 }
343
344# -------------------------------------------------------------------------
345
346 CfgDisplay instproc setup {} {
347 variable adcCodes
348 variable cfgCodes
349 my instvar number master
350 my instvar config
351
352 set thrs [frame ${master}.thrs]
353 set bins [frame ${master}.bins]
354 set clip [frame ${master}.clip]
355
356 set config(thrs) [labelframe ${thrs}.frame -borderwidth 1 -relief sunken -text {Thresholds}]
357
358 set column 0
359 foreach {input} [list "ADC" "e thrs min" "e thrs max" "p thrs min" "p thrs max"] {
360 label ${config(thrs)}.label_${column} -text "${input}"
361 grid ${config(thrs)}.label_${column} -row 0 -column ${column} -sticky ew -padx 5 -pady 7
362 incr column
363 }
364
365 foreach {ch id} [array get adcCodes {[1-2]}] {
366 label ${config(thrs)}.chan_${ch} -text "${id} "
367 grid ${config(thrs)}.chan_${ch} -row ${ch} -column 0 -sticky ew -padx 5 -pady 7
368 foreach {num} [list 0 1 2 3] {
369 set column [expr {$num + 1}]
370 set value $cfgCodes(${ch}_${num})
371 spinbox ${config(thrs)}.thrs_${value} -from 0 -to 4095 \
372 -increment 10 -width 10 -textvariable [myvar thrs($value)] \
373 -validate all -vcmd {::mca::validate 4095 4 %P}
374 grid ${config(thrs)}.thrs_${value} -row ${ch} -column ${column} -sticky w -padx 5 -pady 7
375 }
376 }
377
378 grid $config(thrs) -row 0 -column 0 -sticky news -padx 10
379
380 set config(bins) [labelframe ${bins}.frame -borderwidth 1 -relief sunken -text {Bins}]
381
382 set column 0
383 foreach {input} [list "ADC" "thrs 0" "thrs 1" "thrs 2" "thrs 3" "thrs 4"] {
384 label ${config(bins)}.label_${column} -text "${input}"
385 grid ${config(bins)}.label_${column} -row 0 -column ${column} -sticky ew -padx 5 -pady 7
386 incr column
387 }
388
389 foreach {ch id} [array get adcCodes {[3-6]}] {
390 label ${config(bins)}.chan_${ch} -text "${id} "
391 grid ${config(bins)}.chan_${ch} -row ${ch} -column 0 -sticky ew -padx 5 -pady 7
392 foreach {num} [list 0 1 2 3 4] {
393 set column [expr {$num + 1}]
394 set value $cfgCodes(${ch}_${num})
395 spinbox ${config(bins)}.bins_${value} -from 0 -to 4095 \
396 -increment 10 -width 10 -textvariable [myvar thrs($value)] \
397 -validate all -vcmd {::mca::validate 4095 4 %P}
398 grid ${config(bins)}.bins_${value} -row ${ch} -column ${column} -sticky w -padx 5 -pady 7
399 }
400 }
401
402 grid $config(bins) -row 0 -column 0 -sticky news -padx 10
403
404 set config(clip) [labelframe ${clip}.frame -borderwidth 1 -relief sunken -text {Signal clipping}]
405
406 set column 0
407 foreach {input} [list "ADC" "delay" "decay"] {
408 label ${config(clip)}.label_${column} -text "${input}"
409 grid ${config(clip)}.label_${column} -row 0 -column ${column} -sticky ew -padx 5 -pady 7
410 incr column
411 }
412
413 foreach {ch id} [array get adcCodes] {
414 label ${config(clip)}.chan_${ch} -text "${id} "
415 grid ${config(clip)}.chan_${ch} -row ${ch} -column 0 -sticky ew -padx 5 -pady 7
416 spinbox ${config(clip)}.delay_${ch} -from 0 -to 62 \
417 -increment 2 -width 10 -textvariable [myvar delay($ch)] \
418 -validate all -vcmd {::mca::validate 63 5 %P}
419 grid ${config(clip)}.delay_${ch} -row ${ch} -column 1 -sticky w -padx 5 -pady 7
420 spinbox ${config(clip)}.decay_${ch} -from 0 -to 65535 \
421 -increment 10 -width 10 -textvariable [myvar decay($ch)] \
422 -validate all -vcmd {::mca::validate 65535 5 %P}
423 grid ${config(clip)}.decay_${ch} -row ${ch} -column 2 -sticky w -padx 5 -pady 7
424 }
425
426 grid $config(clip) -row 0 -column 0 -sticky news -padx 10
427
428 grid ${thrs} -row 0 -column 2 -sticky news
429 grid ${bins} -row 0 -column 1 -sticky news
430 grid ${clip} -row 0 -column 0 -sticky news
431
432 grid columnconfigure ${master} 0 -weight 1
433 grid columnconfigure ${master} 1 -weight 1
434 grid columnconfigure ${master} 2 -weight 1
435 grid rowconfigure ${master} 0 -weight 1
436
437 grid rowconfigure ${thrs} 0 -weight 0
438 grid rowconfigure ${bins} 0 -weight 0
439 grid rowconfigure ${clip} 0 -weight 0
440 }
441
442# -------------------------------------------------------------------------
443
444 CfgDisplay instproc decay_update args {
445 my instvar controller decay delay
446
447 set command {}
448 for {set i 1} {$i <= 6} {incr i} {
449 set a $delay($i).0
450 set b $decay($i).0
451 set value [expr int(exp(-${a}/${b})*1024*20)]
452 append command [format {000200%02x0004%04x} [expr {38 + 2 * (${i} - 1)}] $value]
453 }
454
455 $controller usbCmd $command
456 }
457
458# -------------------------------------------------------------------------
459
460 CfgDisplay instproc delay_update args {
461 my instvar controller delay
462
463 set command {}
464 for {set i 1} {$i <= 6} {incr i} {
465 append command [format {000200%02x0004%04x} [expr {39 + 2 * (${i} - 1)}] $delay($i)]
466 }
467
468 $controller usbCmd $command
469
470 my decay_update
471 }
472
473# -------------------------------------------------------------------------
474
475 CfgDisplay instproc thrs_update args {
476 my instvar controller thrs
477
478 set command {}
479 for {set i 0} {$i <= 27} {incr i} {
480 append command [format {000200%02x0004%04x} [expr {10 + ${i}}] $thrs($i)]
481 }
482
483 $controller usbCmd $command
484 }
485
486# -------------------------------------------------------------------------
487
488 Class MuxDisplay -parameter {
489 {master}
490 {controller}
491 }
492
493# -------------------------------------------------------------------------
494
495 MuxDisplay instproc init {} {
496
497 my setup
498
499 next
500 }
501
502# -------------------------------------------------------------------------
503
504 MuxDisplay instproc destroy {} {
505 next
506 }
507
508# -------------------------------------------------------------------------
509
510 MuxDisplay instproc start {} {
511 variable adcCodes
512 my instvar config chan_val
513
514 set chan_val(1) 0
515 set chan_val(2) 0
516 set chan_val(3) 0
517 set chan_val(4) 0
518 set chan_val(5) 0
519 set chan_val(6) 0
520
521 trace add variable [myvar chan_val] write [myproc chan_val_update]
522 trace add variable [myvar polar] write [myproc polar_update]
523
524 $config(1).chan_1_1 select
525 $config(2).chan_1_2 select
526 $config(3).chan_1_3 select
527 $config(4).chan_1_4 select
528 $config(5).chan_1_5 select
529 $config(6).chan_2_4 select
530
531 foreach {ch dummy} [array get adcCodes] {
532 $config(inv).polar_${ch} deselect
533 }
534 }
535
536# -------------------------------------------------------------------------
537
538 MuxDisplay instproc setup {} {
539 variable oscCodes
540 variable adcCodes
541 variable inpCodes
542 my instvar master
543 my instvar config
544
545 set size [array size inpCodes]
546 set oscList [array get oscCodes]
547 set adcList [array get adcCodes]
548 set inpList [array get inpCodes]
549
550 set mux [frame ${master}.mux]
551 set key [frame ${master}.key]
552 set inv [frame ${master}.inv]
553
554 foreach {osc title} $oscList {
555 set config($osc) [labelframe ${mux}.$osc -borderwidth 1 -relief sunken -text $title]
556 foreach {code input} $inpList {
557 set column [expr {$code + 1}]
558 label $config($osc).input_${input} -text " ${input}"
559 grid $config($osc).input_${input} -row 0 -column ${column} -sticky w
560 }
561 foreach {ch id} $adcList {
562 label $config($osc).chan_${ch} -text "${id} "
563 grid $config($osc).chan_${ch} -row ${ch} -column 0 -sticky ew
564 foreach {code input} $inpList {
565 set column [expr {$code + 1}]
566 set value [expr {$size * ($ch - 1) + $code}]
567 radiobutton $config($osc).chan_${code}_${ch} -variable [myvar chan_val($osc)] -value ${value}
568 grid $config($osc).chan_${code}_${ch} -row ${ch} -column ${column} -sticky w
569 }
570 }
571 set column [expr {($osc - 1) % 3}]
572 set row [expr {($osc - 1) / 3}]
573 grid $config($osc) -row ${row} -column ${column} -sticky news -padx 10
574 }
575
576 set config(key) [labelframe ${key}.frame -borderwidth 1 -relief sunken -text {legend}]
577
578 label $config(key).rs -text "rs - raw signal"
579 grid $config(key).rs -row 0 -column 0 -sticky news
580
581 label $config(key).cs -text "cs - filtered and clipped signal"
582 grid $config(key).cs -row 0 -column 1 -sticky news
583
584 label $config(key).av -text "av - amplitude value"
585 grid $config(key).av -row 0 -column 2 -sticky news
586
587 label $config(key).af -text "af - amplitude flag"
588 grid $config(key).af -row 0 -column 3 -sticky news
589
590 label $config(key).bn -text "bn - bin number"
591 grid $config(key).bn -row 0 -column 4 -sticky news
592
593 label $config(key).bf -text "bf - bin flag"
594 grid $config(key).bf -row 0 -column 5 -sticky news
595
596 grid $config(key) -row 0 -column 0 -sticky news -padx 10
597
598
599 set config(inv) [labelframe ${inv}.frame -borderwidth 1 -relief sunken -text {polarity inversion}]
600 label $config(inv).chan_label -text "channel "
601 grid $config(inv).chan_label -row 0 -column 0 -sticky e
602 label $config(inv).polar_label -text "polarity"
603 grid $config(inv).polar_label -row 1 -column 0 -sticky e
604 foreach {ch dummy} $adcList {
605 label $config(inv).chan_${ch} -text "${ch} "
606 grid $config(inv).chan_${ch} -row 0 -column ${ch} -sticky ew
607 checkbutton $config(inv).polar_${ch} -variable [myvar polar($ch)]
608 grid $config(inv).polar_${ch} -row 1 -column ${ch} -sticky w
609 }
610 grid $config(inv) -row 0 -column 0 -sticky news -padx 10
611
612 grid ${key} -row 0 -column 0 -sticky news
613 grid ${mux} -row 1 -column 0 -sticky news
614 grid ${inv} -row 2 -column 0 -sticky news
615
616 grid columnconfigure ${master} 0 -weight 1
617 grid rowconfigure ${master} 0 -weight 1
618 grid rowconfigure ${master} 1 -weight 1
619 grid rowconfigure ${master} 2 -weight 1
620
621 grid columnconfigure ${inv} 0 -weight 1
622
623 grid columnconfigure ${key} 0 -weight 1
624 grid columnconfigure $config(key) 0 -weight 1
625 grid columnconfigure $config(key) 1 -weight 1
626 grid columnconfigure $config(key) 2 -weight 1
627 grid columnconfigure $config(key) 3 -weight 1
628 grid columnconfigure $config(key) 4 -weight 1
629 grid columnconfigure $config(key) 5 -weight 1
630
631
632 grid columnconfigure ${mux} 0 -weight 1
633 grid columnconfigure ${mux} 1 -weight 1
634 grid columnconfigure ${mux} 2 -weight 1
635 }
636
637# ------------------------------------------------------------------------
638
639 MuxDisplay instproc chan_val_update args {
640 my instvar controller chan_val
641
642 set byte1 [format {%02x%02x} $chan_val(2) $chan_val(1)]
643 set byte2 [format {%02x%02x} $chan_val(4) $chan_val(3)]
644 set byte3 [format {%02x%02x} $chan_val(6) $chan_val(5)]
645
646 $controller usbCmd 000200020004${byte1}000200030004${byte2}000200040004${byte3}
647 }
648
649# -------------------------------------------------------------------------
650
651 MuxDisplay instproc polar_update args {
652 my instvar controller polar
653
654 set value {0b}
655 for {set i 6} {$i >= 1} {incr i -1} {
656 append value $polar($i)
657 }
658
659 set value [format {%04x} $value]
660
661 $controller usbCmd 000200010004${value}
662 }
663
664# -------------------------------------------------------------------------
665
666 Class HstDisplay -parameter {
667 {number}
668 {master}
669 {controller}
670 }
671
672# -------------------------------------------------------------------------
673
674 HstDisplay instproc init {} {
675
676 my set data {}
677
678 vector create [myvar xvec](80)
679 vector create [myvar yvec](80)
680
681 # fill one vector for the x axis with 80 points
682 [myvar xvec] seq -0.5 79.5
683
684 my setup
685
686 next
687 }
688
689# -------------------------------------------------------------------------
690
691 HstDisplay instproc destroy {} {
692 next
693 }
694
695# -------------------------------------------------------------------------
696
697 HstDisplay instproc start {} {
698 my instvar config
699
700 trace add variable [myvar data] write [myproc data_update]
701
702 trace add variable [myvar axis] write [myproc axis_update]
703
704 ${config}.axis_check select
705
706 my set yvec_bak 0.0
707 my set yvec_old 0.0
708 }
709
710# -------------------------------------------------------------------------
711
712 HstDisplay instproc setup {} {
713 my instvar number master
714 my instvar xvec yvec graph
715 my instvar config thrs thrs_val base base_typ base_val
716 my instvar cntr_h cntr_m cntr_s
717
718 # create a graph widget and show a grid
719 set graph [graph ${master}.graph -height 250 -leftmargin 80]
720 $graph crosshairs configure -hide no -linewidth 1 -color darkblue -dashes {2 2}
721 $graph grid configure -hide no
722 $graph legend configure -hide yes
723 $graph axis configure x -min 0 -max 80
724
725 set config [frame ${master}.config -width 170]
726
727 checkbutton ${config}.axis_check -text {log scale} -variable [myvar axis]
728
729 frame ${config}.spc1 -width 170 -height 30
730
731 frame ${config}.chan_frame -borderwidth 0 -width 170
732 legendLabel ${config}.chan_frame 0 axisy {Bin entries}
733 legendLabel ${config}.chan_frame 1 axisx {Bin number}
734
735 frame ${config}.spc2 -width 170 -height 30
736
737 button ${config}.start -text Start \
738 -bg yellow -activebackground yellow -command [myproc cntr_start]
739 button ${config}.reset -text Reset \
740 -bg red -activebackground red -command [myproc cntr_reset]
741
742 frame ${config}.spc3 -width 170 -height 30
743
744 button ${config}.register -text Register \
745 -bg lightblue -activebackground lightblue -command [myproc register]
746
747 grid ${config}.axis_check -sticky w
748 grid ${config}.spc1
749 grid ${config}.chan_frame -sticky ew -padx 5
750 grid ${config}.spc2
751 grid ${config}.start -sticky ew -pady 3 -padx 5
752 grid ${config}.reset -sticky ew -pady 3 -padx 5
753 grid ${config}.spc3
754 grid ${config}.register -sticky ew -pady 3 -padx 5
755
756 grid ${graph} -row 0 -column 0 -sticky news
757 grid ${config} -row 0 -column 1
758
759 grid rowconfigure ${master} 0 -weight 1
760 grid columnconfigure ${master} 0 -weight 1
761 grid columnconfigure ${master} 1 -weight 0 -minsize 80
762
763 grid columnconfigure ${config}.chan_frame 1 -weight 1
764
765 # enable zooming
766 Blt_ZoomStack $graph
767
768 my crosshairs $graph
769
770 #bind .graph <Motion> {%W crosshairs configure -position @%x,%y}
771
772 # create one element with data for the x and y axis, no dots
773 $graph element create Spectrum1 -color blue -linewidth 2 -symbol none -smooth step -xdata [myvar xvec] -ydata [myvar yvec]
774 }
775
776# -------------------------------------------------------------------------
777
778 HstDisplay instproc coor_update {W x y} {
779 my instvar config graph
780
781 $W crosshairs configure -position @${x},${y}
782
783 set index [$W axis invtransform x $x]
784 set index [::tcl::mathfunc::round $index]
785 catch {
786 ${config}.chan_frame.axisy_value configure -text [[myvar yvec] index $index]
787 ${config}.chan_frame.axisx_value configure -text ${index}.0
788 }
789 }
790# -------------------------------------------------------------------------
791
792 HstDisplay instproc crosshairs {graph} {
793 set method [myproc coor_update]
794 bind $graph <Motion> [list [self] coor_update %W %x %y]
795 bind $graph <Leave> {
796 %W crosshairs off
797 }
798 bind $graph <Enter> {
799 %W crosshairs on
800 }
801 }
802
803# -------------------------------------------------------------------------
804
805 HstDisplay instproc axis_update args {
806 my instvar axis graph
807 if {$axis} {
808 $graph axis configure y -min 1 -max 1E10 -logscale yes
809 } else {
810 $graph axis configure y -min {} -max {} -logscale no
811 }
812 }
813
814# -------------------------------------------------------------------------
815
816 HstDisplay instproc cntr_reset {} {
817 my instvar controller number
818
819 my cntr_stop
820
821 set value [format %04x [expr {1 << (5 + ${number})}]]
822 $controller usbCmd 000200000004${value}0002000000040000
823
824 my acquire
825 }
826
827# -------------------------------------------------------------------------
828
829 HstDisplay instproc cntr_start {} {
830 my instvar controller config number auto
831
832 set val_addr [format %02x [expr {6 + ${number}}]]
833
834 ${config}.start configure -text Stop -command [myproc cntr_stop]
835# ${config}.reset configure -state disabled
836
837 $controller usbCmd 000200${val_addr}00040001
838
839 set auto 1
840
841 after 100 [myproc acquire_loop]
842 }
843
844# -------------------------------------------------------------------------
845
846 HstDisplay instproc cntr_stop {} {
847 my instvar controller config number auto
848
849 set val_addr [format %02x [expr {6 + ${number}}]]
850
851 ${config}.start configure -text Start -command [myproc cntr_start]
852
853 $controller usbCmd 000200${val_addr}00040000
854
855 set auto 0
856
857 my acquire
858 }
859
860# -------------------------------------------------------------------------
861
862 HstDisplay instproc data_update args {
863 my instvar data
864 usb::convertBlt $data 4 [myvar yvec]
865 }
866
867# -------------------------------------------------------------------------
868
869 HstDisplay instproc acquire_loop {} {
870 my instvar cntr_val auto
871
872 my acquire
873
874 if {$auto} {
875 after 1000 [myproc acquire_loop]
876 }
877 }
878
879# -------------------------------------------------------------------------
880
881 HstDisplay instproc acquire {} {
882 my instvar controller config number
883
884 set size 80
885
886 set prefix [format {%x} [expr {$number + 2}]]
887
888 set value [format {%08x} [expr {$size * 2}]]
889
890 set command 0001${prefix}000000200000001[string range $value 0 3]0003[string range $value 4 7]00050000
891
892 $controller usbCmdReadRaw $command [expr {$size * 4}] [myvar data]
893 }
894
895# -------------------------------------------------------------------------
896
897 HstDisplay instproc save_data {data} {
898 my instvar number
899
900 set types {
901 {{Data Files} {.dat} }
902 {{All Files} * }
903 }
904
905 set stamp [clock format [clock seconds] -format %Y%m%d_%H%M%S]
906 set fname spectrum_[expr {$number + 1}]_${stamp}.dat
907
908 set fname [tk_getSaveFile -filetypes $types -initialfile $fname]
909 if {[string equal $fname {}]} {
910 return
911 }
912
913 set x [catch {
914 set fid [open $fname w+]
915 puts $fid $data
916 close $fid
917 }]
918
919 if { $x || ![file exists $fname] || ![file isfile $fname] || ![file readable $fname] } {
920 tk_messageBox -icon error \
921 -message "An error occurred while writing to \"$fname\""
922 } else {
923 tk_messageBox -icon info \
924 -message "File \"$fname\" written successfully"
925 }
926 }
927
928# -------------------------------------------------------------------------
929
930 HstDisplay instproc register {} {
931 my save_data [join [[myvar yvec] range 0 79] \n]
932 }
933
934# -------------------------------------------------------------------------
935
936 Class OscDisplay -parameter {
937 {master}
938 {controller}
939 }
940
941# -------------------------------------------------------------------------
942
943 OscDisplay instproc init {} {
944 my instvar sequence data xvec yvec
945
946 set data {}
947
948 set sequence 0
949
950# set xvec [vector create #auto(262144)]
951# set xvec [vector create #auto(10000)]
952 set xvec [vector create #auto(60000)]
953
954 for {set i 1} {$i <= 9} {incr i} {
955# dict set yvec $i [vector create #auto(262144)]
956# dict set yvec $i [vector create #auto(10000)]
957 dict set yvec $i [vector create #auto(60000)]
958 }
959
960 # fill one vector for the x axis
961# $xvec seq 0 262143
962# $xvec seq 0 10000
963 $xvec seq 0 60000
964
965 my setup
966
967 next
968 }
969
970# -------------------------------------------------------------------------
971
972 OscDisplay instproc destroy {} {
973 next
974 }
975
976# -------------------------------------------------------------------------
977
978 OscDisplay instproc start {} {
979 my instvar config
980 my instvar recs_val directory
981
982 set directory $::env(HOME)
983 set recs_val 100
984
985 trace add variable [myvar chan] write [myproc chan_update]
986
987 trace add variable [myvar data] write [myproc data_update]
988
989 trace add variable [myvar auto] write [myproc auto_update]
990
991 trace add variable [myvar thrs] write [myproc thrs_update 0]
992 trace add variable [myvar thrs_val] write [myproc thrs_update 0]
993
994 trace add variable [myvar recs_val] write [myproc recs_val_update]
995
996 trace add variable [myvar last] write [myproc last_update]
997
998 for {set i 1} {$i <= 6} {incr i} {
999 ${config}.chan_frame.chan${i}_check select
1000 ${config}.chan_frame.chan${i}_value configure -text 0.0
1001 }
1002 ${config}.chan_frame.axisx_value configure -text 0.0
1003
1004 ${config}.thrs_check select
1005 ${config}.thrs_field set 60
1006 }
1007
1008# -------------------------------------------------------------------------
1009
1010 OscDisplay instproc setup {} {
1011 my instvar master
1012 my instvar xvec yvec graph
1013 my instvar config
1014
1015 # create a graph widget and show a grid
1016 set graph [graph ${master}.graph -height 250 -leftmargin 80]
1017 $graph crosshairs configure -hide no -linewidth 1 -color darkblue -dashes {2 2}
1018 $graph grid configure -hide no
1019 $graph legend configure -hide yes
1020 $graph axis configure x -min 0 -max 60000
1021 $graph axis configure y -min 0 -max 4100
1022
1023# scale ${master}.last -orient horizontal -from 1 -to 27 -tickinterval 0 -showvalue no -variable [myvar last]
1024
1025 set config [frame ${master}.config -width 170]
1026
1027 frame ${config}.chan_frame -width 170
1028 legendButton ${config}.chan_frame 0 chan1 {Channel 1} [myvar chan(1)] turquoise2
1029 legendButton ${config}.chan_frame 1 chan2 {Channel 2} [myvar chan(2)] SpringGreen2
1030 legendButton ${config}.chan_frame 2 chan3 {Channel 3} [myvar chan(3)] orchid2
1031 legendButton ${config}.chan_frame 3 chan4 {Channel 4} [myvar chan(4)] orange2
1032 legendButton ${config}.chan_frame 4 chan5 {Channel 5} [myvar chan(5)] blue1 white
1033 legendButton ${config}.chan_frame 5 chan6 {Channel 6} [myvar chan(6)] gray65 white
1034 legendLabel ${config}.chan_frame 6 axisx {Time axis}
1035
1036 frame ${config}.spc1 -width 170 -height 30
1037
1038 checkbutton ${config}.auto_check -text {auto update} -variable [myvar auto]
1039
1040 frame ${config}.spc2 -width 170 -height 30
1041
1042 checkbutton ${config}.thrs_check -text threshold -variable [myvar thrs]
1043 spinbox ${config}.thrs_field -from 1 -to 4095 \
1044 -increment 5 -width 10 -textvariable [myvar thrs_val] \
1045 -validate all -vcmd {::mca::validate 4095 4 %P}
1046
1047 frame ${config}.spc3 -width 170 -height 30
1048
1049 button ${config}.acquire -text Acquire \
1050 -bg green -activebackground green -command [myproc acquire_start]
1051 button ${config}.register -text Register \
1052 -bg lightblue -activebackground lightblue -command [myproc register]
1053
1054 frame ${config}.spc4 -width 170 -height 30
1055
1056 label ${config}.recs -text {number of records}
1057 spinbox ${config}.recs_field -from 0 -to 10000 \
1058 -increment 10 -width 10 -textvariable [myvar recs_val] \
1059 -validate all -vcmd {::mca::validate 10000 5 %P}
1060
1061 frame ${config}.spc5 -width 170 -height 10
1062
1063 button ${config}.sequence -text {Start Recording} -command [myproc sequence_start] \
1064 -bg yellow -activebackground yellow
1065
1066 frame ${config}.spc6 -width 170 -height 30
1067
1068 button ${config}.recover -text {Read file} \
1069 -bg lightblue -activebackground lightblue -command [myproc recover]
1070
1071 grid ${config}.chan_frame -sticky ew
1072 grid ${config}.spc1
1073 grid ${config}.auto_check -sticky w
1074 grid ${config}.spc2
1075 grid ${config}.thrs_check -sticky w
1076 grid ${config}.thrs_field -sticky ew -pady 1 -padx 5
1077 grid ${config}.spc3
1078 grid ${config}.acquire -sticky ew -pady 3 -padx 5
1079 grid ${config}.register -sticky ew -pady 3 -padx 5
1080 grid ${config}.spc4
1081 grid ${config}.recs -sticky w -pady 1 -padx 3
1082 grid ${config}.recs_field -sticky ew -pady 1 -padx 5
1083 grid ${config}.spc5
1084 grid ${config}.sequence -sticky ew -pady 3 -padx 5
1085 grid ${config}.spc6
1086 grid ${config}.recover -sticky ew -pady 3 -padx 5
1087
1088 grid ${graph} -row 0 -column 0 -sticky news
1089 grid ${config} -row 0 -column 1
1090
1091# grid ${master}.last -row 1 -column 0 -columnspan 2 -sticky ew
1092
1093 grid rowconfigure ${master} 0 -weight 1
1094 grid columnconfigure ${master} 0 -weight 1
1095 grid columnconfigure ${master} 1 -weight 0 -minsize 120
1096
1097 grid columnconfigure ${config}.chan_frame 2 -weight 1
1098
1099 # enable zooming
1100 Blt_ZoomStack $graph
1101
1102 my crosshairs $graph
1103
1104 # create one element with data for the x and y axis, no dots
1105 $graph pen create pen1 -color turquoise3 -linewidth 2 -symbol none
1106 $graph pen create pen2 -color SpringGreen3 -linewidth 2 -symbol none
1107 $graph pen create pen3 -color orchid3 -linewidth 2 -symbol none
1108 $graph pen create pen4 -color orange3 -linewidth 2 -symbol none
1109 $graph pen create pen5 -color blue2 -linewidth 2 -symbol none
1110 $graph pen create pen6 -color gray55 -linewidth 2 -symbol none
1111
1112 $graph element create Spectrum1 -pen pen1 -xdata $xvec -ydata [dict get $yvec 1]
1113 $graph element create Spectrum2 -pen pen2 -xdata $xvec -ydata [dict get $yvec 2]
1114 $graph element create Spectrum3 -pen pen3 -xdata $xvec -ydata [dict get $yvec 3]
1115 $graph element create Spectrum4 -pen pen4 -xdata $xvec -ydata [dict get $yvec 4]
1116 $graph element create Spectrum5 -pen pen5 -xdata $xvec -ydata [dict get $yvec 5]
1117 $graph element create Spectrum6 -pen pen6 -xdata $xvec -ydata [dict get $yvec 6]
1118 }
1119
1120# -------------------------------------------------------------------------
1121
1122 OscDisplay instproc coor_update {W x y} {
1123 my instvar xvec yvec graph
1124 my instvar config
1125
1126 $W crosshairs configure -position @${x},${y}
1127
1128 set index [$W axis invtransform x $x]
1129 set index [::tcl::mathfunc::round $index]
1130 catch {
1131 ${config}.chan_frame.chan1_value configure -text [[dict get $yvec 1] index $index]
1132 ${config}.chan_frame.chan2_value configure -text [[dict get $yvec 2] index $index]
1133 ${config}.chan_frame.chan3_value configure -text [[dict get $yvec 3] index $index]
1134 ${config}.chan_frame.chan4_value configure -text [[dict get $yvec 4] index $index]
1135 ${config}.chan_frame.chan5_value configure -text [[dict get $yvec 5] index $index]
1136 ${config}.chan_frame.chan6_value configure -text [[dict get $yvec 6] index $index]
1137 ${config}.chan_frame.axisx_value configure -text ${index}.0
1138 }
1139 }
1140# -------------------------------------------------------------------------
1141
1142 OscDisplay instproc crosshairs {graph} {
1143 set method [myproc coor_update]
1144 bind $graph <Motion> [list [self] coor_update %W %x %y]
1145 bind $graph <Leave> {
1146 %W crosshairs off
1147 }
1148 bind $graph <Enter> {
1149 %W crosshairs on
1150 }
1151 }
1152
1153# -------------------------------------------------------------------------
1154
1155 OscDisplay instproc chan_update {name key op} {
1156 my instvar config graph chan
1157
1158 if {$chan(${key})} {
1159 $graph pen configure pen${key} -linewidth 2
1160 } else {
1161 $graph pen configure pen${key} -linewidth 0
1162 }
1163 }
1164
1165# -------------------------------------------------------------------------
1166
1167 OscDisplay instproc recs_val_update args {
1168 my instvar recs_val
1169 if {[string equal $recs_val {}]} {
1170 set recs_val 0
1171 }
1172 }
1173
1174# -------------------------------------------------------------------------
1175
1176 OscDisplay instproc last_update args {
1177 my instvar graph last
1178
1179 set first [expr {$last - 1}]
1180
1181 $graph axis configure x -min ${first}0000 -max ${last}0000
1182 }
1183
1184# -------------------------------------------------------------------------
1185
1186 OscDisplay instproc thrs_update {reset args} {
1187 my instvar controller config thrs thrs_val
1188
1189 if {[string equal $thrs_val {}]} {
1190 set thrs_val 0
1191 }
1192
1193 if {$thrs} {
1194 ${config}.thrs_field configure -state normal
1195 set value [format {%03x} $thrs_val]
1196 } else {
1197 ${config}.thrs_field configure -state disabled
1198 set value 000
1199 }
1200
1201 set command {}
1202 if {$reset} {
1203 append command 0002000500041${value}
1204 }
1205 append command 0002000500040${value}
1206
1207 $controller usbCmd $command
1208 }
1209
1210# -------------------------------------------------------------------------
1211
1212 OscDisplay instproc data_update args {
1213 my instvar data yvec
1214 my instvar graph chan waiting sequence auto
1215
1216 usb::convertOsc $data $yvec
1217
1218 foreach {key value} [array get chan] {
1219 $graph pen configure pen${key} -dashes 0
1220 }
1221
1222 set waiting 0
1223
1224 if {$sequence} {
1225 my sequence_register
1226 } elseif {$auto} {
1227 after 1000 [myproc acquire_start]
1228 }
1229 }
1230
1231# -------------------------------------------------------------------------
1232
1233 OscDisplay instproc acquire_start {} {
1234 my instvar graph chan controller waiting
1235
1236 foreach {key value} [array get chan] {
1237 $graph pen configure pen${key} -dashes dot
1238 }
1239
1240 # restart
1241 my thrs_update 1
1242
1243 set waiting 1
1244
1245 after 200 [myproc acquire_loop]
1246 }
1247
1248# -------------------------------------------------------------------------
1249
1250 OscDisplay instproc acquire_loop {} {
1251 my instvar controller waiting
1252
1253# set size 262144
1254# set size 10000
1255 set size 60000
1256
1257 set value [format {%08x} [expr {$size * 4}]]
1258
1259 set command 00011000000200000001[string range $value 0 3]0003[string range $value 4 7]00050000
1260
1261 $controller usbCmdReadRaw $command [expr {$size * 8}] [myvar data]
1262
1263 if {$waiting} {
1264 after 200 [myproc acquire_loop]
1265 }
1266 }
1267
1268# -------------------------------------------------------------------------
1269
1270 OscDisplay instproc auto_update args {
1271 my instvar config auto
1272
1273 if {$auto} {
1274 ${config}.recs_field configure -state disabled
1275 ${config}.sequence configure -state disabled
1276 ${config}.acquire configure -state disabled
1277 ${config}.register configure -state disabled
1278 ${config}.recover configure -state disabled
1279
1280 my acquire_start
1281 } else {
1282 ${config}.recs_field configure -state normal
1283 ${config}.sequence configure -state active
1284 ${config}.acquire configure -state active
1285 ${config}.register configure -state active
1286 ${config}.recover configure -state active
1287 }
1288 }
1289
1290# -------------------------------------------------------------------------
1291
1292 OscDisplay instproc save_data {fname} {
1293 my instvar data
1294
1295 set fid [open $fname w+]
1296 fconfigure $fid -translation binary -encoding binary
1297
1298# puts -nonewline $fid [binary format "H*iH*" "1f8b0800" [clock seconds] "0003"]
1299# puts -nonewline $fid [zlib deflate $data]
1300 puts -nonewline $fid $data
1301# puts -nonewline $fid [binary format i [zlib crc32 $data]]
1302# puts -nonewline $fid [binary format i [string length $data]]
1303
1304 close $fid
1305 }
1306
1307# -------------------------------------------------------------------------
1308
1309 OscDisplay instproc open_data {} {
1310 set types {
1311 {{Data Files} {.dat} }
1312 {{All Files} * }
1313 }
1314
1315 set fname [tk_getOpenFile -filetypes $types]
1316 if {[string equal $fname {}]} {
1317 return
1318 }
1319
1320 set x [catch {
1321 set fid [open $fname r+]
1322 fconfigure $fid -translation binary -encoding binary
1323# set size [file size $fname]
1324# seek $fid 10
1325# my set data [zlib inflate [read $fid [expr {$size - 18}]]]
1326 my set data [read $fid]
1327 close $fid
1328 }]
1329
1330 if { $x || ![file exists $fname] || ![file isfile $fname] || ![file readable $fname] } {
1331 tk_messageBox -icon error \
1332 -message "An error occurred while reading \"$fname\""
1333 } else {
1334 tk_messageBox -icon info \
1335 -message "File \"$fname\" read successfully"
1336 }
1337 }
1338
1339# -------------------------------------------------------------------------
1340
1341 OscDisplay instproc register {} {
1342 set types {
1343 {{Data Files} {.dat} }
1344 {{All Files} * }
1345 }
1346
1347 set stamp [clock format [clock seconds] -format {%Y%m%d_%H%M%S}]
1348 set fname oscillogram_${stamp}.dat
1349
1350 set fname [tk_getSaveFile -filetypes $types -initialfile $fname]
1351 if {[string equal $fname {}]} {
1352 return
1353 }
1354
1355 if {[catch {my save_data $fname} result]} {
1356 tk_messageBox -icon error \
1357 -message "An error occurred while writing to \"$fname\""
1358 } else {
1359 tk_messageBox -icon info \
1360 -message "File \"$fname\" written successfully"
1361 }
1362 }
1363
1364# -------------------------------------------------------------------------
1365
1366 OscDisplay instproc recover {} {
1367 my open_data
1368 }
1369
1370# -------------------------------------------------------------------------
1371
1372 OscDisplay instproc sequence_start {} {
1373 my instvar config recs_val recs_bak directory counter sequence
1374
1375 set counter 1
1376 if {$counter > $recs_val} {
1377 return
1378 }
1379
1380 set directory [tk_chooseDirectory -initialdir $directory -title {Choose a directory}]
1381
1382 if {[string equal $directory {}]} {
1383 return
1384 }
1385
1386 ${config}.recs_field configure -state disabled
1387 ${config}.sequence configure -text {Stop Recording} -command [myproc sequence_stop]
1388 ${config}.acquire configure -state disabled
1389 ${config}.register configure -state disabled
1390 ${config}.recover configure -state disabled
1391
1392 set recs_bak $recs_val
1393
1394 set sequence 1
1395
1396 my acquire_start
1397 }
1398
1399# -------------------------------------------------------------------------
1400
1401 OscDisplay instproc sequence_register {} {
1402 my instvar config recs_val recs_bak directory counter
1403
1404 set fname [file join $directory oscillogram_$counter.dat]
1405
1406 my incr counter
1407
1408 if {[catch {my save_data $fname} result]} {
1409 tk_messageBox -icon error \
1410 -message "An error occurred while writing to \"$fname\""
1411 } elseif {$counter <= $recs_bak} {
1412 set recs_val [expr {$recs_bak - $counter}]
1413 my acquire_start
1414 return
1415 }
1416
1417 my sequence_stop
1418 }
1419
1420# -------------------------------------------------------------------------
1421
1422 OscDisplay instproc sequence_stop {} {
1423 my instvar config recs_val recs_bak sequence
1424
1425 set sequence 0
1426
1427 set recs_val $recs_bak
1428
1429 ${config}.recs_field configure -state normal
1430 ${config}.sequence configure -text {Start Recording} -command [myproc sequence_start]
1431 ${config}.acquire configure -state active
1432 ${config}.register configure -state active
1433 ${config}.recover configure -state active
1434 }
1435
1436# -------------------------------------------------------------------------
1437
1438 namespace export MuxDisplay
1439 namespace export HstDisplay
1440 namespace export CfgDisplay
1441 namespace export OscDisplay
1442}
1443
1444set notebook [::blt::tabnotebook .notebook -borderwidth 1 -selectforeground black -side bottom]
1445
1446grid ${notebook} -row 0 -column 0 -sticky news -pady 5
1447
1448grid rowconfigure . 0 -weight 1
1449grid columnconfigure . 0 -weight 1
1450
1451::mca::UsbController usb
1452
1453set window [frame ${notebook}.mux]
1454$notebook insert end -text "Interconnect" -window $window -fill both
1455::mca::MuxDisplay mux -master $window -controller usb
1456
1457set window [frame ${notebook}.cfg]
1458$notebook insert end -text "Configuration" -window $window -fill both
1459::mca::CfgDisplay cfg -master $window -controller usb
1460
1461set window [frame ${notebook}.hst]
1462$notebook insert end -text "Histogram" -window $window -fill both
1463::mca::HstDisplay hst -number 0 -master $window -controller usb
1464
1465set window [frame ${notebook}.ept]
1466$notebook insert end -text "Oscilloscope" -window $window -fill both
1467::mca::OscDisplay osc -master $window -controller usb
1468
1469update
1470
1471cfg start
1472
1473mux start
1474
1475hst start
1476
1477osc start
Note: See TracBrowser for help on using the repository browser.