sct_positmotor_common.tcl
script_context_util.tcl Readability improvements. sicshipadaba.c SICS-321 Fix segfault sct_jogmotor_common.tcl Started making a jog motor object. r2762 | ffr | 2008-12-24 13:24:25 +1100 (Wed, 24 Dec 2008) | 10 lines
This commit is contained in:
Ferdi Franceschini
committed by
Douglas Clowes
Douglas Clowes
parent
2d6dbe647f
commit
fb817f2aa8
@@ -2334,7 +2334,11 @@ static int GetHdbNode(SConnection *pCon, SicsInterp *pSics, void *pData,
|
||||
}
|
||||
}
|
||||
memset(&newValue,0,sizeof(hdbValue));
|
||||
GetHipadabaPar(targetNode, &newValue, pCon);
|
||||
/* ffr XXX I expect if status=0 then we don't have a valid value
|
||||
Original code was causing a segfault for hdb text nodes
|
||||
*/
|
||||
if (0 == GetHipadabaPar(targetNode, &newValue, pCon))
|
||||
return 0;
|
||||
parData = formatValue(newValue, targetNode);
|
||||
if(parData == NULL){
|
||||
SCWrite(pCon,"ERROR: out of memory formatting data",eError);
|
||||
|
||||
175
site_ansto/instrument/config/motors/sct_jogmotor_common.tcl
Normal file
175
site_ansto/instrument/config/motors/sct_jogmotor_common.tcl
Normal file
@@ -0,0 +1,175 @@
|
||||
namespace eval ::scobj::jogmotor {
|
||||
variable cmd_table
|
||||
|
||||
proc getSpeed {axis} {
|
||||
sct send "MG _SP${axis}"
|
||||
return rdspeed
|
||||
}
|
||||
|
||||
proc setSpeed {axis} {
|
||||
set speed [sct target]
|
||||
sct send "SP${axis}=${speed}"
|
||||
return getACK
|
||||
}
|
||||
|
||||
proc getACK {sct_controller} {
|
||||
set sp [sct result]
|
||||
switch -glob $sp {
|
||||
"ASCERR:*" {
|
||||
sct seterror $sp
|
||||
error $sp
|
||||
}
|
||||
OK {
|
||||
return idle
|
||||
}
|
||||
default {
|
||||
return idle
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
proc rdspeed {} {
|
||||
set data [sct result]
|
||||
switch -glob -- $data {
|
||||
"ASCERR:*" {
|
||||
sct geterror $data
|
||||
}
|
||||
default {
|
||||
if {$data != [sct oldval]} {
|
||||
sct oldval $data
|
||||
sct update $data
|
||||
sct utime readtime
|
||||
}
|
||||
}
|
||||
}
|
||||
return idle
|
||||
}
|
||||
|
||||
proc jogCmd {sct_controller axis} {
|
||||
variable cmd_table
|
||||
|
||||
set jcmd [string tolower [lindex [sct target] 0]]
|
||||
switch $jcmd [subst {
|
||||
$cmd_table(UP) {
|
||||
set cmd UP
|
||||
set dirn 1
|
||||
}
|
||||
$cmd_table(DOWN) {
|
||||
set cmd DOWN
|
||||
set dirn -1
|
||||
}
|
||||
default {
|
||||
set cmd UNKNOWN
|
||||
}
|
||||
}]
|
||||
if {$cmd != "UNKNOWN"} {
|
||||
set jogspeed [expr $dirn * [hval [hsibPath "speed"] ]]
|
||||
|
||||
$sct_controller send "JG${axis}=$jogspeed"
|
||||
$sct_controller send "SH${axis}"
|
||||
sct send "BG${axis}"
|
||||
return getACK
|
||||
} else {
|
||||
return idle
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# TODO Check thread 0 and motion control disabled?
|
||||
proc check_motor {} {
|
||||
set val [sct target]
|
||||
return OK
|
||||
}
|
||||
|
||||
proc status {axis} {
|
||||
sct send "TS${axis}"
|
||||
return updatestatus
|
||||
}
|
||||
##
|
||||
# Bit 7 Axis in motion if high
|
||||
# Bit 6 Axis error exceeds error limit if high
|
||||
# Bit 5 A motor off if high
|
||||
# Bit 4 Undefined
|
||||
# Bit 3 Forward Limit Switch Status inactive if high
|
||||
# Bit 2 Reverse Limit Switch Status inactive if high
|
||||
# Bit 1 Home A Switch Status
|
||||
# Bit 0 Latched
|
||||
# We're interested in bits 7, 3 and 2.
|
||||
proc updatestatus {} {
|
||||
set data [sct result]
|
||||
|
||||
if {$data != [sct oldval]} {
|
||||
set mv_off_fwd 132
|
||||
set mv_off_rvs 136
|
||||
set mv_between 140
|
||||
set forward 4
|
||||
set reverse 8
|
||||
set inbetween 12
|
||||
switch -- [expr $data & 140] [subst {
|
||||
$mv_between - $mv_off_fwd - $mv_off_rvs {sct update "moving"}
|
||||
$forward {sct update "forward"}
|
||||
$reverse {sct update "reverse"}
|
||||
$inbetween {sct update "inbetween"}
|
||||
default {
|
||||
sct geterror "Invalid switch status: $data"
|
||||
}
|
||||
}]
|
||||
sct oldval $data
|
||||
sct utime readtime
|
||||
}
|
||||
return idle
|
||||
}
|
||||
# jog_table maps limit switches to positions
|
||||
# jog_table {
|
||||
# upper n1 "up"
|
||||
# middle n2 "inbetween"
|
||||
# lower n3 "down"
|
||||
#}
|
||||
proc mk_sct_jogmotor {sct_controller axis jogmotor {initcmd_table {UP "up" DOWN "down"}}} {
|
||||
variable cmd_table
|
||||
foreach {cmd name} $initcmd_table {
|
||||
set cmd_table($cmd) [string tolower $name]
|
||||
}
|
||||
|
||||
if [ catch {
|
||||
set ns ::scobj::jogmotor
|
||||
MakeSICSObj $jogmotor SCT_JOG_MOTOR
|
||||
set jog_hpath /sics/${jogmotor}
|
||||
hfactory $jog_hpath/speed plain spy float
|
||||
hsetprop $jog_hpath/speed read ${ns}::getSpeed $axis
|
||||
hsetprop $jog_hpath/speed rdspeed ${ns}::rdspeed
|
||||
hsetprop $jog_hpath/speed getACK ${ns}::getACK $sct_controller
|
||||
hsetprop $jog_hpath/speed write ${ns}::setSpeed $axis
|
||||
hsetprop $jog_hpath/speed oldval UNKNOWN
|
||||
|
||||
hfactory $jog_hpath/command plain user text
|
||||
hsetprop $jog_hpath/command write ${ns}::jogCmd $sct_controller $axis
|
||||
hsetprop $jog_hpath/command getACK ${ns}::getACK $sct_controller
|
||||
|
||||
hfactory $jog_hpath/status plain spy text
|
||||
hsetprop $jog_hpath/status read ${ns}::status $axis
|
||||
hsetprop $jog_hpath/status updatestatus ${ns}::updatestatus
|
||||
hsetprop $jog_hpath/status oldval UNKNOWN
|
||||
|
||||
$sct_controller poll $jog_hpath/speed
|
||||
$sct_controller write $jog_hpath/speed
|
||||
$sct_controller write $jog_hpath/command
|
||||
$sct_controller poll $jog_hpath/status
|
||||
|
||||
sicslist setatt $jogmotor long_name $jogmotor
|
||||
} message ] {
|
||||
return -code error $message
|
||||
}
|
||||
}
|
||||
|
||||
namespace export mk_sct_jogmotor
|
||||
}
|
||||
namespace import ::scobj::jogmotor::*
|
||||
##
|
||||
# Eg
|
||||
# hfactory /controllers plain spy none
|
||||
#
|
||||
# makesctcontroller /controllers/sct_mc1 std localhost:62034
|
||||
#
|
||||
# mk_sct_jogmotor sct_mc1 chi index { 1 0 2 15 3 20 }
|
||||
|
||||
@@ -155,7 +155,7 @@ namespace eval ::scobj::positmotor {
|
||||
set posit_table($motor,$posindex) $val
|
||||
}
|
||||
|
||||
proc mk_sct_positmotor {sct_controller motor parnode param table_ID posit_list} {
|
||||
proc mk_sct_positmotor {sct_controller motor scobjNode param table_ID posit_list} {
|
||||
variable posit_table
|
||||
variable posit_indices
|
||||
|
||||
@@ -172,11 +172,9 @@ namespace eval ::scobj::positmotor {
|
||||
|
||||
if [ catch {
|
||||
set ns ::scobj::positmotor
|
||||
# set parnode ${motor}_motor
|
||||
MakeSICSObj $parnode SCT_POSIT_MOTOR
|
||||
MakeSICSObj $scobjNode SCT_POSIT_MOTOR
|
||||
# Make setable position parameter and poll it.
|
||||
# hattach /sics/${parnode} $param $param
|
||||
set posindex_node /sics/${parnode}/${param}
|
||||
set posindex_node /sics/${scobjNode}/${param}
|
||||
hfactory $posindex_node plain user float
|
||||
hsetprop $posindex_node read ${ns}::rd_index $param $motor
|
||||
hsetprop $posindex_node state_reading_index ${ns}::state_reading_index $posindex_node $param $motor
|
||||
@@ -186,7 +184,7 @@ namespace eval ::scobj::positmotor {
|
||||
hsetprop $posindex_node oldval UNKNOWN
|
||||
hsetprop $posindex_node force_update True
|
||||
# hsetprop $posindex_node motprecision [SplitReply [samx precision]]
|
||||
hfactory $posindex_node/motprecision script "getmotpar samx precision" "samx precision " float 1
|
||||
hfactory $posindex_node/motprecision script "getmotpar $motor precision" "$motor precision " float 1
|
||||
|
||||
hfactory $posindex_node/lookup_table plain spy none
|
||||
hsetprop $posindex_node/lookup_table ID $table_ID
|
||||
@@ -212,10 +210,10 @@ namespace eval ::scobj::positmotor {
|
||||
$sct_controller poll $posindex_node
|
||||
$sct_controller write $posindex_node
|
||||
|
||||
sicslist setatt $parnode long_name $parnode
|
||||
sicslist setatt $scobjNode long_name $scobjNode
|
||||
|
||||
hinitprops $parnode
|
||||
hinitprops $parnode $param
|
||||
hinitprops $scobjNode
|
||||
hinitprops $scobjNode $param
|
||||
} message ] {
|
||||
return -code error $message
|
||||
}
|
||||
|
||||
@@ -2,19 +2,21 @@ namespace eval ::scobj { }
|
||||
##
|
||||
# @brief Initialise the hdb properties required for generating the GumTree interface and
|
||||
# saving data for script context objects
|
||||
proc ::scobj::hinitprops {sobj args} {
|
||||
if {$args == ""} {
|
||||
set hpath /sics/$sobj
|
||||
hsetprop $hpath nxalias $sobj
|
||||
# @param scobj, name of script context object
|
||||
# @param par, optional parameter
|
||||
proc ::scobj::hinitprops {scobj {par "@none"}} {
|
||||
if {$par == "@none"} {
|
||||
set hpath /sics/$scobj
|
||||
hsetprop $hpath nxalias $scobj
|
||||
} else {
|
||||
set hpath /sics/$sobj/$args
|
||||
hsetprop $hpath nxalias ${sobj}_$args
|
||||
set hpath /sics/$scobj/$par
|
||||
hsetprop $hpath nxalias ${scobj}_$par
|
||||
}
|
||||
hsetprop $hpath control true
|
||||
hsetprop $hpath data true
|
||||
hsetprop $hpath nxsave true
|
||||
hsetprop $hpath mutable true
|
||||
hsetprop $hpath klass parameter
|
||||
hsetprop $hpath sicsdev $sobj
|
||||
hsetprop $hpath sicsdev $scobj
|
||||
hsetprop $hpath sdsinfo ::nexus::scobj::sdsinfo
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user