package require XOTcl package require BLT package require swt package require usb package require zlib wm minsize . 990 680 image create bitmap leftarrow -data " #define leftarrow_width 5\n #define leftarrow_height 5\n static unsigned char leftarrow_bits\[\] = {\n 0x10, 0x1C, 0x1F, 0x1C, 0x10};" image create bitmap rightarrow -data " #define rightarrow_width 5\n #define rightarrow_height 5\n static unsigned char rightarrow_bits\[\] = {\n 0x01, 0x07, 0x1F, 0x07, 0x01};" namespace eval ::mca { namespace import ::xotcl::* namespace import ::blt::vector namespace import ::blt::graph namespace import ::blt::tabnotebook # ------------------------------------------------------------------------- variable oscCodes array set oscCodes { 1 {Channel 1} 2 {Channel 2} 3 {Channel 3} 4 {Channel 4} 5 {Channel 5} 6 {Trigger} } # ------------------------------------------------------------------------- variable adcCodes array set adcCodes { 1 {ADC 1} 2 {ADC 2} 3 {ADC 3} } # ------------------------------------------------------------------------- variable inpCodes array set inpCodes { 0 {raw data} 1 {filtered} 2 {amplitude} 3 {amp flag} } # ------------------------------------------------------------------------- proc validate {max size value} { if {![regexp {^[0-9]*$} $value]} { return 0 } elseif {[regexp {^0[0-9]+$} $value]} { return 0 } elseif {$value > $max} { return 0 } elseif {[string length $value] > $size} { return 0 } else { return 1 } } # ------------------------------------------------------------------------- proc doublevalidate {max value} { if {![regexp {^[0-9]{0,2}\.?[0-9]{0,3}$} $value]} { return 0 } elseif {[regexp {^0[0-9]+$} $value]} { return 0 } elseif {$value > $max} { return 0 } else { return 1 } } # ------------------------------------------------------------------------- proc legendLabel {master row key title} { label ${master}.${key}_label -anchor w -text ${title} label ${master}.${key}_value -width 10 -anchor e -text {} grid ${master}.${key}_label -row ${row} -column 1 -sticky w grid ${master}.${key}_value -row ${row} -column 2 -sticky ew } # ------------------------------------------------------------------------- proc legendButton {master row key title var bg {fg black}} { checkbutton ${master}.${key}_check -variable $var label ${master}.${key}_label -anchor w -text ${title} -bg ${bg} -fg $fg label ${master}.${key}_value -width 10 -anchor e -text {} -bg ${bg} -fg $fg grid ${master}.${key}_check -row ${row} -column 0 -sticky w grid ${master}.${key}_label -row ${row} -column 1 -sticky w grid ${master}.${key}_value -row ${row} -column 2 -sticky ew } # ------------------------------------------------------------------------- Class UsbController # ------------------------------------------------------------------------- UsbController instproc init {} { my set ignore false next } # ------------------------------------------------------------------------- UsbController instproc usbConnect {} { my instvar handle ignore puts usbConnect if {[my exists handle]} { $handle disconnect unset handle } if {!$ignore} { while {[catch {usb::connect 0x09FB 0x6001 1 1 0} result]} { set answer [tk_messageBox -icon error -type abortretryignore \ -message {Cannot access USB device} -detail $result] if {[string equal $answer abort]} exit if {[string equal $answer ignore]} { set ignore true return } } set handle $result } } # ------------------------------------------------------------------------- UsbController instproc usbHandle {} { my instvar handle ignore if {[my exists handle]} { return $handle } elseif {!$ignore} { my usbConnect } } # ------------------------------------------------------------------------- UsbController instproc usbCmd {command} { set code [catch {[my usbHandle] writeRaw [usb::convert $command]} result] switch -- $code { 1 { # puts $result my usbConnect } } } # ------------------------------------------------------------------------- UsbController instproc usbCmdReadRaw {command size data} { my usbCmd $command set code [catch {[my usbHandle] readRaw $size} result] switch -- $code { 0 { set $data $result } 1 { # puts $result my usbConnect } 5 { # puts Busy } } } # ------------------------------------------------------------------------- UsbController instproc usbCmdReadRaw {command size data} { my usbCmd $command set code [catch {[my usbHandle] readRaw $size} result] switch -- $code { 0 { set $data $result } 1 { # puts $result my usbConnect } 5 { # puts Busy } } } # ------------------------------------------------------------------------- UsbController instproc usbCmdReadHex {command width size data} { my usbCmd $command set code [catch {[my usbHandle] readHex $width $size} result] switch -- $code { 0 { set $data $result } 1 { # puts $result my usbConnect } 5 { # puts Busy } } } # ------------------------------------------------------------------------- Class MuxDisplay -parameter { {master} {controller} } # ------------------------------------------------------------------------- MuxDisplay instproc init {} { my setup next } # ------------------------------------------------------------------------- MuxDisplay instproc destroy {} { next } # ------------------------------------------------------------------------- MuxDisplay instproc start {} { my instvar config chan_val hstmux set chan_val(1) 0 set chan_val(2) 0 set chan_val(3) 0 set chan_val(4) 0 set chan_val(5) 0 set chan_val(6) 0 set hstmux(1) 0 set hstmux(2) 0 set hstmux(3) 0 trace add variable [myvar chan_val] write [myproc chan_val_update] trace add variable [myvar polar] write [myproc polar_update] trace add variable [myvar hstmux] write [myproc hstmux_update] $config(1).chan_1_1 select $config(2).chan_1_2 select $config(3).chan_1_3 select $config(4).chan_1_1 select $config(5).chan_3_1 select $config(6).chan_3_1 select $config(7).hstmux_1_1 select $config(8).hstmux_2_2 select $config(9).hstmux_3_1 select for {set i 1} {$i <= 3} {incr i} { $config(10).polar_$i select } } # ------------------------------------------------------------------------- MuxDisplay instproc setup {} { variable oscCodes variable adcCodes variable inpCodes my instvar master my instvar config set size [array size inpCodes] set oscList [array get oscCodes] set adcList [array get adcCodes] set inpList [array get inpCodes] foreach {osc title} $oscList { set config($osc) [labelframe ${master}.mux_$osc -borderwidth 1 -relief sunken -text $title -font {-weight bold}] foreach {ch dummy} $adcList { label $config($osc).chan_${ch} -text "#$ch " grid $config($osc).chan_${ch} -row 0 -column $ch -sticky w } foreach {code input} $inpList { set row [expr {$code + 1}] set last 0 foreach {ch dummy} $adcList { set value [expr {$size * ($ch - 1) + $code}] radiobutton $config($osc).chan_${code}_${ch} -variable [myvar chan_val($osc)] -value ${value} grid $config($osc).chan_${code}_${ch} -row ${row} -column $ch -sticky w set last $ch } $config($osc).chan_${code}_${last} configure -text $input } set column [expr {($osc - 1) % 3}] set row [expr {($osc - 1) / 3 + 1}] grid $config($osc) -row $row -column $column -sticky news -padx 10 -pady 10 } set config(7) [labelframe ${master}.mux_7 -borderwidth 1 -relief sunken -text {Spectrum histogram 1} -font {-weight bold}] set config(8) [labelframe ${master}.mux_8 -borderwidth 1 -relief sunken -text {Spectrum histogram 2} -font {-weight bold}] set config(9) [labelframe ${master}.mux_9 -borderwidth 1 -relief sunken -text {Rate histogram} -font {-weight bold}] set config(10) [labelframe ${master}.mux_10 -borderwidth 1 -relief sunken -text {Polarity inversion} -font {-weight bold}] for {set i 1} {$i <= 3} {incr i} { set value [expr {$i - 1}] radiobutton $config(7).hstmux_1_$i -text "ADC $i" -variable [myvar hstmux(1)] -value $value grid ${config(7)}.hstmux_1_$i radiobutton $config(8).hstmux_2_$i -text "ADC $i" -variable [myvar hstmux(2)] -value $value grid ${config(8)}.hstmux_2_$i radiobutton $config(9).hstmux_3_$i -text "ADC $i" -variable [myvar hstmux(3)] -value $value grid ${config(9)}.hstmux_3_$i checkbutton $config(10).polar_$i -text "ADC $i" -variable [myvar polar($i)] grid ${config(10)}.polar_$i } grid $config(7) -row 3 -column 0 -sticky news -padx 10 -pady 30 grid $config(8) -row 3 -column 1 -sticky news -padx 10 -pady 30 grid $config(9) -row 3 -column 2 -sticky news -padx 10 -pady 30 grid $config(10) -row 4 -column 0 -sticky news -padx 10 -pady 10 grid columnconfigure ${master} 0 -weight 1 grid columnconfigure ${master} 1 -weight 1 grid columnconfigure ${master} 2 -weight 1 grid rowconfigure ${master} 0 -weight 1 grid rowconfigure ${master} 1 -weight 0 grid rowconfigure ${master} 2 -weight 0 grid rowconfigure ${master} 3 -weight 0 grid rowconfigure ${master} 4 -weight 0 grid rowconfigure ${master} 5 -weight 1 } # ------------------------------------------------------------------------ MuxDisplay instproc chan_val_update args { my instvar controller chan_val set byte1 [format {%02x%02x} $chan_val(2) $chan_val(1)] set byte2 [format {%02x%02x} $chan_val(4) $chan_val(3)] set byte3 [format {%02x%02x} $chan_val(6) $chan_val(5)] $controller usbCmd 000200020004${byte1}000200030004${byte2}000200040004${byte3} } # ------------------------------------------------------------------------- MuxDisplay instproc polar_update args { my instvar controller polar set value [format {%x%x%x} $polar(3) $polar(2) $polar(1)] $controller usbCmd 0002000100040${value} } # ------------------------------------------------------------------------- MuxDisplay instproc hstmux_update args { my instvar controller hstmux set value [format {%x%x%x} $hstmux(3) $hstmux(2) $hstmux(1)] $controller usbCmd 0002000600040${value} } # ------------------------------------------------------------------------- Class HstDisplay -parameter { {number} {master} {controller} } # ------------------------------------------------------------------------- HstDisplay instproc init {} { my set data {} vector create [myvar xvec](4096) vector create [myvar yvec](4096) # fill one vector for the x axis with 4096 points [myvar xvec] seq -0.5 4095.5 my setup next } # ------------------------------------------------------------------------- HstDisplay instproc destroy {} { next } # ------------------------------------------------------------------------- HstDisplay instproc start {} { my instvar config trace add variable [myvar data] write [myproc data_update] trace add variable [myvar cntr_val] write [myproc cntr_val_update] trace add variable [myvar rate_val] write [myproc rate_val_update] trace add variable [myvar axis] write [myproc axis_update] trace add variable [myvar thrs] write [myproc thrs_update] trace add variable [myvar thrs_val] write [myproc thrs_update] ${config}.axis_check select ${config}.thrs_check select ${config}.thrs_field set 25 my set xmin_val 0 my set xmax_val 4095 trace add variable [myvar xmin_val] write [myproc xmin_val_update] trace add variable [myvar xmax_val] write [myproc xmax_val_update] my stat_update set cntr_tmp 1200000000 my set cntr_val $cntr_tmp my set cntr_bak $cntr_tmp my set cntr_old $cntr_tmp my set yvec_bak 0.0 my set yvec_old 0.0 my set rate_val(inst) 0.0 my set rate_val(mean) 0.0 my set date_val(start) {} my set date_val(stop) {} my set after {} ${config}.chan_frame.entr_value configure -text 0.0 ${config}.chan_frame.axisy_value configure -text 0.0 ${config}.chan_frame.axisx_value configure -text 0.0 ${config}.stat_frame.tot_value configure -text 0.0 ${config}.stat_frame.bkg_value configure -text 0.0 # my cntr_reset } # ------------------------------------------------------------------------- HstDisplay instproc setup {} { my instvar number master my instvar xvec yvec graph my instvar config thrs thrs_val my instvar cntr_h cntr_m cntr_s # create a graph widget and show a grid set graph [graph ${master}.graph -height 250 -leftmargin 80] $graph crosshairs configure -hide no -linewidth 1 -color darkblue -dashes {2 2} $graph grid configure -hide no $graph legend configure -hide yes $graph marker create line -name xmin -coords "0 -Inf 0 Inf" -linewidth 2 -outline red $graph marker create line -name xmax -coords "4095 -Inf 4095 Inf" -linewidth 2 -outline red $graph marker bind xmin [list [self] marker_enter xmin] $graph marker bind xmin [list [self] marker_leave xmin] $graph marker bind xmax [list [self] marker_enter xmax] $graph marker bind xmax [list [self] marker_leave xmax] set config [frame ${master}.config -width 170] checkbutton ${config}.axis_check -text {log scale} -variable [myvar axis] frame ${config}.spc1 -width 170 -height 20 frame ${config}.rate_frame -borderwidth 0 -width 170 legendLabel ${config}.rate_frame 0 inst {Inst. rate, 1/s} legendLabel ${config}.rate_frame 1 mean {Avg. rate, 1/s} frame ${config}.spc2 -width 170 -height 10 frame ${config}.chan_frame -borderwidth 0 -width 170 legendLabel ${config}.chan_frame 0 entr {Total entries} frame ${config}.chan_frame.spc1 -height 10 grid ${config}.chan_frame.spc1 -row 1 legendLabel ${config}.chan_frame 2 axisy {Bin entries} legendLabel ${config}.chan_frame 3 axisx {Bin number} frame ${config}.spc3 -width 170 -height 10 label ${config}.roi -text {Region of interest} frame ${config}.roi_frame -borderwidth 0 -width 170 label ${config}.roi_frame.min_title -anchor w -text {start:} label ${config}.roi_frame.min_value -width 4 -anchor e -text {} label ${config}.roi_frame.spc1 -width 5 -anchor w -text {} label ${config}.roi_frame.max_title -anchor w -text {end:} label ${config}.roi_frame.max_value -width 4 -anchor e -text {} grid ${config}.roi_frame.min_title ${config}.roi_frame.min_value \ ${config}.roi_frame.spc1 ${config}.roi_frame.max_title \ ${config}.roi_frame.max_value frame ${config}.stat_frame -borderwidth 0 -width 17 legendLabel ${config}.stat_frame 0 tot {total entries} legendLabel ${config}.stat_frame 1 bkg {bkg entries} frame ${config}.spc4 -width 170 -height 20 checkbutton ${config}.thrs_check -text {amplitude threshold} -variable [myvar thrs] spinbox ${config}.thrs_field -from 1 -to 4095 \ -increment 5 -width 10 -textvariable [myvar thrs_val] \ -validate all -vcmd {::mca::validate 4095 4 %P} frame ${config}.spc5 -width 170 -height 20 label ${config}.cntr -text {time of exposure} frame ${config}.cntr_frame -borderwidth 0 -width 170 label ${config}.cntr_frame.h -width 3 -anchor w -text {h} entry ${config}.cntr_frame.h_field -width 3 -textvariable [myvar cntr_h] \ -validate all -vcmd {::mca::validate 999 3 %P} label ${config}.cntr_frame.m -width 3 -anchor w -text {m} entry ${config}.cntr_frame.m_field -width 3 -textvariable [myvar cntr_m] \ -validate all -vcmd {::mca::validate 59 2 %P} label ${config}.cntr_frame.s -width 3 -anchor w -text {s} entry ${config}.cntr_frame.s_field -width 6 -textvariable [myvar cntr_s] \ -validate all -vcmd {::mca::doublevalidate 59.999 %P} grid ${config}.cntr_frame.h_field ${config}.cntr_frame.h \ ${config}.cntr_frame.m_field ${config}.cntr_frame.m ${config}.cntr_frame.s_field ${config}.cntr_frame.s frame ${config}.spc6 -width 170 -height 20 button ${config}.start -text Start \ -bg yellow -activebackground yellow -command [myproc cntr_start] button ${config}.reset -text Reset \ -bg red -activebackground red -command [myproc cntr_reset] frame ${config}.spc7 -width 170 -height 20 button ${config}.register -text Register \ -bg lightblue -activebackground lightblue -command [myproc register] frame ${config}.spc8 -width 170 -height 20 button ${config}.recover -text {Read file} \ -bg lightblue -activebackground lightblue -command [myproc recover] grid ${config}.axis_check -sticky w grid ${config}.spc1 grid ${config}.rate_frame -sticky ew -padx 5 grid ${config}.spc2 grid ${config}.chan_frame -sticky ew -padx 5 grid ${config}.spc3 grid ${config}.roi -sticky w -pady 1 -padx 5 grid ${config}.roi_frame -sticky ew -padx 5 grid ${config}.stat_frame -sticky ew -padx 5 grid ${config}.spc4 grid ${config}.thrs_check -sticky w grid ${config}.thrs_field -sticky ew -pady 1 -padx 5 grid ${config}.spc5 grid ${config}.cntr -sticky w -pady 1 -padx 3 grid ${config}.cntr_frame -sticky ew -padx 5 grid ${config}.spc6 grid ${config}.start -sticky ew -pady 3 -padx 5 grid ${config}.reset -sticky ew -pady 3 -padx 5 grid ${config}.spc7 grid ${config}.register -sticky ew -pady 3 -padx 5 grid ${config}.spc8 grid ${config}.recover -sticky ew -pady 3 -padx 5 grid ${graph} -row 0 -column 0 -sticky news grid ${config} -row 0 -column 1 grid rowconfigure ${master} 0 -weight 1 grid columnconfigure ${master} 0 -weight 1 grid columnconfigure ${master} 1 -weight 0 -minsize 80 grid columnconfigure ${config}.rate_frame 1 -weight 1 grid columnconfigure ${config}.chan_frame 1 -weight 1 grid columnconfigure ${config}.stat_frame 1 -weight 1 my crosshairs $graph #bind .graph {%W crosshairs configure -position @%x,%y} # create one element with data for the x and y axis, no dots $graph element create Spectrum1 -color blue -linewidth 2 -symbol none -smooth step -xdata [myvar xvec] -ydata [myvar yvec] } # ------------------------------------------------------------------------- HstDisplay instproc marker_enter {marker} { my instvar config graph $graph configure -cursor hand2 $graph crosshairs off blt::RemoveBindTag $graph zoom-$graph $graph marker bind $marker [list [self] marker_press $marker] $graph marker bind $marker [list [self] marker_release $marker] } # ------------------------------------------------------------------------- HstDisplay instproc marker_leave {marker} { my instvar config graph $graph configure -cursor crosshair $graph crosshairs on blt::AddBindTag $graph zoom-$graph $graph marker bind $marker {} $graph marker bind $marker {} } # ------------------------------------------------------------------------- HstDisplay instproc marker_press {marker} { my instvar config graph $graph marker bind $marker [list [self] ${marker}_motion %W %x %y] } # ------------------------------------------------------------------------- HstDisplay instproc marker_release {marker} { my instvar config graph $graph marker bind $marker {} } # ------------------------------------------------------------------------- HstDisplay instproc xmin_motion {W x y} { my instvar config graph xmin_val set index [$graph axis invtransform x $x] set index [::tcl::mathfunc::round $index] if {$index < 0} { set index 0 } set xmin_val $index } # ------------------------------------------------------------------------- HstDisplay instproc xmax_motion {W x y} { my instvar config graph xmax_val set index [$graph axis invtransform x $x] set index [::tcl::mathfunc::round $index] if {$index > 4095} { set index 4095 } set xmax_val $index } # ------------------------------------------------------------------------- HstDisplay instproc coor_update {W x y} { my instvar config graph $W crosshairs configure -position @${x},${y} set index [$W axis invtransform x $x] set index [::tcl::mathfunc::round $index] catch { ${config}.chan_frame.axisy_value configure -text [[myvar yvec] index $index] ${config}.chan_frame.axisx_value configure -text ${index}.0 } } # ------------------------------------------------------------------------- HstDisplay instproc crosshairs {graph} { set method [myproc coor_update] bind $graph [list [self] coor_update %W %x %y] bind $graph { %W crosshairs off } bind $graph { %W crosshairs on } } # ------------------------------------------------------------------------- HstDisplay instproc axis_update args { my instvar axis graph $graph axis configure x -min 0 -max 4096 Blt_ZoomStack $graph if {$axis} { $graph axis configure y -min 1 -max 1E10 -logscale yes } else { $graph axis configure y -min {} -max {} -logscale no } } # ------------------------------------------------------------------------- HstDisplay instproc thrs_update args { my instvar controller config number thrs thrs_val if {[string equal $thrs_val {}]} { set thrs_val 0 } set val_addr [format {%02x} [expr {7 + ${number}}]] if {$thrs} { ${config}.thrs_field configure -state normal set value [format {%03x} $thrs_val] } else { ${config}.thrs_field configure -state disabled set value 000 } $controller usbCmd 000200${val_addr}00040${value} } # ------------------------------------------------------------------------- HstDisplay instproc stat_update {} { my instvar config graph xmin_val xmax_val set ymin_val [[myvar yvec] index $xmin_val] set ymax_val [[myvar yvec] index $xmax_val] ${config}.roi_frame.min_value configure -text $xmin_val ${config}.roi_frame.max_value configure -text $xmax_val ${config}.stat_frame.tot_value configure \ -text [usb::integrateBlt [myvar yvec] $xmin_val $xmax_val 0] ${config}.stat_frame.bkg_value configure \ -text [expr {($xmax_val - $xmin_val + 1) * ($ymin_val + $ymax_val) / 2.0}] } # ------------------------------------------------------------------------- HstDisplay instproc xmin_val_update args { my instvar config graph xmin_val xmax_val if {$xmin_val > 4075} { set xmin_val 4075 } if {$xmin_val > $xmax_val - 20} { set xmax_val [expr {$xmin_val + 20}] } $graph marker configure xmin -coords "$xmin_val -Inf $xmin_val Inf" my stat_update } # ------------------------------------------------------------------------- HstDisplay instproc xmax_val_update args { my instvar config graph xmin_val xmax_val if {$xmax_val < 20} { set xmax_val 20 } if {$xmax_val < $xmin_val + 20} { set xmin_val [expr {$xmax_val - 20}] } $graph marker configure xmax -coords "$xmax_val -Inf $xmax_val Inf" my stat_update } # ------------------------------------------------------------------------- HstDisplay instproc rate_val_update {name key op} { my instvar config rate_val ${config}.rate_frame.${key}_value configure -text [format {%.2e} $rate_val(${key})] } # ------------------------------------------------------------------------- HstDisplay instproc cntr_val_update args { my instvar cntr_val cntr_h cntr_m cntr_s set cntr_tmp [expr {${cntr_val}/20000}] set cntr_h [expr {${cntr_tmp}/3600000}] set cntr_m [expr {${cntr_tmp}%3600000/60000}] set cntr_s [expr {${cntr_tmp}%3600000%60000/1000.0}] } # ------------------------------------------------------------------------- HstDisplay instproc cntr_setup {} { my instvar controller number cntr_val set word0 [format {%08x} [expr {${cntr_val} & 0xFFFFFFFF}]] set word1 [format {%08x} [expr {${cntr_val} >> 32}]] set prefix [format {%x} [expr {5 + ${number}}]] set command {} append command 0001${prefix}000000200000004[string range $word0 4 7] append command 0001${prefix}000000200010004[string range $word0 0 3] append command 0001${prefix}000000200020004[string range $word1 4 7] append command 0001${prefix}000000200030004[string range $word1 0 3] # send counter value $controller usbCmd $command # load counter value # set val_addr [format {%02x} [expr {12 + ${number}}]] # $controller usbCmd 000200${val_addr}00040001000200${val_addr}00040000 } # ------------------------------------------------------------------------- HstDisplay instproc cntr_reset {} { my instvar controller config number my instvar cntr_val cntr_bak cntr_old yvec_bak yvec_old rate_val date_val my cntr_stop set value [format {%04x} [expr {1 << (5 + ${number})}]] $controller usbCmd 000200000004${value}0002000000040000 set cntr_val $cntr_bak my cntr_setup set cntr_old $cntr_bak set yvec_bak 0.0 set yvec_old 0.0 set rate_val(inst) 0.0 set rate_val(mean) 0.0 ${config}.chan_frame.entr_value configure -text 0.0 set date_val(start) {} set date_val(stop) {} my acquire my cntr_ready } # ------------------------------------------------------------------------- HstDisplay instproc cntr_ready {} { my instvar config cntr_val cntr_bak set cntr_val $cntr_bak ${config}.start configure -text Start -command [myproc cntr_start] ${config}.reset configure -state active ${config}.cntr_frame.h_field configure -state normal ${config}.cntr_frame.m_field configure -state normal ${config}.cntr_frame.s_field configure -state normal } # ------------------------------------------------------------------------- HstDisplay instproc cntr_start {} { my instvar config my instvar cntr_h cntr_m cntr_s my instvar cntr_val cntr_bak cntr_old yvec_bak yvec_old date_val set h $cntr_h set m $cntr_m set s $cntr_s if {[string equal $h {}]} { set h 0 } if {[string equal $m {}]} { set m 0 } if {[string equal $s {}]} { set s 0 } if {[string equal $date_val(start) {}]} { set date_val(start) [clock format [clock seconds] -format {%d/%m/%Y %H:%M:%S}] } set cntr_tmp [expr {${h}*3600000 + ${m}*60000 + ${s}*1000}] set cntr_tmp [expr {entier(20000 * ${cntr_tmp})}] if {$cntr_tmp > 0} { ${config}.cntr_frame.h_field configure -state disabled ${config}.cntr_frame.m_field configure -state disabled ${config}.cntr_frame.s_field configure -state disabled set cntr_val $cntr_tmp set cntr_bak $cntr_tmp set cntr_old $cntr_tmp set yvec_bak [usb::integrateBlt [myvar yvec] 0 4095 0] set yvec_old $yvec_bak my cntr_setup my cntr_resume } } # ------------------------------------------------------------------------- HstDisplay instproc cntr_pause {} { my instvar config my cntr_stop ${config}.start configure -text Resume -command [myproc cntr_resume] # ${config}.reset configure -state active } # ------------------------------------------------------------------------- HstDisplay instproc cntr_resume {} { my instvar controller config number auto after set val_addr [format {%02x} [expr {13 + ${number}}]] ${config}.start configure -text Pause -command [myproc cntr_pause] # ${config}.reset configure -state disabled $controller usbCmd 000200${val_addr}00040002 set auto 1 set after [after 100 [myproc acquire_loop]] } # ------------------------------------------------------------------------- HstDisplay instproc cntr_stop {} { my instvar controller config number auto after date_val set date_val(stop) [clock format [clock seconds] -format {%d/%m/%Y %H:%M:%S}] set val_addr [format {%02x} [expr {13 + ${number}}]] $controller usbCmd 000200${val_addr}00040000 set auto 0 after cancel $after } # ------------------------------------------------------------------------- HstDisplay instproc data_update args { my instvar data usb::convertBlt $data 4 [myvar yvec] } # ------------------------------------------------------------------------- HstDisplay instproc acquire_loop {} { my instvar cntr_val auto after my acquire if {$cntr_val == 0} { my cntr_stop my cntr_ready } elseif {$auto} { set after [after 1000 [myproc acquire_loop]] } } # ------------------------------------------------------------------------- HstDisplay instproc acquire {} { my instvar controller config number my instvar cntr_val cntr_bak cntr_old yvec_bak yvec_old rate_val set size 4096 set prefix [format {%x} [expr {2 + ${number}}]] set value [format {%08x} [expr {$size * 2}]] set command 0001${prefix}000000200000001[string range $value 0 3]0003[string range $value 4 7]00050000 $controller usbCmdReadRaw $command [expr {$size * 4}] [myvar data] set yvec_new [usb::integrateBlt [myvar yvec] 0 4095 0] set prefix [format {%x} [expr {5 + ${number}}]] set command 0001${prefix}000000200000003000400050000 $controller usbCmdReadHex $command 8 1 [myvar cntr_val] set cntr_new $cntr_val if {$cntr_new < $cntr_old} { set rate_val(inst) [expr {($yvec_new - $yvec_old)*20000000/($cntr_old - $cntr_new)}] set rate_val(mean) [expr {($yvec_new - $yvec_bak)*20000000/($cntr_bak - $cntr_new)}] ${config}.chan_frame.entr_value configure -text $yvec_new my stat_update set yvec_old $yvec_new set cntr_old $cntr_new } } # ------------------------------------------------------------------------- HstDisplay instproc save_data {data} { my instvar number my instvar yvec_old rate_val date_val set types { {{Data Files} {.dat} } {{All Files} * } } set stamp [clock format [clock seconds] -format {%Y%m%d_%H%M%S}] set fname spectrum_[expr {$number + 1}]_${stamp}.dat set fname [tk_getSaveFile -filetypes $types -initialfile $fname] if {[string equal $fname {}]} { return } set x [catch { set fid [open $fname w+] puts $fid "info {" puts $fid "start date: $date_val(start)" if {[string equal $date_val(stop) {}]} { puts $fid "stop date: [clock format [clock seconds] -format {%d/%m/%Y %H:%M:%S}]" } else { puts $fid "stop date: $date_val(stop)" } puts $fid "average rate: [format {%.2e} $rate_val(mean)] counts/s" puts $fid "total counts: $yvec_old" puts $fid "}" puts $fid "data {" puts $fid $data puts $fid "}" close $fid }] if { $x || ![file exists $fname] || ![file isfile $fname] || ![file readable $fname] } { tk_messageBox -icon error \ -message "An error occurred while writing to \"$fname\"" } else { tk_messageBox -icon info \ -message "File \"$fname\" written successfully" } } # ------------------------------------------------------------------------- HstDisplay instproc open_data {} { set types { {{Data Files} {.dat} } {{All Files} * } } set fname [tk_getOpenFile -filetypes $types] if {[string equal $fname {}]} { return } set x [catch { set fid [open $fname r+] set content [read $fid 131072] set yvec_new [split [dict get $content data] \n] close $fid }] if { $x || ![file exists $fname] || ![file isfile $fname] || ![file readable $fname] } { tk_messageBox -icon error \ -message "An error occurred while reading \"$fname\"" } else { tk_messageBox -icon info \ -message "File \"$fname\" read successfully" my cntr_reset [myvar yvec] set $yvec_new } } # ------------------------------------------------------------------------- HstDisplay instproc register {} { my save_data [join [[myvar yvec] range 0 4095] \n] } # ------------------------------------------------------------------------- HstDisplay instproc recover {} { my instvar config my open_data ${config}.chan_frame.entr_value configure -text [usb::integrateBlt [myvar yvec] 0 4095 0] my stat_update } # ------------------------------------------------------------------------- Class CntDisplay -parameter { {master} {controller} } # ------------------------------------------------------------------------- CntDisplay instproc init {} { my set data {} my set cntr 0 my set recs 0 vector create [myvar xvec](10000) vector create [myvar yvec](10000) # fill one vector for the x axis with 10000 points [myvar xvec] seq -0.5 9999.5 my setup next } # ------------------------------------------------------------------------- CntDisplay instproc destroy {} { next } # ------------------------------------------------------------------------- CntDisplay instproc start {} { my instvar config trace add variable [myvar data] write [myproc data_update] trace add variable [myvar thrs] write [myproc thrs_update] trace add variable [myvar thrs_val] write [myproc thrs_update] trace add variable [myvar cntr] write [myproc cntr_update] trace add variable [myvar recs] write [myproc recs_update] trace add variable [myvar axis] write [myproc axis_update] ${config}.axis_check select ${config}.thrs_check select ${config}.thrs_field set 25 my set cntr_val 100 my set cntr_bak 100 my set recs_val 100 my set recs_bak 100 ${config}.chan_frame.mean_value configure -text [format {%.2e} 0.0] ${config}.chan_frame.entr_value configure -text 0.0 ${config}.chan_frame.axisy_value configure -text 0.0 ${config}.chan_frame.axisx_value configure -text 0.0 # my cntr_reset } # ------------------------------------------------------------------------- CntDisplay instproc setup {} { my instvar master my instvar xvec yvec graph my instvar config my instvar cntr_ms # create a graph widget and show a grid set graph [graph ${master}.graph -height 250 -leftmargin 80] $graph crosshairs configure -hide no -linewidth 1 -color darkblue -dashes {2 2} $graph grid configure -hide no $graph legend configure -hide yes set config [frame ${master}.config -width 170] checkbutton ${config}.axis_check -text {log scale} -variable [myvar axis] frame ${config}.spc1 -width 170 -height 30 frame ${config}.chan_frame -borderwidth 0 -width 170 legendLabel ${config}.chan_frame 0 mean {Mean value} legendLabel ${config}.chan_frame 1 entr {Total entries} legendLabel ${config}.chan_frame 2 empty {} legendLabel ${config}.chan_frame 3 axisy {Bin entries} legendLabel ${config}.chan_frame 4 axisx {Bin number} frame ${config}.spc3 -width 170 -height 30 checkbutton ${config}.thrs_check -text {amplitude threshold} -variable [myvar thrs] spinbox ${config}.thrs_field -from 1 -to 4095 \ -increment 5 -width 10 -textvariable [myvar thrs_val] \ -validate all -vcmd {::mca::validate 4095 4 %P} frame ${config}.spc4 -width 170 -height 30 label ${config}.cntr -text {time of exposure (ms)} spinbox ${config}.cntr_field -from 0 -to 9999 \ -increment 10 -width 10 -textvariable [myvar cntr_val] \ -validate all -vcmd {::mca::validate 9999 4 %P} frame ${config}.spc5 -width 170 -height 10 label ${config}.recs -text {number of exposures} spinbox ${config}.recs_field -from 0 -to 99999 \ -increment 10 -width 10 -textvariable [myvar recs_val] \ -validate all -vcmd {::mca::validate 99999 5 %P} frame ${config}.spc6 -width 170 -height 10 button ${config}.start -text {Start} \ -bg yellow -activebackground yellow -command [myproc recs_start] button ${config}.reset -text Reset \ -bg red -activebackground red -command [myproc cntr_reset] frame ${config}.spc7 -width 170 -height 30 button ${config}.register -text Register \ -bg lightblue -activebackground lightblue -command [myproc register] frame ${config}.spc8 -width 170 -height 30 button ${config}.recover -text {Read file} \ -bg lightblue -activebackground lightblue -command [myproc recover] grid ${config}.axis_check -sticky w grid ${config}.spc1 grid ${config}.chan_frame -sticky ew -padx 5 grid ${config}.spc3 grid ${config}.thrs_check -sticky w grid ${config}.thrs_field -sticky ew -pady 1 -padx 5 grid ${config}.spc4 grid ${config}.cntr -sticky w -pady 1 -padx 3 grid ${config}.cntr_field -sticky ew -pady 1 -padx 5 grid ${config}.spc5 grid ${config}.recs -sticky w -pady 1 -padx 3 grid ${config}.recs_field -sticky ew -pady 1 -padx 5 grid ${config}.spc6 grid ${config}.start -sticky ew -pady 3 -padx 5 grid ${config}.reset -sticky ew -pady 3 -padx 5 grid ${config}.spc7 grid ${config}.register -sticky ew -pady 3 -padx 5 grid ${config}.spc8 grid ${config}.recover -sticky ew -pady 3 -padx 5 grid ${graph} -row 0 -column 0 -sticky news grid ${config} -row 0 -column 1 grid rowconfigure ${master} 0 -weight 1 grid columnconfigure ${master} 0 -weight 1 grid columnconfigure ${master} 1 -weight 0 -minsize 80 grid columnconfigure ${config}.chan_frame 1 -weight 1 my crosshairs $graph #bind .graph {%W crosshairs configure -position @%x,%y} # create one element with data for the x and y axis, no dots $graph element create Spectrum1 -color blue -linewidth 2 -symbol none -smooth step -xdata [myvar xvec] -ydata [myvar yvec] } # ------------------------------------------------------------------------- CntDisplay instproc coor_update {W x y} { my instvar config graph $W crosshairs configure -position @${x},${y} set index [$W axis invtransform x $x] set index [::tcl::mathfunc::round $index] catch { ${config}.chan_frame.axisy_value configure -text [[myvar yvec] index $index] ${config}.chan_frame.axisx_value configure -text ${index}.0 } } # ------------------------------------------------------------------------- CntDisplay instproc crosshairs {graph} { set method [myproc coor_update] bind $graph [list [self] coor_update %W %x %y] bind $graph { %W crosshairs off } bind $graph { %W crosshairs on } } # ------------------------------------------------------------------------- CntDisplay instproc thrs_update args { my instvar controller config thrs thrs_val if {[string equal $thrs_val {}]} { set thrs_val 0 } set number 0 set val_addr [format {%02x} [expr {9 + ${number}}]] if {$thrs} { ${config}.thrs_field configure -state normal set value [format {%03x} $thrs_val] } else { ${config}.thrs_field configure -state disabled set value 000 } $controller usbCmd 000200${val_addr}00040${value} } # ------------------------------------------------------------------------- CntDisplay instproc cntr_update args { my instvar cntr cntr_val set cntr_val [expr {${cntr}/20000}] } # ------------------------------------------------------------------------- CntDisplay instproc recs_update args { my instvar recs recs_val set recs_val [expr {${recs}*1}] } # ------------------------------------------------------------------------- CntDisplay instproc cntr_setup {} { my instvar controller cntr_val set cntr_tmp [expr {${cntr_val} * 20000}] set word0 [format {%08x} [expr {${cntr_tmp} & 0xFFFFFFFF}]] set word1 [format {%08x} [expr {${cntr_tmp} >> 32}]] set prefix [format {%x} 9] set command {} append command 0001${prefix}000000200000004[string range $word0 4 7] append command 0001${prefix}000000200010004[string range $word0 0 3] append command 0001${prefix}000000200020004[string range $word1 4 7] append command 0001${prefix}000000200030004[string range $word1 0 3] # send counter value $controller usbCmd $command } # ------------------------------------------------------------------------- CntDisplay instproc recs_setup {} { my instvar controller recs_val set word0 [format {%08x} [expr {${recs_val} & 0xFFFFFFFF}]] set word1 [format {%08x} [expr {${recs_val} >> 32}]] set prefix [format {%x} 10] set command {} append command 0001${prefix}000000200000004[string range $word0 4 7] append command 0001${prefix}000000200010004[string range $word0 0 3] append command 0001${prefix}000000200020004[string range $word1 4 7] append command 0001${prefix}000000200030004[string range $word1 0 3] # send counter value $controller usbCmd $command } # ------------------------------------------------------------------------- CntDisplay instproc cntr_reset {} { my instvar controller after_handle my instvar cntr_val cntr_bak recs_val recs_bak my cntr_stop set value [format {%04x} [expr {1 << 11}]] $controller usbCmd 000200000004${value}0002000000040000 my recs_stop } # ------------------------------------------------------------------------- CntDisplay instproc cntr_ready {} { my instvar config cntr_val cntr_bak recs_val recs_bak set cntr_val $cntr_bak set recs_val $recs_bak ${config}.start configure -text Start -command [myproc recs_start] ${config}.reset configure -state active ${config}.cntr_field configure -state normal ${config}.recs_field configure -state normal } # ------------------------------------------------------------------------- CntDisplay instproc recs_start {} { my instvar controller config auto my instvar cntr_val cntr_bak recs_val recs_bak if {$cntr_val > 0 && $recs_val > 0} { ${config}.start configure -text {Stop} -command [myproc recs_stop] ${config}.cntr_field configure -state disabled ${config}.recs_field configure -state disabled set cntr_bak $cntr_val set recs_bak $recs_val my cntr_setup my recs_setup set val_addr [format {%02x} 16] $controller usbCmd 000200${val_addr}00040002 set auto 1 after 100 [myproc acquire_loop] } } # ------------------------------------------------------------------------- CntDisplay instproc recs_stop {} { my instvar cntr_val cntr_bak recs_val recs_bak my cntr_stop set cntr_val $cntr_bak my cntr_setup set recs_val $recs_bak my recs_setup my acquire my cntr_ready } # ------------------------------------------------------------------------- CntDisplay instproc cntr_stop {} { my instvar controller config auto set val_addr [format {%02x} 16] $controller usbCmd 000200${val_addr}00040000 set auto 0 } # ------------------------------------------------------------------------- CntDisplay instproc acquire_loop {} { my instvar recs_val auto my acquire if {$recs_val == 0} { my cntr_stop my cntr_ready } elseif {$auto} { after 1000 [myproc acquire_loop] } } # ------------------------------------------------------------------------- CntDisplay instproc data_update args { my instvar config data usb::convertBlt $data 2 [myvar yvec] ${config}.chan_frame.mean_value configure \ -text [format {%.2e} [usb::integrateBlt [myvar yvec] 0 9999 1]] ${config}.chan_frame.entr_value configure \ -text [usb::integrateBlt [myvar yvec] 0 9999 0] } # ------------------------------------------------------------------------- CntDisplay instproc axis_update args { my instvar axis graph $graph axis configure x -min 0 -max 10000 Blt_ZoomStack $graph if {$axis} { $graph axis configure y -min 1 -max 1E5 -logscale yes } else { $graph axis configure y -min {} -max {} -logscale no } } # ------------------------------------------------------------------------- CntDisplay instproc acquire {} { my instvar controller config my instvar cntr cntr_val recs recs_val set size 10000 set prefix [format {%x} 8] set value [format {%08x} $size] set command 0001${prefix}000000200000001[string range $value 0 3]0003[string range $value 4 7]00050000 $controller usbCmdReadRaw $command [expr {$size * 2}] [myvar data] set prefix [format {%x} 9] set command 0001${prefix}000000200000003000400050000 $controller usbCmdReadHex $command 8 1 [myvar cntr] set prefix [format {%x} 10] set command 0001${prefix}000000200000003000400050000 $controller usbCmdReadHex $command 8 1 [myvar recs] } # ------------------------------------------------------------------------- CntDisplay instproc save_data {data} { set types { {{Data Files} {.dat} } {{All Files} * } } set stamp [clock format [clock seconds] -format {%Y%m%d_%H%M%S}] set fname counts_${stamp}.dat set fname [tk_getSaveFile -filetypes $types -initialfile $fname] if {[string equal $fname {}]} { return } set x [catch { set fid [open $fname w+] puts $fid $data close $fid }] if { $x || ![file exists $fname] || ![file isfile $fname] || ![file readable $fname] } { tk_messageBox -icon error \ -message "An error occurred while writing to \"$fname\"" } else { tk_messageBox -icon info \ -message "File \"$fname\" written successfully" } } # ------------------------------------------------------------------------- CntDisplay instproc open_data {} { set types { {{Data Files} {.dat} } {{All Files} * } } set fname [tk_getOpenFile -filetypes $types] if {[string equal $fname {}]} { return } set x [catch { set fid [open $fname r+] fconfigure $fid -translation binary -encoding binary [myvar yvec] set [split [read $fid] \n] close $fid }] if { $x || ![file exists $fname] || ![file isfile $fname] || ![file readable $fname] } { tk_messageBox -icon error \ -message "An error occurred while reading \"$fname\"" } else { tk_messageBox -icon info \ -message "File \"$fname\" read successfully" } } # ------------------------------------------------------------------------- CntDisplay instproc register {} { my save_data [join [[myvar yvec] range 0 9999] \n] } # ------------------------------------------------------------------------- CntDisplay instproc recover {} { my open_data } # ------------------------------------------------------------------------- Class OscDisplay -parameter { {master} {controller} } # ------------------------------------------------------------------------- OscDisplay instproc init {} { my instvar sequence data xvec yvec set data {} set sequence 0 # set xvec [vector create #auto(262144)] set xvec [vector create #auto(10000)] for {set i 1} {$i <= 9} {incr i} { # dict set yvec $i [vector create #auto(262144)] dict set yvec $i [vector create #auto(10000)] } # fill one vector for the x axis # $xvec seq 0 262143 $xvec seq 0 10000 my setup next } # ------------------------------------------------------------------------- OscDisplay instproc destroy {} { next } # ------------------------------------------------------------------------- OscDisplay instproc start {} { my instvar config my instvar recs_val directory set directory $::env(HOME) set recs_val 100 trace add variable [myvar chan] write [myproc chan_update] trace add variable [myvar data] write [myproc data_update] trace add variable [myvar auto] write [myproc auto_update] trace add variable [myvar thrs] write [myproc thrs_update 0] trace add variable [myvar thrs_val] write [myproc thrs_update 0] trace add variable [myvar recs_val] write [myproc recs_val_update] trace add variable [myvar last] write [myproc last_update] for {set i 1} {$i <= 6} {incr i} { ${config}.chan_frame.chan${i}_check select ${config}.chan_frame.chan${i}_value configure -text 0.0 } ${config}.chan_frame.axisx_value configure -text 0.0 ${config}.thrs_check select ${config}.thrs_field set 100 } # ------------------------------------------------------------------------- OscDisplay instproc setup {} { my instvar master my instvar xvec yvec graph my instvar config # create a graph widget and show a grid set graph [graph ${master}.graph -height 250 -leftmargin 80] $graph crosshairs configure -hide no -linewidth 1 -color darkblue -dashes {2 2} $graph grid configure -hide no $graph legend configure -hide yes $graph axis configure x -min 0 -max 10000 $graph axis configure y -min 0 -max 4100 # scale ${master}.last -orient horizontal -from 1 -to 27 -tickinterval 0 -showvalue no -variable [myvar last] set config [frame ${master}.config -width 170] frame ${config}.chan_frame -width 170 legendButton ${config}.chan_frame 0 chan1 {Channel 1} [myvar chan(1)] turquoise2 legendButton ${config}.chan_frame 1 chan2 {Channel 2} [myvar chan(2)] SpringGreen2 legendButton ${config}.chan_frame 2 chan3 {Channel 3} [myvar chan(3)] orchid2 legendButton ${config}.chan_frame 3 chan4 {Channel 4} [myvar chan(4)] orange2 legendButton ${config}.chan_frame 4 chan5 {Channel 5} [myvar chan(5)] blue1 white legendButton ${config}.chan_frame 5 chan6 {Channel 6} [myvar chan(6)] gray65 white legendLabel ${config}.chan_frame 6 axisx {Time axis} frame ${config}.spc1 -width 170 -height 30 checkbutton ${config}.auto_check -text {auto update} -variable [myvar auto] frame ${config}.spc2 -width 170 -height 30 checkbutton ${config}.thrs_check -text threshold -variable [myvar thrs] spinbox ${config}.thrs_field -from 1 -to 4095 \ -increment 5 -width 10 -textvariable [myvar thrs_val] \ -validate all -vcmd {::mca::validate 4095 4 %P} frame ${config}.spc3 -width 170 -height 30 button ${config}.acquire -text Acquire \ -bg green -activebackground green -command [myproc acquire_start] button ${config}.register -text Register \ -bg lightblue -activebackground lightblue -command [myproc register] frame ${config}.spc4 -width 170 -height 30 label ${config}.recs -text {number of records} spinbox ${config}.recs_field -from 0 -to 10000 \ -increment 10 -width 10 -textvariable [myvar recs_val] \ -validate all -vcmd {::mca::validate 10000 5 %P} frame ${config}.spc5 -width 170 -height 10 button ${config}.sequence -text {Start Recording} -command [myproc sequence_start] \ -bg yellow -activebackground yellow frame ${config}.spc6 -width 170 -height 30 button ${config}.recover -text {Read file} \ -bg lightblue -activebackground lightblue -command [myproc recover] grid ${config}.chan_frame -sticky ew grid ${config}.spc1 grid ${config}.auto_check -sticky w grid ${config}.spc2 grid ${config}.thrs_check -sticky w grid ${config}.thrs_field -sticky ew -pady 1 -padx 5 grid ${config}.spc3 grid ${config}.acquire -sticky ew -pady 3 -padx 5 grid ${config}.register -sticky ew -pady 3 -padx 5 grid ${config}.spc4 grid ${config}.recs -sticky w -pady 1 -padx 3 grid ${config}.recs_field -sticky ew -pady 1 -padx 5 grid ${config}.spc5 grid ${config}.sequence -sticky ew -pady 3 -padx 5 grid ${config}.spc6 grid ${config}.recover -sticky ew -pady 3 -padx 5 grid ${graph} -row 0 -column 0 -sticky news grid ${config} -row 0 -column 1 # grid ${master}.last -row 1 -column 0 -columnspan 2 -sticky ew grid rowconfigure ${master} 0 -weight 1 grid columnconfigure ${master} 0 -weight 1 grid columnconfigure ${master} 1 -weight 0 -minsize 120 grid columnconfigure ${config}.chan_frame 2 -weight 1 # enable zooming Blt_ZoomStack $graph my crosshairs $graph # create one element with data for the x and y axis, no dots $graph pen create pen1 -color turquoise3 -linewidth 2 -symbol none $graph pen create pen2 -color SpringGreen3 -linewidth 2 -symbol none $graph pen create pen3 -color orchid3 -linewidth 2 -symbol none $graph pen create pen4 -color orange3 -linewidth 2 -symbol none $graph pen create pen5 -color blue2 -linewidth 2 -symbol none $graph pen create pen6 -color gray55 -linewidth 2 -symbol none $graph element create Spectrum1 -pen pen1 -xdata $xvec -ydata [dict get $yvec 1] $graph element create Spectrum2 -pen pen2 -xdata $xvec -ydata [dict get $yvec 2] $graph element create Spectrum3 -pen pen3 -xdata $xvec -ydata [dict get $yvec 3] $graph element create Spectrum4 -pen pen4 -xdata $xvec -ydata [dict get $yvec 4] $graph element create Spectrum5 -pen pen5 -xdata $xvec -ydata [dict get $yvec 5] $graph element create Spectrum6 -pen pen6 -xdata $xvec -ydata [dict get $yvec 6] } # ------------------------------------------------------------------------- OscDisplay instproc coor_update {W x y} { my instvar xvec yvec graph my instvar config $W crosshairs configure -position @${x},${y} set index [$W axis invtransform x $x] set index [::tcl::mathfunc::round $index] catch { ${config}.chan_frame.chan1_value configure -text [[dict get $yvec 1] index $index] ${config}.chan_frame.chan2_value configure -text [[dict get $yvec 2] index $index] ${config}.chan_frame.chan3_value configure -text [[dict get $yvec 3] index $index] ${config}.chan_frame.chan4_value configure -text [[dict get $yvec 4] index $index] ${config}.chan_frame.chan5_value configure -text [[dict get $yvec 5] index $index] ${config}.chan_frame.chan6_value configure -text [[dict get $yvec 6] index $index] ${config}.chan_frame.axisx_value configure -text ${index}.0 } } # ------------------------------------------------------------------------- OscDisplay instproc crosshairs {graph} { set method [myproc coor_update] bind $graph [list [self] coor_update %W %x %y] bind $graph { %W crosshairs off } bind $graph { %W crosshairs on } } # ------------------------------------------------------------------------- OscDisplay instproc chan_update {name key op} { my instvar config graph chan if {$chan(${key})} { $graph pen configure pen${key} -linewidth 2 } else { $graph pen configure pen${key} -linewidth 0 } } # ------------------------------------------------------------------------- OscDisplay instproc recs_val_update args { my instvar recs_val if {[string equal $recs_val {}]} { set recs_val 0 } } # ------------------------------------------------------------------------- OscDisplay instproc last_update args { my instvar graph last set first [expr {$last - 1}] $graph axis configure x -min ${first}0000 -max ${last}0000 } # ------------------------------------------------------------------------- OscDisplay instproc thrs_update {reset args} { my instvar controller config thrs thrs_val if {[string equal $thrs_val {}]} { set thrs_val 0 } if {$thrs} { ${config}.thrs_field configure -state normal set value [format {%03x} $thrs_val] } else { ${config}.thrs_field configure -state disabled set value 000 } set command {} if {$reset} { append command 0002000500041${value} } append command 0002000500040${value} $controller usbCmd $command } # ------------------------------------------------------------------------- OscDisplay instproc data_update args { my instvar data yvec my instvar graph chan waiting sequence auto usb::convertOsc $data $yvec foreach {key value} [array get chan] { $graph pen configure pen${key} -dashes 0 } set waiting 0 if {$sequence} { my sequence_register } elseif {$auto} { after 1000 [myproc acquire_start] } } # ------------------------------------------------------------------------- OscDisplay instproc acquire_start {} { my instvar graph chan controller waiting foreach {key value} [array get chan] { $graph pen configure pen${key} -dashes dot } # restart my thrs_update 1 set waiting 1 after 200 [myproc acquire_loop] } # ------------------------------------------------------------------------- OscDisplay instproc acquire_loop {} { my instvar controller waiting # set size 262144 set size 10000 set value [format {%08x} [expr {$size * 4}]] set command 00011000000200000001[string range $value 0 3]0003[string range $value 4 7]00050000 $controller usbCmdReadRaw $command [expr {$size * 8}] [myvar data] if {$waiting} { after 200 [myproc acquire_loop] } } # ------------------------------------------------------------------------- OscDisplay instproc auto_update args { my instvar config auto if {$auto} { ${config}.recs_field configure -state disabled ${config}.sequence configure -state disabled ${config}.acquire configure -state disabled ${config}.register configure -state disabled ${config}.recover configure -state disabled my acquire_start } else { ${config}.recs_field configure -state normal ${config}.sequence configure -state active ${config}.acquire configure -state active ${config}.register configure -state active ${config}.recover configure -state active } } # ------------------------------------------------------------------------- OscDisplay instproc save_data {fname} { my instvar data set fid [open $fname w+] fconfigure $fid -translation binary -encoding binary # puts -nonewline $fid [binary format "H*iH*" "1f8b0800" [clock seconds] "0003"] # puts -nonewline $fid [zlib deflate $data] puts -nonewline $fid $data # puts -nonewline $fid [binary format i [zlib crc32 $data]] # puts -nonewline $fid [binary format i [string length $data]] close $fid } # ------------------------------------------------------------------------- OscDisplay instproc open_data {} { set types { {{Data Files} {.dat} } {{All Files} * } } set fname [tk_getOpenFile -filetypes $types] if {[string equal $fname {}]} { return } set x [catch { set fid [open $fname r+] fconfigure $fid -translation binary -encoding binary # set size [file size $fname] # seek $fid 10 # my set data [zlib inflate [read $fid [expr {$size - 18}]]] my set data [read $fid] close $fid }] if { $x || ![file exists $fname] || ![file isfile $fname] || ![file readable $fname] } { tk_messageBox -icon error \ -message "An error occurred while reading \"$fname\"" } else { tk_messageBox -icon info \ -message "File \"$fname\" read successfully" } } # ------------------------------------------------------------------------- OscDisplay instproc register {} { set types { {{Data Files} {.dat} } {{All Files} * } } set stamp [clock format [clock seconds] -format {%Y%m%d_%H%M%S}] set fname oscillogram_${stamp}.dat set fname [tk_getSaveFile -filetypes $types -initialfile $fname] if {[string equal $fname {}]} { return } if {[catch {my save_data $fname} result]} { tk_messageBox -icon error \ -message "An error occurred while writing to \"$fname\"" } else { tk_messageBox -icon info \ -message "File \"$fname\" written successfully" } } # ------------------------------------------------------------------------- OscDisplay instproc recover {} { my open_data } # ------------------------------------------------------------------------- OscDisplay instproc sequence_start {} { my instvar config recs_val recs_bak directory counter sequence set counter 1 if {$counter > $recs_val} { return } set directory [tk_chooseDirectory -initialdir $directory -title {Choose a directory}] if {[string equal $directory {}]} { return } ${config}.recs_field configure -state disabled ${config}.sequence configure -text {Stop Recording} -command [myproc sequence_stop] ${config}.acquire configure -state disabled ${config}.register configure -state disabled ${config}.recover configure -state disabled set recs_bak $recs_val set sequence 1 my acquire_start } # ------------------------------------------------------------------------- OscDisplay instproc sequence_register {} { my instvar config recs_val recs_bak directory counter set fname [file join $directory oscillogram_$counter.dat] my incr counter if {[catch {my save_data $fname} result]} { tk_messageBox -icon error \ -message "An error occurred while writing to \"$fname\"" } elseif {$counter <= $recs_bak} { set recs_val [expr {$recs_bak - $counter}] my acquire_start return } my sequence_stop } # ------------------------------------------------------------------------- OscDisplay instproc sequence_stop {} { my instvar config recs_val recs_bak sequence set sequence 0 set recs_val $recs_bak ${config}.recs_field configure -state normal ${config}.sequence configure -text {Start Recording} -command [myproc sequence_start] ${config}.acquire configure -state active ${config}.register configure -state active ${config}.recover configure -state active } # ------------------------------------------------------------------------- namespace export MuxDisplay namespace export HstDisplay namespace export CntDisplay namespace export OscDisplay } set notebook [::blt::tabnotebook .notebook -borderwidth 1 -selectforeground black -side bottom] grid ${notebook} -row 0 -column 0 -sticky news -pady 5 grid rowconfigure . 0 -weight 1 grid columnconfigure . 0 -weight 1 ::mca::UsbController usb set window [frame ${notebook}.hst_0] $notebook insert end -text "Spectrum histogram 1" -window $window -fill both ::mca::HstDisplay hst_0 -number 0 -master $window -controller usb set window [frame ${notebook}.hst_1] $notebook insert end -text "Spectrum histogram 2" -window $window -fill both ::mca::HstDisplay hst_1 -number 1 -master $window -controller usb set window [frame ${notebook}.cnt_0] $notebook insert end -text "Rate histogram" -window $window -fill both ::mca::CntDisplay cnt_0 -master $window -controller usb set window [frame ${notebook}.mux] $notebook insert end -text "Interconnect" -window $window -fill both ::mca::MuxDisplay mux -master $window -controller usb set window [frame ${notebook}.ept] $notebook insert end -text "Oscilloscope" -window $window -fill both ::mca::OscDisplay osc -master $window -controller usb update usb usbCmd 00000000 hst_0 start hst_1 start cnt_0 start mux start osc start