add drivers from l_samenv@samenv

tcl/drivers/OOspec.tcl

@@ -0,0 +1,47 @@
+namespace eval OOspec {} {
+}
+# OceanOptics spectrometer over python
+proc stdConfig::OOspec {} {
+  controller std "\n" 15 
+  prop startcmd "*IDN?"
+  
+  pollperiod 15 15
+
+  obj OOspec  -none
+   kids OOSpectrometer {
+    node peak1 rd
+    prop read OOspec::measure
+    node peak2 upd
+    node peak3 upd
+    node peak4 upd
+    node peak5 upd
+    node peak6 upd
+    node peak7 upd
+    node peak8 upd
+   }
+
+}
+
+
+
+
+proc OOspec::measure {} {
+    sct send "AQUIRE"
+    return OOspec::update
+  }
+
+
+proc OOspec::update {} {
+  set output [sct result]
+  set items [split $output " "]
+ 
+  updateval [sct parent]/peak1 [lindex $items 0]
+  updateval [sct parent]/peak2 [lindex $items 1]
+  updateval [sct parent]/peak3 [lindex $items 2]
+  updateval [sct parent]/peak4 [lindex $items 3]
+  updateval [sct parent]/peak5 [lindex $items 4]
+  updateval [sct parent]/peak6 [lindex $items 5]
+  updateval [sct parent]/peak7 [lindex $items 6]
+  updateval [sct parent]/peak8 [lindex $items 7]
+    return idle
+}

tcl/drivers/cmnnanov.tcl

@@ -0,0 +1,66 @@
+# keithley 2182 cmnnanovoltmeter
+namespace eval cmnnanov {} {
+}
+
+proc stdConfig::cmnnanov {} {
+  controller std "\n" 5
+  prop startcmd "*IDN?"
+
+  obj Keithley2182 rd -none
+  prop read cmnnanov::read
+  kids cmn_fixp {
+    node u1 upd
+    node temp upd
+    node u2 upd
+    node chan out
+    default 0
+    prop write cmnnanov::setchan
+    prop enum auto,chan1,chan2
+  }
+}
+
+proc cmnnanov::read {} {
+  sct send ":FETCH?"
+  return cmnnanov::update 
+}
+
+proc cmnnanov::update {} {
+  set mode [hvali [sct]/chan]
+  if {$mode == 0} {
+    set chan [silent 1 sct channel]
+  } else {
+    set chan $mode
+  }
+  hupdate [sct]/u$chan [sct result]
+  hdelprop [sct]/u$chan geterror
+  set volt [hvali [sct]/u1]
+  if {$chan == 1} {
+    hupdate [sct]/temp [expr 0.001*(1.62 + 15790.0/($volt*1000. - 58.92))]
+  }
+  if {$mode != 0} {
+    return idle
+  }
+  set chan [expr 3-$chan]
+  sct send ";SENS:CHAN $chan;:SENS:CHAN?"
+  sct channel $chan
+  return stdSct::complete
+}
+
+proc cmnnanov::setchan {} {
+  set mode [sct target]
+  if {$mode == 0} {
+    sct update $mode
+    return idle
+  }
+  set chan $mode
+  sct send ";SENS:CHAN $chan;:SENS:CHAN?"
+  sct channel $chan
+  return cmnnanov::updatechan
+}
+
+proc cmnnanov::updatechan {} {
+  sct update [sct result]
+  return idle
+}
+
+

tcl/drivers/dilprep.tcl

@@ -0,0 +1,181 @@
+namespace eval dilprep {
+  array set score {dil2 0 dil3 0 dil4 0}
+  array set curves {dil2 cx198 dil3 cx262 dil4 cx078}
+}
+
+
+proc stdConfig::dilprep {} {
+  controller syncedprot
+
+  obj DILPREP wr
+  prop enum warm=0,warmup=1,undef=-1
+  default -1
+  prop read dilprep::poll
+  prop check dilprep::check
+  prop write stdSct::complete
+  prop buffer ""
+  # last time when sample was warm
+  prop warmtime 0
+  # last time when sample was cold
+  prop coldtime 0
+  # last time when sample warming up faster than slopelimit
+  prop steeptime 0
+  # last time when detection was undefined
+  prop undeftime [DoubleTime]
+
+  kids dilprep {
+    node coldlimit par 280
+    prop help "stick is detected cold when T < coldlimit"
+    node warmlimit par 290
+    prop help "stick is detected warm when T > warmlimit for more than window sec"
+    node slopelimit par 0.1
+    prop help "stick is detected warm when tslope < slopelimit for more than window sec"
+    node window par 600
+    prop help "time window (sec)"
+    node dil out -int
+    prop enum undef=0,dil2=2,dil3=3,dil4=4
+    prop check dilprep::checktype
+    prop write stdSct::complete
+  }
+}
+
+proc dilprep::check {} {
+  if {[sct target] == 1} {
+    # reset slope
+    tslope node /ts
+  }
+  sct update [sct target]
+}
+
+proc dilprep::checktype {} {
+  variable score
+  variable curves
+
+  enum_decode [sct] [sct target] num dilname
+  foreach {key value} [array get score] {
+    set score($key) 0
+  }
+  if {$dilname ne "undef"} {
+    set score($dilname) 12
+  }
+  set crv $curves($dilname)
+  ts curve $crv
+  sct update [sct target]
+}
+
+proc dilprep::poll {} {
+  variable score
+  variable curves
+
+  if {[result _tmon status] eq "no response"} {
+    sct connected 0
+  } elseif {[silent 1 sct connected] == 0} {
+    device name none
+    device makeitem action plugged
+    device makeitem newdevice dilprep
+  }
+  set now [DoubleTime]
+  set onek [silent 0 result tmon onek/raw]
+  set stillt [silent 0 result tmon stillt/raw]
+  set mix [silent 0 result tmon mix/raw]
+  if {$onek * $stillt * $mix == 0} {
+    sct update -1
+    return idle
+  }
+  # guess dilution type from typical resistivities
+  # determine possible candidate
+  set dilname undef
+  if {abs($mix - 2200) < 50 && abs($onek - 2260) < 100 && abs($stillt - 2260) < 100} {
+    if {$onek > 2260} {
+      if {$stillt > 2260} {
+        set dilname dil4
+      }
+    } elseif {$stillt < 2260} {
+      set dilname dil2
+    } else {
+      set dilname dil3
+    }
+  }
+  set maxscore 0
+  # increase score for matching candidate, decrease for others (clamped within 0..12)
+  foreach {key value} [array get score] {
+    if {$key eq $dilname} {
+      set value [expr min(12, $value + 1)]
+    } else {
+      set value [expr max(0, $value - 1)]
+    }
+    if {$value > $maxscore} {
+      set maxscore $value
+    }
+    set score($key) $value
+  }
+  if {$dilname eq "undef"} {
+    sct undeftime $now
+    return idle
+  }
+  if {$maxscore eq 0} {
+    # no max score
+    enum_update [sct]/dil undef
+  } elseif {$score($dilname) >= $maxscore} {
+    if {$dilname ne [enum_txt [sct]/dil]} {
+      clientput "detected $dilname"
+      # highest score for $dilname
+      enum_update [sct]/dil $dilname
+      set crv $curves($dilname)
+      ts curve $crv
+    }
+  }
+  set mode [sctval [sct]]
+  set lim [hval [sct]/warmlimit]
+  set ts [silent 0 result ts]
+  set window [hval [sct]/window]
+  if {$mode == 1} {
+    # warming up
+    if {$ts < $lim} {
+      sct coldtime $now
+    }
+    if {[silent 999 hval /tslope] > [hval [sct]/slopelimit]} {
+      sct steeptime $now
+    }
+    if {$now > min([sct steeptime], [sct coldtime]) + $window} {
+      # warm
+      if {[sct steeptime] < [sct coldtime]} {
+        clientput "stick is warm (slope < [hval [sct]/slopelimit] for more than $window sec)"
+      } else {
+        clientput "stick is warm (T > [hval [sct]/warmlimit] for more than $window sec)"
+      }
+      sct target 0
+      check
+      return idle
+    }
+  } elseif {$mode < 0} {
+    # undef
+    if {$ts != 0} {
+      if {$now > [sct undeftime] + 120} {
+        if {$ts > [hval [sct]/warmlimit]} {
+          set mode 0
+          clientput "stick is warm"
+        } else {
+          set mode 1
+          clientput "stick is warming up"
+        }
+      }
+      sct target $mode
+      check
+      return idle
+    }
+  } else {
+    # warm or undef
+    if {$ts > [hval [sct]/coldlimit]} {
+      sct warmtime $now
+    }
+    if {[hval [sct]/dil] != 0 && $now > [sct warmtime] + $window} {
+      # warmup
+      sct target 1
+      check
+      return idle
+    }
+  }
+  sct update $mode
+  return idle
+}

tcl/drivers/k2601bVS.tcl

@@ -0,0 +1,62 @@
+# keithley 2601B sourcemeter Voltage Source
+namespace eval k2601bVS {} {
+}
+
+proc stdConfig::k2601bVS {} {
+  controller std "\n" 5
+  prop startcmd "reset() display.smua.measure.func = display.MEASURE_DCAMPS smua.source.func = smua.OUTPUT_DCVOLTS smua.source.autorangev = 1 smua.source.output = 0 print(localnode.description)"
+
+  pollperiod 1.0 1.0
+
+  obj k2601bVS -none
+   
+
+  kids k2601bVS {
+    node Enable wr -int
+    default 0
+    prop label Output
+    prop writecmd "smua.source.output = %d print(smua.source.output)"
+    prop readcmd "print(smua.source.output)"
+    prop readfmt "%d"
+    prop enum off,on
+    
+    node Ilim wr
+    default 2.0
+    prop label Current_Limit
+    prop writecmd "smua.source.limiti = %g  print(smua.source.limiti)"
+    prop readcmd "print(smua.source.limiti)"
+     prop readfmt "%g"
+
+#    node Itrip rd
+#    prop label CurrentTrip
+#    prop readcmd ":SENS:AMPS:PROT:TRIP?"
+#    prop readfmt "%g"
+        
+    node vset wr
+    default  0.00
+    prop label SetVoltage
+    prop writecmd "smua.source.levelv = %g print(smua.source.levelv)"
+    prop readcmd "print(smua.source.levelv)"
+    prop readfmt "%g"
+
+    node  Vmeas rd
+    prop label Voltage
+    prop readcmd "print(smua.measure.v())"
+    prop readfmt "%g"
+    
+    node  Imeas rd
+    prop label Current
+    prop readcmd "print(smua.measure.i())"
+    prop readfmt "%g"
+
+    node  Rmeas rd
+    prop label Resistance
+    prop readcmd "print(smua.measure.r())"
+    prop readfmt "%g"
+
+    node  Pmeas rd
+    prop label Power
+    prop readcmd "print(smua.measure.p())"
+    prop readfmt "%g"
+  }
+}

tcl/drivers/k6487.tcl

@@ -0,0 +1,19 @@
+# keithley 6487 picoammeter / voltage source
+namespace eval k6487 {} {
+}
+
+proc stdConfig::k6487 {} {
+  controller std "\n" 5
+  prop startcmd "*IDN?"
+
+  obj Keithley6487 wr
+  prop readcmd "SOUR:VOLT?"
+  prop writecmd "SOUR:VOLT %.12g"
+  kids "k6487 voltage source" {
+    node voltrange wr -int
+    prop read "SOUR:VOLT:RANGE?"
+    prop write "SOUR:VOLT:RANGE %d"
+    prop enum 10=10,50=50,500=500
+  }
+}
+

tcl/drivers/ls370.tcl

@@ -0,0 +1,75 @@
+#LS370 simple driver
+
+namespace eval ls370 {} {
+}
+
+proc stdConfig::ls370 {} {
+  variable ctrl
+  controller std "\n" 5
+  prop startcmd "*IDN?"
+
+  obj calib370 rd
+  default 0
+  prop read calib370::read
+  prop period 15
+  prop period0 0
+  kids "Sensor Channels" {
+    node chan1 upd
+    prop newline 1
+    node active1 par 1
+    prop enum 1
+    node chan2 upd
+    node active2 par 1
+    prop enum 1
+    node chan3 upd
+    node active3 par 1
+    prop enum 1
+    node chan4 upd
+    node active4 par 1
+    prop enum 1
+    node chan5 upd
+    node active5 par 1
+    prop enum 1
+    node chan6 upd
+    node active6 par 1
+    prop enum 1
+    node chan7 upd
+    node active7 par 1
+    prop enum 1
+    node chan8 upd
+    node active8 par 1
+    prop enum 1
+  }
+}
+
+proc ls370::read {} {
+  if {[sct period] ne [sct period0]} {
+    [sct controller] poll [sct] [sct period] read read
+    sct period0 [sct period]
+  }
+  if {[hvali [sct]] > 0} {
+    sct send "RDGK?[hvali [sct]]"
+    return ls370::update
+  }
+  sct update 1
+  sct send "SCAN 1,0;SCAN?"
+  return stdSct::complete
+}
+
+proc ls370::update {} {
+  set chan [hvali [sct]]
+  hdelprop [sct]/chan$chan geterror
+  hupdate [sct]/chan$chan [sct result]
+  for {set i 0} {$i < 8} {incr i} {
+    incr chan
+    if {$chan > 8} {
+      set chan 1
+    }
+    if {[hvali [sct]/active$chan]} {
+      break
+    }
+  }
+  sct update $chan
+  sct send "SCAN $chan,0;SCAN?"
+  return stdSct::complete
+}

tcl/drivers/luft.tcl

@@ -0,0 +1,52 @@
+namespace eval luft {} {
+}
+
+proc stdConfig::luft {label} {
+  controller syncedprot
+
+  pollperiod 10 10
+
+  obj LUFT upd
+  kids "luft monitor $label" {
+    node confirm wr -text -spy
+    prop write luft::writeCf
+    prop read luft::readCf
+    prop timeout [expr [clock seconds] + 600]
+  }
+}
+
+proc luft::set_error {errtxt} {
+  updateval [sct parent]/status $errtxt
+  if {$errtxt eq ""} {
+    catch {hdelprop [sct parent] geterror}
+    catch {hdelprop [sct] geterror}
+  } else {
+    updateerror [sct parent]/status $errtxt 1
+  }
+}
+
+proc luft::readCf {} {
+  if {[clock seconds] > [sct timeout]} {
+    luft::set_error "luft monitor off"
+  }
+  return idle
+}
+
+proc luft::writeCf {} {
+  sct cnt 0
+  set errtxt [lassign [sct target] timeout val]
+  if {[silent 0 sct verbose]} {
+    clientput [sct target]
+  }
+  if {$errtxt eq ""} {
+    updateval [sct parent] $val
+    # sct print [sct]=$val
+    luft::set_error ""
+  } else {
+    luft::set_error "epics error: $val $errtxt"
+  }
+  if {[scan [lindex [sct target] 0] %d period]} {
+    sct timeout [expr [clock seconds] + $period + 10]
+  }
+  return idle
+}

tcl/drivers/magres.tcl

