source: trunk/MultiChannelUSB/UserInterface.tcl@ 180

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

replace HOMEPATH with HOME

File size: 71.1 KB
RevLine 
[73]1package require XOTcl
2
3package require BLT
4package require swt
5package require usb
6
[85]7package require zlib
[73]8
[168]9wm minsize . 990 680
[85]10
[169]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
[73]22namespace eval ::mca {
23 namespace import ::xotcl::*
24
25 namespace import ::blt::vector
26 namespace import ::blt::graph
27 namespace import ::blt::tabnotebook
28
[159]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} {
[85]63 if {![regexp {^[0-9]*$} $value]} {
[73]64 return 0
[159]65 } elseif {[regexp {^0[0-9]+$} $value]} {
66 return 0
[85]67 } elseif {$value > $max} {
[73]68 return 0
[159]69 } elseif {[string length $value] > $size} {
[73]70 return 0
71 } else {
72 return 1
73 }
74 }
75
76# -------------------------------------------------------------------------
77
[159]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 }
[85]89
90# -------------------------------------------------------------------------
91
[159]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 {}
[85]95
[159]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
[170]118 UsbController instproc init {} {
119
120 my set ignore false
121
122 next
123 }
124
125# -------------------------------------------------------------------------
126
[159]127 UsbController instproc usbConnect {} {
[170]128 my instvar handle ignore
[159]129
130 puts usbConnect
131
132 if {[my exists handle]} {
133 $handle disconnect
134 unset handle
[85]135 }
[170]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 }
[159]146
[170]147 set handle $result
[159]148
[170]149 }
[85]150 }
151
152# -------------------------------------------------------------------------
153
[159]154 UsbController instproc usbHandle {} {
[170]155 my instvar handle ignore
[85]156
[159]157 if {[my exists handle]} {
158 return $handle
[170]159 } elseif {!$ignore} {
[159]160 my usbConnect
161 }
162 }
[85]163
[159]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 }
[85]173 }
174
175 }
176
177# -------------------------------------------------------------------------
178
[159]179 UsbController instproc usbCmdReadRaw {command size data} {
180 my usbCmd $command
[85]181
[159]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} {
[85]200 my usbCmd $command
201
[159]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 }
[85]214 }
[159]215 }
[85]216
[159]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 }
[85]235 }
236
237# -------------------------------------------------------------------------
238
[159]239 Class MuxDisplay -parameter {
[77]240 {master}
[159]241 {controller}
[77]242 }
243
244# -------------------------------------------------------------------------
245
[159]246 MuxDisplay instproc init {} {
[77]247
248 my setup
249
250 next
251 }
252
253# -------------------------------------------------------------------------
254
[159]255 MuxDisplay instproc destroy {} {
[77]256 next
257 }
258
259# -------------------------------------------------------------------------
260
[159]261 MuxDisplay instproc start {} {
[161]262 my instvar config chan_val hstmux
[77]263
[159]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
[77]270
[161]271 set hstmux(1) 0
272 set hstmux(2) 0
[162]273 set hstmux(3) 0
[161]274
[159]275 trace add variable [myvar chan_val] write [myproc chan_val_update]
[77]276 trace add variable [myvar polar] write [myproc polar_update]
[161]277 trace add variable [myvar hstmux] write [myproc hstmux_update]
[77]278
[159]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
[77]285
[162]286 $config(7).hstmux_1_1 select
287 $config(8).hstmux_2_2 select
288 $config(9).hstmux_3_1 select
289
[159]290 for {set i 1} {$i <= 3} {incr i} {
[162]291 $config(10).polar_$i select
[159]292 }
[77]293 }
294
295# -------------------------------------------------------------------------
296
[159]297 MuxDisplay instproc setup {} {
298 variable oscCodes
299 variable adcCodes
300 variable inpCodes
301 my instvar master
[77]302 my instvar config
303
[159]304 set size [array size inpCodes]
305 set oscList [array get oscCodes]
306 set adcList [array get adcCodes]
307 set inpList [array get inpCodes]
[77]308
[159]309 foreach {osc title} $oscList {
[161]310 set config($osc) [labelframe ${master}.mux_$osc -borderwidth 1 -relief sunken -text $title -font {-weight bold}]
[77]311
[159]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}]
[161]328 set row [expr {($osc - 1) / 3 + 1}]
329 grid $config($osc) -row $row -column $column -sticky news -padx 10 -pady 10
[159]330 }
[77]331
[162]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}]
[161]334 set config(9) [labelframe ${master}.mux_9 -borderwidth 1 -relief sunken -text {Rate histogram} -font {-weight bold}]
[162]335
336 set config(10) [labelframe ${master}.mux_10 -borderwidth 1 -relief sunken -text {Polarity inversion} -font {-weight bold}]
337
[159]338 for {set i 1} {$i <= 3} {incr i} {
[161]339 set value [expr {$i - 1}]
340
[162]341 radiobutton $config(7).hstmux_1_$i -text "ADC $i" -variable [myvar hstmux(1)] -value $value
342 grid ${config(7)}.hstmux_1_$i
[161]343
[162]344 radiobutton $config(8).hstmux_2_$i -text "ADC $i" -variable [myvar hstmux(2)] -value $value
345 grid ${config(8)}.hstmux_2_$i
[161]346
[162]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
[159]352 }
[162]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
[77]356
[162]357 grid $config(10) -row 4 -column 0 -sticky news -padx 10 -pady 10
358
[159]359 grid columnconfigure ${master} 0 -weight 1
360 grid columnconfigure ${master} 1 -weight 1
361 grid columnconfigure ${master} 2 -weight 1
[77]362
[159]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
[162]367 grid rowconfigure ${master} 4 -weight 0
368 grid rowconfigure ${master} 5 -weight 1
[77]369
370 }
371
372
[159]373# ------------------------------------------------------------------------
[77]374
[159]375 MuxDisplay instproc chan_val_update args {
376 my instvar controller chan_val
[77]377
[159]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)]
[77]381
[159]382 $controller usbCmd 000200020004${byte1}000200030004${byte2}000200040004${byte3}
[77]383 }
384
385# -------------------------------------------------------------------------
386
[159]387 MuxDisplay instproc polar_update args {
388 my instvar controller polar
[77]389
[159]390 set value [format {%x%x%x} $polar(3) $polar(2) $polar(1)]
[77]391
[159]392 $controller usbCmd 0002000100040${value}
[77]393 }
394
395# -------------------------------------------------------------------------
396
[161]397 MuxDisplay instproc hstmux_update args {
398 my instvar controller hstmux
399
[162]400 set value [format {%x%x%x} $hstmux(3) $hstmux(2) $hstmux(1)]
[161]401
[162]402 $controller usbCmd 0002000600040${value}
[161]403 }
404
405# -------------------------------------------------------------------------
406
[159]407 Class HstDisplay -parameter {
[73]408 {number}
409 {master}
[159]410 {controller}
[73]411 }
412
413# -------------------------------------------------------------------------
414
[159]415 HstDisplay instproc init {} {
[73]416
[159]417 my set data {}
[73]418
[159]419 vector create [myvar xvec](4096)
420 vector create [myvar yvec](4096)
[73]421
[159]422 # fill one vector for the x axis with 4096 points
423 [myvar xvec] seq -0.5 4095.5
424
[73]425 my setup
426
427 next
428 }
429
430# -------------------------------------------------------------------------
431
[159]432 HstDisplay instproc destroy {} {
[73]433 next
434 }
435
436# -------------------------------------------------------------------------
437
[159]438 HstDisplay instproc start {} {
439 my instvar config
[73]440
[159]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]
[73]444
[159]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]
[73]448
[159]449 ${config}.axis_check select
[73]450
[159]451 ${config}.thrs_check select
452 ${config}.thrs_field set 25
[74]453
[169]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
[159]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
[74]468
[159]469 my set rate_val(inst) 0.0
470 my set rate_val(mean) 0.0
[167]471
[170]472 my set date_val(start) {}
473 my set date_val(stop) {}
[171]474 my set after {}
[170]475
[167]476 ${config}.chan_frame.entr_value configure -text 0.0
[73]477
[167]478 ${config}.chan_frame.axisy_value configure -text 0.0
479 ${config}.chan_frame.axisx_value configure -text 0.0
480
[169]481 ${config}.stat_frame.tot_value configure -text 0.0
482 ${config}.stat_frame.bkg_value configure -text 0.0
483
[159]484# my cntr_reset
[73]485 }
486
487# -------------------------------------------------------------------------
488
[159]489 HstDisplay instproc setup {} {
[73]490 my instvar number master
[159]491 my instvar xvec yvec graph
492 my instvar config thrs thrs_val
493 my instvar cntr_h cntr_m cntr_s
[73]494
495 # create a graph widget and show a grid
496 set graph [graph ${master}.graph -height 250 -leftmargin 80]
[159]497 $graph crosshairs configure -hide no -linewidth 1 -color darkblue -dashes {2 2}
[73]498 $graph grid configure -hide no
499 $graph legend configure -hide yes
500
[169]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
[159]508 set config [frame ${master}.config -width 170]
[73]509
[159]510 checkbutton ${config}.axis_check -text {log scale} -variable [myvar axis]
[73]511
[169]512 frame ${config}.spc1 -width 170 -height 20
[73]513
[159]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
[169]518 frame ${config}.spc2 -width 170 -height 10
[159]519
520 frame ${config}.chan_frame -borderwidth 0 -width 170
521 legendLabel ${config}.chan_frame 0 entr {Total entries}
[169]522 frame ${config}.chan_frame.spc1 -height 10
523 grid ${config}.chan_frame.spc1 -row 1
[159]524 legendLabel ${config}.chan_frame 2 axisy {Bin entries}
525 legendLabel ${config}.chan_frame 3 axisx {Bin number}
[169]526
527 frame ${config}.spc3 -width 170 -height 10
[159]528
[169]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 {}
[159]536
[169]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
[159]548 checkbutton ${config}.thrs_check -text {amplitude threshold} -variable [myvar thrs]
[73]549 spinbox ${config}.thrs_field -from 1 -to 4095 \
550 -increment 5 -width 10 -textvariable [myvar thrs_val] \
[159]551 -validate all -vcmd {::mca::validate 4095 4 %P}
[73]552
[169]553 frame ${config}.spc5 -width 170 -height 20
[73]554
[159]555 label ${config}.cntr -text {time of exposure}
556 frame ${config}.cntr_frame -borderwidth 0 -width 170
[73]557
[159]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}
[73]567
[159]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
[74]570
[169]571 frame ${config}.spc6 -width 170 -height 20
[74]572
[159]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
[169]578 frame ${config}.spc7 -width 170 -height 20
[159]579
[73]580 button ${config}.register -text Register \
581 -bg lightblue -activebackground lightblue -command [myproc register]
582
[169]583 frame ${config}.spc8 -width 170 -height 20
[168]584
585 button ${config}.recover -text {Read file} \
586 -bg lightblue -activebackground lightblue -command [myproc recover]
587
[159]588 grid ${config}.axis_check -sticky w
[73]589 grid ${config}.spc1
[159]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
[169]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
[73]598 grid ${config}.thrs_check -sticky w
599 grid ${config}.thrs_field -sticky ew -pady 1 -padx 5
[169]600 grid ${config}.spc5
[159]601 grid ${config}.cntr -sticky w -pady 1 -padx 3
602 grid ${config}.cntr_frame -sticky ew -padx 5
[169]603 grid ${config}.spc6
[159]604 grid ${config}.start -sticky ew -pady 3 -padx 5
605 grid ${config}.reset -sticky ew -pady 3 -padx 5
[169]606 grid ${config}.spc7
[73]607 grid ${config}.register -sticky ew -pady 3 -padx 5
[169]608 grid ${config}.spc8
[168]609 grid ${config}.recover -sticky ew -pady 3 -padx 5
[73]610
611 grid ${graph} -row 0 -column 0 -sticky news
612 grid ${config} -row 0 -column 1
613
[77]614 grid rowconfigure ${master} 0 -weight 1
615 grid columnconfigure ${master} 0 -weight 1
616 grid columnconfigure ${master} 1 -weight 0 -minsize 80
617
[159]618 grid columnconfigure ${config}.rate_frame 1 -weight 1
619 grid columnconfigure ${config}.chan_frame 1 -weight 1
[169]620 grid columnconfigure ${config}.stat_frame 1 -weight 1
[159]621
622 my crosshairs $graph
623
[73]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
[159]627 $graph element create Spectrum1 -color blue -linewidth 2 -symbol none -smooth step -xdata [myvar xvec] -ydata [myvar yvec]
[73]628 }
629
630# -------------------------------------------------------------------------
631
[169]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
[159]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 }
[85]703 }
[169]704
[85]705# -------------------------------------------------------------------------
706
[159]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 }
[73]717
[159]718# -------------------------------------------------------------------------
[73]719
[159]720 HstDisplay instproc axis_update args {
721 my instvar axis graph
[167]722 $graph axis configure x -min 0 -max 4096
723 Blt_ZoomStack $graph
[159]724 if {$axis} {
725 $graph axis configure y -min 1 -max 1E10 -logscale yes
[73]726 } else {
[159]727 $graph axis configure y -min {} -max {} -logscale no
[73]728 }
729 }
730
731# -------------------------------------------------------------------------
732
[159]733 HstDisplay instproc thrs_update args {
734 my instvar controller config number thrs thrs_val
[74]735
[159]736 if {[string equal $thrs_val {}]} {
737 set thrs_val 0
738 }
[74]739
[170]740 set val_addr [format {%02x} [expr {7 + ${number}}]]
[159]741
[73]742 if {$thrs} {
743 ${config}.thrs_field configure -state normal
[170]744 set value [format {%03x} $thrs_val]
[73]745 } else {
746 ${config}.thrs_field configure -state disabled
[159]747 set value 000
[73]748 }
[159]749
750 $controller usbCmd 000200${val_addr}00040${value}
[73]751 }
752
753# -------------------------------------------------------------------------
754
[169]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
[159]799 HstDisplay instproc rate_val_update {name key op} {
800 my instvar config rate_val
[74]801
[159]802 ${config}.rate_frame.${key}_value configure -text [format {%.2e} $rate_val(${key})]
803 }
[85]804
[159]805# -------------------------------------------------------------------------
[74]806
[159]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}]
[73]814 }
815
816# -------------------------------------------------------------------------
817
[159]818 HstDisplay instproc cntr_setup {} {
819 my instvar controller number cntr_val
[74]820
[170]821 set word0 [format {%08x} [expr {${cntr_val} & 0xFFFFFFFF}]]
822 set word1 [format {%08x} [expr {${cntr_val} >> 32}]]
[159]823
[170]824 set prefix [format {%x} [expr {5 + ${number}}]]
[159]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
[170]836# set val_addr [format {%02x} [expr {12 + ${number}}]]
[159]837# $controller usbCmd 000200${val_addr}00040001000200${val_addr}00040000
[74]838 }
839
[159]840# -------------------------------------------------------------------------
[74]841
[159]842 HstDisplay instproc cntr_reset {} {
[170]843 my instvar controller config number
844 my instvar cntr_val cntr_bak cntr_old yvec_bak yvec_old rate_val date_val
[74]845
[159]846 my cntr_stop
[74]847
[170]848 set value [format {%04x} [expr {1 << (5 + ${number})}]]
[159]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
[167]858 set rate_val(inst) 0.0
859 set rate_val(mean) 0.0
860 ${config}.chan_frame.entr_value configure -text 0.0
[170]861
862 set date_val(start) {}
863 set date_val(stop) {}
864
[159]865 my acquire
866
867 my cntr_ready
[74]868 }
869
[159]870# -------------------------------------------------------------------------
[74]871
[159]872 HstDisplay instproc cntr_ready {} {
873 my instvar config cntr_val cntr_bak
[74]874
[159]875 set cntr_val $cntr_bak
[74]876
[159]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
[74]883 }
884
885# -------------------------------------------------------------------------
886
[159]887 HstDisplay instproc cntr_start {} {
888 my instvar config
889 my instvar cntr_h cntr_m cntr_s
[170]890 my instvar cntr_val cntr_bak cntr_old yvec_bak yvec_old date_val
[159]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
[73]898 }
[159]899 if {[string equal $m {}]} {
900 set m 0
901 }
902 if {[string equal $s {}]} {
903 set s 0
904 }
[170]905 if {[string equal $date_val(start) {}]} {
906 set date_val(start) [clock format [clock seconds] -format {%d/%m/%Y %H:%M:%S}]
907 }
[73]908
[159]909 set cntr_tmp [expr {${h}*3600000 + ${m}*60000 + ${s}*1000}]
910 set cntr_tmp [expr {entier(20000 * ${cntr_tmp})}]
[73]911
[159]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
[169]920 set yvec_bak [usb::integrateBlt [myvar yvec] 0 4095 0]
[159]921 set yvec_old $yvec_bak
922
923 my cntr_setup
924
925 my cntr_resume
[73]926 }
927 }
928
929# -------------------------------------------------------------------------
930
[159]931 HstDisplay instproc cntr_pause {} {
932 my instvar config
[73]933
[159]934 my cntr_stop
935
936 ${config}.start configure -text Resume -command [myproc cntr_resume]
937# ${config}.reset configure -state active
938
939 }
940
[73]941# -------------------------------------------------------------------------
942
[159]943 HstDisplay instproc cntr_resume {} {
[170]944 my instvar controller config number auto after
[159]945
[170]946 set val_addr [format {%02x} [expr {13 + ${number}}]]
[159]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
[170]955 set after [after 100 [myproc acquire_loop]]
[73]956 }
957
958# -------------------------------------------------------------------------
959
[159]960 HstDisplay instproc cntr_stop {} {
[170]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}]
[159]964
[170]965 set val_addr [format {%02x} [expr {13 + ${number}}]]
[159]966
967 $controller usbCmd 000200${val_addr}00040000
968
969 set auto 0
[170]970
971 after cancel $after
[73]972 }
973
974# -------------------------------------------------------------------------
975
[159]976 HstDisplay instproc data_update args {
977 my instvar data
978 usb::convertBlt $data 4 [myvar yvec]
979 }
[73]980
[159]981# -------------------------------------------------------------------------
982
983 HstDisplay instproc acquire_loop {} {
[170]984 my instvar cntr_val auto after
[159]985
[73]986 my acquire
987
[159]988 if {$cntr_val == 0} {
989 my cntr_stop
990 my cntr_ready
991 } elseif {$auto} {
[170]992 set after [after 1000 [myproc acquire_loop]]
[159]993 }
[73]994 }
995
996# -------------------------------------------------------------------------
997
[159]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
[73]1001
[159]1002 set size 4096
1003
[162]1004 set prefix [format {%x} [expr {2 + ${number}}]]
[159]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]
[169]1011 set yvec_new [usb::integrateBlt [myvar yvec] 0 4095 0]
[159]1012
[162]1013 set prefix [format {%x} [expr {5 + ${number}}]]
[159]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
[169]1023 my stat_update
[159]1024
1025 set yvec_old $yvec_new
1026 set cntr_old $cntr_new
1027 }
1028 }
1029
[73]1030# -------------------------------------------------------------------------
1031
[159]1032 HstDisplay instproc save_data {data} {
1033 my instvar number
[170]1034 my instvar yvec_old rate_val date_val
[73]1035
[159]1036 set types {
1037 {{Data Files} {.dat} }
1038 {{All Files} * }
1039 }
[73]1040
[170]1041 set stamp [clock format [clock seconds] -format {%Y%m%d_%H%M%S}]
[159]1042 set fname spectrum_[expr {$number + 1}]_${stamp}.dat
[73]1043
[159]1044 set fname [tk_getSaveFile -filetypes $types -initialfile $fname]
1045 if {[string equal $fname {}]} {
1046 return
1047 }
[73]1048
[159]1049 set x [catch {
1050 set fid [open $fname w+]
[170]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 {"
[159]1062 puts $fid $data
[170]1063 puts $fid "}"
[159]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 }
[73]1074 }
1075
1076# -------------------------------------------------------------------------
1077
[168]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+]
[170]1091 set content [read $fid 131072]
1092 set yvec_new [split [dict get $content data] \n]
[168]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"
[170]1102 my cntr_reset
1103 [myvar yvec] set $yvec_new
[168]1104 }
1105 }
1106
1107# -------------------------------------------------------------------------
1108
[159]1109 HstDisplay instproc register {} {
1110 my save_data [join [[myvar yvec] range 0 4095] \n]
[73]1111 }
1112
1113# -------------------------------------------------------------------------
1114
[168]1115 HstDisplay instproc recover {} {
[169]1116 my instvar config
[168]1117 my open_data
[169]1118 ${config}.chan_frame.entr_value configure -text [usb::integrateBlt [myvar yvec] 0 4095 0]
1119 my stat_update
[168]1120 }
1121
1122# -------------------------------------------------------------------------
1123
[159]1124 Class CntDisplay -parameter {
1125 {master}
1126 {controller}
1127 }
[73]1128
[159]1129# -------------------------------------------------------------------------
[73]1130
[159]1131 CntDisplay instproc init {} {
1132
1133 my set data {}
1134 my set cntr 0
1135 my set recs 0
1136
[165]1137 vector create [myvar xvec](10000)
1138 vector create [myvar yvec](10000)
[159]1139
[165]1140 # fill one vector for the x axis with 10000 points
1141 [myvar xvec] seq -0.5 9999.5
[159]1142
1143 my setup
1144
1145 next
[73]1146 }
1147
1148# -------------------------------------------------------------------------
1149
[159]1150 CntDisplay instproc destroy {} {
1151 next
1152 }
[73]1153
[159]1154# -------------------------------------------------------------------------
[73]1155
[159]1156 CntDisplay instproc start {} {
1157 my instvar config
1158
[85]1159 trace add variable [myvar data] write [myproc data_update]
[159]1160
[73]1161 trace add variable [myvar thrs] write [myproc thrs_update]
[159]1162 trace add variable [myvar thrs_val] write [myproc thrs_update]
[73]1163
[159]1164 trace add variable [myvar cntr] write [myproc cntr_update]
1165 trace add variable [myvar recs] write [myproc recs_update]
[85]1166
[159]1167 trace add variable [myvar axis] write [myproc axis_update]
1168
1169 ${config}.axis_check select
1170
[73]1171 ${config}.thrs_check select
[159]1172 ${config}.thrs_field set 25
[85]1173
[159]1174 my set cntr_val 100
1175 my set cntr_bak 100
1176 my set recs_val 100
1177 my set recs_bak 100
[167]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
[159]1184
1185# my cntr_reset
[73]1186 }
1187
1188# -------------------------------------------------------------------------
1189
[159]1190 CntDisplay instproc setup {} {
1191 my instvar master
1192 my instvar xvec yvec graph
1193 my instvar config
1194 my instvar cntr_ms
[73]1195
1196 # create a graph widget and show a grid
1197 set graph [graph ${master}.graph -height 250 -leftmargin 80]
[159]1198 $graph crosshairs configure -hide no -linewidth 1 -color darkblue -dashes {2 2}
[73]1199 $graph grid configure -hide no
1200 $graph legend configure -hide yes
1201
[159]1202 set config [frame ${master}.config -width 170]
[73]1203
[85]1204 checkbutton ${config}.axis_check -text {log scale} -variable [myvar axis]
[73]1205
[159]1206 frame ${config}.spc1 -width 170 -height 30
[73]1207
[159]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}
[73]1214
[159]1215 frame ${config}.spc3 -width 170 -height 30
[73]1216
[159]1217 checkbutton ${config}.thrs_check -text {amplitude threshold} -variable [myvar thrs]
[73]1218 spinbox ${config}.thrs_field -from 1 -to 4095 \
1219 -increment 5 -width 10 -textvariable [myvar thrs_val] \
[159]1220 -validate all -vcmd {::mca::validate 4095 4 %P}
[73]1221
[159]1222 frame ${config}.spc4 -width 170 -height 30
[73]1223
[159]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}
[73]1228
[159]1229 frame ${config}.spc5 -width 170 -height 10
[73]1230
[159]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
[73]1246 button ${config}.register -text Register \
1247 -bg lightblue -activebackground lightblue -command [myproc register]
1248
[168]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
[85]1254 grid ${config}.axis_check -sticky w
1255 grid ${config}.spc1
[159]1256 grid ${config}.chan_frame -sticky ew -padx 5
[85]1257 grid ${config}.spc3
[73]1258 grid ${config}.thrs_check -sticky w
1259 grid ${config}.thrs_field -sticky ew -pady 1 -padx 5
[85]1260 grid ${config}.spc4
[159]1261 grid ${config}.cntr -sticky w -pady 1 -padx 3
1262 grid ${config}.cntr_field -sticky ew -pady 1 -padx 5
[85]1263 grid ${config}.spc5
[159]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
[73]1270 grid ${config}.register -sticky ew -pady 3 -padx 5
[168]1271 grid ${config}.spc8
1272 grid ${config}.recover -sticky ew -pady 3 -padx 5
[73]1273
1274 grid ${graph} -row 0 -column 0 -sticky news
1275 grid ${config} -row 0 -column 1
1276
[77]1277 grid rowconfigure ${master} 0 -weight 1
1278 grid columnconfigure ${master} 0 -weight 1
1279 grid columnconfigure ${master} 1 -weight 0 -minsize 80
1280
[159]1281 grid columnconfigure ${config}.chan_frame 1 -weight 1
1282
1283 my crosshairs $graph
1284
[73]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
[159]1288 $graph element create Spectrum1 -color blue -linewidth 2 -symbol none -smooth step -xdata [myvar xvec] -ydata [myvar yvec]
[73]1289 }
1290
1291# -------------------------------------------------------------------------
1292
[159]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
[85]1303 }
1304 }
1305# -------------------------------------------------------------------------
1306
[159]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 }
[85]1316 }
1317
1318# -------------------------------------------------------------------------
1319
[159]1320 CntDisplay instproc thrs_update args {
1321 my instvar controller config thrs thrs_val
[73]1322
[159]1323 if {[string equal $thrs_val {}]} {
1324 set thrs_val 0
1325 }
1326
1327 set number 0
[170]1328 set val_addr [format {%02x} [expr {9 + ${number}}]]
[159]1329
1330 if {$thrs} {
1331 ${config}.thrs_field configure -state normal
[170]1332 set value [format {%03x} $thrs_val]
[73]1333 } else {
[159]1334 ${config}.thrs_field configure -state disabled
1335 set value 000
[73]1336 }
[159]1337
1338 $controller usbCmd 000200${val_addr}00040${value}
[73]1339 }
1340
1341# -------------------------------------------------------------------------
1342
[159]1343 CntDisplay instproc cntr_update args {
1344 my instvar cntr cntr_val
1345 set cntr_val [expr {${cntr}/20000}]
[73]1346
1347 }
1348
1349# -------------------------------------------------------------------------
1350
[159]1351 CntDisplay instproc recs_update args {
1352 my instvar recs recs_val
1353 set recs_val [expr {${recs}*1}]
1354 }
[73]1355
[159]1356# -------------------------------------------------------------------------
[73]1357
[159]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
[73]1375 }
1376
1377# -------------------------------------------------------------------------
1378
[159]1379 CntDisplay instproc recs_setup {} {
1380 my instvar controller recs_val
[73]1381
[159]1382 set word0 [format {%08x} [expr {${recs_val} & 0xFFFFFFFF}]]
1383 set word1 [format {%08x} [expr {${recs_val} >> 32}]]
[73]1384
[159]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
[73]1395 }
1396
1397# -------------------------------------------------------------------------
1398
[159]1399 CntDisplay instproc cntr_reset {} {
1400 my instvar controller after_handle
1401 my instvar cntr_val cntr_bak recs_val recs_bak
[73]1402
[159]1403 my cntr_stop
[85]1404
[159]1405 set value [format {%04x} [expr {1 << 11}]]
1406 $controller usbCmd 000200000004${value}0002000000040000
[73]1407
[159]1408 my recs_stop
[73]1409 }
1410
1411# -------------------------------------------------------------------------
1412
[159]1413 CntDisplay instproc cntr_ready {} {
1414 my instvar config cntr_val cntr_bak recs_val recs_bak
[73]1415
[159]1416 set cntr_val $cntr_bak
1417 set recs_val $recs_bak
[73]1418
[159]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
[73]1424 }
1425
1426# -------------------------------------------------------------------------
1427
[159]1428 CntDisplay instproc recs_start {} {
1429 my instvar controller config auto
1430 my instvar cntr_val cntr_bak recs_val recs_bak
[73]1431
[159]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
[73]1436
[159]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]
[73]1450 }
1451 }
1452
1453# -------------------------------------------------------------------------
1454
[159]1455 CntDisplay instproc recs_stop {} {
1456 my instvar cntr_val cntr_bak recs_val recs_bak
[73]1457
[159]1458 my cntr_stop
[85]1459
[159]1460 set cntr_val $cntr_bak
1461 my cntr_setup
[73]1462
[159]1463 set recs_val $recs_bak
1464 my recs_setup
1465
1466 my acquire
1467
1468 my cntr_ready
[73]1469 }
1470
1471# -------------------------------------------------------------------------
1472
[159]1473 CntDisplay instproc cntr_stop {} {
1474 my instvar controller config auto
[85]1475
[159]1476 set val_addr [format {%02x} 16]
[85]1477
[159]1478 $controller usbCmd 000200${val_addr}00040000
1479
1480 set auto 0
[85]1481 }
1482
1483# -------------------------------------------------------------------------
1484
[159]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]
[73]1495 }
[159]1496 }
[73]1497
[159]1498# -------------------------------------------------------------------------
[73]1499
[159]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 \
[169]1505 -text [format {%.2e} [usb::integrateBlt [myvar yvec] 0 9999 1]]
[159]1506 ${config}.chan_frame.entr_value configure \
[169]1507 -text [usb::integrateBlt [myvar yvec] 0 9999 0]
[159]1508
1509 }
1510
1511# -------------------------------------------------------------------------
1512
1513 CntDisplay instproc axis_update args {
1514 my instvar axis graph
[167]1515 $graph axis configure x -min 0 -max 10000
1516 Blt_ZoomStack $graph
[159]1517 if {$axis} {
1518 $graph axis configure y -min 1 -max 1E5 -logscale yes
[73]1519 } else {
[159]1520 $graph axis configure y -min {} -max {} -logscale no
[73]1521 }
1522 }
1523
1524# -------------------------------------------------------------------------
1525
[159]1526 CntDisplay instproc acquire {} {
1527 my instvar controller config
1528 my instvar cntr cntr_val recs recs_val
[73]1529
[165]1530 set size 10000
[159]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
[73]1551# -------------------------------------------------------------------------
1552
[159]1553 CntDisplay instproc save_data {data} {
[73]1554
[159]1555 set types {
1556 {{Data Files} {.dat} }
1557 {{All Files} * }
1558 }
[85]1559
[170]1560 set stamp [clock format [clock seconds] -format {%Y%m%d_%H%M%S}]
[159]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 }
[85]1581 }
1582
1583# -------------------------------------------------------------------------
1584
[168]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
[159]1614 CntDisplay instproc register {} {
[165]1615 my save_data [join [[myvar yvec] range 0 9999] \n]
[159]1616 }
1617
1618# -------------------------------------------------------------------------
1619
[168]1620 CntDisplay instproc recover {} {
1621 my open_data
1622 }
1623
1624# -------------------------------------------------------------------------
1625
[159]1626 Class OscDisplay -parameter {
[85]1627 {master}
[159]1628 {controller}
[85]1629 }
1630
1631# -------------------------------------------------------------------------
1632
[159]1633 OscDisplay instproc init {} {
1634 my instvar sequence data xvec yvec
[85]1635
[159]1636 set data {}
1637
1638 set sequence 0
[85]1639
[159]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)]
[73]1646 }
[85]1647
1648 # fill one vector for the x axis
[159]1649# $xvec seq 0 262143
[85]1650 $xvec seq 0 10000
1651
1652 my setup
1653
1654 next
[73]1655 }
1656
1657# -------------------------------------------------------------------------
1658
[159]1659 OscDisplay instproc destroy {} {
[85]1660 next
[73]1661 }
1662
1663# -------------------------------------------------------------------------
1664
[159]1665 OscDisplay instproc start {} {
1666 my instvar config
1667 my instvar recs_val directory
[73]1668
[174]1669 set directory $::env(HOME)
[159]1670 set recs_val 100
[85]1671
[159]1672 trace add variable [myvar chan] write [myproc chan_update]
[73]1673
[159]1674 trace add variable [myvar data] write [myproc data_update]
[73]1675
[159]1676 trace add variable [myvar auto] write [myproc auto_update]
[85]1677
[159]1678 trace add variable [myvar thrs] write [myproc thrs_update 0]
1679 trace add variable [myvar thrs_val] write [myproc thrs_update 0]
1680
[85]1681 trace add variable [myvar recs_val] write [myproc recs_val_update]
1682
[159]1683 trace add variable [myvar last] write [myproc last_update]
1684
[167]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
[159]1690
1691 ${config}.thrs_check select
1692 ${config}.thrs_field set 100
[73]1693 }
1694
1695# -------------------------------------------------------------------------
1696
[159]1697 OscDisplay instproc setup {} {
[85]1698 my instvar master
[159]1699 my instvar xvec yvec graph
1700 my instvar config
[85]1701
1702 # create a graph widget and show a grid
[159]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
[85]1709
[159]1710# scale ${master}.last -orient horizontal -from 1 -to 27 -tickinterval 0 -showvalue no -variable [myvar last]
[85]1711
[159]1712 set config [frame ${master}.config -width 170]
[85]1713
[159]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}
[85]1722
[159]1723 frame ${config}.spc1 -width 170 -height 30
[85]1724
[159]1725 checkbutton ${config}.auto_check -text {auto update} -variable [myvar auto]
[85]1726
[159]1727 frame ${config}.spc2 -width 170 -height 30
[85]1728
[159]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}
[85]1733
[159]1734 frame ${config}.spc3 -width 170 -height 30
[85]1735
[159]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]
[85]1740
[159]1741 frame ${config}.spc4 -width 170 -height 30
[85]1742
[159]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}
[85]1747
[159]1748 frame ${config}.spc5 -width 170 -height 10
[85]1749
[159]1750 button ${config}.sequence -text {Start Recording} -command [myproc sequence_start] \
1751 -bg yellow -activebackground yellow
[85]1752
[168]1753 frame ${config}.spc6 -width 170 -height 30
[85]1754
[159]1755 button ${config}.recover -text {Read file} \
1756 -bg lightblue -activebackground lightblue -command [myproc recover]
1757
1758 grid ${config}.chan_frame -sticky ew
[85]1759 grid ${config}.spc1
[159]1760 grid ${config}.auto_check -sticky w
[85]1761 grid ${config}.spc2
[159]1762 grid ${config}.thrs_check -sticky w
1763 grid ${config}.thrs_field -sticky ew -pady 1 -padx 5
[85]1764 grid ${config}.spc3
1765 grid ${config}.acquire -sticky ew -pady 3 -padx 5
1766 grid ${config}.register -sticky ew -pady 3 -padx 5
[159]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
[85]1774
[159]1775 grid ${graph} -row 0 -column 0 -sticky news
[85]1776 grid ${config} -row 0 -column 1
1777
[159]1778# grid ${master}.last -row 1 -column 0 -columnspan 2 -sticky ew
[85]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
[159]1784 grid columnconfigure ${config}.chan_frame 2 -weight 1
[85]1785
1786 # enable zooming
[159]1787 Blt_ZoomStack $graph
[85]1788
[159]1789 my crosshairs $graph
[85]1790
1791 # create one element with data for the x and y axis, no dots
[159]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]
[85]1805 }
1806
1807# -------------------------------------------------------------------------
1808
[159]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
[85]1825 }
1826 }
1827# -------------------------------------------------------------------------
1828
[159]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
[85]1834 }
[159]1835 bind $graph <Enter> {
1836 %W crosshairs on
[85]1837 }
1838 }
1839
1840# -------------------------------------------------------------------------
1841
[159]1842 OscDisplay instproc chan_update {name key op} {
1843 my instvar config graph chan
[85]1844
[159]1845 if {$chan(${key})} {
1846 $graph pen configure pen${key} -linewidth 2
[85]1847 } else {
[159]1848 $graph pen configure pen${key} -linewidth 0
[85]1849 }
1850 }
1851
1852# -------------------------------------------------------------------------
1853
[159]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 }
[85]1860
1861# -------------------------------------------------------------------------
1862
[159]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
[85]1869 }
1870
1871# -------------------------------------------------------------------------
1872
[159]1873 OscDisplay instproc thrs_update {reset args} {
1874 my instvar controller config thrs thrs_val
[85]1875
[159]1876 if {[string equal $thrs_val {}]} {
1877 set thrs_val 0
1878 }
[85]1879
[159]1880 if {$thrs} {
1881 ${config}.thrs_field configure -state normal
[170]1882 set value [format {%03x} $thrs_val]
[159]1883 } else {
1884 ${config}.thrs_field configure -state disabled
1885 set value 000
[85]1886 }
1887
[159]1888 set command {}
1889 if {$reset} {
1890 append command 0002000500041${value}
[85]1891 }
[159]1892 append command 0002000500040${value}
1893
1894 $controller usbCmd $command
[85]1895 }
1896
1897# -------------------------------------------------------------------------
1898
[159]1899 OscDisplay instproc data_update args {
1900 my instvar data yvec
1901 my instvar graph chan waiting sequence auto
[73]1902
[159]1903 usb::convertOsc $data $yvec
[73]1904
[159]1905 foreach {key value} [array get chan] {
1906 $graph pen configure pen${key} -dashes 0
1907 }
[85]1908
[159]1909 set waiting 0
[85]1910
[159]1911 if {$sequence} {
1912 my sequence_register
1913 } elseif {$auto} {
1914 after 1000 [myproc acquire_start]
1915 }
1916 }
[85]1917
[159]1918# -------------------------------------------------------------------------
[85]1919
[159]1920 OscDisplay instproc acquire_start {} {
1921 my instvar graph chan controller waiting
[85]1922
[159]1923 foreach {key value} [array get chan] {
1924 $graph pen configure pen${key} -dashes dot
[85]1925 }
1926
[159]1927 # restart
1928 my thrs_update 1
[73]1929
[159]1930 set waiting 1
[73]1931
[159]1932 after 200 [myproc acquire_loop]
[85]1933 }
1934
1935# -------------------------------------------------------------------------
1936
[159]1937 OscDisplay instproc acquire_loop {} {
1938 my instvar controller waiting
[85]1939
[159]1940# set size 262144
1941 set size 10000
[85]1942
[159]1943 set value [format {%08x} [expr {$size * 4}]]
[85]1944
[159]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]
[85]1948
[159]1949 if {$waiting} {
1950 after 200 [myproc acquire_loop]
1951 }
[85]1952 }
1953
1954# -------------------------------------------------------------------------
1955
[159]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 }
[85]1974 }
1975
1976# -------------------------------------------------------------------------
1977
[159]1978 OscDisplay instproc save_data {fname} {
1979 my instvar data
[85]1980
[159]1981 set fid [open $fname w+]
1982 fconfigure $fid -translation binary -encoding binary
[85]1983
[159]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
[85]1991 }
1992
1993# -------------------------------------------------------------------------
1994
[159]1995 OscDisplay instproc open_data {} {
1996 set types {
1997 {{Data Files} {.dat} }
1998 {{All Files} * }
1999 }
[85]2000
[159]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 }
[85]2023 }
2024
2025# -------------------------------------------------------------------------
2026
[159]2027 OscDisplay instproc register {} {
2028 set types {
2029 {{Data Files} {.dat} }
2030 {{All Files} * }
2031 }
[85]2032
[170]2033 set stamp [clock format [clock seconds] -format {%Y%m%d_%H%M%S}]
[159]2034 set fname oscillogram_${stamp}.dat
[85]2035
[159]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 }
[85]2049
[159]2050# -------------------------------------------------------------------------
[85]2051
[159]2052 OscDisplay instproc recover {} {
2053 my open_data
2054 }
[85]2055
[159]2056# -------------------------------------------------------------------------
[85]2057
[159]2058 OscDisplay instproc sequence_start {} {
2059 my instvar config recs_val recs_bak directory counter sequence
[85]2060
[159]2061 set counter 1
2062 if {$counter > $recs_val} {
2063 return
2064 }
[85]2065
[159]2066 set directory [tk_chooseDirectory -initialdir $directory -title {Choose a directory}]
[85]2067
[159]2068 if {[string equal $directory {}]} {
2069 return
2070 }
[85]2071
[159]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
[85]2079
[159]2080 set sequence 1
2081
2082 my acquire_start
[85]2083 }
2084
2085# -------------------------------------------------------------------------
2086
[159]2087 OscDisplay instproc sequence_register {} {
2088 my instvar config recs_val recs_bak directory counter
[85]2089
[159]2090 set fname [file join $directory oscillogram_$counter.dat]
[85]2091
[159]2092 my incr counter
[85]2093
[159]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
[85]2100 return
2101 }
[159]2102
2103 my sequence_stop
[85]2104 }
2105
2106# -------------------------------------------------------------------------
2107
[159]2108 OscDisplay instproc sequence_stop {} {
2109 my instvar config recs_val recs_bak sequence
[85]2110
[159]2111 set sequence 0
2112
2113 set recs_val $recs_bak
[85]2114
[159]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
[85]2120 }
2121
2122# -------------------------------------------------------------------------
2123
[159]2124 namespace export MuxDisplay
[73]2125 namespace export HstDisplay
[159]2126 namespace export CntDisplay
[73]2127 namespace export OscDisplay
2128}
2129
[78]2130set notebook [::blt::tabnotebook .notebook -borderwidth 1 -selectforeground black -side bottom]
[73]2131
[159]2132grid ${notebook} -row 0 -column 0 -sticky news -pady 5
[73]2133
[78]2134grid rowconfigure . 0 -weight 1
[159]2135grid columnconfigure . 0 -weight 1
[78]2136
[159]2137::mca::UsbController usb
[73]2138
[159]2139set window [frame ${notebook}.hst_0]
[162]2140$notebook insert end -text "Spectrum histogram 1" -window $window -fill both
[159]2141::mca::HstDisplay hst_0 -number 0 -master $window -controller usb
[73]2142
[162]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
[159]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
[73]2150
[159]2151set window [frame ${notebook}.mux]
2152$notebook insert end -text "Interconnect" -window $window -fill both
2153::mca::MuxDisplay mux -master $window -controller usb
[73]2154
[85]2155set window [frame ${notebook}.ept]
[159]2156$notebook insert end -text "Oscilloscope" -window $window -fill both
2157::mca::OscDisplay osc -master $window -controller usb
[85]2158
[159]2159update
[85]2160
[159]2161usb usbCmd 00000000
[73]2162
[159]2163hst_0 start
[73]2164
[162]2165hst_1 start
2166
[159]2167cnt_0 start
[73]2168
[159]2169mux start
[77]2170
[159]2171osc start
Note: See TracBrowser for help on using the repository browser.