diff --git a/tcl/astrium.tcl b/tcl/astrium.tcl index 783ad9e3..3959ae79 100644 --- a/tcl/astrium.tcl +++ b/tcl/astrium.tcl @@ -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 diff --git a/tcl/el755.tcl b/tcl/el755.tcl new file mode 100644 index 00000000..0eddccf5 --- /dev/null +++ b/tcl/el755.tcl @@ -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 +} diff --git a/tcl/hdbutil.tcl b/tcl/hdbutil.tcl index 6091852e..82b83619 100644 --- a/tcl/hdbutil.tcl +++ b/tcl/hdbutil.tcl @@ -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} diff --git a/tcl/phytron.tcl b/tcl/phytron.tcl index 042821ba..e11a2273 100644 --- a/tcl/phytron.tcl +++ b/tcl/phytron.tcl @@ -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 diff --git a/tcl/pimotor.tcl b/tcl/pimotor.tcl new file mode 100644 index 00000000..d7ddf5ea --- /dev/null +++ b/tcl/pimotor.tcl @@ -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 +} diff --git a/tcl/stddrive.tcl b/tcl/stddrive.tcl new file mode 100644 index 00000000..e3c93959 --- /dev/null +++ b/tcl/stddrive.tcl @@ -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 +}