@@ -0,0 +1,139 @@
+# magnet resistivity measured with IPS
+
+namespace eval magres {} {
+}
+
+proc stdConfig::magres {} {
+  variable hostport none
+  variable name
+  controller syncedprot
+  pollperiod 1 1
+
+  obj magres rd
+  prop read magres::read
+  prop last 0
+  prop htr 0
+  prop exc 0
+  kids "magnet resistance" {
+    node active out
+    default 0
+    prop enum 1
+    prop write magres::setactive
+
+    node coil upd
+
+    node excitation par 0.1
+  }
+}
+
+proc magres::setactive {} {
+  if {[sct target]} {
+    sct init 1
+    mf persmode 3
+  } else {
+    sct init 11
+  }
+  sct update [sct target]
+  return idle
+}
+
+proc magres::read {} {
+  if {[result mf persmode] != 3} {
+    # switch off immedately as a run mf has been done
+    updateval [sct]/active 0
+    return idle
+  }
+  set ramp [result mf ramp]
+  set ampRamp [result mf ampRamp]
+  if {$ramp == 0 || $ampRamp == 0} {
+    mf ramp 0.5
+    sct init 1
+    return idle
+  }
+  set fact [expr $ramp / $ampRamp]
+  set exc [hvali [sct]/excitation]
+  if {abs($exc) > 0.1} {
+    clientput "excitation is limited to 0.1 A"
+    set exc 0.1
+  }
+  set init [sct init]
+  if {[hvali [sct]/active] == 0} {
+    sct geterror "off"
+    if {$init > 0} {
+      if {$init <= 10} {
+        if {abs([result mf current] - [sct exc] * $fact) > 0.001} {
+          clientput "bad state of power supply"
+          return idle
+        }
+        set init 11
+      }
+      switch $init {
+        11 { mf send C3 }
+        12 { mf send H2 }
+        30 { mf send I0 }
+        31 { mf send A1 }
+        32 { mf send H0 }
+        33 {
+          mf send C1
+          mf persmode 1
+        }
+        34 { return idle }
+        default {
+        }
+      }
+      incr init
+      sct init $init
+    }
+    return idle
+  }
+  if {$init > 10 || ($init == 10 && $exc != [sct exc])} {
+    set init 1
+  }
+  if {$init < 10} {
+    switch $init {
+      1 {
+        mf send C3
+      }
+      2 { mf send T0.5000 }
+      3 {
+        mf send [format I%.4f $exc]
+        sct exc $exc
+      }
+      4 { mf send A1 }
+      5 { mf send R0 }
+      default {
+        sct init 10
+        return idle
+      }
+    }
+    incr init
+    sct init $init
+    return idle
+  }
+  set mf [expr $fact * $exc]
+  set curT [result mf current]
+  set res [expr [result mf voltage] / $curT * $fact]
+  set now [DoubleTime]
+  if {[sct htr]} {
+    if {$now > [sct last] + 10} {
+      updateval [sct]/coil $res
+      if {$now > [sct last] + 20} {
+        sct last $now
+        sct htr 0
+        mf send H0
+      }
+    }
+  } else {
+    if {$now > [sct last] + 10} {
+      sct update $res
+      if {$res > 1} {
+        hsetprop [sct]/coil geterror off
+      } elseif {$now > [sct last] + 20} {
+        sct last $now
+        sct htr 1
+        mf send H2
+      }
+    }
+  }
+  return idle
+}

tcl/drivers/mirror.tcl

@@ -0,0 +1,46 @@
+# mirror defined list of parameters to a remote object (e.g. SECoP)
+namespace eval mirror {
+}
+
+proc stdConfig::mirror {pars} {
+  controller syncedprot
+  variable node
+
+  pollperiod 0.25 0.25
+
+  obj MIRROR -text wr
+  default $pars
+  prop read mirror::update
+  prop write mirror::stdSct::completeUpdate
+  kids "mirror settings" {
+  }
+}
+
+proc mirror::update {} {
+  if {[catch {
+    set vpar [hval [sct]]
+    set pars [hlist $vpar]
+    set now [DoubleTime]
+    set timestamp 0
+    foreach par $pars {
+      if {$par ne "timestamp"} {
+        set par [string map {_ .} $par]
+        set value [get_var_value $par]
+        if {$value != [hval $vpar/$par]} {
+          hset $vpar/$par $value
+          set timestamp $now
+        }
+      }
+    }
+    if {$timestamp != 0} {
+      hset $vpar/timestamp $timestamp
+    }
+
+  } msg]} {
+    hset $vpar/timestamp [DoubleTime]
+    hupdate [sct]/status $msg
+  } else {
+    hupdate [sct]/status ""
+  }
+  return idle
+}

tcl/drivers/motvalve.tcl

@@ -0,0 +1,49 @@
+# motorized valve (DC-motor with endswitch)
+namespace eval motvalve {} {
+}
+
+proc stdConfig::motvalve {} {
+  controller std "\n" 5
+  prop startcmd "t"
+
+  obj MotValve wr
+  prop write motvalve::write
+  prop read motvalve::read
+  prop enum close,open,closing,opening
+  kids "motor valve" {
+    node pos upd
+  }
+}
+
+proc motvalve::write {} {
+  if {[sct target] == 1 || [sct target] == 3} {
+    sct send o
+  } else {
+    sct send c
+  }
+  return motvalve::read
+}
+
+proc motvalve::read {} {
+  sct send ep
+  return motvalve::update
+}
+
+proc motvalve::update {} {
+  set pos -1
+  set state -1
+  set error ""
+  scan [sct result] "e%d p%f %s" state pos error 
+  updateval [sct]/pos $pos
+  switch $state {
+    0 {sct enum closed,open}
+    1 {sct enum close,opened}
+    2 {sct enum close,open,closing}
+    3 {sct enum close,open,opening=3}
+  }
+  sct update $state
+  if {"$error" ne ""} {
+    sct geterror $error
+  }
+  return idle
+}

tcl/drivers/pfeiffermulti.tcl

@@ -0,0 +1,71 @@
+namespace eval pfeiffermulti {} {
+}
+
+proc stdConfig::pfeiffermulti {} {
+  variable node
+
+  controller std "" 5 
+  prop read pfeiffermulti::read
+  prop update pfeiffermulti::update
+
+  obj TPGM rd
+  prop cmd PR1
+  prop @errorcnt 0
+
+  kids TPG {
+    node p2 rd
+    prop cmd PR2
+
+    node p3 rd
+    prop cmd PR3
+
+    node p4 rd
+    prop cmd PR4
+
+    node p5 rd
+    prop cmd PR5
+
+    node p6 rd
+    prop cmd PR6
+
+    # node prx rd -text
+    # prop cmd PRX
+
+    # node sp1 rd -text
+    # prop cmd SP1
+
+    # node sp2 rd -text
+    # prop cmd SP2
+
+    # node sps rd -text
+    # prop cmd SPS
+  }
+}
+
+proc pfeiffermulti::read {} {
+  sct send "[sct cmd]\r\n"
+  return update
+}
+
+proc pfeiffermulti::update {} {
+  scan [sct result] %c ack
+  if {$ack == 6} {
+    sct send "\005"
+    return pfeiffermulti::update2
+  }
+  if {$ack == 21} {
+    error "NAK received on [sct cmd]"
+  }
+  return [pfeiffermulti::read]
+}
+
+proc pfeiffermulti::update2 {} {
+  if {[string match "PR*" [sct cmd]]} {
+    sct update [lindex [split [sct result] ,] 1]
+  } else {
+    sct update [sct result]
+  }
+  sct @errorcnt 0
+  return idle
+}
+

tcl/drivers/secop_0.tcl

