102 lines
2.4 KiB
Tcl
102 lines
2.4 KiB
Tcl
# -- 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
|
|
}
|