Moved to util directory.
r1496 | ffr | 2007-02-16 16:33:47 +1100 (Fri, 16 Feb 2007) | 2 lines
This commit is contained in:
Ferdi Franceschini
committed by
Douglas Clowes
Douglas Clowes
parent
1b061bf8da
commit
b76fa90814
@@ -1,71 +0,0 @@
|
|||||||
# $Revision: 1.6 $
|
|
||||||
# $Date: 2006-11-07 01:48:22 $
|
|
||||||
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
|
|
||||||
# Last revision by $Author: ffr $
|
|
||||||
|
|
||||||
# globals controller, channel
|
|
||||||
|
|
||||||
# Open a communications channel to a dmc2280 motor controller
|
|
||||||
# contName: controller name, eg dmc2280_controller1
|
|
||||||
# The host and port in the SICS configuration file will be used by default
|
|
||||||
proc dmc_connect {contName {host ""} {port ""}} {
|
|
||||||
upvar #0 $contName controller;
|
|
||||||
global channel;
|
|
||||||
|
|
||||||
if {$host == ""} {set host $controller(host)}
|
|
||||||
if {$port == ""} {set port $controller(port)}
|
|
||||||
|
|
||||||
if [catch {socket $host $port} con] {
|
|
||||||
error "Failed to connect to $contName IP($host) port($port)\n\
|
|
||||||
$con\n
|
|
||||||
Is the motor controller switched on? Are the network cables plugged in?\n
|
|
||||||
NOTE: You can only have a maximum of eight connections per motor controller.\n
|
|
||||||
If there are other programs (eg SICS) connected to the controller then all\n
|
|
||||||
of the available connections may have been used up."
|
|
||||||
}
|
|
||||||
set controller(socket) $con
|
|
||||||
set channel($contName) $con
|
|
||||||
set channel($con) $contName
|
|
||||||
set channel($controller(host)) $con
|
|
||||||
fconfigure $con -buffering line -translation crlf -blocking true
|
|
||||||
}
|
|
||||||
|
|
||||||
proc dmc_close {dmc_socket} {
|
|
||||||
close $dmc_socket;
|
|
||||||
}
|
|
||||||
|
|
||||||
# Send a dmc2280 command
|
|
||||||
proc dmc_sendCmd {dmc_socket cmd} {
|
|
||||||
global channel
|
|
||||||
set contName $channel($dmc_socket);
|
|
||||||
upvar #0 $contName controller
|
|
||||||
puts $dmc_socket $cmd
|
|
||||||
set status [read $dmc_socket 1]
|
|
||||||
if {$status == "?"} {
|
|
||||||
puts $dmc_socket "TC 1"
|
|
||||||
set status [read $dmc_socket 1]
|
|
||||||
if {$status == "?"} {
|
|
||||||
error "error: dmc command $cmd failed"
|
|
||||||
} else {
|
|
||||||
set dmcError [dmc_receive $dmc_socket]
|
|
||||||
set errInfo "DM2280 controller $contName
|
|
||||||
host $controller(host)
|
|
||||||
port $controller(port)"
|
|
||||||
error "DMC2280 ERROR $dmcError: when running command $cmd\n$errInfo"
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
return $status
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
# Receive a dmc2280 command
|
|
||||||
proc dmc_receive {dmc_socket} {
|
|
||||||
global channel
|
|
||||||
set contName $channel($dmc_socket);
|
|
||||||
upvar #0 $contName controller
|
|
||||||
gets $dmc_socket line
|
|
||||||
# Consume the following colon
|
|
||||||
read $dmc_socket 1
|
|
||||||
return $line
|
|
||||||
}
|
|
||||||
|
|
||||||
@@ -1,36 +0,0 @@
|
|||||||
#!/usr/bin/tclsh
|
|
||||||
# DMC2280 uses cont-Z (hex 1a) as the EOF char
|
|
||||||
# Usage:
|
|
||||||
# ./getDMCprog.tcl -host dmcIP -port dmcPort > dmcprog.txt
|
|
||||||
# To fetch the code from the dmc2280 controller at dmcIP and
|
|
||||||
# write it to dmcprog.txt, dmcPort should be 1034.
|
|
||||||
# Note: Your computer must be on the same NBI vlan as the dmc
|
|
||||||
# controller for this to work. However you can use ssh port
|
|
||||||
# forwarding to work remotely.
|
|
||||||
|
|
||||||
# On your computer run the following ssh command,
|
|
||||||
# ssh -L 1034:dmcIP:1034 sicsHostIP -lroot
|
|
||||||
# Then send the code with
|
|
||||||
# ./getDMCprog.tcl -host localhost -port 1034 > dmcprog.txt
|
|
||||||
|
|
||||||
array set args $argv
|
|
||||||
|
|
||||||
set con4 [socket $args(-host) $args(-port)]
|
|
||||||
fconfigure $con4 -buffering line -translation crlf -eofchar \x1a
|
|
||||||
|
|
||||||
proc Echo {chan } {
|
|
||||||
global forever
|
|
||||||
|
|
||||||
if {[eof $chan]} {
|
|
||||||
# A rude exit works best. Closing the socket and terminating the forever loop is unreliable
|
|
||||||
exit
|
|
||||||
#close $chan
|
|
||||||
#set forever done
|
|
||||||
} else {
|
|
||||||
puts [gets $chan]
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
fileevent $con4 readable [list Echo $con4]
|
|
||||||
puts $con4 UL
|
|
||||||
vwait forever
|
|
||||||
@@ -1,82 +0,0 @@
|
|||||||
package require Tk
|
|
||||||
|
|
||||||
proc unknown {args} {}
|
|
||||||
|
|
||||||
# Check that the current position matches the configured home position
|
|
||||||
proc checkHome {motor} {
|
|
||||||
global channel
|
|
||||||
upvar #0 $motor motName
|
|
||||||
upvar #0 ${motor}_status motStatus
|
|
||||||
set chan $channel($motName(host))
|
|
||||||
if {[info exists motName(absenc)] && $motName(absenc) == 1} {
|
|
||||||
dmc_sendCmd $chan "TP$motName(axis)"
|
|
||||||
set homeIndex absenchome
|
|
||||||
} else {
|
|
||||||
dmc_sendCmd $chan "TD$motName(axis)"
|
|
||||||
set homeIndex motorhome
|
|
||||||
}
|
|
||||||
set home [dmc_receive $chan]
|
|
||||||
set motStatus(position) $home
|
|
||||||
set motStatus(home) $motName($homeIndex)
|
|
||||||
if {$home == $motName($homeIndex)} {
|
|
||||||
set motStatus(homeTest) TEST_PASSED
|
|
||||||
} else {
|
|
||||||
set motStatus(homeTest) TEST_FAILED
|
|
||||||
}
|
|
||||||
return $motStatus(homeTest)
|
|
||||||
}
|
|
||||||
|
|
||||||
# This implementation of the "Motor" command stores the
|
|
||||||
# configured motor parameters in an array named
|
|
||||||
# after the motor.
|
|
||||||
proc Motor {name type par} {
|
|
||||||
global motors
|
|
||||||
upvar #0 $par arr
|
|
||||||
upvar #0 $name param_arr
|
|
||||||
upvar #0 ${name}_status status
|
|
||||||
array set param_arr [array get arr]
|
|
||||||
array set status [list position "" home "" upperLim "" lowerLim "" homeTest NOTDONE limitTest NOTDONE]
|
|
||||||
lappend motors $name
|
|
||||||
}
|
|
||||||
|
|
||||||
# Returns the test result status colour for the gui
|
|
||||||
proc color {status} {
|
|
||||||
switch $status {
|
|
||||||
TEST_PASSED {return green}
|
|
||||||
TEST_FAILED {return red}
|
|
||||||
default {return lightgrey}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
# You can easily test the home position of individual motors
|
|
||||||
# with this gui
|
|
||||||
# Click on the button to run the checkHome command, the position
|
|
||||||
# (in encoder counts or motor steps) will be displayed with
|
|
||||||
# green if the configured home matches the reported position,
|
|
||||||
# red otherwise.
|
|
||||||
proc testgui {} {
|
|
||||||
package require Tk
|
|
||||||
global motors
|
|
||||||
toplevel .w
|
|
||||||
frame .w.top
|
|
||||||
|
|
||||||
foreach m $motors {
|
|
||||||
global ${m}_status
|
|
||||||
set info($m) [frame .w.top.f$m]
|
|
||||||
|
|
||||||
set testResult $info($m).e$m
|
|
||||||
button $info($m).$m -text $m -command "$testResult configure -background \[color \[checkHome $m\]\]"
|
|
||||||
entry $testResult -textvariable ${m}_status(position)
|
|
||||||
pack $info($m).$m -side left
|
|
||||||
pack $info($m).e$m -side left
|
|
||||||
}
|
|
||||||
|
|
||||||
set n 0
|
|
||||||
foreach m $motors {
|
|
||||||
set r [expr $n % 20]
|
|
||||||
set c [expr $n / 20]
|
|
||||||
grid $info($m) -row $r -column $c
|
|
||||||
incr n
|
|
||||||
}
|
|
||||||
pack .w.top
|
|
||||||
}
|
|
||||||
@@ -1,135 +0,0 @@
|
|||||||
#!/usr/bin/env tclsh
|
|
||||||
|
|
||||||
# $Revision: 1.9 $
|
|
||||||
# $Date: 2006-11-29 21:25:07 $
|
|
||||||
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
|
|
||||||
# Last revision by $Author: ffr $
|
|
||||||
|
|
||||||
# Load troubleshooting setup
|
|
||||||
source dmc2280_util.tcl
|
|
||||||
source troubleshoot_setup.tcl
|
|
||||||
source motorinfo.tcl
|
|
||||||
|
|
||||||
if { $argc > 0 } {
|
|
||||||
set configFileName [lindex $argv 0]
|
|
||||||
}
|
|
||||||
|
|
||||||
# Use this to create an array of named parameters to initialise motors.
|
|
||||||
proc params {args} {
|
|
||||||
upvar 1 "" x;
|
|
||||||
if [info exists x] {unset x}
|
|
||||||
foreach {k v} $args {set x([string tolower $k]) $v}
|
|
||||||
}
|
|
||||||
|
|
||||||
namespace eval sics_config {
|
|
||||||
proc loadConfig {fName} {
|
|
||||||
variable ContList
|
|
||||||
if [info exists ContList] {unset ContList}
|
|
||||||
# Temporarily define unknown proc to skip undefined procs
|
|
||||||
rename ::unknown _unknown
|
|
||||||
proc ::unknown {args} {}
|
|
||||||
if [catch {uplevel #0 source $fName} errMsg] {
|
|
||||||
rename ::unknown ""
|
|
||||||
rename _unknown ::unknown
|
|
||||||
error $errMsg
|
|
||||||
} else {
|
|
||||||
rename ::unknown ""
|
|
||||||
rename _unknown ::unknown
|
|
||||||
}
|
|
||||||
if [catch {set ContList [uplevel #0 info vars dmc2280_controller*]} result] {error $result}
|
|
||||||
if {[llength $ContList] == 0} {error "Error: There are no dmc2280_controllerN(host/port) arrays in the $fName configuration file"}
|
|
||||||
#Add the controller to the sics_config namespace
|
|
||||||
foreach c $ContList {upvar #0 $c cont; puts "$c IP:port = $cont(host):$cont(port)"}
|
|
||||||
}
|
|
||||||
|
|
||||||
proc subExists {contName sub} {
|
|
||||||
upvar #0 $contName controller
|
|
||||||
if [catch {::dmc_sendCmd $controller(socket) "LS $sub,0"} errMsg] {
|
|
||||||
error "Subroutine $sub does not exist on controller $contName"
|
|
||||||
}
|
|
||||||
::dmc_receive $controller(socket)
|
|
||||||
}
|
|
||||||
|
|
||||||
# Returns -1 if thread is not running, line number if it is
|
|
||||||
proc checkThread {contName thnum} {
|
|
||||||
upvar #0 $contName controller
|
|
||||||
::dmc_sendCmd $controller(socket) "MG _XQ$thnum"
|
|
||||||
set reply [::dmc_receive $controller(socket) ]
|
|
||||||
if {$reply == -1} {
|
|
||||||
error "Thread $thnum not running on controller $contName"
|
|
||||||
}
|
|
||||||
return $reply
|
|
||||||
}
|
|
||||||
|
|
||||||
# GUI STUFF
|
|
||||||
package require Tk
|
|
||||||
variable ContList
|
|
||||||
global ldFrame
|
|
||||||
set ldFrameName ".loadFile"
|
|
||||||
set ldFrame(button) $ldFrameName.ldConf
|
|
||||||
set ldFrame(entry) $ldFrameName.ldEntry
|
|
||||||
|
|
||||||
|
|
||||||
proc ::guiLoadC {} {
|
|
||||||
::sics_config::loadConfig [eval $::sics_config::ldFrame(entry) get]
|
|
||||||
}
|
|
||||||
|
|
||||||
proc ::guiConnect {w cont} {
|
|
||||||
::dmc_connect $cont
|
|
||||||
$w configure -activebackground green
|
|
||||||
$w configure -background green
|
|
||||||
}
|
|
||||||
|
|
||||||
proc ::guiCheckSubs {w cont} {
|
|
||||||
global contSubs
|
|
||||||
foreach sub $contSubs($cont) {
|
|
||||||
::sics_config::subExists $cont $sub
|
|
||||||
}
|
|
||||||
$w configure -activebackground green
|
|
||||||
$w configure -background green
|
|
||||||
}
|
|
||||||
|
|
||||||
proc ::guiCheckThreads {w cont} {
|
|
||||||
global contThreads
|
|
||||||
foreach thr $contThreads($cont) {
|
|
||||||
::sics_config::checkThread $cont $thr
|
|
||||||
}
|
|
||||||
$w configure -activebackground green
|
|
||||||
$w configure -background green
|
|
||||||
}
|
|
||||||
|
|
||||||
frame $ldFrameName
|
|
||||||
pack $ldFrameName
|
|
||||||
button $ldFrame(button) -text "Load config" -command {guiLoadC; ::sics_config::mkGui}
|
|
||||||
entry $ldFrame(entry) -textvariable configFileName -width -1
|
|
||||||
pack $ldFrame(button) -side left
|
|
||||||
pack $ldFrame(entry) -side left
|
|
||||||
|
|
||||||
|
|
||||||
proc mkGui {} {
|
|
||||||
variable ContList
|
|
||||||
lappend Headings $ContList
|
|
||||||
frame .t -bg black
|
|
||||||
table .t $ContList
|
|
||||||
pack .t
|
|
||||||
testgui
|
|
||||||
}
|
|
||||||
proc table {w headings args} {
|
|
||||||
set r 0
|
|
||||||
|
|
||||||
foreach name $headings {
|
|
||||||
lappend Header [label $w.$name -text $name]
|
|
||||||
}
|
|
||||||
foreach name $headings {
|
|
||||||
lappend Connect [button $w.connect$name -text connect -command "guiConnect $w.connect$name $name"]
|
|
||||||
lappend CheckSubs [button $w.chkSubs$name -text "Check subs" -command "guiCheckSubs $w.chkSubs$name $name"]
|
|
||||||
lappend CheckThreads [button $w.chkThrs$name -text "Check threads" -command "guiCheckThreads $w.chkThrs$name $name"]
|
|
||||||
}
|
|
||||||
eval grid $Header -sticky news -padx 1 -pady 1
|
|
||||||
eval grid $Connect -sticky news -padx 1 -pady 1
|
|
||||||
eval grid $CheckSubs -sticky news -padx 1 -pady 1
|
|
||||||
eval grid $CheckThreads -sticky news -padx 1 -pady 1
|
|
||||||
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
@@ -1,51 +0,0 @@
|
|||||||
# Some useful functions for SICS configuration.
|
|
||||||
|
|
||||||
# $Revision: 1.7 $
|
|
||||||
# $Date: 2007-02-13 05:21:49 $
|
|
||||||
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
|
|
||||||
# Last revision by $Author: ffr $
|
|
||||||
|
|
||||||
# Utility fucntion for setting the home and upper and lower
|
|
||||||
# limits for a motor
|
|
||||||
proc setHomeandRange {args} {
|
|
||||||
set usage "
|
|
||||||
Usage: setHomeandRange -motor motName -home homeVal -lowrange low -uprange high
|
|
||||||
eg
|
|
||||||
setHomeandRange -motor mchi -home 90 -lowrange 5 -uprange 7
|
|
||||||
this sets the home position to 90 degreess for motor mchi
|
|
||||||
with the lower limit at 85 and the upper limit at 97
|
|
||||||
"
|
|
||||||
if {$args == ""} {clientput $usage; return}
|
|
||||||
array set params $args
|
|
||||||
set motor $params(-motor)
|
|
||||||
set home $params(-home)
|
|
||||||
set lowlim [expr $home - $params(-lowrange)]
|
|
||||||
set uplim [expr $home + $params(-uprange)]
|
|
||||||
|
|
||||||
uplevel 1 "$motor softlowerlim $lowlim"
|
|
||||||
uplevel 1 "$motor softupperlim $uplim"
|
|
||||||
uplevel 1 "$motor home $home"
|
|
||||||
}
|
|
||||||
|
|
||||||
# Use this to create an array of named parameters to initialise motors.
|
|
||||||
proc params {args} {
|
|
||||||
upvar 1 "" x;
|
|
||||||
if [info exists x] {unset x}
|
|
||||||
foreach {k v} $args {set x([string tolower $k]) $v}
|
|
||||||
}
|
|
||||||
|
|
||||||
# Parse motor readings for virtual motor scripts.
|
|
||||||
proc SplitReply { text } {
|
|
||||||
set l [split $text =]
|
|
||||||
return [string trim [lindex $l 1]]
|
|
||||||
}
|
|
||||||
|
|
||||||
# Sets motor position reading to pos by adjusting the softzero
|
|
||||||
proc setpos {motor pos} {
|
|
||||||
set currPos [SplitReply [$motor]]
|
|
||||||
set oldZero [SplitReply [$motor softzero]]
|
|
||||||
set newZero [expr $currPos - $pos + $oldZero]
|
|
||||||
uplevel #0 "$motor softzero $newZero"
|
|
||||||
}
|
|
||||||
publish setpos user
|
|
||||||
publish SplitReply user
|
|
||||||
Reference in New Issue
Block a user