@@ -0,0 +1,675 @@
+# secop driver
+
+namespace eval secop {} {
+}
+
+proc stdConfig::secop {{shownUnits ALL}} {
+  variable node
+  variable name
+  
+  set timeout 5
+  controller secop timeout=$timeout
+  prop commerror secop::errorscript
+  prop connection_lost 0
+  prop check secop::check
+  prop write secop::write
+  prop startcmd *IDN?
+  prop end_fast 0
+  prop secopPath /$name
+  prop timeout $timeout
+  prop active 0
+  prop shownUnits $shownUnits
+  
+  set node $node/tasks
+  prop start secop::start
+
+  # the pollperiod does not really matter
+  pollperiod 5 5
+  obj SECoP -text wr
+
+  prop read secop::readmsg
+  prop test secop::test
+  prop check secop::checkmsg
+  prop write secop::writemsg
+  prop cmd ""
+
+  variable ctrl
+  variable path
+  hsetprop /sics/$ctrl ignore_no_response 1
+
+}
+
+proc secop::errorscript {} {
+  if {[string match {ASCERR: no response*} [sct result]]} {
+    sct send ping
+    return secop::update
+  }
+  sct connection_lost 1
+  error [sct result]
+}
+
+proc secop::checkmsg {} {
+#  variable MQ[sct]
+#  upvar 0 MQ[sct] mq
+#  if {![info exists mq]} {
+#    # create message queue
+#    set mq [list]
+#  }
+#  if {[llength $mq] > 0} {
+#    set next [lindex $mq 0]
+#    set mq [lrange $mq 1 end]
+#    lappend mq [sct target]
+#    sct target $next
+#  }
+  
+  # interrupt pending wait for update
+  [sct controller] timeout 0.001
+  # without the following line "0.001" appears on client, why?
+  return ""
+}
+
+proc secop::writemsg {} {
+  # we grabbed access, so restore normal timeout
+  [sct controller] timeout [sct timeout]
+  sct send [sct target]
+  return secop::update
+}
+
+proc secop::readmsg {} {
+  if {[sct connection_lost]} {
+    sct connection_lost 0
+    return [secop::start]
+  }
+  return [secop::get]
+}
+
+proc secop::test {} {
+  clientput test
+  return idle
+}
+
+proc secop::check {} {
+  set validator [silent {} sct validator]
+  eval $validator
+  lassign [split [hinfo [sct]] ","] type
+  if {$type eq "text"} {
+    set msg "change [sct secopar] \"[sct target]\""
+  } else {
+    set msg "change [sct secopar] [sct target]"
+  }
+  [sct controller] que [sct secopPath] write [list secop::queuedwrite $msg]
+}
+
+proc secop::queuedwrite {msg} {
+  sct changed [DoubleTime]
+  # send message on /secop node
+  sct send $msg
+  return secop::update
+}
+
+proc secop::write {} {
+  # dummy write
+  # clientput "secop::write [sct] [hvali [sct]]"
+  return idle
+}
+
+proc secop::get {} {
+  sct send ""
+  return secop::update
+}
+
+proc secop::check_range {{low None} {high None}} {
+  [sct controller] timeout 0.001
+  if {$low ne "None" && [sct target] < $low} {
+    error "value [sct target] must be >= $low"
+  }
+  if {$high ne "None" && [sct target] > $high} {
+    error "value [sct target] must be <= $high"
+  }
+}
+
+proc secop::check_enum {} {
+  [sct controller] timeout 0.001
+}
+
+proc secop::check_length {{low None} {high None}} {
+  if {$low ne "None" && [string length [sct target]] < $low} {
+    error "value [sct target] must not be shorter than $low"
+  }
+  if {$high ne "None" && [string length [sct target]] > $high} {
+    error "value [sct target] must not be longer than $high"
+  }
+}
+
+proc secop::make_par {secopar desc {kind ""}} {
+  set path [topath $secopar [silent "" dict get $desc group]]
+  array set props $desc
+  set validator_args [lassign [silent "" set props(datatype)] secoptype0]
+  if {$secoptype0 eq "tuple" && [string match *:status $secopar]} {
+    lassign $validator_args elements
+    make_par0 text ${path}_text $secopar $desc
+    hsetprop ${path}_text width 24
+    set validator_args [lassign [lindex $elements 0] secoptype]
+    set status_node 1
+  } else {
+    set secoptype $secoptype0
+    set status_node 0
+  }
+  switch -- $secoptype {
+    double {set type float}
+    int - enum {set type int}
+    string {
+      set type text
+      # can not use SICS drivable for string
+      set kind ""
+    }
+    bool {set type text}
+    none {set type none}
+    default {
+      clientput "unknown type for $secopar (use text): $secoptype ($props(datatype))"
+      set type text
+    }
+  }
+  make_par0 $type $path $secopar $desc $kind
+  hsetprop $path secoptype $secoptype0
+  if {$status_node} {
+    hsetprop $path nonewline 1
+  }
+  switch -- $secoptype {
+    enum {
+      set enumprop [list]
+      set wid 8
+      foreach {name value} [lindex $validator_args 0] {
+        lappend enumprop "$name=$value"
+        set wid [expr max($wid,[string length $name])]
+      }
+      hsetprop $path enum [join $enumprop ,]
+      if {$wid > 8} {
+        hsetprop $path width $wid
+      }
+    }
+    bool {
+      hsetprop $path enum 1
+      hsetprop $path validator secop::check_enum
+    }
+    double - int {
+      hsetprop $path validator [concat secop::check_range $validator_args]
+    }
+    string {
+      hsetprop $path width 16
+      hsetprop $path validator [concat secop::check_range $validator_args]
+    }
+  }
+  return $path
+}
+
+proc secop::make_par0 {type path secopar desc {kind std}} {
+  array set props $desc
+  # clientput "$path $desc"
+  set readonly [silent 0 set props(readonly)]
+  if {$readonly} {
+    set priv internal
+  } else {
+    set priv user
+  }
+  if {[silent "" hinfo $path] ne ""} {
+    error "$path exists already"
+  }
+  lassign [split $path /] nul obj par
+  if {$par eq ""} {
+    if {$kind eq "driv"} {
+      dynsctdriveobj $obj float user SECoP [sct controller]
+      hfactory $path link $obj    
+      hsetprop $obj checklimits secop::checklimits
+      hsetprop $obj halt secop::halt
+      # allow start without run:
+      hsetprop $obj check secop::checklimits
+      hsetprop $obj write secop::complete_run
+      set readonly 0
+      hsetprop $obj sicscommand "run $obj"
+    } else {
+      # clientput "OBJ $obj $type"
+      dynsicsobj $obj SECoP $priv $type
+      hfactory $path link $obj
+    }
+    hsetprop $path group $obj
+    hsetprop $path objectPath $path
+    hsetprop /sics/[sct controller] p_$secopar:value $path
+  } else {
+    if {$par eq "status"} {
+      set path /$obj/s_status
+    }
+    # clientput "PAR $path $type"
+    hfactory $path plain $priv $type
+    if {[info exists props(visibility)]} {
+      if {$props(visibility) >= 3} {
+        hsetprop $path visible false      
+      }
+    }
+  }
+  hsetprop $path secopar $secopar
+  hsetprop /sics/[sct controller] p_$secopar $path
+  if {!$readonly} {
+    [sct controller] write $path
+  } else {
+    [sct controller] connect $path
+  }
+  logsetup $path 1
+  if {[info exists props(value)]} {
+    clientput "VALUE in descr $path"
+    if {[catch {hupdate /$path $props(value)} msg]} {
+      clientput $msg
+    }
+    unset props(value)
+  }
+  set fmtunit ""
+  if {[info exists props(unit)]} {
+    set fmtunit [format { [%s]} $props(unit)]
+    if {$par eq "" || $par eq "target"} {
+      if {[sct shownUnits] eq "ALL" || [lsearch [sct shownUnits] $props(unit)] >= 0} {
+        GraphAdd $path $props(unit) [join [lrange [split $path /] 1 end] .]
+      }
+    }
+  }
+  if {[info exists props(description)]} {
+    hsetprop $path help "$props(description)$fmtunit"
+    unset props(description)
+  }
+  foreach {prop item} [array get props] {
+    hsetprop $path s_$prop $item
+  }
+}
+
+proc secop::make_cmd {secopar desc {first 0}} {
+  array set props $desc
+  set path [topath $secopar [silent "" dict get $desc group]]
+  lassign [split $secopar :] obj cmd
+  lassign [silent "" set props(arguments)] secoptype validator
+  if {$secoptype eq ""} {
+    $obj makescriptfunc $cmd "secop::check_cmd [sct secopPath] $secopar" user
+    hsetprop $path newline $first
+    hsetprop $path secopar $secopar
+    hsetprop $path sicscommand "$obj $cmd"
+    if {[info exists props(visibility)]} {
+      if {$props(visibility) >= 3} {
+        hsetprop $path visible false      
+      }
+    }
+  } else {
+    if {[llength $secoptype] == 1} {
+      set secoptype [lindex $secoptype 0]
+    }
+    clientput "MAKE_CMD $secoptype"
+    dict set desc datatype $secoptype
+    make_par $secopar $desc
+    lassign $secoptype maintype
+    if {$maintype eq "double" || $maintype eq "int" || $maintype eq "bool"} {
+      hsetprop $path check "secop::check_cmd_num [sct secopPath] $secopar"
+    } else {
+      hsetprop $path check "secop::check_cmd_text [sct secopPath] $secopar"
+    }
+  }
+}
+
+proc secop::check_cmd {secopPath secopar} {
+  hset $secopPath "do $secopar"
+}
+
+proc secop::check_cmd_num {secopPath secopar} {
+  hset $secopPath [format {do %s [%.15g]} $secopar [sct target]]
+  sct update [sct target]
+}
+
+proc secop::check_cmd_text {secopPath secopar} {
+  hset $secopPath [format {do %s ["%s"]} $secopar [sct target]]
+  sct update [sct target]
+}
+
+proc secop::make_module {obj desc} {
+  if {[obj_list exists $obj]} {
+    clientput "$obj exists already"
+    return
+  }
+  obj_list makeitem $obj /$obj
+
+  array unset modprop
+  set parlist [list]
+  set cmdlist [list]
+  set pardict [dict create]
+  foreach {key item} $desc {
+    switch $key {
+      parameters {
+        set parlist $item
+      }
+      commands {
+        set cmdlist $item
+      }
+      default {
+        set modprop($key) $item
+      }
+    }
+  }
+  if {[dict exists $parlist value]} {
+    set value [dict get $parlist value]
+    dict unset parlist value
+  } else {
+    set value [dict create datatype none]
+  }
+  set classes [silent "" set modprop(interface_class)]
+  if {[string match "* Drivable *" " $classes "]} {
+    set path [make_par $obj $value driv]
+  } else {
+    set path [make_par $obj $value]
+  }
+  if {[info exists modprop(visibility)] && $modprop(visibility) >= 3} {
+    hdelprop $path group
+  }
+  foreach {prop val} [array get modprop] {
+    hsetprop $obj sm_$prop $val
+  }
+  device_layout makeitem /$obj [silent 0 set modprop(layoutpos)]
+
+  set groups [dict create]
+  foreach {parname pardesc} [concat $parlist $cmdlist] {
+    if {[dict exists $pardesc group]} {
+      dict set groups [dict get $pardesc group] 1
+    } 
+  }
+  foreach g [dict keys $groups] {
+    clientput "GROUP $g"
+    hfactory $obj/$g plain user none
+    hsetprop $obj/$g group "group $g"
+  }
+  foreach {parname pardesc} $parlist {
+    make_par $obj:$parname $pardesc
+  }
+  # first commands with arguments
+  foreach {parname pardesc} $cmdlist {
+    if {[dict get $pardesc arguments] ne ""} {
+      make_cmd $obj:$parname $pardesc 1
+    }
+  }
+  # then commands without arguments, on one line
+  set first 1
+  foreach {parname pardesc} $cmdlist {
+    if {[dict get $pardesc arguments] eq ""} {
+      make_cmd $obj:$parname $pardesc $first
+      set first 0
+    }
+  }
+}
+
+proc secop::make_node {desc} {
+  array unset nodeprop
+  set modlist [list]
+  foreach {key item} $desc {
+    switch $key {
+      modules {
+        set modlist $item
+      }
+      default {
+        set nodeprop($key) $item
+      }
+    }
+  }
+  foreach {modname moddesc} $modlist {
+    make_module $modname $moddesc
+  }
+  foreach {prop val} [array get nodeprop] {
+    sct sn_$prop $val
+  }
+  sort_layout
+}
+
+proc secop::topath {secopar {pargroup ""}} {
+  lassign [split [string tolower $secopar] :] module parameter
+  if {$parameter eq "value" || $parameter eq ""} {
+    return "/$module"
+  }
+  if {$parameter eq "status"} {
+    set parameter s_status
+  }
+  if {[string match {_*} $parameter]} {
+    set parameter [string range $parameter 1 end]
+  }
+  if {$pargroup ne ""} {
+    return "/$module/$pargroup/$parameter"
+  }
+  return "/$module/$parameter"
+}
+
+proc secop::update {} {
+  set sent_message [silent 0 sct sent_message]
+  set message_to_client ""
+    
+  lassign [sct result] messagetype par val
+  set path [silent "" hgetpropval /sics/[sct controller] p_$par]
+  lassign [split $par :] obj
+  switch $messagetype {
+    update - changed {
+      #if {[sct] ne "/secop"} {
+      #  clientput "[sct] is not /secop, why?"
+      #}
+      #if {![sct active]} {
+      #  clientput [sct result]
+      #}
+      if {$messagetype eq "changed"} {
+        if {[string match *:target $par]} {
+          hsetprop /$obj writestatus done
+        }
+        hsetprop $path changed 0
+        if {[lrange $sent_message 0 1] eq [list change $par]} {
+          set message_to_client [sct result]
+        }
+        # clientput "CH $path [sct result]"
+      } else {
+        if {[DoubleTime] < [silent 0 hgetpropval $path changed] + 10} {
+          # ignore updates of variables during change
+          # clientput "ignore [sct result]"
+          return idle
+        }
+        if {[lrange $sent_message 0 1] eq [list read $par]} {
+          set message_to_client [sct result]
+        }
+      }
+      lassign $val value qual
+      if {[silent 0 hgetpropval $path secoptype] eq "tuple" &&
+          [string match *:status $par]} {
+        if {[llength $value] > 2} {
+          set text_value [lrange $value 1 end]
+        } else {
+          set text_value [lindex $value 1]
+        }
+        set objpath [sct parent $path]
+        set visible_old [silent true hgetpropval $objpath visible]
+        if {$text_value ne "disabled"} {
+          set visible_new true
+          set shown 1
+        } else {
+          set visible_new false
+          set shown 0
+        }
+        if {$visible_new ne $visible_old} {
+          hsetprop $objpath visible $visible_new
+          GraphItem shown $objpath $shown
+        }
+        lassign $value value
+        if {[catch {updateval ${path}_text $text_value}]} {
+          clientput "cannot update ${path}_text to $text_value"
+          clientput "MSG([sct result])"
+        }
+        if {[string match *:status $par]} {
+          set oldstatus [silent idle hgetpropval /$obj status]
+          if {[silent 0 hgetpropval /$obj writestatus] eq "start"} {
+            set status run
+          } elseif {[string match 3* $value]} {
+            set status run
+          } elseif {[string match 4* $value]} {
+            set status posfault
+          } else {
+            set status idle
+            if {[silent "" hgetpropval $obj type] eq "drivable" && $oldstatus eq "run"} {
+              if {[catch {
+                set oldvalue [silent 0 hgetpropval $obj value_before_run]
+                set oldtarget [silent 0 hgetpropval $obj target_before_run]
+                set value [hval /$obj]
+                set target [silent 0 hgetpropval /$obj target]
+                set delay [expr [DoubleTime] - [silent 0 hgetpropval $obj write_time]]
+                if {abs($value - $oldvalue) < abs($target - $oldtarget) * 0.1 && $delay < 10} {
+                  # clientput "WARNING: $obj status is idle, but value has not moved: abs($value - $oldvalue) < abs($target - $oldtarget) * 0.1 delay $delay"
+                  set status run
+                } 
+              } msg]} {
+                clientput "WARNING: $msg"
+              }
+            }
+          }
+          hsetprop /$obj status $status
+        }
+      }
+      if {[catch {updateval $path $value} msg]} {
+        if {$value eq "None"} {
+          hsetprop $path geterror None
+        } else {
+          clientput "cannot update $path to $value"
+          clientput $msg
+        }
+      } elseif {[string match *:target $par]} {
+        # clientput [sct result]/[silent "" hgetpropval /$obj status]
+        if {[silent "" hgetpropval /$obj status] eq "idle"} {
+          hsetprop /$obj target $value
+        }
+      }
+      catch {
+        hsetprop $path timestamp [dict get $qual t]
+      }
+    }
+    pong {
+      if {[lindex $sent_message 0] eq "ping"} {
+        set message_to_client [sct result]
+      }
+    }
+    done {
+      if {[lrange $sent_message 0 2] eq [list do $par]} {
+        set message_to_client [sct result]
+      } else {
+        clientput "done $par $val"
+      }
+    }
+    active {
+      if {[lindex $sent_message 0] eq "activate"} {
+        set message_to_client [sct result]
+      } else {
+        clientput ACTIVE
+      }
+      sct active 1
+      sct end_fast 0
+    }
+    error {
+      lassign $val origin info
+      lassign $origin requesttype requestpar requestval
+      set path [silent "" hgetpropval /sics/[sct controller] p_$requestpar]
+      if {$requesttype eq "change" && $path ne ""} {
+        hsetprop $path changed 0
+      }
+      set errortext [lindex [dict get $info errorinfo] 0]
+      if {$origin eq $sent_message} {
+        set message_to_client [sct result]
+      } else {
+        clientput "ERROR: $path $errortext"
+      }
+    }
+    default {
+      if {$sent_message ne ""} {
+        set message_to_client [sct result]
+      } else {
+        # show untreated message
+        clientput [sct result]
+      }
+    }
+  }
+  if {$message_to_client ne ""} {
+    clientput "> $sent_message\n< $message_to_client"
+    sct sent_message ""
+    sct sent_time 1e20
+  } elseif {[DoubleTime] > [silent 1e20 sct sent_time] + 10} {
+    clientput "timeout waiting for response to $sent_message"
+    sct sent_message ""
+    sct sent_time 1e20
+  }
+  if {[DoubleTime] < [sct end_fast]} {
+    return secop::get
+  }
+  [sct controller] queue [sct] read secop::get
+  return idle
+}
+
+proc secop::checklimits {} {
+  # for whatever strange reason checklimits is called twice
+  # in addition again as write script of the obj node
+  # do this only once
+  if {[silent 0 sct status] ne "run" ||
+      [sct target] != [silent "x" hgetpropval [sct]/target target]} {
+    sct value_before_run [hval [sct]]
+    sct target_before_run [hval [sct]/target]
+    hset [sct]/target [sct target]
+    sct status run
+  }
+}
+
+proc secop::complete_run {} {
+  sct print "run [sct objectName] to [sct target]"
+  return idle
+}
+
+proc secop::halt {} {
+  [sct objectName] stop
+  sct writestatus done
+  sct target_before_run [silent 0 sct target]
+  # sct status posfault
+  # clientput HALT:[sct]
+  return idle
+}
+
+proc secop::start {} {
+  [sct controller] timeout [sct timeout]
+  sct send *IDN?
+  return secop::getidn
+}
+
+proc secop::getidn {} {
+  clientput [sct result]
+  [sct controller] queue [sct secopPath] start secop::describe
+  sct active 0
+  return idle
+}
+
+proc secop::describe {} {
+  sct send describe
+  return secop::describing
+}
+
+proc secop::describing {} {
+  lassign [sct result] messagetype par val
+  switch $messagetype {
+    describing {
+      do_as_manager {
+        make_node $val
+      }
+    }
+    default {
+      clientput "ignore $messagetype $par ..."
+    }
+  }
+  sct send activate
+  sct end_fast [expr [DoubleTime] + 5]
+  return secop::update
+}
+
+proc secop_send {args} {
+  hset /secop $args
+  hsetprop /secop sent_message $args
+  hsetprop /secop sent_time [DoubleTime]
+}
+
+publishLazy secop_send

tcl/drivers/secop_1.tcl

