[Nscldaq-cvscommits] SF.net SVN: nscldaq:[3624] branches/11.0-s800conv-development/usb/common/ tcldrivers

[<jr...@us...>]

Revision: 3624
          http://sourceforge.net/p/nscldaq/code/3624
Author:   jrtomps
Date:     2014-07-08 16:18:19 +0000 (Tue, 08 Jul 2014)
Log Message:
-----------
Removes some verbose output for tcl script drivers and fixes some bugs

Modified Paths:
--------------
    branches/11.0-s800conv-development/usb/common/tcldrivers/controlscript.tcl
    branches/11.0-s800conv-development/usb/common/tcldrivers/readoutscript.tcl
    branches/11.0-s800conv-development/usb/common/tcldrivers/xxusb.tcl

Modified: branches/11.0-s800conv-development/usb/common/tcldrivers/controlscript.tcl
===================================================================
--- branches/11.0-s800conv-development/usb/common/tcldrivers/controlscript.tcl	2014-07-08 14:56:34 UTC (rev 3623)
+++ branches/11.0-s800conv-development/usb/common/tcldrivers/controlscript.tcl	2014-07-08 16:18:19 UTC (rev 3624)
@@ -45,8 +45,6 @@
   #
   # \return OK always. 
   method Initialize driverPtr { 
-    puts stdout "controlscript::Initialize"
-    flush stdout
     global ::Globals
     variable _deviceNamespace
     variable _deviceType
@@ -68,8 +66,6 @@
   #
   # \return OK always. 
   method Update driverPtr {
-    puts "controlscript::Update"
-    flush stdout
     global ::Globals::aController
     variable _deviceNamespace
     variable _deviceType
@@ -112,7 +108,6 @@
   #
   # \param aList list to a USB controller (either CCUSB or VMUSB)
   method addMonitorList {aList}  {
-    puts "controlscript::addMonitorList"
     variable _deviceNamespace
     variable _deviceType
     global ::Globals::aTclEventList
@@ -138,7 +133,7 @@
   #
   # \param data a tcl list of data bytes remaining to be processed 
   method processMonitorList {data}  {
-    puts "controlscript::processMonitorList not implemented yet"
+#    puts "controlscript::processMonitorList not implemented yet"
   }
   ##
   # _setControllerType

Modified: branches/11.0-s800conv-development/usb/common/tcldrivers/readoutscript.tcl
===================================================================
--- branches/11.0-s800conv-development/usb/common/tcldrivers/readoutscript.tcl	2014-07-08 14:56:34 UTC (rev 3623)
+++ branches/11.0-s800conv-development/usb/common/tcldrivers/readoutscript.tcl	2014-07-08 16:18:19 UTC (rev 3624)
@@ -15,7 +15,7 @@
 #
 snit::type readoutscript {
 
-  option -controllerrtype -default {} -configuremethod _setControllerType
+  option -controllertype -default {} -configuremethod _setControllerType
   option -initscript      -default {} -configuremethod _setScript
   option -rdolistscript   -default {} -configuremethod _setScript
   option -onendscript     -default {} -configuremethod _setScript
@@ -86,7 +86,7 @@
   # list passed as an argument.
   #
   # \param aList list to a USB controller (either CCUSB or VMUSB)
-  method addMonitorList {aList}  {
+  method addReadoutList {aList}  {
     variable _deviceNamespace
     variable _deviceType
     global ::Globals::aTclEventList
@@ -95,13 +95,13 @@
     set ::Globals::aReadoutList [${_deviceNamespace}::convert${_deviceType}ReadoutList $aList]
 
     # Create a local variable for use by the script
-    lappend ::Globals::aTclEventList 100
-    if {[string length $options(-monitorscript)]>0} {
-      uplevel #0 source $options(-monitorscript)
+    set ::Globals::aTclEventList [list]
+    if {[string length $options(-rdolistscript)]>0} {
+      uplevel #0 source $options(-rdolistscript)
     }
 
     # append the new stuff onto the existing readout list
-    set newops [::convertToReadoutList $::Globals::aTclEventList]
+    set newops [${_deviceNamespace}::convertToReadoutList $::Globals::aTclEventList]
     $::Globals::aReadoutList append $newops
   }
 

Modified: branches/11.0-s800conv-development/usb/common/tcldrivers/xxusb.tcl
===================================================================
--- branches/11.0-s800conv-development/usb/common/tcldrivers/xxusb.tcl	2014-07-08 14:56:34 UTC (rev 3623)
+++ branches/11.0-s800conv-development/usb/common/tcldrivers/xxusb.tcl	2014-07-08 16:18:19 UTC (rev 3624)
@@ -1,36 +1,35 @@
 #===================================================================
 # class XXUSB
 #===================================================================
+package provide xxusb 1.0
 
-package provide XXUSB 1.0
 package require Itcl
-package require Tk 
 
-
 itcl::class XXUSB {
 	protected variable event
 	protected variable scaler
 	protected variable self
 	
-	constructor {} {
+	constructor {xxusb} {
 		set event ""
 		set scaler ""
-		set self [string trimleft $this :]
+#		set self [string trimleft $this :]
+		set self $xxusb
 	}
 	
 	destructor {}
 	
 	public method GetVariable {v} {set $v}
 	public method AddToStack {stack command}
-	public method FinishStack {stack}
+#	public method FinishStack {stack}
 	public method ClearStack {stack} {set $stack ""}
-	public method LoadStack {stack}
-	public method LoadStacks {stacks}
+#	public method LoadStack {stack}
+#	public method LoadStacks {stacks}
 	public method StopDAQ {}
 	public method StartDAQ {}
 	public method USBTrigger {}
 	public method ScalerDump {}
-	public method Flash {}
+#	public method Flash {}
 }
 
 itcl::body XXUSB::AddToStack {stack command} {
@@ -39,106 +38,104 @@
 	}
 }
 
-itcl::body XXUSB::FinishStack {stack} {
-# First element of stack is total length
-# Add a 0 if VM-USB to match 32 bit structure
-	if {[string first VM $self] == 0} {
-		set pile [expr [llength $stack]+1]
-		lappend pile 0
-	} else {
-		set pile [llength $stack]
-	}
-	foreach s $stack {lappend pile [expr $s]}
-	return $pile
-}
+#itcl::body XXUSB::FinishStack {stack} {
+## First element of stack is total length
+## Add a 0 if VM-USB to match 32 bit structure
+#	if {[string first VM $self] == 0} {
+#		set pile [expr [llength $stack]+1]
+#		lappend pile 0
+#	} else {
+#		set pile [llength $stack]
+#	}
+#	foreach s $stack {lappend pile [expr $s]}
+#	return $pile
+#}
 
-itcl::body XXUSB::LoadStack {stack} {
-# First element of stack is total length
-# Add a 0 if VM-USB to match 32 bit structure
-	if {[string first VM $self] == 0} {
-		set pile [expr [llength [set $stack]]+1]
-		lappend pile 0
-	} else {
-		set pile [llength [set $stack]]
-	}
-	foreach s [set $stack] {lappend pile [expr $s]}
-	if {[string equal $stack event]} {set s 2}
-	if {[string equal $stack scaler]} {set s 3}
-	if {![info exist s]} {
-		tk_messageBox -icon error -message "Error while loading stack in $self\n\
-		unknown stack: $stack ; must be either event or scaler"
-		return
-	}
-	set ret [::XXUSBWriteStack $self $s $pile]
-	set check [::XXUSBReadStack $self $s]
-	for {set i 0} {$i < [llength $pile]} {incr i} {
-		if {![expr [lindex $pile $i] == [lindex $check $i]]} {
-			tk_messageBox -icon error -message "Error loading $stack stack in $self!"
-			return
-		}
-	}
-}
+#itcl::body XXUSB::LoadStack {stack} {
+## First element of stack is total length
+## Add a 0 if VM-USB to match 32 bit structure
+#	if {[string first VM $self] == 0} {
+#		set pile [expr [llength [set $stack]]+1]
+#		lappend pile 0
+#	} else {
+#		set pile [llength [set $stack]]
+#	}
+#	foreach s [set $stack] {lappend pile [expr $s]}
+#	if {[string equal $stack event]} {set s 2}
+#	if {[string equal $stack scaler]} {set s 3}
+#	if {![info exist s]} {
+#		tk_messageBox -icon error -message "Error while loading stack in $self\n\
+#		unknown stack: $stack ; must be either event or scaler"
+#		return
+#	}
+#	set ret [::XXUSBWriteStack $self $s $pile]
+#	set check [::XXUSBReadStack $self $s]
+#	for {set i 0} {$i < [llength $pile]} {incr i} {
+#		if {![expr [lindex $pile $i] == [lindex $check $i]]} {
+#			tk_messageBox -icon error -message "Error loading $stack stack in $self!"
+#			return
+#		}
+#	}
+#}
 
 # This procedure loads all stacks specified in the list "stacks" one after another
 # This is required in particular in the VMUSB otherwise stacks gets overwritten
-itcl::body XXUSB::LoadStacks {stacks} {
-	set index 0
-	foreach stack $stacks {
-# First element of stack is total length
-# Add the starting address if VM-USB for which stacks can be contiguous
-		if {[string first VM $self] == 0} {
-			set pile [expr [llength [set $stack]]+1]
-			lappend pile $index
-		} else {
-			set pile [llength [set $stack]]
-		}
-		foreach s [set $stack] {lappend pile [expr $s]}
-		if {[string equal $stack event]} {set s 2}
-		if {[string equal $stack scaler]} {set s 3}
-		if {[string equal $stack id2]} {set s 18}
-		if {[string equal $stack id3]} {set s 19}
-		if {[string equal $stack id4]} {set s 34}
-		if {[string equal $stack id5]} {set s 35}
-		if {[string equal $stack id6]} {set s 50}
-		if {[string equal $stack id7]} {set s 51}
-		if {![info exist s]} {
-			tk_messageBox -icon error -message "Error while loading stack in $self\n\
-			unknown stack: $stack ; must be event, scaler or id2 to id7"
-			return
-		}
-		incr index [llength $pile]
-		set ret [::XXUSBWriteStack $self $s $pile]
-	}
-}
+#itcl::body XXUSB::LoadStacks {stacks} {
+#	set index 0
+#	foreach stack $stacks {
+## First element of stack is total length
+## Add the starting address if VM-USB for which stacks can be contiguous
+#		if {[string first VM $self] == 0} {
+#			set pile [expr [llength [set $stack]]+1]
+#			lappend pile $index
+#		} else {
+#			set pile [llength [set $stack]]
+#		}
+#		foreach s [set $stack] {lappend pile [expr $s]}
+#		if {[string equal $stack event]} {set s 2}
+#		if {[string equal $stack scaler]} {set s 3}
+#		if {[string equal $stack id2]} {set s 18}
+#		if {[string equal $stack id3]} {set s 19}
+#		if {[string equal $stack id4]} {set s 34}
+#		if {[string equal $stack id5]} {set s 35}
+#		if {[string equal $stack id6]} {set s 50}
+#		if {[string equal $stack id7]} {set s 51}
+#		if {![info exist s]} {
+#			tk_messageBox -icon error -message "Error while loading stack in $self\n\
+#			unknown stack: $stack ; must be event, scaler or id2 to id7"
+#			return
+#		}
+#		incr index [llength $pile]
+#		set ret [::XXUSBWriteStack $self $s $pile]
+#	}
+#}
 
 itcl::body XXUSB::StopDAQ {} {
-	::XXUSBWriteRegister $self 5 0
+	$self writeActionRegister 0
 }
 
 itcl::body XXUSB::StartDAQ {} {
-	::XXUSBWriteRegister $self 5 1
+	$self writeActionRegister [expr 0x1]
 }
 
 itcl::body XXUSB::USBTrigger {} {
-	set mode [expr [::XXUSBReadRegister $self 5]&0x1]
-	::XXUSBWriteRegister $self 5 [expr 2+$mode]
+	$self writeActionRegister [expr 0x2]
 }
 
 itcl::body XXUSB::ScalerDump {} {
-	set mode [expr [::XXUSBReadRegister $self 5]&0x1]
-	::XXUSBWriteRegister $self 5 [expr 16+$mode]
+	$self writeActionRegister [expr 0x10]
 }
 
-itcl::body XXUSB::Flash {} {
-	set filename [tk_getOpenFile -title "Select xxusb firmware file" -filetypes {{"bit firmware file" {.bit}}}]
-	if {[string length $filename] == 0} {return}
-	set file [open $filename r]
-	fconfigure $file -translation binary
-	set bin [read $file]
-	close $file
-	set size [file size $filename]
-	binary scan $bin cu$size bytes
-	if {[string first VM $self] == 0} {set blocks 830} else {set blocks 512}
-	for {set i 0} {$i < $size} {incr i} {lappend lbytes [lindex $bytes $i]}
-	XXUSBFlashProgram $self $lbytes $blocks
-}
+#itcl::body XXUSB::Flash {} {
+#	set filename [tk_getOpenFile -title "Select xxusb firmware file" -filetypes {{"bit firmware file" {.bit}}}]
+#	if {[string length $filename] == 0} {return}
+#	set file [open $filename r]
+#	fconfigure $file -translation binary
+#	set bin [read $file]
+#	close $file
+#	set size [file size $filename]
+#	binary scan $bin cu$size bytes
+#	if {[string first VM $self] == 0} {set blocks 830} else {set blocks 512}
+#	for {set i 0} {$i < $size} {incr i} {lappend lbytes [lindex $bytes $i]}
+#	XXUSBFlashProgram $self $lbytes $blocks
+#}

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