diff --git a/site_ansto/instrument/TEST_SICS/fakeDMC/README.txt b/site_ansto/instrument/TEST_SICS/fakeDMC/README.txt new file mode 100644 index 00000000..20d26638 --- /dev/null +++ b/site_ansto/instrument/TEST_SICS/fakeDMC/README.txt @@ -0,0 +1,18 @@ +cont.tcl: starts a fake dmc controller. +eg + ./cont.tcl -cont 1 -port pmc1-wombat +will launch a fake motion controller which will listen for connections on port +pmc1-wombat. +NOTE: The example given above will require that a port entry for pmc1-wombat is +made in the /etc/services file and that a dmc2280_controller1_sim.tcl +configuration file exists in the fakeDMC directory. + +mkSimAxes.tcl: creates the fake dmc configuration files. +You must run this script the first time that you install the fake DMC controller +scripts or after you make changes to the sics configuration file. + +eg +./mkSimAxes.tcl wombat +this will create configuration files for the fake DMC controllers based on the +wombat_configuration.tcl file in the sics/server directory. + diff --git a/site_ansto/instrument/TEST_SICS/fakeDMC/cont.tcl b/site_ansto/instrument/TEST_SICS/fakeDMC/cont.tcl new file mode 100755 index 00000000..6cb33d18 --- /dev/null +++ b/site_ansto/instrument/TEST_SICS/fakeDMC/cont.tcl @@ -0,0 +1,21 @@ +#!/usr/bin/tclsh + +# $Revision: 1.1 $ +# $Date: 2006-10-12 23:06:05 $ +# Author: Ferdi Franceschini (ffr@ansto.gov.au) +# Last revision by: $Author: ffr $ + +# Creates a fake motion controller based on an +# instrument configuration file. +# Usage ./cont.tcl -cont -port +# where cnum is the controller number (1,2,3,4) and +# and the portname is something like pmc2-wombat + +if {$tcl_interactive==0} { array set arga $argv} +source dmcParse.tcl +source simAxis.tcl +source dmc2280Server.tcl +if {$tcl_interactive==0} { + source dmc2280_controller$arga(-cont)_sim.tcl + startserver -port $arga(-port); +} diff --git a/site_ansto/instrument/TEST_SICS/fakeDMC/dmc2280Server.tcl b/site_ansto/instrument/TEST_SICS/fakeDMC/dmc2280Server.tcl new file mode 100644 index 00000000..7aa3ee84 --- /dev/null +++ b/site_ansto/instrument/TEST_SICS/fakeDMC/dmc2280Server.tcl @@ -0,0 +1,66 @@ +# $Revision: 1.1 $ +# $Date: 2006-10-12 23:06:05 $ +# Author: Ferdi Franceschini (ffr@ansto.gov.au) +# Last revision by: $Author: ffr $ + +# Creates a socket server which listens for connections and accepts commands +# from DMC2280 clients (eg SICS). +proc serverOpen {channel addr port} { + global connected + set connected 1 + fileevent $channel readable "readLine Server $channel" + puts "OPENED" + return; +} + +# Reads a command from a DMC2280 client and then performs an appropriate +# action depending on whether or not the command produces output or has +# been defined. +proc readLine {who channel} { + global didRead + global B + if {[gets $channel line]<0} { + fileevent $channel readable {} + after idle "close $channel;set out 1" + } else { + puts "RECEIVED: $line" + + switch -glob $line { + "" {puts -nonewline $channel ":"} + "kill" {exit} + "SH*" - "BG*" - "PA*" - "DP*" - "AT*" - "MO*" - "ST*" - "SP*" - "AC*" - "DC*" { + eval [parse $line] + puts -nonewline $channel ":" + } + "TP*" - "TD*" { + set output [eval [parse $line]] + puts $channel " $output"; puts -nonewline $channel ":" + } + "TS*" { + set output [eval [parse $line]] + puts $channel " $output"; puts -nonewline $channel ":" + } + "TC 1" { + puts $channel " DMC2280 ERROR"; puts -nonewline $channel ":" + } + "MG _*" { + set output [eval [parse $line]] + puts $channel " $output"; puts -nonewline $channel ":" + } + } + flush $channel; + set didRead 1 + } + return; +} + +# startserver -port 1034 +proc startserver {args} { + global tcl_interactive; + array set parr $args; + set connected 0; + set server [socket -server serverOpen $parr(-port)]; + after 100 update; + if {$tcl_interactive==0} {vwait forever } + return; +} diff --git a/site_ansto/instrument/TEST_SICS/fakeDMC/dmcParse.tcl b/site_ansto/instrument/TEST_SICS/fakeDMC/dmcParse.tcl new file mode 100644 index 00000000..897500a0 --- /dev/null +++ b/site_ansto/instrument/TEST_SICS/fakeDMC/dmcParse.tcl @@ -0,0 +1,40 @@ +# $Revision: 1.1 $ +# $Date: 2006-10-12 23:06:05 $ +# Author: Ferdi Franceschini (ffr@ansto.gov.au) +# Last revision by: $Author: ffr $ + +# Parses a subset of DMC2280 commands and returns the corresponding command +# which is defined in dmc2280Server.tcl + +# dmc2280 has two letter commands as follows +#parses CM exp, _CM, {TP,TD}, CM=exp, CM, CM +# axis=ABCDEFGH, num=01234567 +proc parse {cmdst args} { + # CM exp, handles MG + if {[string length $args] > 0} {return "$cmdst $args"} + + # _CM, {TP,TD} get an axis property or position + set num [scan $cmdst {_%2s%1[ABCDEFGH0-7]} cmd an]; + if {$num == 2} {return "dmget $cmd $an"} + set num [scan $cmdst {%2s%1[ABCDEFGH]} cmd axis]; + if {$num == 2 && [string first $cmd "TD TP"] != -1} { + return "dmget $cmd $axis"; + } + + # CM=exp + # Try + # set line "DPB=(_TPB - 7818915)*(25000/8192) + 0" + # parse $line + set cmdlst [split $cmdst =]; + if {[llength $cmdlst] == 2} { + set num [scan [lindex $cmdlst 0] {%2s%1[ABCDEFGH0-7]} cmd axis]; + return "dmset $cmd $axis [lindex $cmdlst 1]"; + } + + # CM + set num [scan $cmdst {%2s%1[ABCDEFGH]} cmd axis]; + if {$num == 2} {return "dmcall $cmd $axis"} + + return $cmdst; + +} diff --git a/site_ansto/instrument/TEST_SICS/fakeDMC/loadConfig.tcl b/site_ansto/instrument/TEST_SICS/fakeDMC/loadConfig.tcl new file mode 100644 index 00000000..e0c1be00 --- /dev/null +++ b/site_ansto/instrument/TEST_SICS/fakeDMC/loadConfig.tcl @@ -0,0 +1,42 @@ +#!/usr/bin/env tclsh +# TODO setup loopback devices for controllers. + +# $Revision: 1.1 $ +# $Date: 2006-10-12 23:06:05 $ +# Author: Ferdi Franceschini (ffr@ansto.gov.au) +# Last revision by $Author: ffr $ + +# Load troubleshooting setup +#source dmc2280_util.tcl + +if { $argc > 0 } { + set configFileName [lindex $argv 0] +} + +proc loadConfig {fName} { + global ContList + global IPtoContName; + + 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; + set IPtoContName($cont(host)) $c; + puts "$c IP:port = $cont(host):$cont(port)"; + } +} + + diff --git a/site_ansto/instrument/TEST_SICS/fakeDMC/mkSimAxes.tcl b/site_ansto/instrument/TEST_SICS/fakeDMC/mkSimAxes.tcl new file mode 100755 index 00000000..b65d7d2a --- /dev/null +++ b/site_ansto/instrument/TEST_SICS/fakeDMC/mkSimAxes.tcl @@ -0,0 +1,85 @@ +#!/usr/bin/tclsh + +# $Revision: 1.1 $ +# $Date: 2006-10-12 23:06:05 $ +# Author: Ferdi Franceschini (ffr@ansto.gov.au) +# Last revision by: $Author: ffr $ + +# Creates fake DMC configuration files based on the instrument +# configuration file. + +proc usage {} { +puts "mkSimAxes.tcl INSTNAME"; +puts "INSTNAME is the instrument name (eg wombat, echidna)" +} + +source loadConfig.tcl + +# 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 +} + +proc mkSimMotor {args} { + foreach m $args { + upvar #0 $m axis; + puts $axis(host); + } +} + +proc mkSimAxes {} { + global IPtoContName motors ContList simConts; + array get IPtoContName; + puts $motors; + + foreach c $ContList { + set simFile($c) [open ${c}_sim.tcl w]; + } + + foreach m $motors { + upvar #0 $m motor; + + set nm $motor(axis); + set ${nm}Pos 0; + set ${nm}stepsPerX 20125; + set speed [expr $motor(stepsPerX) * $motor(maxSpeed)] + set acc [expr $motor(stepsPerX) * $motor(maxAccel)] + set dec [expr $motor(stepsPerX) * $motor(maxDecel)] + if [ info exists motor(absEnc) ] { + set enPos $motor(absEncHome); + set enCnts $motor(cntsPerX); + } else { + set enPos 0; + set enCnts 0; + } + puts $simFile($IPtoContName($motor(host))) "array set $nm \[\list TD 0 TP $enPos SP $speed AC $acc DC $dec cntsPerX $enCnts stepsPerX $motor(stepsPerX) PA 0 TS 44 \]"; + +# eval "lappend $IPtoContName($motor(host))_motors $m"; + } + + foreach c $ContList { + close $simFile($c); + } +} + +proc main {args} { + cd ../sics/server; + loadConfig $args; + cd ../../fakeDMC; + mkSimAxes; +} + +if {$tcl_interactive==0} { + main ${argv}_configuration.tcl; +} + diff --git a/site_ansto/instrument/TEST_SICS/fakeDMC/simAxis.tcl b/site_ansto/instrument/TEST_SICS/fakeDMC/simAxis.tcl new file mode 100644 index 00000000..6da344fe --- /dev/null +++ b/site_ansto/instrument/TEST_SICS/fakeDMC/simAxis.tcl @@ -0,0 +1,108 @@ +# $Revision: 1.1 $ +# $Date: 2006-10-12 23:06:05 $ +# Author: Ferdi Franceschini (ffr@ansto.gov.au) +# Last revision by: $Author: ffr $ + +# Requires a configuration array for each axis that you want to simulate. +# eg +#array set B [list AC 25000 TP 7827107 TD 25000 PA 25000 stepsPerX 25000 cntsPerX 8192 DC 25000 SP 25000] +# The mkSimAxes.tcl script creates files with arrays like the example above. + +# Substitutes position values for _TDx and _TPx +# then evaluates the expression. +proc evaluate {args} { + regsub -all {_T[DP][ABCDEFGH]} $args {[eval [parse &]]} expression; + regsub -all {\d+} $expression {&.0} expression; + return [uplevel #0 expr $expression]; +} + +proc dmset {cmd axis args} { + set num [scan $args {%d} val]; + if {$num == 1} { + set val $args; + } else { + set val [evaluate $args] + } + if {[string first $cmd "PA SP AC DC"] != -1} { + uplevel #0 set ${axis}($cmd) $val; + } else { + uplevel #0 $cmd $axis $val; + } +} + +proc dmget {cmd axis} { + uplevel #0 set ${axis}($cmd) +} + +proc dmcall {cmd paxis} { + upvar $paxis axis; + uplevel #0 eval $cmd $paxis +} + +proc DP {axis val} { + uplevel #0 eval set ${axis}(TD) $val +} +proc TS {axis} { + uplevel #0 eval set ${axis}(TS) +} + +proc SH {args} {} +proc MO {args} {} + +proc BG {_axis} { + upvar #0 $_axis axis; + set axis(TS) 140; # moving, limit switches open + set timeStep 0.1; # seconds + set target $axis(PA); + set diff [expr $target - $axis(TD)]; + set sign [expr ($axis(PA) - $axis(TD)) < 0 ? -1 : 1]; + set step [expr $sign * $timeStep * $axis(SP) ]; + if {[expr abs($diff) < abs($step)]} { + set step $diff; + set timeStep [expr abs($step / $axis(SP))]; + } + every [expr round($timeStep * 1000)] "nextstep $_axis $step $target" + +# set diff [expr $target - $axis(TD)]; +# set mult [expr $axis(cntsPerX).0/$axis(stepsPerX)]; +# set axis(TP) [expr round($diff*$mult + $axis(TP))]; +# set axis(TD) $target; +} + +# Don't handle _XQ _HX +proc MG {msg} { +# If msg starts with _ then return val for axis + if {[string index $msg 0] == "_"} { + return [eval [parse $msg]]; + } else { + return $msg; + } +} + + +proc every {ms body} { + if [eval $body] { + after $ms [list every $ms $body]; + } + return; +} + +proc nextstep {paxis step target} { + upvar #0 $paxis axis; + set mult [expr $axis(cntsPerX).0/$axis(stepsPerX)]; + set axis(TP) [expr $step * $mult + $axis(TP)]; + set axis(TD) [expr $axis(TD) + $step]; + if {[expr abs($axis(TD) - $target.0)] < 0.5} { + set axis(TS) 44; # Stopped, limit switches open + return 0; + } elseif {[expr abs($target - $axis(TD)) < abs($step)]} { + set diff [expr $target - $axis(TD)]; + set axis(TP) [expr round($diff*$mult + $axis(TP))]; + set axis(TD) $target; + set axis(TS) 44; # Stopped, limit switches open + return 0; + } else { + return 1; + } +} +