- Added a user specific range test to the astrium driver for the POLDI
- Added speed parameter to phytron - Added new drivers for EL755 magnets and the PI DC-406 motor controller
This commit is contained in:
koennecke
@ -457,7 +457,21 @@ if {$poldi == 1} {
|
||||
}
|
||||
return OK
|
||||
}
|
||||
|
||||
#-------
|
||||
proc poldispeedwrite {} {
|
||||
set val [sct target]
|
||||
set l [split [config myrights] =]
|
||||
set rights [string trim [lindex $l 1]]
|
||||
if {$rights == 2} {
|
||||
if {$val < 4990 || $val > 15000} {
|
||||
clientput "ERROR: Users may only drive the chopper between 5000 - 15000 RPM"
|
||||
hupdate /sics/choco/stop 1
|
||||
return idle
|
||||
}
|
||||
}
|
||||
return [astchopwrite "nspee 1 "]
|
||||
}
|
||||
#-----------
|
||||
set choppers [list chopper]
|
||||
set chopperparlist [list amode aspee nspee nphas dphas averl ratio vibra vibax t_cho \
|
||||
flowr vakum valve sumsi spver state]
|
||||
@ -471,7 +485,20 @@ if {$poldi == 1} {
|
||||
set maxspeed 15000
|
||||
set minphase 80
|
||||
astriumMakeChopperParameters
|
||||
astMakeChopperSpeed1 chopperspeed
|
||||
# astMakeChopperSpeed1 chopperspeed
|
||||
|
||||
set path /sics/choco/chopper/speed
|
||||
hfactory $path plain user float
|
||||
hsetprop $path read astspeedread chopper
|
||||
hsetprop $path write poldispeedwrite
|
||||
hsetprop $path astchopwritereply astchopwritereply
|
||||
chocosct write $path
|
||||
hsetprop $path checklimits astchopspeedlimit 0
|
||||
hsetprop $path halt astchopstop
|
||||
hsetprop $path checkstatus astchopcheckspeed chopper
|
||||
hsetprop $path priv user
|
||||
makesctdriveobj chopperspeed $path DriveAdapter chocosct
|
||||
|
||||
astMakeChopperPhase1 chopperphase
|
||||
hsetprop /sics/choco/chopper/phase checklimit poldiastchopphaselimit
|
||||
Publish chosta Spy
|
||||
|
||||
97
tcl/el755.tcl
Normal file
97
tcl/el755.tcl
Normal file
@ -0,0 +1,97 @@
|
||||
#-------------------------------------------------------------
|
||||
# This is a scriptcontext driver for the PSI EL755 magnet
|
||||
# controller.
|
||||
#
|
||||
# scriptchains:
|
||||
# read - readreply
|
||||
# write - writereply - writereadback
|
||||
#
|
||||
# copyright: see file COPYRIGHT
|
||||
#
|
||||
# Mark Koennecke, November 2009
|
||||
#--------------------------------------------------------------
|
||||
|
||||
namespace eval el755 {}
|
||||
|
||||
#--------------------------------------------------------------
|
||||
proc el755::read {num} {
|
||||
sct send [format "I %d" $num]
|
||||
return readreply
|
||||
}
|
||||
#--------------------------------------------------------------
|
||||
proc el755::readreply {num} {
|
||||
set reply [sct result]
|
||||
if {[string first ? $reply] >= 0} {
|
||||
if {[string first ?OV $reply] >= 0} {
|
||||
sct send [format "I %d" $num]
|
||||
# clientput "EL755 did an overflow...."
|
||||
return readreply
|
||||
}
|
||||
error $reply
|
||||
}
|
||||
set n [stscan $reply "%f %f" soll ist]
|
||||
if {$n < 2} {
|
||||
sct send [format "I %d" $num]
|
||||
clientput "Invalid response $reply from EL755"
|
||||
return readreply
|
||||
}
|
||||
sct update $ist
|
||||
return idle
|
||||
}
|
||||
#------------------------------------------------------------------
|
||||
proc el755::write {num} {
|
||||
set cur [sct target]
|
||||
sct send [format "I %d %f" $num $cur]
|
||||
return writereply
|
||||
}
|
||||
#------------------------------------------------------------------
|
||||
proc el755::writereply {num} {
|
||||
set reply [sct result]
|
||||
if {[string first ? $reply] >= 0} {
|
||||
if {[string first ?OV $reply] >= 0} {
|
||||
set cur [sct target]
|
||||
sct send [format "I %d %f" $num $cur]
|
||||
# clientput "EL755 did an overflow...."
|
||||
return writereply
|
||||
}
|
||||
error $reply
|
||||
}
|
||||
sct send [format "I %d" $num]
|
||||
return writereadback
|
||||
}
|
||||
#--------------------------------------------------------------------
|
||||
proc el755::writereadback {num} {
|
||||
set reply [sct result]
|
||||
if {[string first ? $reply] >= 0} {
|
||||
if {[string first ?OV $reply] >= 0} {
|
||||
set cur [sct target]
|
||||
sct send [format "I %d" $num]
|
||||
# clientput "EL755 did an overflow...."
|
||||
return writereadback
|
||||
}
|
||||
error $reply
|
||||
}
|
||||
set n [stscan $reply "%f %f" soll ist]
|
||||
if {$n < 2} {
|
||||
sct send [format "I %d" $num]
|
||||
clientput "Invalid response $reply from EL755"
|
||||
return writereadback
|
||||
}
|
||||
set cur [sct target]
|
||||
if {abs($cur - $soll) < .1} {
|
||||
return idle
|
||||
}
|
||||
return el755::write $num
|
||||
}
|
||||
#--------------------------------------------------------------------
|
||||
proc el755::makeel755 {name num sct} {
|
||||
stddrive::makestddrive $name EL755Magnet $sct
|
||||
set path /sics/${name}
|
||||
hsetprop $path read el755::read $num
|
||||
hsetprop $path readreply el755::readreply $num
|
||||
hsetprop $path write el755::write $num
|
||||
hsetprop $path writereply el755::writereply $num
|
||||
hsetprop $path writereadback el755::writereadback $num
|
||||
$sct poll $path 60
|
||||
$sct write $path
|
||||
}
|
||||
@ -700,6 +700,7 @@ proc makemumo {rootpath mumoname} {
|
||||
#-----------------------------------------------------------------
|
||||
proc hdbbatchpath {pathstring} {
|
||||
exe batchpath $pathstring
|
||||
catch {batchroot $pathstring}
|
||||
catch {hupdate /instrument/commands/batch/execute/file/values}
|
||||
catch {hupdate /instrument/commands/batch/batchpath}
|
||||
catch {hupdate /instrument/experiment/batchpath}
|
||||
|
||||
@ -34,14 +34,25 @@
|
||||
# - writing postion:
|
||||
# setpos - setrcv
|
||||
#
|
||||
# reading status:
|
||||
# - reading status:
|
||||
# sendstatus - rcvstatus - statpos
|
||||
#
|
||||
# - reading speed:
|
||||
# readspeed - rcvspeed
|
||||
#
|
||||
# - setting speed:
|
||||
# writespeed - rcvwspeed - rcvspeed
|
||||
#
|
||||
# Mark Koennecke, June 2009
|
||||
#
|
||||
# Added code to switch a brake on for schneider_m2
|
||||
#
|
||||
# Mark Koennecke, September 2009
|
||||
#
|
||||
# Added code to support the speed parameter
|
||||
#
|
||||
# Mark Koennecke, December 2009
|
||||
# TODO: speed still has to be tested: 02-12-2009
|
||||
#-------------------------------------------------------------------------
|
||||
|
||||
namespace eval phytron {}
|
||||
@ -145,6 +156,32 @@ proc phytron::statend {axis} {
|
||||
sct update idle
|
||||
return idle
|
||||
}
|
||||
#------------------------------------------------------------------------
|
||||
proc phytron::readspeed {axis} {
|
||||
sct send "0${axis}P14R"
|
||||
return rcvspeed
|
||||
}
|
||||
#------------------------------------------------------------------------
|
||||
proc phytron::rcvspeed {} {
|
||||
set data [phyton::check]
|
||||
set speed [string range $data 3 end]
|
||||
sct update $speed
|
||||
return idle
|
||||
}
|
||||
#------------------------------------------------------------------------
|
||||
proc phytron::writespeed {axis} {
|
||||
set val [sct target]
|
||||
sct send "0${axis}P14S$val"
|
||||
return rcvwspeed
|
||||
}
|
||||
#------------------------------------------------------------------------
|
||||
proc phytron::rcvwspeed {axis} {
|
||||
set data [phyton::check]
|
||||
if {[string first NACK $data] >= 0} {
|
||||
error "Invalid command"
|
||||
}
|
||||
return [phytron::readspeed $axis]
|
||||
}
|
||||
#-------------------------------------------------------------------------
|
||||
proc phytron::halt {controller axis} {
|
||||
$controller send "0${axis}SN"
|
||||
@ -201,6 +238,13 @@ proc phytron::make {name axis controller lowlim upperlim} {
|
||||
hsetprop /sics/${name}/status statend phytron::statend $axis
|
||||
$controller poll /sics/${name}/status 60
|
||||
|
||||
hfactory /sics/{$name}/speed plain user float
|
||||
hsetprop /sics/${name}/speed read "phytron::readspeed $axis"
|
||||
hsetprop /sics/${name}/speed rcvspeed "phytron::rcvspeed"
|
||||
hsetprop /sics/${name}/speed write "phytron::writespeed $axis"
|
||||
hsetprop /sics/${name}/speed rcvwspeed "phytron::rcvwspeed $axis"
|
||||
$controller poll /sics/${name}/speed 60
|
||||
|
||||
$name makescriptfunc halt "phytron::halt $controller $axis" user
|
||||
|
||||
$name makescriptfunc refrun "phytron::refrun $name $controller $axis $lowlim" user
|
||||
@ -210,6 +254,7 @@ proc phytron::make {name axis controller lowlim upperlim} {
|
||||
|
||||
hupdate /sics/${name}/status idle
|
||||
$controller queue /sics/${name}/hardposition progress read
|
||||
$controller queue /sics/${name}/speed progress read
|
||||
}
|
||||
#===============================================================================================
|
||||
# At MORPHEUS there is a special table where one motor needs a brake. This requires a digital I/O
|
||||
|
||||
156
tcl/pimotor.tcl
Normal file
156
tcl/pimotor.tcl
Normal file
@ -0,0 +1,156 @@
|
||||
#----------------------------------------------------
|
||||
# This is a scriptcontext motor driver for the
|
||||
# prehistoric Physik Instrumente DC-406 DC motor
|
||||
# controller.
|
||||
#
|
||||
# copyright: see file COPYRIGHT
|
||||
#
|
||||
# Scriptchains:
|
||||
# - read - readreply
|
||||
# - write - writerepy
|
||||
# - sendstatus - statusreply - statuspos
|
||||
# - speedread - readreply
|
||||
# - writespeed - speedreply
|
||||
# - writenull - speedreply
|
||||
#
|
||||
# Mark Koennecke, Neovember 2009, after the
|
||||
# C original from 1998
|
||||
#-----------------------------------------------------
|
||||
|
||||
namespace eval pimotor {}
|
||||
#----------------------------------------------------
|
||||
proc pimotor::read {num} {
|
||||
sct send [format "%1.1dTP" $num]
|
||||
return readreply
|
||||
}
|
||||
#----------------------------------------------------
|
||||
proc pimotor::readreply {} {
|
||||
set result [sct result]
|
||||
if {[string first ? $result] >= 0} {
|
||||
error $result
|
||||
}
|
||||
set val [string range $result 3 end]
|
||||
sct update $val
|
||||
return idle
|
||||
}
|
||||
#----------------------------------------------------
|
||||
proc pimotor::write {num name} {
|
||||
set ival [expr int([sct target])]
|
||||
sct send [format "%1.1dMA%10.10d{0}" $num $ival]
|
||||
hupdate /sics/${name}/status run
|
||||
return writereply
|
||||
}
|
||||
#----------------------------------------------------
|
||||
proc pimotor::writereply {} {
|
||||
# the DC-406 does not reply on this, so we have for sure a
|
||||
# timeout here which we ignore. We do nothing else, as we
|
||||
# need a little wait anyway to get the motor to start
|
||||
# before starting to check status.
|
||||
wait 2
|
||||
set con [sct controller]
|
||||
$con queue /sics/${name}/status progress read
|
||||
return idle
|
||||
}
|
||||
#-----------------------------------------------------
|
||||
proc pimotor::sendstatus {num} {
|
||||
sct send [format "%1.1dTV" $num]
|
||||
return statusreply
|
||||
}
|
||||
#------------------------------------------------------
|
||||
proc pimotor::statusreply {num} {
|
||||
set result [sct result]
|
||||
if {[string first ? $result] >= 0} {
|
||||
sct update error
|
||||
error $result
|
||||
}
|
||||
set val [string range $result 3 end]
|
||||
if {abs($val) > 0} {
|
||||
sct update run
|
||||
[sct controller] queue sct progress read
|
||||
} else {
|
||||
pimotor::read $num
|
||||
return statuspos
|
||||
}
|
||||
return idle
|
||||
}
|
||||
#------------------------------------------------------
|
||||
proc pimotor::statuspos {name} {
|
||||
set result [sct result]
|
||||
if {[string first ? $result] >= 0} {
|
||||
error $result
|
||||
}
|
||||
set val [string range $result 3 end]
|
||||
hupdate /sics/${name} $val
|
||||
return idle
|
||||
}
|
||||
#-------------------------------------------------------
|
||||
proc pimotor::readspeed {num} {
|
||||
sct send [format "%1.1dTY" $num]
|
||||
return readreply
|
||||
}
|
||||
#--------------------------------------------------------
|
||||
proc pimotor::writespeed {num} {
|
||||
sct send [format "%1.1dSV%7.7d{0}" $num [sct target]]
|
||||
return speedreply
|
||||
}
|
||||
#----------------------------------------------------
|
||||
proc pimotor::emptyreply {} {
|
||||
return idle
|
||||
}
|
||||
#-----------------------------------------------------
|
||||
proc pimotor::writenull {controller num} {
|
||||
$controller send [format "%1.1dDH{0}" $num]
|
||||
return Done
|
||||
}
|
||||
#------------------------------------------------------
|
||||
proc pimotor::writeon {controller num} {
|
||||
$controller send [format "%1.1dMN{0}" $num]
|
||||
return Done
|
||||
}
|
||||
#------------------------------------------------------
|
||||
proc pimotor::halt {controller num} {
|
||||
$controller send [format "%1.1dAB{0}" $num]
|
||||
return Done
|
||||
}
|
||||
#------------------------------------------------------
|
||||
proc pimotor::makepimotor {name num sct lowlim upperlim} {
|
||||
MakeSecMotor $name
|
||||
|
||||
hdel /sics/${name}/hardupperlim
|
||||
hdel /sics/${name}/hardlowerlim
|
||||
hfactory /sics/${name}/hardupperlim plain internal float
|
||||
hfactory /sics/${name}/hardlowerlim plain internal float
|
||||
$name hardlowerlim $lowlim
|
||||
$name softlowerlim $lowlim
|
||||
$name hardupperlim $upperlim
|
||||
$name softupperlim $upperlim
|
||||
|
||||
hsetprop /sics/${name}/hardposition read pimotor::read $num
|
||||
hsetprop /sics/${name}/hardposition readreply pimotor::readreply
|
||||
$sct poll /sics/${name} 60
|
||||
|
||||
hsetprop /sics/${name}/hardposition write pimotor::write $num $name
|
||||
hsetprop /sics/${name}/hardposition writereply pimotor::writereply
|
||||
$sct write /sics/${name}/hardposition
|
||||
|
||||
hsetprop /sics/${name}/status read pimotor::sendstatus $num
|
||||
hsetprop /sics/${name}/status statusreply pimotor::statusreply $num
|
||||
hsetprop /sics/${name}/status statuspos pimotor::statuspos $name
|
||||
$sct poll /sics/${name}/status 60
|
||||
|
||||
hfactory /sics/${name}/speed plain user int
|
||||
hsetprop /sics/${name}/speed read pimotor::speedread $num
|
||||
hsetprop /sics/${name}/speed readreply pimotor::readreply
|
||||
$sct poll /sics/${name}/speed 120
|
||||
|
||||
hsetprop /sics/${name}/speed write pimotor::writespeed $num
|
||||
hsetprop /sics/${name}/speed speedreply pimotor::speedreply
|
||||
$sct write /sics/${name}/speed
|
||||
|
||||
$name makescriptfunc halt "pimotor::halt $sct $num" user
|
||||
$name makescriptfunc on "pimotor::writeon $sct $num" user
|
||||
$name makescriptfunc home "pimotor::writenull $sct $num" user
|
||||
|
||||
hupdate /sics/${name}/status idle
|
||||
$sct queue /sics/${name}/hardposition progress read
|
||||
}
|
||||
100
tcl/stddrive.tcl
Normal file
100
tcl/stddrive.tcl
Normal file
@ -0,0 +1,100 @@
|
||||
#------------------------------------------------------
|
||||
# This is some code for a standard drivable object in
|
||||
# the scriptcontext system. It implements an empty
|
||||
# object which throws errors when accessed. Users
|
||||
# of such an object can override it to do
|
||||
# something more acceptable. This object also
|
||||
# provides for basic limit checking and status
|
||||
# checking. It can serve as a basis for creating
|
||||
# new drivable objects, for instance environment
|
||||
# control devices. A possible user has as the
|
||||
# first thing in a write script to set the target
|
||||
# node to the desired value.
|
||||
#
|
||||
# copyright: see file COPYRIGHT
|
||||
#
|
||||
# Mark Koennecke, November 2009
|
||||
#--------------------------------------------------------
|
||||
|
||||
namespace eval stddrive {}
|
||||
|
||||
proc stddrive::stdcheck {name} {
|
||||
set val [sct target]
|
||||
set upper [hval /sics/${name}/upperlimit]
|
||||
set lower [hval /sics/${name}/lowerlimit]
|
||||
if {$val < $lower || $val > $upper} {
|
||||
error "$val is out of range $lower - $upper for $name"
|
||||
}
|
||||
return OK
|
||||
}
|
||||
#-------------------------------------------------------
|
||||
proc stddrive::stdstatus {name} {
|
||||
set test [catch {sct geterror} errortxt]
|
||||
if {$test == 0} {
|
||||
return fault
|
||||
}
|
||||
set stop [hval /sics/${name}/stop]
|
||||
if {$stop == 1} {
|
||||
return fault
|
||||
}
|
||||
set target [sct target]
|
||||
set tol [hval /sics/${name}/tolerance]
|
||||
set is [hval /sics/${name}]
|
||||
if {abs($target - $is) < $tol} {
|
||||
return idle
|
||||
} else {
|
||||
[sct controller] queue /sics/${name} progress read
|
||||
return busy
|
||||
}
|
||||
}
|
||||
#-------------------------------------------------------
|
||||
proc stddrive::stop {name} {
|
||||
hset /sics/${name}/stop 1
|
||||
return OK
|
||||
}
|
||||
#-------------------------------------------------------
|
||||
proc stddrive::deread {} {
|
||||
sct update -9999.99
|
||||
return idle
|
||||
}
|
||||
#--------------------------------------------------------
|
||||
proc stddrive::dewrite {name} {
|
||||
# hset /sics/${name}/stop 1
|
||||
error "$name is not configured, cannot drive"
|
||||
}
|
||||
#--------------------------------------------------------
|
||||
proc stddrive::deconfigure {name} {
|
||||
set allowed [list upperlimit lowerlimit tolerance stop]
|
||||
set nodelist [split [hlist /sics/${name}] \n]
|
||||
foreach node $nodelist {
|
||||
if {[string length $node] < 1} {
|
||||
continue
|
||||
}
|
||||
if {[lsearch -exact $allowed [string trim $node]] < 0} {
|
||||
clientput "Deleting $node"
|
||||
hdel /sics/${name}/${node}
|
||||
}
|
||||
}
|
||||
hsetprop /sics/${name} read stddrive::deread
|
||||
hsetprop /sics/${name} write stddrive::dewrite $name
|
||||
}
|
||||
#--------------------------------------------------------
|
||||
proc stddrive::makestddrive {name sicsclass sct} {
|
||||
makesctdriveobj $name float user $sicsclass $sct
|
||||
hfactory /sics/${name}/tolerance plain user float
|
||||
hset /sics/${name}/tolerance 2.0
|
||||
hfactory /sics/${name}/upperlimit plain user float
|
||||
hset /sics/${name}/upperlimit 300
|
||||
hfactory /sics/${name}/lowerlimit plain user float
|
||||
hset /sics/${name}/lowerlimit 10
|
||||
hfactory /sics/${name}/stop plain internal int
|
||||
hset /sics/${name}/stop 0
|
||||
|
||||
hsetprop /sics/${name} checklimits stddrive::stdcheck $name
|
||||
hsetprop /sics/${name} checkstatus stddrive::stdstatus $name
|
||||
hsetprop /sics/${name} halt stddrive::stop $name
|
||||
deconfigure $name
|
||||
$sct write /sics/${name}
|
||||
$sct poll /sics/${name} 60
|
||||
hupdate /sics/${name} -9999.99
|
||||
}
|
||||
Reference in New Issue
Block a user