@@ -0,0 +1,699 @@
+# secop driver
+
+namespace eval secop {} {
+}
+
+proc stdConfig::secop {{shownUnits ALL}} {
+  variable node
+  variable name
+  
+  controller secop3 timeout=60
+  prop commerror secop::errorscript
+  prop connection_lost 0
+  prop check secop::check
+  prop write secop::write
+  prop startcmd *IDN?
+  prop end_fast 0
+  prop secopPath /$name
+  prop active 0
+  prop shownUnits $shownUnits
+  
+  set node $node/tasks
+  prop start secop::start
+
+  pollperiod 0.01 0.01
+  obj SECoP -text wr
+
+  prop read secop::readmsg_
+  prop test secop::test
+  prop check secop::checkmsg
+  prop write secop::writemsg
+  prop cmd ""
+
+  variable ctrl
+  variable path
+  hsetprop /sics/$ctrl ignore_no_response 1
+
+}
+
+proc secop::errorscript {} {
+  if {[string match {ASCERR: no response*} [sct result]]} {
+    sct send ping
+    return secop::update_
+  }
+  sct connection_lost 1
+  [sct controller] poll [sct] 1
+  error [sct result]
+}
+
+proc secop::checkmsg {} {
+#  variable MQ[sct]
+#  upvar 0 MQ[sct] mq
+#  if {![info exists mq]} {
+#    # create message queue
+#    set mq [list]
+#  }
+#  if {[llength $mq] > 0} {
+#    set next [lindex $mq 0]
+#    set mq [lrange $mq 1 end]
+#    lappend mq [sct target]
+#    sct target $next
+#  }
+  
+  return ""
+}
+
+proc secop::writemsg {} {
+  sct send [sct target]
+  return secop::update_
+}
+
+proc secop::readmsg_ {} {  # ending with _: invisible on debug
+  if {[sct connection_lost]} {
+    sct connection_lost 0
+    return [secop::start]
+  }
+  sct send ""
+  return secop::update_
+}
+
+proc secop::test {} {
+  clientput test
+  return idle
+}
+
+proc secop::check {} {
+  if {[silent "" sct secopar] eq ""} return
+  set validator [silent {} sct validator]
+  eval $validator
+  lassign [split [hinfo [sct]] ","] type
+  if {$type eq "text"} {
+    set msg "change [sct secopar] \"[sct target]\""
+  } else {
+    set msg "change [sct secopar] [sct target]"
+  }
+  [sct controller] que [sct secopPath] write [list secop::queuedwrite $msg]
+}
+
+proc secop::queuedwrite {msg} {
+  sct changed [DoubleTime]
+  # send message on /secop node
+  sct send $msg
+  return secop::update_
+}
+
+proc secop::write {} {
+  # dummy write
+  # clientput "secop::write [sct] [hvali [sct]]"
+  return idle
+}
+
+proc secop::get {} {
+  error "secop::get is obsolete"
+  sct send ""
+  return secop::update_
+}
+
+proc secop::check_range {{low None} {high None}} {
+  if {$low ne "None" && [sct target] < $low} {
+    error "value [sct target] must be >= $low"
+  }
+  if {$high ne "None" && [sct target] > $high} {
+    error "value [sct target] must be <= $high"
+  }
+}
+
+proc secop::check_bool {} {
+  switch -- [string tolower [sct target]] {
+    off - false - no - 0 - on - true - yes - 1 {
+      return
+    }
+  }
+  error "illegal value for boolean: [sct target]"
+}
+
+proc secop::check_length {{low None} {high None}} {
+  if {$low ne "None" && [string length [sct target]] < $low} {
+    error "value [sct target] must not be shorter than $low"
+  }
+  if {$high ne "None" && [string length [sct target]] > $high} {
+    error "value [sct target] must not be longer than $high"
+  }
+}
+
+proc secop::make_par {secopar desc {kind ""}} {
+  set path [topath $secopar [silent "" dict get $desc group]]
+  array set props $desc
+  set validator_args [lassign [silent "" set props(datatype)] secoptype0]
+  if {$secoptype0 eq "tuple" && [string match *:status $secopar]} {
+    lassign $validator_args elements
+    set text_path [regsub {status_code$} $path status_text]
+    make_par0 text $text_path $secopar $desc
+    hsetprop $text_path width 24
+    set validator_args [lassign [lindex $elements 0] secoptype]
+    set status_node 1
+  } else {
+    set secoptype $secoptype0
+    set status_node 0
+  }
+  switch -- $secoptype {
+    double {set type float}
+    int - enum {set type int}
+    string {
+      set type text
+      # can not use SICS drivable for string
+      set kind ""
+    }
+    bool {set type text}
+    none {set type none}
+    default {
+      clientput "unknown type for $secopar (use text): $secoptype ($props(datatype))"
+      set type text
+    }
+  }
+  make_par0 $type $path $secopar $desc $kind
+  hsetprop $path secoptype $secoptype0
+  if {$status_node} {
+    hsetprop $path nonewline 1
+  }
+  lassign [split $path /] nul obj par
+  set fmtunit ""
+  if {[lsearch [list enum int double] $secoptype0] >= 0} {
+    set fmtunit ""
+    if {[info exists props(unit)]} {
+      set fmtunit [format { [%s]} $props(unit)]
+    }
+    if {$par eq "" || $par eq "target"} {
+      set unit [silent 1 set props(unit)]
+      if {[sct shownUnits] eq "ALL" || [lsearch [sct shownUnits] $unit] >= 0} {
+        GraphAdd $path $unit
+      }
+    }
+  }
+  if {[info exists props(description)]} {
+    hsetprop $path help "$props(description)$fmtunit"
+    unset props(description)
+  }
+  switch -- $secoptype {
+    enum {
+      set enumprop [list]
+      set wid 8
+      set sorted [list]
+      foreach {name value} [lindex $validator_args 0] {
+         lappend sorted [list $value $name]
+      }
+      foreach value_name [lsort -integer -index 0 $sorted] {
+        lassign $value_name value name
+        lappend enumprop "$name=$value"
+        set wid [expr max($wid,[string length $name])]
+      }
+      hsetprop $path enum [join $enumprop ,]
+      if {[silent "" hgetpropval $path type] eq "drivable"} {
+        hsetprop $path visible false
+      }
+      if {$wid > 8} {
+        hsetprop $path width $wid
+      }
+    }
+    bool {
+      hsetprop $path enum 1
+      hsetprop $path validator secop::check_bool
+    }
+    double - int {
+      hsetprop $path validator [concat secop::check_range $validator_args]
+    }
+    string {
+      hsetprop $path width 16
+      hsetprop $path validator [concat secop::check_range $validator_args]
+    }
+  }
+  return $path
+}
+
+proc secop::make_par0 {type path secopar desc {kind std}} {
+  array set props $desc
+  # clientput "$path $desc"
+  set readonly [silent 0 set props(readonly)]
+  if {$readonly} {
+    set priv internal
+  } else {
+    set priv user
+  }
+  if {[silent "" hinfo $path] ne ""} {
+    error "$path exists already!"
+  }
+  lassign [split $path /] nul obj par
+  if {$par eq ""} {
+    if {$kind eq "driv"} {
+      dynsctdriveobj $obj float user SECoP [sct controller]
+      hfactory $path link $obj
+      hsetprop $obj checklimits secop::checklimits
+      hsetprop $obj checkstatus secop::checkstatus
+      hsetprop $obj halt secop::halt
+      # allow start without run:
+      hsetprop $obj check secop::checklimits
+      hsetprop $obj write secop::complete_run
+      set readonly 0
+      hsetprop $obj sicscommand "run $obj"
+    } else {
+      # clientput "OBJ $obj $type"
+      dynsicsobj $obj SECoP $priv $type
+      hfactory $path link $obj
+    }
+    hsetprop $path group $obj
+    hsetprop $path s_group $obj
+    hsetprop $path objectPath $path
+    hsetprop /sics/[sct controller] p_$secopar:value $path
+  } else {
+    if {$par eq "status"} {
+      set path /$obj/status_code
+    }
+    # clientput "PAR $path $type [array get props]"
+    hfactory $path plain $priv $type
+    if {[info exists props(visibility)]} {
+      if {$props(visibility) >= 3} {
+        hsetprop $path visible false      
+      }
+    }
+  }
+  hsetprop $path secopar $secopar
+  hsetprop /sics/[sct controller] p_$secopar $path
+  if {!$readonly} {
+    [sct controller] write $path
+  } else {
+    [sct controller] connect $path
+  }
+  logsetup $path 1
+  if {[info exists props(value)]} {
+    clientput "VALUE in descr $path"
+    if {[catch {hupdate /$path $props(value)} msg]} {
+      clientput $msg
+    }
+    unset props(value)
+  }
+  foreach {prop item} [array get props] {
+    hsetprop $path s_$prop $item
+  }
+}
+
+proc secop::make_cmd {secopar desc {first 0}} {
+  array set props $desc
+  set path [topath $secopar [silent "" dict get $desc group]]
+  set cmd [join [lassign [split $path /] _ obj] /]
+  lassign [lindex [silent "" set props(datatype)] 1] secoptype validator
+  if {$secoptype eq "None"} {
+    $obj makescriptfunc $cmd "secop::check_cmd [sct secopPath] $secopar" user
+    hsetprop $path newline $first
+    hsetprop $path secopar $secopar
+    hsetprop $path sicscommand "$obj $cmd"
+    if {[info exists props(visibility)]} {
+      if {$props(visibility) >= 3} {
+        hsetprop $path visible false      
+      }
+    }
+  } else {
+    if {[llength $secoptype] == 1} {
+      set secoptype [lindex $secoptype 0]
+    }
+    dict set desc datatype $secoptype
+    make_par $secopar $desc
+    lassign $secoptype maintype
+    if {$maintype eq "double" || $maintype eq "int" || $maintype eq "bool"} {
+      hsetprop $path check "secop::check_cmd_num [sct secopPath] $secopar"
+    } else {
+      hsetprop $path check "secop::check_cmd_text [sct secopPath] $secopar"
+    }
+  }
+}
+
+proc secop::check_cmd {secopPath secopar} {
+  hset $secopPath "do $secopar"
+}
+
+proc secop::check_cmd_num {secopPath secopar} {
+  hset $secopPath [format {do %s %.15g} $secopar [sct target]]
+  sct update [sct target]
+}
+
+proc secop::check_cmd_text {secopPath secopar} {
+  hset $secopPath [format {do %s "%s"} $secopar [sct target]]
+  sct update [sct target]
+}
+
+proc secop::make_module {obj desc} {
+  clientput "MAKE_MODULE $obj"
+  if {[obj_list exists $obj]} {
+    clientput "$obj exists already"
+    return
+  }
+  obj_list makeitem $obj /$obj
+
+  array unset modprop
+  set parlist [list]
+  set pardict [dict create]
+  foreach {key item} $desc {
+    switch $key {
+      accessibles {
+        foreach acsitm $item {
+          lassign $acsitm parname pardesc
+          dict set pardict $parname $pardesc
+        }
+      }
+      default {
+        set modprop($key) $item
+      }
+    }
+  }
+  if {[dict exists $pardict value]} {
+    set value [dict get $pardict value]
+    dict unset pardict value
+  } else {
+    set value [dict create datatype none]
+  }
+  set classes [silent "" set modprop(interface_class)]
+  if {[string match "* Drivable *" " $classes "]} {
+    set path [make_par $obj $value driv]
+  } else {
+    set path [make_par $obj $value]
+  }
+  if {[info exists modprop(visibility)] && $modprop(visibility) >= 3} {
+    hdelprop $path group
+  }
+  foreach {prop val} [array get modprop] {
+    hsetprop $obj sm_$prop $val
+  }
+  device_layout makeitem /$obj [silent 0 set modprop(layoutpos)]
+
+  set groups [dict create]
+  foreach {parname pardesc} $pardict {
+    if {[dict exists $pardesc group]} {
+      dict set groups [dict get $pardesc group] 1
+    } 
+  }
+  foreach g [dict keys $groups] {
+    clientput "GROUP $g"
+    hfactory $obj/$g plain user none
+    hsetprop $obj/$g group "group $g"
+  }
+  set shortcmds [list]
+  foreach {parname pardesc} $pardict {
+    set datatype [dict get $pardesc datatype]
+    if {[lindex $datatype 0] eq "command"} {
+      if {[lindex $datatype 1] ne "None"} {
+        # only commands with arguments
+        make_cmd $obj:$parname $pardesc 1
+      } else {
+        lappend shortcmds $parname $pardesc
+      }
+    } else {
+      make_par $obj:$parname $pardesc
+    }
+  }
+  # then commands without arguments, on one line
+  set first 1
+  foreach {parname pardesc} $shortcmds {
+    make_cmd $obj:$parname $pardesc $first
+    set first 0
+  }
+}
+
+proc secop::make_node {desc} {
+  array unset nodeprop
+  set modlist [list]
+  foreach {key item} $desc {
+    switch $key {
+      modules {
+        set modlist $item
+      }
+      default {
+        set nodeprop($key) $item
+      }
+    }
+  }
+  foreach moditem $modlist {
+    lassign $moditem modname moddesc
+    make_module $modname $moddesc
+  }
+  foreach {prop val} [array get nodeprop] {
+    sct sn_$prop $val
+  }
+  sort_layout
+}
+
+proc secop::topath {secopar {pargroup ""}} {
+  lassign [split [string tolower $secopar] :] module parameter
+  if {$parameter eq "value" || $parameter eq ""} {
+    return "/$module"
+  }
+  if {$parameter eq "status"} {
+    set parameter status_code
+  }
+  if {[string match {_*} $parameter]} {
+    set parameter [string range $parameter 1 end]
+  }
+  if {$pargroup ne ""} {
+    return "/$module/$pargroup/$parameter"
+  }
+  return "/$module/$parameter"
+}
+
+proc secop::update_ {} {
+  if {[silent "" sct result] eq ""} {
+    return idle
+  }
+  set sent_message [silent "" sct sent_message]
+  set message_to_client ""
+    
+  lassign "[sct result]" messagetype par val
+  set path [silent "" hgetpropval /sics/[sct controller] p_$par]
+  lassign [split $par :] obj
+  switch $messagetype {
+    update - changed {
+      # clientput "*** [DoubleTime]: [sct result]"
+      #if {[sct] ne "/secop"} {
+      #  clientput "[sct] is not /secop, why?"
+      #}
+      #if {![sct active]} {
+      #  clientput [sct result]
+      #}
+      if {$messagetype eq "changed"} {
+        if {[string match *:target $par]} {
+          hsetprop /$obj writestatus done
+        }
+        hsetprop $path changed 0
+        if {[lrange $sent_message 0 1] eq [list change $par]} {
+          set message_to_client [sct result]
+        }
+        # clientput "CH $path [sct result]"
+      } else {
+        if {[DoubleTime] < [silent 0 hgetpropval $path changed] + 10} {
+          # ignore updates of variables during change
+          # clientput "ignore [sct result]"
+          return idle
+        }
+        if {[lrange $sent_message 0 1] eq [list read $par]} {
+          set message_to_client [sct result]
+        }
+      }
+      lassign $val value qual
+      if {[silent 0 hgetpropval $path secoptype] eq "tuple" &&
+          [string match *:status $par]} {
+        if {[llength $value] > 2} {
+          set text_value [lrange $value 1 end]
+        } else {
+          set text_value [lindex $value 1]
+        }
+        set objpath [sct parent $path]
+        lassign $value value
+        if {$value != 0} {
+          hsetprop $objpath group [hgetpropval $objpath s_group]
+          set shown 1
+        } else {
+          catch {hdelprop $objpath group}
+          set shown 0
+        }
+        if {$value < 100 || $value >= 400} { # error
+          updateerror $objpath $text_value
+          catch {
+            logsetup $objpath/target clear
+          }
+        } else {
+          # logsetup $objpath 1
+          updateval $objpath [hvali $objpath]
+        }
+        GraphItem shown $objpath $shown
+        if {[silent "" hgetpropval $objpath/target logger_name] ne ""} {
+          GraphItem shown $objpath/target $shown
+        }
+        set text_path [regsub {status_code$} $path status_text]
+        if {[catch {updateval $text_path $text_value}]} {
+          clientput "cannot update $text_path to $text_value"
+          clientput "MSG([sct result])"
+        }
+      }
+      if {[catch {updateval $path $value} msg]} {
+        if {$value eq "None"} {
+          hsetprop $path geterror None
+        } else {
+          clientput "cannot update $path to $value"
+          clientput $msg
+        }
+      } elseif {[string match *:target $par]} {
+        if {[string match 1* [silent 0 hval /$obj/status_code]]} {
+          hsetprop /$obj target $value
+        }
+      }
+      catch {
+        hsetprop $path timestamp [dict get $qual t]
+      }
+    }
+    pong {
+      if {[lindex $sent_message 0] eq "ping"} {
+        set message_to_client [sct result]
+      }
+    }
+    done {
+      if {[lrange $sent_message 0 2] eq [list do $par]} {
+        set message_to_client [sct result]
+      } else {
+        clientput "done $par $val"
+      }
+    }
+    active {
+      if {[lindex $sent_message 0] eq "activate"} {
+        set message_to_client [sct result]
+      } else {
+        clientput ACTIVE
+      }
+      sct active 1
+      sct end_fast 0
+    }
+    error {
+      lassign $val origin errortext
+      lassign $origin requesttype requestpar requestval
+      set path [silent "" hgetpropval /sics/[sct controller] p_$requestpar]
+      if {$requesttype eq "change" && $path ne ""} {
+        hsetprop $path changed 0
+      }
+      if {$origin eq $sent_message} {
+        set message_to_client [sct result]
+      } else {
+        clientput "ERROR: $path $errortext"
+      }
+    }
+    describing {
+      do_as_manager {
+        make_node $val
+      }
+      [sct controller] poll [sct] 0.01
+      sct send activate
+      return secop::update_
+    }
+    default {
+      if {[string match "*,*" $messagetype]} {
+        clientput IDN=[sct result]
+        sct send describe
+        sct active 0
+        return secop::update_
+      }
+      if {$sent_message ne ""} {
+        set message_to_client [sct result]
+      } else {
+        # show untreated message
+        clientput [sct result]
+      }
+    }
+  }
+  if {$message_to_client ne ""} {
+    clientput "> $sent_message\n< $message_to_client"
+    sct sent_message ""
+    sct sent_time 1e20
+  } elseif {[DoubleTime] > [silent 1e20 sct sent_time] + 10} {
+    clientput "timeout waiting for response to $sent_message"
+    sct sent_message ""
+    sct sent_time 1e20
+  }
+  #if {[DoubleTime] < [sct end_fast]} {
+  #  return secop::get
+  #}
+  # [sct controller] queue [sct] read secop::get
+  return idle
+}
+
+proc secop::checklimits {} {
+  # for whatever strange reason checklimits is called twice
+  # in addition again as write script of the obj node
+  # do this only once
+  set ws [silent 0 sct writestatus]
+  if {$ws ne "checked" && $ws ne "start" ||
+      [sct target] != [silent "x" hgetpropval [sct]/target target]} {
+    hset [sct]/target [sct target]
+    sct writestatus checked
+  }
+}
+
+proc secop::checkstatus {} {
+  set ws [silent 0 sct writestatus]
+  set status [hvali [sct]/status_code]
+  if {[string match 3* $status]} {
+    set result run
+  } elseif {[string match 4* $status]} {
+    set result posfault
+  } else {
+    if {$ws ne "done"} {
+      set result run
+    } else {
+      set result idle
+    }
+  }
+  sct status $result
+  return $result
+}
+
+proc secop::complete_run {} {
+  sct print "run [sct objectName] to [sct target]"
+  return idle
+}
+
+proc secop::halt {} {
+  [sct objectName] stop
+  sct writestatus done
+  # clientput HALT:[sct]
+  return idle
+}
+
+proc secop::start {} {
+  sct send *IDN?
+  return secop::update_
+}
+
+proc secop::describe {} {
+  sct send describe
+  return secop::describing
+}
+
+proc secop::describing {} {
+  #obsolete?
+  lassign [sct result] messagetype par val
+  switch $messagetype {
+    describing {
+      do_as_manager {
+        make_node $val
+      }
+    }
+    default {
+      clientput "ignore $messagetype $par ..."
+    }
+  }
+  sct send activate
+  sct end_fast [expr [DoubleTime] + 5]
+  return secop::update_
+}
+
+proc secop_send {args} {
+  hset /secop $args
+  hsetprop /secop sent_message $args
+  hsetprop /secop sent_time [DoubleTime]
+}
+
+publishLazy secop_send

