initial commit

tcl/startup/gensct.tcl

@@ -0,0 +1,101 @@
+# -- send command
+
+#write action
+proc gen_start_send {} {
+  sct send [sct target]
+  return gen_complete_send
+}
+
+#write action, direct   
+proc gen_complete_send {} {
+  sct print "response = [sct result]" 
+  sct update "[sct target]"
+  return idle
+}  
+
+#config script
+proc gen_make_send {path controller} {
+  hfactory $path/send plain user text
+  $controller write $path/send
+  hsetprop $path/send write gen_start_send
+  hsetprop $path/send visible false
+}
+
+#general error script
+proc gen_error_script {} {
+  set s [split [sct result] :]
+  if {[string equal ASCERR [lindex $s 0]]} {
+    set s [lreplace $s 0 0]
+  }
+  set s [join $s :]
+  [sct controllerName] poll [sct tasksPath] 1 start start
+  error $s
+}
+
+#general controller setup
+proc gen_setup {objectName class access type args} {
+  upvar path path
+  upvar controllerName controllerName
+
+  Layout hdb
+
+  set controllerName _$objectName
+  
+  eval [concat makesctcontroller $controllerName $args]
+  set path /$objectName
+
+  if {[string equal drive $type]} {
+    hfactory $path plain $access float
+    dynsctdriveobj $objectName $path $class $controllerName
+  } else {
+    dynsicsobj $objectName $class $access $type
+    hfactory $path link $objectName
+  }
+
+  hsetprop $path creationCmd "${class}_Make $objectName [lindex $args 1]"
+
+  hfactory $path/controller link $controllerName
+  set cnode $path/controller
+
+  hfactory $path/tasks plain user none
+  hsetprop $path/tasks visible false
+  hsetprop $path/tasks start gen_std_start
+  hsetprop $path/tasks complete gen_std_complete
+
+  hsetprop $cnode idn ""
+  hsetprop $cnode visible false
+  hsetprop $cnode tasksPath $path/tasks
+  hsetprop $cnode objectPath $path
+  hsetprop $cnode objectName $objectName
+  hsetprop $cnode state idle
+  hsetprop $cnode commerror gen_error_script
+
+  gen_make_send $path $controllerName
+  $controllerName queue $path/tasks start start
+
+  hfactory $path/status plain internal text
+  hsetprop $path/status visible false
+  hupdate $path/status ""
+
+  hfactory $path/creationCmd plain internal text
+  hsetprop $path/creationCmd visible false
+  hupdate $path/creationCmd "0"
+
+  obj_list makeitem $objectName "HCP"
+  desc_env makeitem $objectName "HCP"
+}
+
+proc gen_std_start {} {
+  set cmd [silent 0 sct startcmd]
+  if {[string equal 0 $cmd]} {
+    return unpoll
+  }
+  sct send $cmd
+  return complete
+}
+
+proc gen_std_complete {} {
+  sct idn [sct result]
+  sct print "connected [sct objectName]. idn: [sct idn]"
+  return unpoll
+}