source: trunk/MultiChannelUSB/UserInterface.tcl@ 74

package require XOTcl

package require BLT
package require swt
package require usb

wm minsize . 900 720

namespace eval ::mca {
    namespace import ::xotcl::*

    namespace import ::blt::vector
    namespace import ::blt::graph
    namespace import ::blt::tabnotebook

    proc validate {value} {
        if {![regexp {^[1-9][0-9]*$} $value]} {
            return 0
        } elseif {$value > 4095} {
            return 0
        } elseif {[string length $value] > 4} {
            return 0
        } else {
            return 1
        }
    }

# -------------------------------------------------------------------------

    Class OscDisplay -parameter {
        {number}
        {master}
    }

# -------------------------------------------------------------------------

    OscDisplay instproc init {} {
        my instvar data xvec yvec

        set xvec [vector #auto]
        set yvec [vector #auto]
        # fill one vector for the x axis with 1025 points
        $xvec seq 0 1024

        my reset

        my setup

        next
    }

# -------------------------------------------------------------------------

    OscDisplay instproc destroy {} {
        next
    }

# -------------------------------------------------------------------------

    OscDisplay instproc reset {} {
        my instvar data xvec yvec

        set data {}

        $yvec set {}
    }

# -------------------------------------------------------------------------

    OscDisplay instproc start {} {
        my instvar config trig_mux disp_mux

        set trig_mux 2
        set disp_mux 2

        trace add variable [myvar auto] write [myproc auto_update]
        trace add variable [myvar thrs] write [myproc thrs_update]
        trace add variable [myvar thrs_val] write [myproc thrs_val_update]
        trace add variable [myvar disp_val] write [myproc disp_val_update]
        trace add variable [myvar trig_val] write [myproc trig_val_update]

        ${config}.auto_check select
        ${config}.thrs_check select
        ${config}.thrs_field set 60
        ${config}.disp_uwt2 select
        ${config}.trig_uwt2 select
    }

# -------------------------------------------------------------------------

    OscDisplay instproc setup {} {
        my instvar number master
        my instvar data xvec yvec
        my instvar config auto thrs thrs_val disp_val trig_val

        my set restart_command [usb::convert 0001000${number}00000000]
        my set acquire_command [usb::convert 0002000${number}00000000]

        # create a graph widget and show a grid
        set graph [graph ${master}.graph -height 250 -leftmargin 80]
        $graph crosshairs configure -hide no -linewidth 2 -dashes { 1 1 }
        $graph grid configure -hide no
        $graph legend configure -hide yes
        $graph axis configure x -min 0 -max 1024

        set config [frame ${master}.config]

        checkbutton ${config}.auto_check -text {auto update} -variable [myvar auto]

        frame ${config}.spc1 -width 10 -height 10

        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 %P}

        frame ${config}.spc2 -width 10 -height 10

        label ${config}.disp -text {display input}
        radiobutton ${config}.disp_data -text {raw data} -variable [myvar disp_val] -value data
        radiobutton ${config}.disp_uwt1 -text {filter 1} -variable [myvar disp_val] -value uwt1
        radiobutton ${config}.disp_uwt2 -text {filter 2} -variable [myvar disp_val] -value uwt2
        radiobutton ${config}.disp_uwt3 -text {filter 3} -variable [myvar disp_val] -value uwt3
        radiobutton ${config}.disp_base -text {baseline} -variable [myvar disp_val] -value base
#        radiobutton ${config}.disp_sum8 -text {sum of 8} -variable [myvar disp_val] -value sum8

        frame ${config}.spc3 -width 10 -height 10

        label ${config}.trig -text {trigger input}
        radiobutton ${config}.trig_data -text {raw data} -variable [myvar trig_val] -value data
        radiobutton ${config}.trig_uwt1 -text {filter 1} -variable [myvar trig_val] -value uwt1
        radiobutton ${config}.trig_uwt2 -text {filter 2} -variable [myvar trig_val] -value uwt2
        radiobutton ${config}.trig_uwt3 -text {filter 3} -variable [myvar trig_val] -value uwt3
        radiobutton ${config}.trig_base -text {baseline} -variable [myvar trig_val] -value base
#        radiobutton ${config}.trig_sum8 -text {sum of 8} -variable [myvar trig_val] -value sum8

        frame ${config}.spc4 -width 10 -height 10

        button ${config}.acquire -text Acquire \
            -bg green -activebackground green -command [myproc acquire]
        button ${config}.restart -text Restart \
            -bg yellow -activebackground yellow -command [myproc restart]
        button ${config}.register -text Register \
            -bg lightblue -activebackground lightblue -command [myproc register]

        grid ${config}.auto_check -sticky w
        grid ${config}.spc1
        grid ${config}.thrs_check -sticky w
        grid ${config}.thrs_field -sticky ew -pady 1 -padx 5
        grid ${config}.spc2
        grid ${config}.disp -sticky w -pady 1 -padx 3
        grid ${config}.disp_data -sticky w
        grid ${config}.disp_uwt1 -sticky w
        grid ${config}.disp_uwt2 -sticky w
        grid ${config}.disp_uwt3 -sticky w
        grid ${config}.disp_base -sticky w
#        grid ${config}.disp_sum8 -sticky w
        grid ${config}.spc3
        grid ${config}.trig -sticky w -pady 1 -padx 3
        grid ${config}.trig_data -sticky w
        grid ${config}.trig_uwt1 -sticky w
        grid ${config}.trig_uwt2 -sticky w
        grid ${config}.trig_uwt3 -sticky w
        grid ${config}.trig_base -sticky w
#        grid ${config}.disp_sum8 -sticky w
        grid ${config}.spc4
        grid ${config}.acquire -sticky ew -pady 3 -padx 5
        grid ${config}.restart -sticky ew -pady 3 -padx 5
        grid ${config}.register -sticky ew -pady 3 -padx 5

        grid ${graph} -row 0 -column 0 -sticky news
        grid ${config} -row 0 -column 1

        # enable zooming
        Blt_ZoomStack $graph

        #bind .graph <Motion> {%W crosshairs configure -position @%x,%y}

        # create one element with data for the x and y axis, no dots
        $graph element create Spectrum1 -symbol none -xdata $xvec -ydata $yvec
    }

# -------------------------------------------------------------------------

    OscDisplay instproc auto_update args {
        my instvar config auto after_handle

        if {$auto} {
            ${config}.acquire configure -state disabled
            ${config}.restart configure -state disabled
            ${config}.register configure -state disabled

            my acquire_restart_loop
        } else {
            if {[my exists after_handle]} {
                after cancel $after_handle
            }
            ${config}.acquire configure -state active
            ${config}.restart configure -state active
            ${config}.register configure -state active
        }
    }

# -------------------------------------------------------------------------

    OscDisplay instproc thrs_update args {
        my instvar config number thrs thrs_val

        set val_addr [format %04x [expr {17 + ${number}}]]

        if {$thrs} {
            ${config}.thrs_field configure -state normal
            my thrs_val_update
        } else {
            ${config}.thrs_field configure -state disabled
            my send_data [usb::convert ${val_addr}000000000000]
        }
    }

# -------------------------------------------------------------------------

    OscDisplay instproc thrs_val_update args {
        my instvar config number thrs_val

        set val_addr [format %04x [expr {17 + ${number}}]]
        set value [format %04x $thrs_val]

        my send_data [usb::convert ${val_addr}${value}00000000]
    }

# -------------------------------------------------------------------------

    OscDisplay instproc mux {} {
        my instvar trig_mux disp_mux

        format {00%x%x} $trig_mux $disp_mux
    }

# ------------------------------------------------------------------------

    OscDisplay instproc disp_val_update args {
        my instvar number disp_val disp_mux

        set mux_addr [format %04x [expr {20 + ${number}}]]

        switch -- $disp_val {
            data {
                set disp_mux 0
                my send_data [usb::convert ${mux_addr}[my mux]00000000]
            }
            uwt1 {
                set disp_mux 1
                my send_data [usb::convert ${mux_addr}[my mux]00000000]
            }
            uwt2 {
                set disp_mux 2
                my send_data [usb::convert ${mux_addr}[my mux]00000000]
            }
            uwt3 {
                set disp_mux 3
                my send_data [usb::convert ${mux_addr}[my mux]00000000]
            }
            base {
                set disp_mux 4
                my send_data [usb::convert ${mux_addr}[my mux]00000000]
            }
        }
    }

# ------------------------------------------------------------------------

    OscDisplay instproc trig_val_update args {
        my instvar number trig_val trig_mux

        set mux_addr [format %04x [expr {20 + ${number}}]]

        switch -- $trig_val {
            data {
                set trig_mux 0
                my send_data [usb::convert ${mux_addr}[my mux]00000000]
            }
            uwt1 {
                set trig_mux 1
                my send_data [usb::convert ${mux_addr}[my mux]00000000]
            }
            uwt2 {
                set trig_mux 2
                my send_data [usb::convert ${mux_addr}[my mux]00000000]
            }
            uwt3 {
                set trig_mux 3
                my send_data [usb::convert ${mux_addr}[my mux]00000000]
            }
            base {
                set trig_mux 4
                my send_data [usb::convert ${mux_addr}[my mux]00000000]
            }
        }
    }

# -------------------------------------------------------------------------

    OscDisplay instproc save_data {data} {
        set file [tk_getSaveFile]
        if {[string equal $file {}]} {
            return
        }

        set x [catch {set fid [open $file w+]}]
        set y [catch {puts $fid $data}]
        set z [catch {close $fid}]

        if { $x || $y || $z || ![file exists $file] || ![file isfile $file] || ![file readable $file] } {
            tk_messageBox -icon error \
                -message "An error occurred while writing to \"$file\""
        } else {
            tk_messageBox -icon info \
                -message "File \"$file\" written successfully"
        }
    }

# -------------------------------------------------------------------------

    OscDisplay instproc register {} {
        my save_data [my set data]
    }

# -------------------------------------------------------------------------

    OscDisplay instproc send_data {data} {
        global usb_handle

        if {[catch {$usb_handle writeRaw $data} result]} {
            puts {Error during write}
            puts $result
        }
    }

# -------------------------------------------------------------------------

    OscDisplay instproc restart {} {
        my instvar restart_command
        my send_data $restart_command
    }

# -------------------------------------------------------------------------

    OscDisplay instproc acquire {} {
        global usb_handle
        my instvar xvec yvec data
        my instvar acquire_command

        my send_data $acquire_command

        set usb_data {}
        if {[catch {$usb_handle readHex 2 1024} usb_data]} {
            puts {Error during read}
            puts $usb_data
            set usb_data {}
        }

        set data $usb_data

        $yvec set $usb_data
    }

# -------------------------------------------------------------------------

    OscDisplay instproc acquire_restart_loop {} {
        my instvar after_handle

        my acquire
        my restart

        set after_handle [after 1000 [myproc acquire_restart_loop]]
    }

# -------------------------------------------------------------------------

    Class HstDisplay -parameter {
        {number}
        {master}
    }

# -------------------------------------------------------------------------

    HstDisplay instproc init {} {
        my instvar data xvec yvec

        set xvec [vector #auto]
        set yvec [vector #auto]
        # fill one vector for the x axis with 4097 points
        $xvec seq 0 4096

        my reset

        my setup

        next
    }

# -------------------------------------------------------------------------

    HstDisplay instproc destroy {} {
        next
    }

# -------------------------------------------------------------------------

    HstDisplay instproc reset {} {
        my instvar data xvec yvec

        set data {}

        $yvec set {}
    }

# -------------------------------------------------------------------------

    HstDisplay instproc start {} {
        my instvar config base_mux peak_mux

        set base_mux 0
        set peak_mux 1

        trace add variable [myvar auto] write [myproc auto_update]
        trace add variable [myvar peak] write [myproc peak_update]
        trace add variable [myvar thrs] write [myproc thrs_update]
        trace add variable [myvar thrs_val] write [myproc thrs_val_update]
        trace add variable [myvar base] write [myproc base_update]
        trace add variable [myvar base_typ] write [myproc base_typ_update]
        trace add variable [myvar base_val] write [myproc base_val_update]

        ${config}.auto_check select
        ${config}.peak_check select
        ${config}.thrs_check select
        ${config}.thrs_field set 10
        ${config}.base_check select
        ${config}.base_const select
        ${config}.base_field set 35
    }

# -------------------------------------------------------------------------

    HstDisplay instproc setup {} {
        my instvar number master
        my instvar data xvec yvec
        my instvar config auto thrs thrs_val base base_typ base_val

        my set restart_command [usb::convert 0001001${number}00000000]
        my set acquire_command [usb::convert 0002001${number}00000000]

        # create a graph widget and show a grid
        set graph [graph ${master}.graph -height 250 -leftmargin 80]
        $graph crosshairs configure -hide no -linewidth 2 -dashes { 1 1 }
        $graph grid configure -hide no
        $graph legend configure -hide yes
        $graph axis configure x -min 0 -max 4096

        set config [frame ${master}.config]

        checkbutton ${config}.auto_check -text {auto update} -variable [myvar auto]

        frame ${config}.spc1 -width 10 -height 10

        checkbutton ${config}.peak_check -text {peak detect} -variable [myvar peak]

        frame ${config}.spc2 -width 10 -height 10

        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 %P}

        frame ${config}.spc3 -width 10 -height 10

        checkbutton ${config}.base_check -text baseline -variable [myvar base]
        radiobutton ${config}.base_auto -text automatic -variable [myvar base_typ] -value auto
        radiobutton ${config}.base_const -text constant -variable [myvar base_typ] -value const
        spinbox ${config}.base_field -from 1 -to 4095 \
            -increment 5 -width 10 -textvariable [myvar base_val] \
            -validate all -vcmd {::mca::validate %P}

        frame ${config}.spc4 -width 10 -height 10

        button ${config}.acquire -text Acquire \
            -bg green -activebackground green -command [myproc acquire]
        button ${config}.restart -text Restart \
            -bg yellow -activebackground yellow -command [myproc restart]
        button ${config}.register -text Register \
            -bg lightblue -activebackground lightblue -command [myproc register]

        grid ${config}.auto_check -sticky w
        grid ${config}.spc1
        grid ${config}.peak_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}.base_check -sticky w
        grid ${config}.base_auto -sticky w
        grid ${config}.base_const -sticky w
        grid ${config}.base_field -sticky ew -pady 1 -padx 5
        grid ${config}.spc4
        grid ${config}.acquire -sticky ew -pady 3 -padx 5
        grid ${config}.restart -sticky ew -pady 3 -padx 5
        grid ${config}.register -sticky ew -pady 3 -padx 5

        grid ${graph} -row 0 -column 0 -sticky news
        grid ${config} -row 0 -column 1

        # enable zooming
        Blt_ZoomStack $graph

        #bind .graph <Motion> {%W crosshairs configure -position @%x,%y}

        # create one element with data for the x and y axis, no dots
        $graph element create Spectrum1 -symbol none -smooth step -xdata $xvec -ydata $yvec
    }

# -------------------------------------------------------------------------

    HstDisplay instproc auto_update args {
        my instvar auto after_handle
        my instvar config
        if {$auto} {
            ${config}.acquire configure -state disabled
            ${config}.register configure -state disabled

            my acquire_loop
        } else {
            if {[my exists after_handle]} {
                after cancel $after_handle
            }
            ${config}.acquire configure -state active
            ${config}.register configure -state active
        }
    }

# -------------------------------------------------------------------------

    HstDisplay instproc mux {} {
        my instvar base_mux peak_mux

        format {00%x%x} $base_mux $peak_mux
    }

# -------------------------------------------------------------------------

    HstDisplay instproc peak_update args {
        my instvar number peak peak_mux

        set mux_addr [format %04x [expr {23 + ${number}}]]

        if {$peak} {
            set peak_mux 1
            my send_data [usb::convert ${mux_addr}[my mux]00000000]
        } else {
            set peak_mux 0
            my send_data [usb::convert ${mux_addr}[my mux]00000000]
        }
    }

# -------------------------------------------------------------------------

    HstDisplay instproc thrs_update args {
        my instvar config number thrs thrs_val

        set val_addr [format %04x [expr {14 + ${number}}]]
        set value [format %04x $thrs_val]

        if {$thrs} {
            ${config}.thrs_field configure -state normal
            my thrs_val_update
        } else {
            ${config}.thrs_field configure -state disabled
            my send_data [usb::convert ${val_addr}000000000000]
        }
    }

# -------------------------------------------------------------------------

    HstDisplay instproc thrs_val_update args {
        my instvar config number thrs_val

        set val_addr [format %04x [expr {14 + ${number}}]]
        set value [format %04x $thrs_val]

        my send_data [usb::convert ${val_addr}${value}00000000]
    }

# -------------------------------------------------------------------------

    HstDisplay instproc base_update args {
        my instvar config number base base_val base_mux

        set mux_addr [format %04x [expr {23 + ${number}}]]
        set val_addr [format %04x [expr {11 + ${number}}]]

        if {$base} {
            ${config}.base_auto configure -state normal
            ${config}.base_const configure -state normal
            my base_typ_update
        } else {
            ${config}.base_auto configure -state disabled
            ${config}.base_const configure -state disabled
            ${config}.base_field configure -state disabled
            set base_mux 0
            my send_data [usb::convert ${mux_addr}[my mux]00000000${val_addr}000000000000]
        }
    }

# -------------------------------------------------------------------------

    HstDisplay instproc base_typ_update args {
        my instvar config number base_typ base_val base_mux

        set mux_addr [format %04x [expr {23 + ${number}}]]
        set val_addr [format %04x [expr {11 + ${number}}]]
        set value [format %04x $base_val]

        switch -- $base_typ {
            auto {
                ${config}.base_field configure -state disabled
                set base_mux 1
                my send_data [usb::convert ${mux_addr}[my mux]00000000]
            }
            const {
                ${config}.base_field configure -state normal
                set base_mux 0
                my send_data [usb::convert ${mux_addr}[my mux]00000000${val_addr}${value}00000000]
            }
        }
    }

# -------------------------------------------------------------------------

    HstDisplay instproc base_val_update args {
        my instvar number base_val

        set val_addr [format %04x [expr {11 + ${number}}]]
        set value [format %04x $base_val]

        my send_data [usb::convert ${val_addr}${value}00000000]
    }

# -------------------------------------------------------------------------

    HstDisplay instproc save_data {data} {
        set file [tk_getSaveFile]
        if {[string equal $file {}]} {
            return
        }

        set x [catch {set fid [open $file w+]}]
        set y [catch {puts $fid $data}]
        set z [catch {close $fid}]

        if { $x || $y || $z || ![file exists $file] || ![file isfile $file] || ![file readable $file] } {
            tk_messageBox -icon error \
                -message "An error occurred while writing to \"$file\""
        } else {
            tk_messageBox -icon info \
                -message "File \"$file\" written successfully"
        }
    }

# -------------------------------------------------------------------------

    HstDisplay instproc register {} {
        my save_data [my set data]
    }

# -------------------------------------------------------------------------

    HstDisplay instproc send_data {data} {
        global usb_handle

        if {[catch {$usb_handle writeRaw $data} result]} {
            puts {Error during write}
            puts $result
        }
    }

# -------------------------------------------------------------------------

    HstDisplay instproc restart {} {
        my instvar restart_command
        my send_data $restart_command
    }

# -------------------------------------------------------------------------

    HstDisplay instproc acquire {} {
        global usb_handle
        my instvar xvec yvec data fltr_val
        my instvar acquire_command

        my send_data $acquire_command

        set usb_data {}
        if {[catch {$usb_handle readHex 4 4096} usb_data]} {
            puts {Error during read}
            puts $usb_data
            set usb_data {}
        }

        set data $usb_data

        $yvec set $usb_data
    }

# -------------------------------------------------------------------------

    HstDisplay instproc acquire_loop {} {
        my instvar after_handle

        my acquire

        set after_handle [after 1000 [myproc acquire_loop]]
    }

# -------------------------------------------------------------------------

    namespace export HstDisplay
    namespace export OscDisplay
}

set notebook [::blt::tabnotebook .notebook -side bottom]

pack $notebook -expand 1 -fill both

set window [frame ${notebook}.hst_2]
$notebook insert end -text "Histogram" -window $window -fill both
::mca::HstDisplay hst_2 -number 2 -master $window

grid rowconfigure $window 0 -weight 1
grid columnconfigure $window 0 -weight 1
grid columnconfigure $window 1 -weight 0 -minsize 80

set window [frame ${notebook}.osc_2]
$notebook insert end -text "Pulse shape" -window $window -fill both
::mca::OscDisplay osc_2 -number 2 -master $window

grid rowconfigure $window 0 -weight 1
grid columnconfigure $window 0 -weight 1
grid columnconfigure $window 1 -weight 0 -minsize 80

set usb_handle {}

while {[catch {usb::connect 0x09FB 0x6001 1 1 0} usb_handle]} {
    set answer [tk_messageBox -icon error -type retrycancel \
        -message {Cannot access USB device} -detail $usb_handle]
    if {[string equal $answer cancel]} break
}

hst_2 restart
osc_2 restart

hst_2 start
osc_2 start

# configure polarity
# set polarity_command [usb::convert 000A011100000000]
set polarity_command [usb::convert 000A001100000000]
if {[catch {$usb_handle writeRaw $polarity_command} result]} {
    puts {Error during write}
    puts $result
}

hst_2 restart
osc_2 restart