tcl/drivers/secop_2.tcl

@@ -0,0 +1,752 @@
+# secop driver 2 (v1.0c): after datatype modification
+
+namespace eval secop {} {
+}
+
+proc stdConfig::secop {{shownUnits ALL}} {
+  variable node
+  variable name
+  
+  controller secop3 timeout=60
+  prop commerror secop::errorscript_
+  prop connection_lost 0
+  prop check secop::check
+  prop write secop::write
+  prop startcmd *IDN?
+  prop end_fast 0
+  prop secopPath /$name
+  prop active 0
+  prop shownUnits $shownUnits
+  
+  set node $node/tasks
+  prop start secop::start
+
+  pollperiod 0.001 0.001
+  obj SECoP -text wr
+
+  prop read secop::readmsg_
+  prop test secop::test
+  prop check secop::checkmsg
+  prop write secop::writemsg
+  prop cmd ""
+
+  variable ctrl
+  variable path
+  hsetprop /sics/$ctrl ignore_no_response 1
+
+}
+
+proc secop::errorscript_ {} {
+  if {[string match {ASCERR: no response*} [sct result]]} {
+    sct send ping
+    return secop::update_
+  }
+  sct connection_lost 1
+  [sct controller] poll [sct] 1
+  error [sct result]
+}
+
+proc secop::checkmsg {} {
+#  variable MQ[sct]
+#  upvar 0 MQ[sct] mq
+#  if {![info exists mq]} {
+#    # create message queue
+#    set mq [list]
+#  }
+#  if {[llength $mq] > 0} {
+#    set next [lindex $mq 0]
+#    set mq [lrange $mq 1 end]
+#    lappend mq [sct target]
+#    sct target $next
+#  }
+  
+  return ""
+}
+
+proc secop::writemsg {} {
+  sct send [sct target]
+  return secop::update_
+}
+
+proc secop::readmsg_ {} {  # ending with _: invisible on debug
+  if {[sct connection_lost]} {
+    sct connection_lost 0
+    return [secop::start]
+  }
+  sct send ""
+  return secop::update_
+}
+
+proc secop::test {} {
+  clientput test
+  return idle
+}
+
+proc secop::check {} {
+  if {[silent "" sct secopar] eq ""} return
+  set validator [silent {} sct validator]
+  eval $validator
+  lassign [split [hinfo [sct]] ","] type
+  if {$type eq "text"} {
+    set msg "change [sct secopar] \"[sct target]\""
+  } else {
+    set msg "change [sct secopar] [sct target]"
+  }
+  [sct controller] que [sct secopPath] write [list secop::queuedwrite $msg]
+}
+
+proc secop::queuedwrite {msg} {
+  sct changed [DoubleTime]
+  # send message on /secop node
+  sct sent_message $msg
+  sct send $msg
+  return secop::update_
+}
+
+proc secop::write {} {
+  # dummy write
+  # clientput "secop::write [sct] [hvali [sct]]"
+  return idle
+}
+
+proc secop::get {} {
+  error "secop::get is obsolete"
+  sct send ""
+  return secop::update_
+}
+
+proc secop::check_range {min max {absolute_resolution 0} {relative_resolution 0}} {
+  set prec [expr max($absolute_resolution, $relative_resolution * abs([sct target]))]
+clientput "*** $prec [sct target] $max"
+  if {[sct target] < $min} {
+    if {[sct target] >= $min - $prec} {
+      sct target $min
+      return
+    }
+  } elseif {[sct target] > $max} {
+    if {[sct target] <= $max + $prec} {
+      sct target $max
+      return
+    }
+  } else {
+    return
+  }
+  error "[sct] value must be within \[$min, $max\]"
+}
+
+proc secop::check_length {min max} {
+  set len [string length [sct target]]
+  if {$len < $min || $len > $max} {
+      error "[sct] string length must be within \[$min, $max\]"
+  }
+}
+
+proc secop::check_bool {} {
+  switch -- [string tolower [sct target]] {
+    off - false - no - 0 - on - true - yes - 1 {
+      return
+    }
+  }
+  error "illegal value for boolean: [sct target]"
+}
+
+proc secop::check_length {{low None} {high None}} {
+  if {$low ne "None" && [string length [sct target]] < $low} {
+    error "value [sct target] must not be shorter than $low"
+  }
+  if {$high ne "None" && [string length [sct target]] > $high} {
+    error "value [sct target] must not be longer than $high"
+  }
+}
+
+proc secop::make_par {secopar desc {kind ""}} {
+  set path [topath $secopar [silent "" dict get $desc group]]
+  array set props $desc
+  lassign [silent "" set props(datatype)] secoptype0 datadesc
+  if {$secoptype0 eq "tuple" && [string match *:status $secopar]} {
+    set members [dict get $datadesc members]
+    # lassign $validator_args members
+    set text_path [regsub {status_code$} $path status_text]
+    make_par0 text $text_path $secopar $desc
+    hsetprop $text_path width 24
+    lassign [lindex $members 0] secoptype datadesc
+    set status_node 1
+  } else {
+    set secoptype $secoptype0
+    set status_node 0
+  }
+  switch -- $secoptype {
+    double {set type float}
+    int - enum {set type int}
+    string {
+      set type text
+      # can not use SICS drivable for string
+      set kind ""
+    }
+    bool {set type text}
+    none {set type none}
+    default {
+      clientput "unknown type for $secopar (use text): $secoptype ($props(datatype))"
+      set type text
+    }
+  }
+  make_par0 $type $path $secopar $desc $kind
+  hsetprop $path secoptype $secoptype0
+  if {$status_node} {
+    hsetprop $path nonewline 1
+  }
+  lassign [split $path /] nul obj par
+  set fmtunit ""
+  if {[lsearch [list enum int double] $secoptype0] >= 0} {
+    set fmtunit ""
+    if {[catch {set unit [dict get $datadesc unit]}]} {
+      set unit 1
+    } else {
+      set fmtunit [format { [%s]} $unit]
+    }
+    if {$par eq "" || $par eq "target"} {
+      if {[sct shownUnits] eq "ALL" || [lsearch [sct shownUnits] $unit] >= 0} {
+        GraphAdd $path $unit
+      }
+    }
+  }
+  if {[info exists props(description)]} {
+    hsetprop $path help "$props(description)$fmtunit"
+    unset props(description)
+  }
+  switch -- $secoptype {
+    enum {
+      set enumprop [list]
+      set wid 8
+      set sorted [list]
+      set members [dict get $datadesc members]
+
+      foreach {name value} $members {
+         lappend sorted [list $value $name]
+      }
+      foreach value_name [lsort -integer -index 0 $sorted] {
+        lassign $value_name value name
+        lappend enumprop "$name=$value"
+        set wid [expr max($wid,[string length $name])]
+      }
+      hsetprop $path enum [join $enumprop ,]
+      if {[silent "" hgetpropval $path type] eq "drivable"} {
+        hsetprop $path visible false
+      }
+      if {$wid > 8} {
+        hsetprop $path width $wid
+      }
+    }
+    bool {
+      hsetprop $path enum 1
+      hsetprop $path validator secop::check_bool
+    }
+    double {
+      set min [silent -inf dict get $datadesc min]
+      set max [silent  inf dict get $datadesc max]
+      set absolute_resolution [silent 0 dict get $datadesc absolute_resolution]
+      set relative_resolution [silent 1.2e-7 dict get $datadesc relative_resolution]
+      hsetprop $path validator [concat secop::check_range $min $max $absolute_resolution $relative_resolution]
+    }
+    int {
+      set min [silent -inf dict get $datadesc min]
+      set max [silent  inf dict get $datadesc max]
+      hsetprop $path validator [concat secop::check_range $min $max]
+    }
+    string {
+      set min [silent -inf dict get $datadesc min]
+      set max [silent  inf dict get $datadesc max]
+      hsetprop $path width 16
+      hsetprop $path validator [concat secop::check_length $min $max]
+    }
+  }
+  return $path
+}
+
+proc secop::make_par0 {type path secopar desc {kind std}} {
+  array set props $desc
+  # clientput "$path $desc"
+  set readonly [silent 0 set props(readonly)]
+  if {$readonly} {
+    set priv internal
+  } else {
+    set priv user
+  }
+  if {[silent "" hinfo $path] ne ""} {
+    error "$path exists already!"
+  }
+  lassign [split $path /] nul obj par
+  if {$par eq ""} {
+    if {$kind eq "driv"} {
+      dynsctdriveobj $obj float user SECoP [sct controller]
+      hfactory $path link $obj
+      hsetprop $obj checklimits secop::checklimits
+      # hsetprop $obj checkstatus secop::checkstatus
+      hsetprop $obj halt secop::halt
+      # allow start without run:
+      hsetprop $obj check secop::checklimits
+      hsetprop $obj write secop::complete_run
+      set readonly 0
+      hsetprop $obj sicscommand "run $obj"
+    } else {
+      # clientput "OBJ $obj $type"
+      dynsicsobj $obj SECoP $priv $type
+      hfactory $path link $obj
+    }
+    hsetprop $path group $obj
+    hsetprop $path s_group $obj
+    hsetprop $path objectPath $path
+    hsetprop /sics/[sct controller] p_$secopar:value $path
+  } else {
+    if {$par eq "status"} {
+      set path /$obj/status_code
+    }
+    # clientput "PAR $path $type [array get props]"
+    hfactory $path plain $priv $type
+    if {[info exists props(visibility)]} {
+      if {$props(visibility) >= 3} {
+        hsetprop $path visible false      
+      }
+    }
+  }
+  hsetprop $path secopar $secopar
+  hsetprop /sics/[sct controller] p_$secopar $path
+  if {!$readonly} {
+    [sct controller] write $path
+  } else {
+    [sct controller] connect $path
+  }
+  logsetup $path 1
+  if {[info exists props(value)]} {
+    clientput "VALUE in descr $path"
+    if {[catch {hupdate /$path $props(value)} msg]} {
+      clientput $msg
+    }
+    unset props(value)
+  }
+  foreach {prop item} [array get props] {
+    hsetprop $path s_$prop $item
+  }
+}
+
+proc secop::make_cmd {secopar desc {first 0}} {
+  array set props $desc
+  set path [topath $secopar [silent "" dict get $desc group]]
+  set cmd [join [lassign [split $path /] _ obj] /]
+  set datadesc [lindex $props(datatype) 1]
+  set argument None
+  catch {
+    set argument [dict get $datadesc argument]
+  }
+  if {$argument eq "None"} {
+    $obj makescriptfunc $cmd "secop::check_cmd [sct secopPath] $secopar" user
+    hsetprop $path newline $first
+    hsetprop $path secopar $secopar
+    hsetprop $path sicscommand "$obj $cmd"
+    if {[info exists props(visibility)]} {
+      if {$props(visibility) >= 3} {
+        hsetprop $path visible false      
+      }
+    }
+  } else {
+    dict set desc datatype $argument
+    make_par $secopar $desc
+    lassign $argument maintype datadesc
+    if {$maintype eq "double" || $maintype eq "int" || $maintype eq "bool"} {
+      hsetprop $path check "secop::check_cmd_num [sct secopPath] $secopar"
+    } else {
+      hsetprop $path check "secop::check_cmd_text [sct secopPath] $secopar"
+    }
+  }
+}
+
+proc secop::check_cmd {secopPath secopar} {
+  hset $secopPath "do $secopar"
+}
+
+proc secop::check_cmd_num {secopPath secopar} {
+  hset $secopPath [format {do %s %.15g} $secopar [sct target]]
+  sct update [sct target]
+}
+
+proc secop::check_cmd_text {secopPath secopar} {
+  hset $secopPath [format {do %s "%s"} $secopar [sct target]]
+  sct update [sct target]
+}
+
+proc secop::make_module {obj desc} {
+  clientput "MAKE_MODULE $obj"
+  if {[obj_list exists $obj]} {
+    clientput "$obj exists already"
+    return
+  }
+  obj_list makeitem $obj /$obj
+
+  array unset modprop
+  set parlist [list]
+  set pardict [dict create]
+  foreach {key item} $desc {
+    switch $key {
+      accessibles {
+        foreach acsitm $item {
+          lassign $acsitm parname pardesc
+          dict set pardict $parname $pardesc
+        }
+      }
+      default {
+        set modprop($key) $item
+      }
+    }
+  }
+  if {[dict exists $pardict value]} {
+    set value [dict get $pardict value]
+    dict unset pardict value
+  } else {
+    set value [dict create datatype none]
+  }
+  set classes [silent "" set modprop(interface_class)]
+  if {[string match "* Drivable *" " $classes "]} {
+    set path [make_par $obj $value driv]
+  } else {
+    set path [make_par $obj $value]
+  }
+  if {[info exists modprop(visibility)] && $modprop(visibility) >= 3} {
+    hdelprop $path group
+  }
+  foreach {prop val} [array get modprop] {
+    hsetprop $obj sm_$prop $val
+  }
+  device_layout makeitem /$obj [silent 0 set modprop(layoutpos)]
+
+  set groups [dict create]
+  foreach {parname pardesc} $pardict {
+    if {[dict exists $pardesc group]} {
+      dict set groups [dict get $pardesc group] 1
+    } 
+  }
+  foreach g [dict keys $groups] {
+    clientput "GROUP $g"
+    hfactory $obj/$g plain user none
+    hsetprop $obj/$g group "group $g"
+  }
+  set shortcmds [list]
+  foreach {parname pardesc} $pardict {
+    set datatype [dict get $pardesc datatype]
+    lassign $datatype secoptype datadesc
+    if {$secoptype eq "command"} {
+      if {[catch {set argument [dict get $datadesc argument]}]} {
+        set argument None
+      }
+      if {$argument ne "None"} {
+        # only commands with arguments
+        make_cmd $obj:$parname $pardesc 1
+      } else {
+        lappend shortcmds $parname $pardesc
+      }
+    } else {
+      make_par $obj:$parname $pardesc
+    }
+  }
+  # then commands without arguments, on one line
+  set first 1
+  foreach {parname pardesc} $shortcmds {
+    make_cmd $obj:$parname $pardesc $first
+    set first 0
+  }
+}
+
+proc secop::make_node {desc} {
+  array unset nodeprop
+  set modlist [list]
+  foreach {key item} $desc {
+    switch $key {
+      modules {
+        set modlist $item
+      }
+      default {
+        set nodeprop($key) $item
+      }
+    }
+  }
+  foreach moditem $modlist {
+    lassign $moditem modname moddesc
+    make_module $modname $moddesc
+  }
+  foreach {prop val} [array get nodeprop] {
+    sct sn_$prop $val
+  }
+  sort_layout
+}
+
+proc secop::topath {secopar {pargroup ""}} {
+  lassign [split [string tolower $secopar] :] module parameter
+  if {$parameter eq "value" || $parameter eq ""} {
+    return "/$module"
+  }
+  if {$parameter eq "status"} {
+    set parameter status_code
+  }
+  if {[string match {_*} $parameter]} {
+    set parameter [string range $parameter 1 end]
+  }
+  if {$pargroup ne ""} {
+    return "/$module/$pargroup/$parameter"
+  }
+  return "/$module/$parameter"
+}
+
+proc secop::update_ {{wait_for {}}} {
+  if {$wait_for eq ""} {
+    set return_script idle
+  } else {
+    set return_script "secop::update_ $wait_for"
+  }
+  if {[silent "" sct result] eq ""} {
+    return idle
+  }
+  set sent_message [silent "" sct sent_message]
+  set message_to_client ""
+    
+  lassign "[sct result]" messagetype par val
+  set path [silent "" hgetpropval /sics/[sct controller] p_$par]
+  lassign [split $par :] obj
+  switch $messagetype {
+    update - changed {
+      # clientput "*** [DoubleTime]: [sct result]"
+      #if {[sct] ne "/secop"} {
+      #  clientput "[sct] is not /secop, why?"
+      #}
+      #if {![sct active]} {
+      #  clientput [sct result]
+      #}
+      if {$messagetype eq "changed"} {
+        if {[string match *:target $par]} {
+          hsetprop /$obj writestatus done
+        }
+        hsetprop $path changed 0
+        if {[lrange $sent_message 0 1] eq [list change $par]} {
+          set message_to_client [sct result]
+        }
+        # clientput "CH $path [sct result]"
+      } else {
+        if {[DoubleTime] < [silent 0 hgetpropval $path changed] + 10} {
+          # ignore updates of variables during change
+          clientput "ignore [sct result]"
+          return idle
+        }
+        if {[lrange $sent_message 0 1] eq [list read $par]} {
+          set message_to_client [sct result]
+        }
+      }
+      lassign $val value qual
+      if {[silent 0 hgetpropval $path secoptype] eq "tuple" &&
+          [string match *:status $par]} {
+        if {[llength $value] > 2} {
+          set text_value [lrange $value 1 end]
+        } else {
+          set text_value [lindex $value 1]
+        }
+        set objpath [sct parent $path]
+        lassign $value value
+        if {$value != 0} {
+          hsetprop $objpath group [hgetpropval $objpath s_group]
+          set shown 1
+        } else {
+          catch {hdelprop $objpath group}
+          set shown 0
+        }
+        if {$value < 100 || $value >= 400} { # error
+          updateerror $objpath $text_value
+          catch {
+            logsetup $objpath/target clear
+          }
+          if {[silent 0 hgetpropval $objpath status] eq "run"} {
+            hsetprop $objpath status posfault
+          }
+        } else {
+          if {$value >= 300} { # busy
+            hsetprop $objpath status run
+          } else {
+            hsetprop $objpath status idle
+          }
+          logsetup $objpath 1
+        }
+        GraphItem shown $objpath $shown
+        if {[silent "" hgetpropval $objpath/target logger_name] ne ""} {
+          GraphItem shown $objpath/target $shown
+        }
+        set text_path [regsub {status_code$} $path status_text]
+        if {[catch {updateval $text_path $text_value}]} {
+          clientput "cannot update $text_path to $text_value"
+          clientput "MSG([sct result])"
+        }
+      }
+      if {[catch {updateval $path $value} msg]} {
+        if {$value eq "None"} {
+          hsetprop $path geterror None
+        } else {
+          clientput "cannot update $path to $value"
+          clientput $msg
+        }
+      } elseif {[string match *:target $par]} {
+        if {[string match 1* [silent 0 hval /$obj/status_code]]} {
+          hsetprop /$obj target $value
+        }
+      }
+      catch {
+        hsetprop $path timestamp [dict get $qual t]
+      }
+    }
+    pong {
+      if {[lindex $sent_message 0] eq "ping"} {
+        set message_to_client [sct result]
+      }
+    }
+    done {
+      if {[lrange $sent_message 0 2] eq [list do $par]} {
+        set message_to_client [sct result]
+      } else {
+        clientput "done $par $val"
+      }
+    }
+    active {
+      if {[lindex $sent_message 0] eq "activate"} {
+        set message_to_client [sct result]
+      } else {
+        clientput ACTIVE
+      }
+      sct active 1
+      sct end_fast 0
+    }
+    error {
+      lassign $val origin errortext
+      lassign $origin requesttype requestpar requestval
+      set path [silent "" hgetpropval /sics/[sct controller] p_$requestpar]
+      if {$requesttype eq "change" && $path ne ""} {
+        hsetprop $path changed 0
+      }
+      if {$origin eq $sent_message} {
+        set message_to_client [sct result]
+      } else {
+        clientput "ERROR: $path $errortext"
+      }
+    }
+    describing {
+      do_as_manager {
+        make_node $val
+      }
+      sct send activate
+      [sct controller] poll [sct] 0.001
+      return secop::update_
+    }
+    default {
+      if {[string match "*,*" $messagetype]} {
+        clientput IDN=[sct result]
+        sct send describe
+        sct active 0
+        return secop::update_
+      }
+      if {$sent_message ne ""} {
+        set message_to_client [sct result]
+      } else {
+        # show untreated message
+        clientput [sct result]
+      }
+    }
+  }
+  if {$message_to_client ne ""} {
+    clientput "[sct]:\n> $sent_message\n< $message_to_client"
+    sct sent_message ""
+    sct sent_time 1e20
+  } elseif {[DoubleTime] > [silent 1e20 sct sent_time] + 10} {
+    clientput "timeout waiting for response to $sent_message"
+    sct sent_message ""
+    sct sent_time 1e20
+  }
+  #if {[DoubleTime] < [sct end_fast]} {
+  #  return secop::get
+  #}
+  # [sct controller] queue [sct] read secop::get
+  return idle
+}
+
+proc secop::checklimits {} {
+  # for whatever strange reason checklimits is called twice
+  # in addition again as write script of the obj node
+  # do this only once
+  set ws [silent 0 sct writestatus]
+  if {$ws ne "checked" && $ws ne "start" ||
+      [sct target] != [silent "x" hgetpropval [sct]/target target]} {
+    hset [sct]/target [sct target]
+    sct writestatus checked
+    sct status run
+  }
+}
+
+proc secop::checkstatus {} {
+  # obsolete
+  set ws [silent 0 sct writestatus]
+  set status [hvali [sct]/status_code]
+  if {[string match 3* $status]} {
+    set result run
+  } elseif {[string match 4* $status]} {
+    set result posfault
+  } else {
+    if {$ws ne "done"} {
+      set result run
+    } else {
+      set result idle
+    }
+  }
+  sct status $result
+  return $result
+}
+
+proc secop::complete_run {} {
+  sct print "run [sct objectName] to [sct target]"
+  return idle
+}
+
+proc secop::halt {} {
+  [sct objectName] stop
+  sct writestatus done
+  sct status idle
+  # clientput HALT:[sct]
+  return idle
+}
+
+proc secop::start {} {
+  sct send *IDN?
+  return secop::update_
+}
+
+proc secop::describe {} {
+  sct send describe
+  return secop::describing
+}
+
+proc secop::describing {} {
+  #obsolete?
+  lassign [sct result] messagetype par val
+  switch $messagetype {
+    describing {
+      do_as_manager {
+        make_node $val
+      }
+    }
+    default {
+      clientput "ignore $messagetype $par ..."
+    }
+  }
+  sct send activate
+  sct end_fast [expr [DoubleTime] + 5]
+  return secop::update_
+}
+
+proc secop_send {args} {
+  hset /secop $args
+  hsetprop /secop sent_message $args
+  hsetprop /secop sent_time [DoubleTime]
+}
+
+publishLazy secop_send

