- Fixed some scripts

test/sicsstat.tcl

@@ -1,5 +1,9 @@
 exe batchpath ./
 exe syspath ./
+
+#--- BEGIN (commands producing errors on last restore)
+#--- END (commands producing errors on last restore)
+
 lotte UNKNOWN
 lotte setAccess 2
 # Motor brumm

test/testini.tcl

@@ -1,4 +1,4 @@
-# --------------------------------------------------------------------------
+>># --------------------------------------------------------------------------
 # Initialization script for testing SICS
 #
 # Started: Dr. Mark Koennecke, July 2006
@@ -38,8 +38,8 @@ ServerOption InterruptPort 2913
 # Syntax: SicsUser name password userRightsCode
 SicsUser Mugger Mugger  1
 SicsUser User   User      2
-SicsUser Spy    Spy       3
-#SicsUser Spy    007       1
+#SicsUser Spy    Spy       3
+SicsUser Spy    007       1
 
 #----------------- SICS Variable
 VarMake lotte Text User
@@ -327,6 +327,131 @@ hsetprop /sics/farm/schneggecon readCommand   schget
 hsetprop /sics/farm/schneggecon replyCommand  schreply
 }
 
+#-------------- Test new async protocol controller
+makesctcontroller farmser std localhost:7070
+MakeSICSObj farm TestObj
+#---------------------------
+proc farmparcom {par} {
+    sct send $par
+    return parread
+}
+#------------------------
+proc farmparread {} {
+    set rply [sct result]
+    if {[string first ERR $rply] >= 0} {
+	sct geterror $rply
+	return idle
+    }
+    set data [string range $rply 3 end]
+    set node [sct]
+#    hupdate $node $data
+#    hdelprop $node geterror
+    sct update $data
+    sct utime readtime
+    return idle
+}
+#--------------------------
+proc farmcheck {} {
+    set val [sct target]
+    if {$val < -100 || $val > 100} {
+	error "Value out of range"
+    }
+    return OK
+}
+#---------------------------
+proc farmset {par} {
+    set val [sct target]
+    sct send "$par $val"
+    return setreply
+}
+#-------------------------
+proc farmsetreply {} {
+    set rply [sct result]
+    if {[string first ERR $rply] >= 0} {
+	sct print $rply
+    }
+    sct utime settime
+    return idle
+}
+#--------------------------
+hfactory /sics/farm/hase plain spy int  
+hsetprop /sics/farm/hase read farmparcom hase
+hsetprop /sics/farm/hase parread farmparread
+
+hsetprop /sics/farm/hase check farmcheck
+hsetprop /sics/farm/hase write farmset hase
+hsetprop /sics/farm/hase setreply farmsetreply
+
+farmser poll /sics/farm/hase
+farmser write /sics/farm/hase
+
+hfactory /sics/farm/hugo plain spy int  
+hsetprop /sics/farm/hugo read farmparcom hugo
+hsetprop /sics/farm/hugo parread farmparread
+
+hsetprop /sics/farm/hugo check farmcheck
+hsetprop /sics/farm/hugo write farmset hugo
+hsetprop /sics/farm/hugo setreply farmsetreply
+
+farmser poll /sics/farm/hugo
+farmser write /sics/farm/hugo
+
+hfactory /sics/farm/schnegge plain spy float  
+hsetprop /sics/farm/schnegge read farmparcom schnegge
+hsetprop /sics/farm/schnegge parread farmparread
+
+hsetprop /sics/farm/schnegge check farmcheck
+hsetprop /sics/farm/schnegge write farmset schnegge
+hsetprop /sics/farm/schnegge setreply farmsetreply
+
+farmser poll /sics/farm/schnegge
+farmser write /sics/farm/schnegge
+
+hfactory /sics/farm/schneggerunning plain spy int  
+hsetprop /sics/farm/schneggerunning read farmparcom schneggerunning
+hsetprop /sics/farm/schneggerunning parread farmparread
+farmser poll /sics/farm/schneggerunning
+
+hfactory /sics/farm/stone plain spy int  
+hsetprop /sics/farm/stone read farmparcom stone
+hsetprop /sics/farm/stone parread farmparread
+#farmser poll /sics/farm/stone
+
+farmser debug -1
+
+#----------------- drivable scriptcontext adapter
+proc schneggechecklimits {} {
+    return [farmcheck]
+}
+#-----------------------------
+proc schneggestatus {} {
+    set runtime [SICSValue "hgetprop /sics/farm/schneggerunning readtime"]
+    set status [catch {SICSValue "hgetprop /sics/farm/schnegge settime"} starttime]
+    if {$status != 0} {
+#-------- not yet started!
+	return busy
+    }
+    if {$runtime > $starttime} {
+#--------- only look at status values older then the starttime!
+	set tst [hval /sics/farm/schneggerunning]
+	if {$tst == 1} {
+	    return busy
+	} else {
+	    farmser poll /sics/farm/schneggerunning 10
+            hdelprop /sics/farm/schnegge settime
+	    return idle
+	}
+    } else {
+	farmser poll /sics/farm/schneggerunning .5 progress
+	return busy
+    }
+}
+#---------------------------------------------
+hsetprop /sics/farm/schnegge checklimits schneggechecklimits
+hsetprop /sics/farm/schnegge checkstatus schneggestatus
+makesctdrive schnecke /sics/farm/schnegge farmser
+
+
 #source sansdruck.tcl