[Nscldaq-cvscommits] SF.net SVN: nscldaq:[2095] trunk/llnlcontrols/v812usbcontrol.tcl

[<ro...@us...>]

Revision: 2095
          http://nscldaq.svn.sourceforge.net/nscldaq/?rev=2095&view=rev
Author:   ron-fox
Date:     2009-03-12 10:15:08 +0000 (Thu, 12 Mar 2009)

Log Message:
-----------
Add control panel for the CAEN V812 discriminator.  This is
also good for their LE discriminator for the most part.

Added Paths:
-----------
    trunk/llnlcontrols/v812usbcontrol.tcl

Added: trunk/llnlcontrols/v812usbcontrol.tcl
===================================================================
--- trunk/llnlcontrols/v812usbcontrol.tcl	                        (rev 0)
+++ trunk/llnlcontrols/v812usbcontrol.tcl	2009-03-12 10:15:08 UTC (rev 2095)
@@ -0,0 +1,269 @@
+#!/bin/sh
+# Start wish \
+    exec tclsh ${0} ${@}
+
+package require Tk
+
+#    This software is Copyright by the Board of Trustees of Michigan
+#    State University (c) Copyright 2005.
+#
+#    You may use this software under the terms of the GNU public license
+#    (GPL).  The terms of this license are described at:
+#
+#     http://www.gnu.org/licenses/gpl.txt
+#
+#    Author:
+#             Ron Fox
+#            NSCL
+#            Michigan State University
+#            East Lansing, MI 48824-1321
+
+
+
+# Implements a control panel for a single CAEN V812 CFD.
+# Invoke as follows:
+#
+#   v812usbcontrol  filename
+#
+#  Where filename is the name of the configuration file the CFD has been
+#  configured with. This file must also include
+#   set base   baseaddress   
+#
+#   Where baseaddress is the address of the CFD in A24 space.
+#
+#  
+
+#  There's a bit of dirt that we do here.
+#  We use the V812 GUI widget but:
+#  - Provide our  own CFD812 and CFDSTATE packages  that are essentially
+#    no-ops
+# - Hook into the -command switch to keep track of changes the gui makes.
+# - Add a "Commit" button that makes the changes.
+#
+
+
+
+package provide CFD812   2.0;             # Hokey.
+
+
+lappend auto_path  /usr/opt/daq/8.1/TclLibs
+
+
+package require caenv812Gui;             # our widget.
+
+
+set serverPort 27000;    # Where Readout is listening!
+
+
+
+#------------------------------ Dummy CFD812 package -------------------
+
+namespace eval CFD812 {}
+
+proc CFD812::Map {base name {crate 0}} {
+    return dummy
+}
+
+proc CFD812::Unmap name {}
+
+proc CFD812::SetThreshold {name channel value} {}
+
+proc CFD812::SetWidth {name bank value} {}
+
+proc CFD812::SetDeadtime {name bank value} {}
+
+proc CFD812::SetMask {name value} {}
+ 
+proc CFD812::SetMultiplicityThreshold {name value} {}
+
+proc CFD812::GetSerialNumber {name} {return -Unknown-}
+
+proc CFD812::GetBase {name} {return -Unknown-}
+
+#------------------------------------------------------------------
+
+#
+#  If the user makes changes, mark the .commit button red and 
+#  create/change a global variable that describes the change.
+#  The globals help the commit button decide what to do.
+#  as .commit will re-write that file as well.
+#
+
+proc changed {action id value} {
+    set ::changed($action$id) $value
+    .commit config -activebackground red -background red
+
+
+    
+}
+
+
+
+# Load a CFDState based on the information in the load file.
+# Any info not provided is ignored.
+#
+
+proc loadState name {
+
+    # Thresholds
+
+    for {set c 0} {$c < 16} {incr c} {
+	if {[array name ::thresholds $c] ne ""} {
+	    .panel setProperties [list [list threshold$c $::thresholds($c)]]
+
+	}
+    }
+    # Widths
+    
+    for {set w 0} {$w < 2} {incr w} {
+	if {[array name ::widths $w] ne ""} {
+	    .panel setProperties [list [list width$w $::widths($w)]]
+	}
+    }
+
+    # Deadtimes
+
+    for {set d 0} {$d < 2} {incr d} {
+	if {[array name ::deadtimes $d] ne ""} {
+	    .panel setProperties [list [list deadtime$d $::deadtimes($d)]]
+	}
+    }
+
+    # Majority level
+
+    if {[info globals majority] ne ""} {
+	.panel setProperties [list [list majority $::majority]]
+    }
+
+    # Mask
+
+    if {[info globals enables] ne ""} {
+	.panel setProperties [list [list enables $::enables]]
+    }
+
+ 
+}
+#
+#  Update the device from the changed array.
+#  the indices of the changed array are almost right.. we just need to
+#  map 'mask -> inhibits (which by the way are really enables >sigh<
+# The majority level gets calculated to the register value by the server.
+# We poke commands of the form:
+#   Set $::name something somevalue
+# Expect OK back and complain if we don't get it.
+#
+proc updateDevice sock {
+    fconfigure $sock -buffering line
+
+    foreach item [array names ::changed] {
+	set value $::changed($item)
+	
+	# Need to negate thresholds.
+
+	if {$value < 0} {
+	    set value [expr -$value]
+	}
+
+	if {$item eq "mask"} {
+	    set item inhibits
+	}
+
+	puts $sock "Set $::name $item $value"
+	flush $sock
+	set result [gets $sock]
+
+	if {[string range $result 0 4] eq "ERROR"} {
+	    tk_messageBox -icon error -title "Comm error" -type ok \
+		-message "Got an error from the device:\n $result \n Click OK to continue"
+	}
+    }
+    
+}
+
+
+#  This commits the changes to the device and to the configuration file.
+#  note that if we can't contact the tclserver on port we will update the file
+#  in any event, from the complete CFDSTATE.  This allows us to use the
+#  Gui to initialize the file for when the Readout actually starts.
+#
+
+proc commit {} {
+
+    # Write the configuration file:
+
+    set fd [open $::configFile w]
+
+    puts $fd "# Config file saved by v812usbcontrol.tcl [clock format [clock seconds]]"
+
+    puts $fd "set base $::base"
+    puts $fd "set name $::name"
+
+    for {set chan 0} {$chan < 16} {incr chan} {
+	puts $fd "set thresholds($chan) [CFDState::GetThreshold CFD $chan]"
+    }
+    for {set s 0} {$s < 2} {incr s} {
+	puts $fd "set widths($s) [CFDState::GetWidth CFD $s]"
+	puts $fd "set deadtimes($s) [CFDState::GetDeadtime CFD $s]"
+    }
+
+    puts $fd "set majority [CFDState::GetMultiplicity CFD]"
+    puts $fd "set enables  [CFDState::getMask CFD]"
+
+    close $fd
+
+    # If possible update the device.
+
+    if {[catch {socket localhost $::serverPort} sock]} {
+	tk_messageBox -icon info -title {No Readout} -type ok \
+	    -message {Readout is not running, only changing the configuration file}
+    } else {
+	updateDevice $sock
+	close $sock
+    }
+
+
+    # Unset the changed array.
+   
+    catch {unset ::changed}
+
+    #  Re-set the color of the widgets.
+
+
+    set color [. cget -background]
+    .commit config -background $color -activebackground $color
+
+
+}
+
+#-------------------------- Entry point: --------------------------
+
+
+
+if {[llength $argv] != 1} {
+    error "Usage:\n     v812usbcontrol config-file"
+}
+
+set configFile $argv
+
+source $configFile
+
+if {[info var base] eq ""} {
+    error "Config file does not define the base address"
+}
+if {[info var name] eq ""} {
+   error "Config File does not define the name"
+}
+
+
+cfdv812Gui .panel   -base $base -name CFD
+
+
+
+
+button      .commit  -text "Commit" -command commit
+loadState CFD;                    # Load the state data from the file.
+.panel configure  -command changed
+
+
+
+pack .panel .commit
\ No newline at end of file


Property changes on: trunk/llnlcontrols/v812usbcontrol.tcl
___________________________________________________________________
Added: svn:executable
   + *


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.