tcl/drivers/secop_3.tcl

@@ -0,0 +1,754 @@
+# secop driver 3 (v1.0 RC2): modules/accesibles are JSON objects, datatype is 1-element JSON object
+
+namespace eval secop {} {
+}
+
+proc stdConfig::secop {{shownUnits ALL}} {
+  variable node
+  variable name
+  
+  controller secop3 timeout=60
+  prop commerror secop::errorscript_
+  prop connection_lost 0
+  prop check secop::check
+  prop write secop::write
+  prop startcmd *IDN?
+  prop end_fast 0
+  prop secopPath /$name
+  prop active 0
+  prop shownUnits $shownUnits
+  
+  set node $node/tasks
+  prop start secop::start
+
+  pollperiod 0.001 0.001
+  obj SECoP -text wr
+
+  prop read secop::readmsg_
+  prop test secop::test
+  prop check secop::checkmsg
+  prop write secop::writemsg
+  prop cmd ""
+
+  variable ctrl
+  variable path
+  hsetprop /sics/$ctrl ignore_no_response 1
+
+}
+
+proc secop::errorscript_ {} {
+  if {[string match {ASCERR: no response*} [sct result]]} {
+    sct send ping
+    return secop::update_
+  }
+  sct connection_lost 1
+  [sct controller] poll [sct] 1
+  error [sct result]
+}
+
+proc secop::checkmsg {} {
+#  variable MQ[sct]
+#  upvar 0 MQ[sct] mq
+#  if {![info exists mq]} {
+#    # create message queue
+#    set mq [list]
+#  }
+#  if {[llength $mq] > 0} {
+#    set next [lindex $mq 0]
+#    set mq [lrange $mq 1 end]
+#    lappend mq [sct target]
+#    sct target $next
+#  }
+  
+  return ""
+}
+
+proc secop::writemsg {} {
+  sct send [sct target]
+  return secop::update_
+}
+
+proc secop::readmsg_ {} {  # ending with _: invisible on debug
+  if {[sct connection_lost]} {
+    sct connection_lost 0
+    return [secop::start]
+  }
+  sct send ""
+  return secop::update_
+}
+
+proc secop::test {} {
+  clientput test
+  return idle
+}
+
+proc secop::check {} {
+  if {[silent "" sct secopar] eq ""} return
+  set validator [silent {} sct validator]
+  eval $validator
+  lassign [split [hinfo [sct]] ","] type
+  if {$type eq "text"} {
+    set msg "change [sct secopar] \"[sct target]\""
+  } else {
+    set msg "change [sct secopar] [sct target]"
+  }
+  [sct controller] que [sct secopPath] write [list secop::queuedwrite $msg]
+}
+
+proc secop::queuedwrite {msg} {
+  sct changed [DoubleTime]
+  # send message on /secop node
+  sct sent_message $msg
+  sct send $msg
+  return secop::update_
+}
+
+proc secop::write {} {
+  # dummy write
+  # clientput "secop::write [sct] [hvali [sct]]"
+  return idle
+}
+
+proc secop::get {} {
+  error "secop::get is obsolete"
+  sct send ""
+  return secop::update_
+}
+
+proc secop::check_range {min max {absolute_resolution 0} {relative_resolution 0}} {
+  set prec [expr max($absolute_resolution, $relative_resolution * abs([sct target]))]
+clientput "*** $prec [sct target] $max"
+  if {[sct target] < $min} {
+    if {[sct target] >= $min - $prec} {
+      sct target $min
+      return
+    }
+  } elseif {[sct target] > $max} {
+    if {[sct target] <= $max + $prec} {
+      sct target $max
+      return
+    }
+  } else {
+    return
+  }
+  error "[sct] value must be within \[$min, $max\]"
+}
+
+proc secop::check_length {min max} {
+  set len [string length [sct target]]
+  if {$len < $min || $len > $max} {
+      error "[sct] string length must be within \[$min, $max\]"
+  }
+}
+
+proc secop::check_bool {} {
+  switch -- [string tolower [sct target]] {
+    off - false - no - 0 - on - true - yes - 1 {
+      return
+    }
+  }
+  error "illegal value for boolean: [sct target]"
+}
+
+proc secop::check_length {{low None} {high None}} {
+  if {$low ne "None" && [string length [sct target]] < $low} {
+    error "value [sct target] must not be shorter than $low"
+  }
+  if {$high ne "None" && [string length [sct target]] > $high} {
+    error "value [sct target] must not be longer than $high"
+  }
+}
+
+proc secop::make_par {secopar desc {kind ""}} {
+  set path [topath $secopar [silent "" dict get $desc group]]
+  array set props $desc
+  lassign [silent "" set props(datatype)] secoptype0 datadesc
+  if {$secoptype0 eq "tuple" && [string match *:status $secopar]} {
+    set members [dict get $datadesc members]
+    # lassign $validator_args members
+    set text_path [regsub {status_code$} $path status_text]
+    make_par0 text $text_path $secopar $desc
+    hsetprop $text_path width 24
+    lassign [lindex $members 0] secoptype datadesc
+    set status_node 1
+  } else {
+    set secoptype $secoptype0
+    set status_node 0
+  }
+  switch -- $secoptype {
+    double {set type float}
+    int - enum {set type int}
+    string {
+      set type text
+      # can not use SICS drivable for string
+      set kind ""
+    }
+    bool {set type text}
+    none {set type none}
+    default {
+      clientput "unknown type for $secopar (use text): $secoptype ($props(datatype))"
+      set type text
+    }
+  }
+  make_par0 $type $path $secopar $desc $kind
+  hsetprop $path secoptype $secoptype0
+  if {$status_node} {
+    hsetprop $path nonewline 1
+  }
+  lassign [split $path /] nul obj par
+  set fmtunit ""
+  if {[lsearch [list enum int double] $secoptype0] >= 0} {
+    set fmtunit ""
+    if {[catch {set unit [dict get $datadesc unit]}]} {
+      set unit 1
+    } else {
+      set fmtunit [format { [%s]} $unit]
+    }
+    if {$par eq "" || $par eq "target"} {
+      if {[sct shownUnits] eq "ALL" || [lsearch [sct shownUnits] $unit] >= 0} {
+        GraphAdd $path $unit
+      }
+    }
+  }
+  if {[info exists props(description)]} {
+    hsetprop $path help "$props(description)$fmtunit"
+    unset props(description)
+  }
+  switch -- $secoptype {
+    enum {
+      set enumprop [list]
+      set wid 8
+      set sorted [list]
+      set members [dict get $datadesc members]
+
+      foreach {name value} $members {
+         lappend sorted [list $value $name]
+      }
+      foreach value_name [lsort -integer -index 0 $sorted] {
+        lassign $value_name value name
+        lappend enumprop "$name=$value"
+        set wid [expr max($wid,[string length $name])]
+      }
+      hsetprop $path enum [join $enumprop ,]
+      if {[silent "" hgetpropval $path type] eq "drivable"} {
+        hsetprop $path visible false
+      }
+      if {$wid > 8} {
+        hsetprop $path width $wid
+      }
+    }
+    bool {
+      hsetprop $path enum 1
+      hsetprop $path validator secop::check_bool
+    }
+    double {
+      set min [silent -inf dict get $datadesc min]
+      set max [silent  inf dict get $datadesc max]
+      set absolute_resolution [silent 0 dict get $datadesc absolute_resolution]
+      set relative_resolution [silent 1.2e-7 dict get $datadesc relative_resolution]
+      hsetprop $path validator [concat secop::check_range $min $max $absolute_resolution $relative_resolution]
+    }
+    int {
+      set min [silent -inf dict get $datadesc min]
+      set max [silent  inf dict get $datadesc max]
+      hsetprop $path validator [concat secop::check_range $min $max]
+    }
+    string {
+      set min [silent -inf dict get $datadesc min]
+      set max [silent  inf dict get $datadesc max]
+      hsetprop $path width 16
+      hsetprop $path validator [concat secop::check_length $min $max]
+    }
+  }
+  return $path
+}
+
+proc secop::make_par0 {type path secopar desc {kind std}} {
+  array set props $desc
+  # clientput "$path $desc"
+  set readonly [silent 0 set props(readonly)]
+  if {$readonly} {
+    set priv internal
+  } else {
+    set priv user
+  }
+  if {[silent "" hinfo $path] ne ""} {
+    error "$path exists already!"
+  }
+  lassign [split $path /] nul obj par
+  if {$par eq ""} {
+    if {$kind eq "driv"} {
+      dynsctdriveobj $obj float user SECoP [sct controller]
+      hfactory $path link $obj
+      hsetprop $obj checklimits secop::checklimits
+      # hsetprop $obj checkstatus secop::checkstatus
+      hsetprop $obj halt secop::halt
+      # allow start without run:
+      hsetprop $obj check secop::checklimits
+      hsetprop $obj write secop::complete_run
+      set readonly 0
+      hsetprop $obj sicscommand "run $obj"
+    } else {
+      # clientput "OBJ $obj $type"
+      dynsicsobj $obj SECoP $priv $type
+      hfactory $path link $obj
+    }
+    hsetprop $path group $obj
+    hsetprop $path s_group $obj
+    hsetprop $path objectPath $path
+    hsetprop /sics/[sct controller] p_$secopar:value $path
+  } else {
+    if {$par eq "status"} {
+      set path /$obj/status_code
+    }
+    # clientput "PAR $path $type [array get props]"
+    hfactory $path plain $priv $type
+    if {[info exists props(visibility)]} {
+      if {$props(visibility) >= 3} {
+        hsetprop $path visible false      
+      }
+    }
+  }
+  hsetprop $path secopar $secopar
+  hsetprop /sics/[sct controller] p_$secopar $path
+  if {!$readonly} {
+    [sct controller] write $path
+  } else {
+    [sct controller] connect $path
+  }
+  logsetup $path 1
+  if {[info exists props(value)]} {
+    clientput "VALUE in descr $path"
+    if {[catch {hupdate /$path $props(value)} msg]} {
+      clientput $msg
+    }
+    unset props(value)
+  }
+  foreach {prop item} [array get props] {
+    hsetprop $path s_$prop $item
+  }
+}
+
+proc secop::make_cmd {secopar desc {first 0}} {
+  array set props $desc
+  set path [topath $secopar [silent "" dict get $desc group]]
+  set cmd [join [lassign [split $path /] _ obj] /]
+  set datadesc [lindex $props(datatype) 1]
+  set argument None
+  catch {
+    set argument [dict get $datadesc argument]
+  }
+  if {$argument eq "None"} {
+    $obj makescriptfunc $cmd "secop::check_cmd [sct secopPath] $secopar" user
+    hsetprop $path newline $first
+    hsetprop $path secopar $secopar
+    hsetprop $path sicscommand "$obj $cmd"
+    if {[info exists props(visibility)]} {
+      if {$props(visibility) >= 3} {
+        hsetprop $path visible false      
+      }
+    }
+  } else {
+    dict set desc datatype $argument
+    make_par $secopar $desc
+    lassign $argument maintype datadesc
+    if {$maintype eq "double" || $maintype eq "int" || $maintype eq "bool"} {
+      hsetprop $path check "secop::check_cmd_num [sct secopPath] $secopar"
+    } else {
+      hsetprop $path check "secop::check_cmd_text [sct secopPath] $secopar"
+    }
+  }
+}
+
+proc secop::check_cmd {secopPath secopar} {
+  hset $secopPath "do $secopar"
+}
+
+proc secop::check_cmd_num {secopPath secopar} {
+  hset $secopPath [format {do %s %.15g} $secopar [sct target]]
+  sct update [sct target]
+}
+
+proc secop::check_cmd_text {secopPath secopar} {
+  hset $secopPath [format {do %s "%s"} $secopar [sct target]]
+  sct update [sct target]
+}
+
+proc secop::make_module {obj desc} {
+  clientput "MAKE_MODULE $obj"
+  if {[obj_list exists $obj]} {
+    clientput "$obj exists already"
+    return
+  }
+  obj_list makeitem $obj /$obj
+
+  array unset modprop
+  set parlist [list]
+  set pardict [dict create]
+  foreach {key item} $desc {
+    switch $key {
+      accessibles {
+#        foreach acsitm $item {
+#          lassign $acsitm parname pardesc
+#          dict set pardict $parname $pardesc
+#        }
+        foreach {parname pardesc} $item {
+          dict set pardict $parname $pardesc
+        }
+      }
+      default {
+        set modprop($key) $item
+      }
+    }
+  }
+  if {[dict exists $pardict value]} {
+    set value [dict get $pardict value]
+    dict unset pardict value
+  } else {
+    set value [dict create datatype none]
+  }
+  set classes [silent "" set modprop(interface_class)]
+  if {[string match "* Drivable *" " $classes "]} {
+    set path [make_par $obj $value driv]
+  } else {
+    set path [make_par $obj $value]
+  }
+  if {[info exists modprop(visibility)] && $modprop(visibility) >= 3} {
+    hdelprop $path group
+  }
+  foreach {prop val} [array get modprop] {
+    hsetprop $obj sm_$prop $val
+  }
+  device_layout makeitem /$obj [silent 0 set modprop(layoutpos)]
+
+  set groups [dict create]
+  foreach {parname pardesc} $pardict {
+    if {[dict exists $pardesc group]} {
+      dict set groups [dict get $pardesc group] 1
+    } 
+  }
+  foreach g [dict keys $groups] {
+    clientput "GROUP $g"
+    hfactory $obj/$g plain user none
+    hsetprop $obj/$g group "group $g"
+  }
+  set shortcmds [list]
+  foreach {parname pardesc} $pardict {
+    set datatype [dict get $pardesc datatype]
+    lassign $datatype secoptype datadesc
+    if {$secoptype eq "command"} {
+      if {[catch {set argument [dict get $datadesc argument]}]} {
+        set argument None
+      }
+      if {$argument ne "None"} {
+        # only commands with arguments
+        make_cmd $obj:$parname $pardesc 1
+      } else {
+        lappend shortcmds $parname $pardesc
+      }
+    } else {
+      make_par $obj:$parname $pardesc
+    }
+  }
+  # then commands without arguments, on one line
+  set first 1
+  foreach {parname pardesc} $shortcmds {
+    make_cmd $obj:$parname $pardesc $first
+    set first 0
+  }
+}
+
+proc secop::make_node {desc} {
+  array unset nodeprop
+  set modlist [list]
+  foreach {key item} $desc {
+    switch $key {
+      modules {
+        set modlist $item
+      }
+      default {
+        set nodeprop($key) $item
+      }
+    }
+  }
+  foreach {modname moddesc} $modlist {
+    make_module $modname $moddesc
+  }
+  foreach {prop val} [array get nodeprop] {
+    sct sn_$prop $val
+  }
+  sort_layout
+}
+
+proc secop::topath {secopar {pargroup ""}} {
+  lassign [split [string tolower $secopar] :] module parameter
+  if {$parameter eq "value" || $parameter eq ""} {
+    return "/$module"
+  }
+  if {$parameter eq "status"} {
+    set parameter status_code
+  }
+  if {[string match {_*} $parameter]} {
+    set parameter [string range $parameter 1 end]
+  }
+  if {$pargroup ne ""} {
+    return "/$module/$pargroup/$parameter"
+  }
+  return "/$module/$parameter"
+}
+
+proc secop::update_ {{wait_for {}}} {
+  if {$wait_for eq ""} {
+    set return_script idle
+  } else {
+    set return_script "secop::update_ $wait_for"
+  }
+  if {[silent "" sct result] eq ""} {
+    return idle
+  }
+  set sent_message [silent "" sct sent_message]
+  set message_to_client ""
+    
+  lassign "[sct result]" messagetype par val
+  set path [silent "" hgetpropval /sics/[sct controller] p_$par]
+  lassign [split $par :] obj
+  switch $messagetype {
+    update - changed {
+      # clientput "*** [DoubleTime]: [sct result]"
+      #if {[sct] ne "/secop"} {
+      #  clientput "[sct] is not /secop, why?"
+      #}
+      #if {![sct active]} {
+      #  clientput [sct result]
+      #}
+      if {$messagetype eq "changed"} {
+        if {[string match *:target $par]} {
+          hsetprop /$obj writestatus done
+        }
+        hsetprop $path changed 0
+        if {[lrange $sent_message 0 1] eq [list change $par]} {
+          set message_to_client [sct result]
+        }
+        # clientput "CH $path [sct result]"
+      } else {
+        if {[DoubleTime] < [silent 0 hgetpropval $path changed] + 10} {
+          # ignore updates of variables during change
+          clientput "ignore [sct result]"
+          return idle
+        }
+        if {[lrange $sent_message 0 1] eq [list read $par]} {
+          set message_to_client [sct result]
+        }
+      }
+      lassign $val value qual
+      if {[silent 0 hgetpropval $path secoptype] eq "tuple" &&
+          [string match *:status $par]} {
+        if {[llength $value] > 2} {
+          set text_value [lrange $value 1 end]
+        } else {
+          set text_value [lindex $value 1]
+        }
+        set objpath [sct parent $path]
+        lassign $value value
+        if {$value != 0} {
+          hsetprop $objpath group [hgetpropval $objpath s_group]
+          set shown 1
+        } else {
+          catch {hdelprop $objpath group}
+          set shown 0
+        }
+        if {$value < 100 || $value >= 400} { # error
+          updateerror $objpath $text_value
+          catch {
+            logsetup $objpath/target clear
+          }
+          if {[silent 0 hgetpropval $objpath status] eq "run"} {
+            hsetprop $objpath status posfault
+          }
+        } else {
+          if {$value >= 300} { # busy
+            hsetprop $objpath status run
+          } else {
+            hsetprop $objpath status idle
+          }
+          logsetup $objpath 1
+        }
+        GraphItem shown $objpath $shown
+        if {[silent "" hgetpropval $objpath/target logger_name] ne ""} {
+          GraphItem shown $objpath/target $shown
+        }
+        set text_path [regsub {status_code$} $path status_text]
+        if {[catch {updateval $text_path $text_value}]} {
+          clientput "cannot update $text_path to $text_value"
+          clientput "MSG([sct result])"
+        }
+      }
+      if {[catch {updateval $path $value} msg]} {
+        if {$value eq "None"} {
+          hsetprop $path geterror None
+        } else {
+          clientput "cannot update $path to $value"
+          clientput $msg
+        }
+      } elseif {[string match *:target $par]} {
+        if {[string match 1* [silent 0 hval /$obj/status_code]]} {
+          hsetprop /$obj target $value
+        }
+      }
+      catch {
+        hsetprop $path timestamp [dict get $qual t]
+      }
+    }
+    pong {
+      if {[lindex $sent_message 0] eq "ping"} {
+        set message_to_client [sct result]
+      }
+    }
+    done {
+      if {[lrange $sent_message 0 2] eq [list do $par]} {
+        set message_to_client [sct result]
+      } else {
+        clientput "done $par $val"
+      }
+    }
+    active {
+      if {[lindex $sent_message 0] eq "activate"} {
+        set message_to_client [sct result]
+      } else {
+        clientput ACTIVE
+      }
+      sct active 1
+      sct end_fast 0
+    }
+    error {
+      lassign $val origin errortext
+      lassign $origin requesttype requestpar requestval
+      set path [silent "" hgetpropval /sics/[sct controller] p_$requestpar]
+      if {$requesttype eq "change" && $path ne ""} {
+        hsetprop $path changed 0
+      }
+      if {$origin eq $sent_message} {
+        set message_to_client [sct result]
+      } else {
+        clientput "ERROR: $path $errortext"
+      }
+    }
+    describing {
+      do_as_manager {
+        make_node $val
+      }
+      sct send activate
+      [sct controller] poll [sct] 0.001
+      return secop::update_
+    }
+    default {
+      if {[string match "*,*" $messagetype]} {
+        clientput IDN=[sct result]
+        sct send describe
+        sct active 0
+        return secop::update_
+      }
+      if {$sent_message ne ""} {
+        set message_to_client [sct result]
+      } else {
+        # show untreated message
+        clientput [sct result]
+      }
+    }
+  }
+  if {$message_to_client ne ""} {
+    clientput "[sct]:\n> $sent_message\n< $message_to_client"
+    sct sent_message ""
+    sct sent_time 1e20
+  } elseif {[DoubleTime] > [silent 1e20 sct sent_time] + 10} {
+    clientput "timeout waiting for response to $sent_message"
+    sct sent_message ""
+    sct sent_time 1e20
+  }
+  #if {[DoubleTime] < [sct end_fast]} {
+  #  return secop::get
+  #}
+  # [sct controller] queue [sct] read secop::get
+  return idle
+}
+
+proc secop::checklimits {} {
+  # for whatever strange reason checklimits is called twice
+  # in addition again as write script of the obj node
+  # do this only once
+  set ws [silent 0 sct writestatus]
+  if {$ws ne "checked" && $ws ne "start" ||
+      [sct target] != [silent "x" hgetpropval [sct]/target target]} {
+    hset [sct]/target [sct target]
+    sct writestatus checked
+    sct status run
+  }
+}
+
+proc secop::checkstatus {} {
+  # obsolete
+  set ws [silent 0 sct writestatus]
+  set status [hvali [sct]/status_code]
+  if {[string match 3* $status]} {
+    set result run
+  } elseif {[string match 4* $status]} {
+    set result posfault
+  } else {
+    if {$ws ne "done"} {
+      set result run
+    } else {
+      set result idle
+    }
+  }
+  sct status $result
+  return $result
+}
+
+proc secop::complete_run {} {
+  sct print "run [sct objectName] to [sct target]"
+  return idle
+}
+
+proc secop::halt {} {
+  [sct objectName] stop
+  sct writestatus done
+  sct status idle
+  # clientput HALT:[sct]
+  return idle
+}
+
+proc secop::start {} {
+  sct send *IDN?
+  return secop::update_
+}
+
+proc secop::describe {} {
+  sct send describe
+  return secop::describing
+}
+
+proc secop::describing {} {
+  #obsolete?
+  lassign [sct result] messagetype par val
+  switch $messagetype {
+    describing {
+      do_as_manager {
+        make_node $val
+      }
+    }
+    default {
+      clientput "ignore $messagetype $par ..."
+    }
+  }
+  sct send activate
+  sct end_fast [expr [DoubleTime] + 5]
+  return secop::update_
+}
+
+proc secop_send {args} {
+  hset /secop $args
+  hsetprop /secop sent_message $args
+  hsetprop /secop sent_time [DoubleTime]
+}
+
+publishLazy secop_send

