- Fixed various Tcl drivers at startup

- Added a sinqhttp driver for the second generation HM object

tcl/deltatau.tcl

@@ -66,6 +66,10 @@ proc translateAxisError {key} {
 }
 #---------------------------------------------------------------------
 proc evaluateAxisStatus {key} {
+#----- Tcl does not like negative numbers as keys. 
+    if {$key < 0} {
+	set key [expr 50 + abs($key)]
+    }
     switch $key {
 	0 -
 	14 {return idle}
@@ -80,12 +84,12 @@ proc evaluateAxisStatus {key} {
         9 -
         10 -
         11 {return run}
-        -6 {error "Controller aborted"} 
+        56 {error "Controller aborted"} 
-        -5 {error "Axis is deactivated"}
+        55 {error "Axis is deactivated"}
-	-4 {error "emergency stop activated, please release"}
+	54 {error "emergency stop activated, please release"}
-	-3 {error "Axis inhibited"}
+	53 {error "Axis inhibited"}
-	- 1
+	51 -
-	-2 {error "Incoming command is blocked"}
+	52 {error "Incoming command is blocked"}
     }
 }
 #-----------------------------------------------------------------------
@@ -173,7 +177,7 @@ proc pmacsendaxerr {num} {
 proc pmacrcvaxerr {motname num} {
     set status [catch {checkpmacresult} data]
     if {$status != 0} {
-	sct print "ERROR: $data"
+	clientput "ERROR: $data"
 	sct update error
 	sct geterror $data
 	return idle
@@ -182,10 +186,10 @@ proc pmacrcvaxerr {motname num} {
     if {$data != 0 } {
 	set err [translateAxisError $data]
 	if {[string first following $err] >= 0} {
-	    sct print "WARNING: $err"
+	    clientput "WARNING: $err"
 	    sct update poserror
 	} else {
-	    sct print "ERROR: $err"
+	    clientput "ERROR: $err"
 	    sct update error
 	}
 	return idle
@@ -198,7 +202,7 @@ proc pmacrcvaxerr {motname num} {
 proc pmacrcvpos {motname num} {
     set status [catch {checkpmacresult} data]
     if {$status != 0} {
-	sct print "ERROR: $data"
+	clientput "ERROR: $data"
 	sct geterror $data
 	sct update error
 	return idle
@@ -211,7 +215,7 @@ proc pmacrcvpos {motname num} {
 proc pmacrcvstat {motname num sct} {
     set status [catch {checkpmacresult} data]
     if {$status != 0} {
-	sct print "ERROR: $data"
+	clientput "ERROR: $data"
 	sct update error
 	return idle
     } 
@@ -253,7 +257,7 @@ proc pmacsendhardpos {motname num} {
 proc pmacrcvhardpos {num} {
     set status [catch {checkpmacresult} data]
     if {$status != 0} {
-	sct print "ERROR: $data"
+	clientput "ERROR: $data"
 	sct seterror $data
 	return idle
     } 
@@ -264,13 +268,13 @@ proc pmacrcvhardpos {num} {
 proc pmacrcvhardax {motname num sct} {
     set status [catch {checkpmacresult} data]
     if {$status != 0} {
-	sct print "ERROR: $data"
+	clientput "ERROR: $data"
 	sct seterror $data
 	return idle
     } 
     set status [catch {evaluateAxisStatus $data} msg]
     if {$status != 0} {
-	sct print "ERROR: $msg"
+	clientput "ERROR: $msg"
 	sct seterror $msg
 	return idle
     }
@@ -303,6 +307,7 @@ proc pmacrefrun {motorname sct num} {
     $sct send "M${num}=9"
     hupdate /sics/${motorname}/status run
     set motstat run
+    wait 3
     while {[string compare $motstat run] == 0} {
 	$sct queue $path progress read
 	wait 1
@@ -344,6 +349,7 @@ proc MakeDeltaTau {name sct num} {
     set parlist [list scale_factor  hardposition  maxspeed \
 		 commandspeed maxaccel offset axisstatus axiserror status poshwlimitactive \
 		  neghwlimitactive liftaircushion hardlowerlim hardupperlim]
+    $sct send [format "M%2.2d14=0" $num]
     foreach par $parlist {
 	$sct queue /sics/$name/$par progress read
     } 

tcl/el737sec.tcl

@@ -51,7 +51,14 @@ proc el737cmdreply {} {
     set status [catch {el737error $reply} err]
     if {$status != 0} {
 	sct geterror $err
-	sct print "ERROR: $err"
+	set data [sct send]
+	if {[string first overflow $err] >= 0} {
+	    clientput "WARNING:  trying to fix $err on command = $data"
+	    sct send $data
+	    return el737cmdreply
+        } else {
+	    clientput "ERROR: $err, command = $data"
+	}
     }
     return idle
 }

tcl/hdbutil.tcl

@@ -852,7 +852,7 @@ proc sscan args {
 #--------- do scan parameters
 	   append scanvars $var ","
            append scanstarts $start ","
-           set step [expr double($end - $start)/double($np)]
+           set step [expr double($end - $start)/double($np-1)]
 	   append scansteps $step ","
          }
 #------------- set lastcommand text

tcl/pfeiffer.tcl

@@ -38,10 +38,10 @@ set pfiffpar [list Antitrumpet Be-filter Flightpath Sample-Chamber]
 proc pfiffstate {} {
     set val [sct target]
     if {[string compare $val on] == 0} { 
-	sct send "SEN_,2,2,2,2,0,0"
+	sct send "SEN ,2,2,2,2,0,0"
 	sct utime devon
     } else {
-	sct send "SEN_,1,1,1,1,0,0"
+	sct send "SEN ,1,1,1,1,0,0"
     }
     return pfiffstatereply
 }
@@ -106,7 +106,7 @@ foreach p $pfiffpar {
     incr count
 }
 
-hfactory /sics/pfiff/state plain user text
+hfactory /sics/pfiff/state plain spy text
 hupdate /sics/pfiff/state off
 hsetprop /sics/pfiff/state values on,off
 hsetprop /sics/pfiff/state write pfiffstate
@@ -121,8 +121,8 @@ proc pfiffread {num} {
 #--------------------------------------------------------
 proc vac {} {
     global pfiffpar
-    set test [pfiffread 1]
+    set test [hval /sics/pfiff/state]
-    if {[string first off $test] > 0} {
+    if {[string first off $test] >= 0} {
 	hset /sics/pfiff/state on
 	foreach p $pfiffpar {
 	    pfiffsct queue /sics/pfiff/$p progress read
@@ -135,4 +135,4 @@ proc vac {} {
     append result "Sample chamber  :  " [pfiffread 4] "\n"
     return $result
 }
-Publish vac Spy 
+Publish vac User

tcl/sinqhttp.tcl

@@ -0,0 +1,147 @@
+#--------------------------------------------------------
+# This is an asynchronous scriptcontext driven driver for 
+# the SINQ style http based histogram memory. 
+#
+# script chains:
+# -- control
+#       hmhttpcontrol - hmhttpreply
+# -- data
+#       hmhttpdata - hmhttpreply
+# -- status
+#       hmhttpstatus - hmhttpevalstatus -- hmhttpstatusdata
+#
+# copyright: see file COPYRIGHT
+#
+# Mark Koennecke, May 2009
+#---------------------------------------------------------
+proc hmhttpsend {url} {
+    sct send $url
+    return hmhttpreply
+}
+#--------------------------------------------------------
+proc hmhttptest {data} {
+    if {[string first ASCERR $data] >= 0} {
+	error $data
+    }
+    if {[string first ERROR $data] >= 0} {
+	error $data
+    }
+    return $data
+}
+#--------------------------------------------------------
+proc hmhttpreply {} {
+    set reply [sct result]
+    set status [catch {hmhttptest $reply} data]
+    if {$status != 0} {
+	sct geterror $data
+	clientput $data
+    } else {
+	hdelprop [sct] geterror
+    }
+    return idle
+}
+#---------------------------------------------------------
+proc hmhttpcontrol {} {
+    set target [sct target]
+    switch $target {
+	1000 {
+            set ret  [hmhttpsend "/admin/startdaq.egi"]
+	    set path [file dirname [sct]]
+	    [sct controller] queue $path/status progress read
+	    return $ret
+	}
+	1001 {return [hmhttpsend "/admin/stopdaq.egi"] }
+	1002 {return [hmhttpsend "/admin/pausedaq.egi"] }
+	1003 {return [hmhttpsend "/admin/continuedaq.egi"]}
+        1005 {
+	    set path [file dirname [sct]]
+	    set script [hval $path/initscript]
+	    set confdata [eval $script]
+	    return [hmhttpsend "post:/admin/configure.egi:$confdata"]
+	}
+	default {
+	    sct print "ERROR: bad start target $target given to control"
+	    return idle
+	}
+    }
+}
+#---------------------------------------------------------
+proc hmhttpdata {name} {
+    set len [hval /sics/${name}/datalength]
+    set path "/sics/${name}/data"
+    set com [format "node:%s:/admin/readhmdata.egi?bank=0&start=0&end=%d" $path $len]
+    sct send $com
+    return hmhttpdatareply
+}
+#--------------------------------------------------------
+proc hmhttpdatareply {} {
+    set status [catch {hmhttpreply} txt]
+    if {$status == 0} {
+	set path [file dirname [sct]]
+	hdelprop $path/data geterror 
+    }
+    return idle
+}
+#--------------------------------------------------------
+proc hmhttpstatus {} {
+    sct send /admin/textstatus.egi
+    return hmhttpevalstatus
+}
+#-------------------------------------------------------
+proc hmhttpstatusdata {} {
+    catch {hmhttpdatareply}
+    sct update idle
+    return idle
+}
+#---------------------------------------------------------
+proc hmhttpevalstatus {name} {
+    set reply [sct result]
+    set status [catch {hmhttptest $reply} data]
+    if {$status != 0} {
+	sct geterror $data
+	clientput $data
+	sct update error
+	return idle
+    } 
+    hdelprop [sct] geterror
+    set lines [split $data \n]
+    foreach line $lines {
+	set ld [split $line :]
+	sct [string trim [lindex $ld 0]] [string trim [lindex $ld 1]]
+    } 
+    set daq [sct DAQ]
+    set old [hval [sct]]
+    if {$daq == 1} {
+	sct update run
+	[sct controller] queue [sct] progress read
+	return idle
+    } else {
+	if {[string compare $old idle] != 0} {
+	    hmhttpdata $name
+	    return hmhttpstatusdata
+	} else {
+	    return idle
+	}
+    }
+}
+#---------------------------------------------------------
+proc MakeHTTPHM {name rank host initscript {tof NULL} } {
+    sicsdatafactory new ${name}transfer
+    makesctcontroller ${name}sct sinqhttp $host ${name}transfer 600 spy 007
+    MakeSecHM $name $rank $tof
+    hsetprop /sics/${name}/control write hmhttpcontrol
+    hsetprop /sics/${name}/control hmhttpreply  hmhttpreply
+    ${name}sct write /sics/${name}/control
+
+    hsetprop /sics/${name}/data read hmhttpdata $name
+    hsetprop /sics/${name}/data hmhttpdatareply  hmhttpdatareply
+    ${name}sct poll /sics/${name}/data 120
+
+    hsetprop /sics/${name}/status read hmhttpstatus
+    hsetprop /sics/${name}/status hmhttpevalstatus hmhttpevalstatus $name
+    hsetprop /sics/${name}/status hmhttpstatusdata hmhttpstatusdata
+    ${name}sct poll /sics/${name}/status 60
+
+    hfactory /sics/${name}/initscript plain mugger text
+    hset /sics/${name}/initscript $initscript
+}