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

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

add classifier and remove unneeded modules

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