tcl/drivers/sg382.tcl

@@ -0,0 +1,60 @@
+namespace eval sg382 {} {
+}
+
+proc stdConfig::sg382 {} {
+  controller std "\r" 5
+  prop startcmd "*IDN?"
+  
+  pollperiod 5 5
+
+  obj "SG382" wr
+  prop read sg382::read
+  prop write sg382::write
+  
+  kids "frequency generator" {
+    node base par 0
+    prop width 12
+    prop fmt %.8g
+
+    node target -text out
+    prop write sg382::writetext
+    prop width 16
+  }
+
+  return "SG382 frequency generator"
+}
+
+proc sg382::read {} {
+  sct send "FREQ?"
+  return sg382::update
+}
+
+proc sg382::update {} {
+  set value [sct result]
+  hupdate [sct]/target $value
+  set base [hval [sct]/base]
+  if {abs($base - $value) > 1e6} {
+    set base [expr 1e5 * int($value / 1e5)]
+    hupdate [sct]/base $base
+  }
+  sct update [expr $value - $base]
+  return idle
+}
+
+proc sg382::write {} {
+  set base [hval [sct]/base]
+  set value [expr [sct target] + $base]
+  if {abs($base - $value) > 1e6} {
+    set base [expr 1e5 * int($value / 1e5)]
+    hupdate [sct]/base $base
+  }
+  sct send "FREQ $value;FREQ?"
+  sct update [expr $value - $base]
+  return sg382::update
+}
+
+proc sg382::writetext {} {
+  sct send "FREQ [sct target];FREQ?"
+  [sct controller] queue [sct parent] read read
+  return stdSct::completeUpdate
+}

