Modified to for new util, config directory structure.
r1497 | ffr | 2007-02-16 16:39:16 +1100 (Fri, 16 Feb 2007) | 2 lines
This commit is contained in:
Ferdi Franceschini
committed by
Douglas Clowes
Douglas Clowes
parent
b76fa90814
commit
4654c4c9c7
71
site_ansto/instrument/util/dmc2280/dmc2280_util.tcl
Normal file
71
site_ansto/instrument/util/dmc2280/dmc2280_util.tcl
Normal file
@@ -0,0 +1,71 @@
|
||||
# $Revision: 1.1 $
|
||||
# $Date: 2007-02-16 05:36:38 $
|
||||
# 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
|
||||
}
|
||||
|
||||
36
site_ansto/instrument/util/dmc2280/getDMCprog.tcl
Executable file
36
site_ansto/instrument/util/dmc2280/getDMCprog.tcl
Executable file
@@ -0,0 +1,36 @@
|
||||
#!/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
|
||||
82
site_ansto/instrument/util/dmc2280/motorinfo.tcl
Normal file
82
site_ansto/instrument/util/dmc2280/motorinfo.tcl
Normal file
@@ -0,0 +1,82 @@
|
||||
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
|
||||
}
|
||||
0
site_ansto/instrument/util/dmc2280/putDMCprog.tcl
Executable file
0
site_ansto/instrument/util/dmc2280/putDMCprog.tcl
Executable file
135
site_ansto/instrument/util/dmc2280/troubleShoot.tcl
Executable file
135
site_ansto/instrument/util/dmc2280/troubleShoot.tcl
Executable file
@@ -0,0 +1,135 @@
|
||||
#!/usr/bin/env tclsh
|
||||
|
||||
# $Revision: 1.1 $
|
||||
# $Date: 2007-02-16 05:36:38 $
|
||||
# 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
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user