Create fake DMC2280 controllers.

r1138 | ffr | 2006-10-13 09:06:05 +1000 (Fri, 13 Oct 2006) | 2 lines

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.
+

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 <cnum> -port <portname>
+# 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);
+}

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;
+}

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 <CM> as follows
+#parses CM exp, _CM<axis,num>, {TP,TD}<axis>, CM<axis>=exp, CM<axis>, CM
+# axis=ABCDEFGH, num=01234567
+proc parse {cmdst args} {
+  # CM exp, handles MG 
+  if {[string length $args] > 0} {return "$cmdst $args"}
+
+  # _CM<axis,num>, {TP,TD}<axis> 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<axis>=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<axis> 
+  set num [scan $cmdst {%2s%1[ABCDEFGH]} cmd axis];
+  if {$num == 2} {return "dmcall $cmd $axis"}
+
+  return $cmdst;
+
+}

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)";
+  }
+}
+
+

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;
+}
+

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;
+  }
+}
+