tcl/drivers/smc.tcl

@@ -0,0 +1,410 @@
+namespace eval smc {
+}
+
+source drivers/magfield.tcl
+
+proc stdConfig::smc {} {
+
+# GPIB through Prologix controller
+  controller lsc timeout=5 writedelay=0.2
+  prop write smc::write
+  prop read smc::read
+
+  variable node
+  set node $node/tasks
+  prop start smc::start
+
+  pollperiod 2 2
+
+  variable name
+  magfield_obj SMC_MAGFIELD "smc::cmd /$name/smc"
+
+  kids "SMC magnet power supply" {
+
+    magfield_kids
+
+    node smc rd
+    prop read smc::read_gn
+    prop label persistent field
+
+    kids "SMC settings" {
+
+      node ramp_slow out
+      prop write smc::set_ramp_rate ramp_slow
+      default 0.04
+      prop help "ramp rate for coils Tesla/min."
+
+      node ramp_fast out
+      prop write smc::set_ramp_rate ramp_fast
+      default 100
+      prop help "ramp rate for leads Tesla/min."
+
+# use MID as set_field
+      node set_field out
+      prop cmd L
+      prop get S
+      prop check smc::check_mid
+
+      node at_target upd -int
+      prop enum 1
+
+      node heater wr -int
+      prop write smc::set_ramp_rate heater
+      prop enum 1
+      prop cmd H
+      prop get J
+      prop "persistent switch heater"
+
+      node ramp_state out -int
+      prop check smc::chk_ramp_state
+      prop write stdSct::complete
+      prop enum hold,goto_zero,goto_set
+
+      node leads_set upd
+      prop help "calculated current in the leads, converted to Tesla"
+
+      node leads_meas upd
+      prop help {measured current in the leads, converted to Tesla}
+
+      node show_internals -int par 1
+      prop enum 1
+      prop newline 1
+      prop show_more 1
+
+      node ramp_amp_sec wr
+      prop cmd A
+      prop get O
+
+      node pause out -int
+      prop enum 1
+      prop cmd P
+      prop get K
+
+      node ramp_target wr -int
+      prop enum go2zero,go2mid,go2max
+      prop cmd R
+      prop get K
+
+# MAX is always kept as least as high as set_field
+      node max wr
+      prop cmd U
+      prop get S
+
+      node units wr -int
+      prop enum amps,tesla
+      prop cmd T
+      prop get S
+      default 1
+
+      node calib out
+      prop cmd C
+      prop get O
+
+      node heater_voltage out
+      prop cmd W
+      prop get O
+
+      node volt_limit out
+      prop cmd Y
+      prop get S
+
+      node xtrip out -int
+      prop cmd X
+      prop get K
+
+      node volt upd
+
+      node error_code upd -int
+
+      node quench_field upd
+
+      node v_at_lim upd -int
+    }
+  }
+}
+
+proc smc::cmd {node args} {
+  set cmd [linsert $args 0 node_cmd $node]
+  if {[llength $args] < 2} {
+    return [eval $cmd]
+  }
+  lassign $args var val
+  set old [eval [list node_cmd $node $var]]
+  set scache [silent $old hgetpropval $node/$var cached_set]
+  if {[silent 0 hgetpropval $node/$var cache_state] == 2} {
+    set rcache [hgetpropval $node/$var cached_readback]
+    if {$rcache != $old || abs($scache - $rcache) > 0.1 * $scache} {
+      clientput "$node/$var: $old != $rcache || $scache far $rcache"
+      set scache $old
+    }
+  } else {
+    set scache $old
+  }
+  if {$val != $scache} {
+#    clientput "$node: set $var to $val"
+    hsetprop $node/$var cached_set $val
+    return [eval [list node_cmd $node $var $val]]
+  }
+  return $old
+}
+
+proc smc::start {} {
+  sct send  "++addr"
+  return smc::start1
+}
+
+proc smc::start1 {} {
+  sct send  "O\n++read"
+  sct cnt 0
+  return smc::start2
+}
+
+proc smc::start2 {} {
+  set id 0
+  regexp {A.{19}(C.*)} [sct result] -> id
+  if {$id eq "0"} {
+    sct cnt [expr [sct cnt] + 1]
+    if {[sct cnt] < 5} {
+      sct send  "O\n++read"
+      return smc::start2
+    }
+    error "[sct] bad response from SMC: [sct result]"
+  }
+  sct send  "T1\n++ver"
+  return "smc::start3 $id"
+}
+
+proc smc::start3 {id} {
+  clientput [sct result]
+  sct result $id
+  return [stdSct::completeStart]
+}
+
+proc smc::write {} {
+  update_field
+  sct send "[sct cmd][sct target]\n++auto"
+  sct update [sct target]
+  update_field
+  sct cache_state 1
+  return "smc::read 1"
+}
+
+proc smc::complete {} {
+  sct cache_state 1
+clientput "complete [sct]"
+  return idle
+}
+
+proc smc::check_mid {} {
+  if {[sct target] > [hvali [sct parent]/max]} {
+    hset [sct parent]/max [sct target]
+  }
+}
+
+proc smc::read {{from_write 0}} {
+  sct send "[sct get]\n++auto"
+  sct from_write $from_write
+  return smc::update0
+}
+
+proc smc::update0 {} {
+  sct send "++read eoi"
+  return smc::update
+}
+
+proc smc::read_gn {} {
+  if {[hvali [sct]/units] == 0} {
+    sct get G
+  } else {
+    sct get N
+  }
+  return [smc::read]
+}
+
+proc smc::eat_rubbish {} {
+  sct send "++read"
+  return stdSct::complete
+}
+
+proc smc::update_field {} {
+  set op [sct objectPath]
+  magfield::simleads [hgetpropval $op script] pf ls
+  hupdate $op/smc/leads_set $ls
+  if {[hval $op/smc/heater]} {
+    hupdate $op/smc $ls
+  }
+}
+
+proc smc::updateit {node val} {
+  updateval $node $val
+  switch [silent 0 hgetpropval $node cache_state] {
+    1 {
+      set t [hgetpropval $node target]
+      if {$t != $val} {
+        clientput "$node set to $val (target [hgetpropval $node target])"
+      } else {
+        clientput "$node set to $val"
+      }
+      hsetprop $node cached_readback $val
+      hsetprop $node cache_state 2
+      return
+    }
+    2 {
+      if {[hgetpropval $node cached_readback] != $val} {
+        hsetprop $node cache_state 0
+      }
+    }
+  }
+}
+
+proc smc::update {} {
+  set r [sct result]
+  set op [sct objectPath]/smc
+  if {[regexp {T(.)U(.{7})L(.{7})Y(.{4})} $r -> t u l y]} {
+    set tst S
+    updateit $op/units $t
+    updateit $op/max $u
+    updateit $op/set_field $l
+    updateit $op/volt_limit $y
+  } elseif {[regexp {(F|I)(.{8})H(.)} $r -> fi f h]} {
+    set tst J
+    set pf [hvali $op]
+    if {$h == 0} {
+      if {$pf != $f} {
+        clientput "persistent $f"
+      }
+      updateit $op $f
+    } elseif {[catch {hval $op}]} {
+      updateit $op $pf
+    }
+    updateit $op/heater $h
+  } elseif {[regexp {(F|I)(.{8})V(.{4})R(.)(A|V)} $r -> fi f v r av]} {
+    set tst (G|N)
+    updateit $op/leads_meas $f
+    updateit $op/volt $v
+    if {$av eq "A"} {
+      updateit $op/v_at_lim 0
+    } else {
+      updateit $op/v_at_lim 1
+    }
+  } elseif {[regexp {R(.)M(.)P(.)X(.)H(.)Z0.00E(..)Q(.{8})} $r -> r m p x h e q]} {
+    set tst K
+    updateit $op/ramp_target $r
+    updateit $op/pause $p
+    if {$p} {
+      updateit $op/ramp_state 0
+    } else {
+      updateit $op/at_target $m
+      incr r
+      if {$r > 2} {
+        set r 2
+      }
+      updateit $op/ramp_state $r
+    }
+    updateit $op/xtrip $x
+    updateit $op/error_code $e
+    updateit $op/quench_field $q
+  } elseif {[regexp {A(.{8})D.T(.)B0W(.{4})C(.{8})} $r -> a t w c]} {
+    set tst O
+    updateit $op/ramp_amp_sec $a
+    set af [format %.3g [expr $a * $c * 60]]
+    set rf [hvali $op/ramp_fast]
+    set rs [hvali $op/ramp_slow]
+    set h [hvali $op/heater]
+    set am [expr sqrt($rf * $rs)]
+    if {$af > $am && $rf > $rs && $h == 0} {
+      updateit $op/ramp_fast $af
+    }
+    if {$af < $am && $rf > $rs && $h == 1} {
+      updateit $op/ramp_slow $af
+    }
+    updateit $op/units $t
+    updateit $op/heater_voltage $w
+    updateit $op/calib $c
+  } else {
+    set tst [sct get]
+    clientlog "unknown response: [sct get] $r"
+  }
+  catch {update_field}
+  if {![regexp $tst [sct get]]} {
+    [sct controller] queue [sct] write smc::eat_rubbish
+  }
+  return idle
+}
+
+proc smc::ramp_lim {field} {
+  set oldf 0
+  set oldr 99999
+  set result 0
+  foreach {r f} [hval [sct objectPath]/profile] {
+    if {$r > $oldr} {
+      error "ERROR: in ramp profile, ramps must be decreasing"
+    }
+    if {$r == 0} {
+      error "ERROR: in ramp profile, ramps must be > 0"
+    }
+    set oldr $r
+    if {$f < $oldf} {
+      error "ERROR: in ramp profile, fields must be increasing"
+    }
+    set oldf $f
+    if {$result == 0 && $f >= $field} {
+      set result $r
+    }
+  }
+  if {$result == 0} {
+    error "ERROR: field too high"
+  }
+  return $result
+}
+
+proc smc::set_ramp_rate {target_name} {
+  foreach var {heater ramp_slow ramp_fast} {
+    if {$target_name eq $var} {
+      set $var [sct target]
+      sct update [sct target]
+    } else {
+      set $var [hval [sct parent]/$var]
+    }
+  }
+  if {$heater} {
+    set r $ramp_slow
+  } else {
+    set r $ramp_fast
+  }
+  set calib [hval [sct parent]/calib]
+  if {$calib == 0} {
+    set calib 1
+  }
+  set rr [expr $r / 60.0 / $calib]
+  set rr [format %.3g $rr]
+  hset [sct parent]/ramp_amp_sec $rr
+  if {$target_name eq "heater"} {
+    return smc::write
+  }
+  sct cache_state 1
+  return idle
+}
+
+proc smc::chk_ramp_state {} {
+  set pr [sct parent]
+  switch -- [sct target] {
+    0 {
+      clientput "set pause to 1"
+      clientput "hset $pr/pause 1"
+      clientput "pause set to 1"
+      hset $pr/pause 1
+    }
+    1 {
+      hset $pr/pause 0
+      hset $pr/ramp_target 0
+    }
+    2 {
+      hset $pr/pause 0
+      hset $pr/ramp_target 1
+    }
+    default {
+      error "illegal ramp_target: [sct target]"
+    }
+  }
+}

tcl/drivers/text.tcl

@@ -0,0 +1,10 @@
+namespace eval text {
+}
+
+proc stdConfig::text {} {
+  variable node
+  
+  controller syncedprot
+
+  obj text par -text ""
+}