linse/sics
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merging release 2.0 branch with CVS trunk

Browse Source 
r2601 | ffr | 2008-05-30 10:26:57 +1000 (Fri, 30 May 2008) | 2 lines
This commit is contained in:
Ferdi Franceschini
2008-05-30 10:26:57 +10:00
committed by Douglas Clowes
parent 4a937e1608
commit 0749b0effa
125 changed files with 8541 additions and 1810 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
site_ansto/instrument/MANIFEST.TXT
View File

@@ -1,4 +1,5 @@
server_config.tcl
barebones.tcl
util
gumxml.tcl
config/hmm/anstohm_linked.xml

12
site_ansto/instrument/TEST_SICS/fakeDMC/simAxis.tcl
View File

@@ -1,7 +1,7 @@
# $Revision: 1.7 $
# $Date: 2008-05-12 01:08:15 $
# $Revision: 1.8 $
# $Date: 2008-05-30 00:26:54 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by: $Author: dcl $
# Last revision by: $Author: ffr $
# Requires a configuration array for each axis that you want to simulate.
# eg
@@ -87,7 +87,9 @@ proc BG {_axis} {
proc MG {args} {
# Skip formatting
if {[string index [lindex $args 0] 0] == "F"} {
set msg [lrange $args 1 end]
set msg [lrange $args 1 end]
} else {
set msg $args
}
# If msg starts with _ then return val for axis
if {[string index $msg 0] == "_"} {
@@ -111,7 +113,7 @@ proc nextstep {paxis step target} {
set axis(TP) [expr int($step * $mult + $axis(TP))];
set TD_POS [expr int($axis(TD) + $step)];
set axis(TD) [expr int($TD_POS)];
if {$axis(ST) == 1 || [expr abs($TD_POS - double($target))] < 0.5} {
if {$axis(ST) == 1} {
set axis(TS) 44; # Stopped, limit switches open
set axis(BG) 0; # motor has stopped
set axis(ST) 0; # make sure stop flag is unset

48
site_ansto/instrument/barebones.tcl Normal file
View File

@@ -0,0 +1,48 @@
# $Revision: 1.2 $
# $Date: 2008-05-30 00:26:54 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by: $Author: ffr $
# @file This is a barebones SICS configuration file, it's useful for testing
# drivers in isolation.
#
# NOTE\n
# This configuration does not create a GumTree interface or let you
# save nexus data files.
# Required by server_config.tcl
VarMake Instrument Text Internal
Instrument echidna
Instrument lock
#START SERVER CONFIGURATION SECTION
source sics_ports.tcl
########source server_config.tcl
set sicsroot ../
source util/utility.tcl
ServerOption LogFileBaseName $sicsroot/log/serverlog
###### installprotocolhandler
ServerOption statusfile $sicsroot/log/status.tcl
ServerOption RedirectFile $sicsroot/log/stdout
ServerOption LogFileDir $sicsroot/log
ServerOption QuieckPort [get_portnum $quieckport ]
ServerOption ServerPort [get_portnum $serverport ]
ServerOption InterruptPort [get_portnum $interruptport ]
ServerOption TelWord sicslogin
ServerOption TelnetPort [get_portnum $telnetport ]
ServerOption ReadUserPasswdTimeout 600000
ServerOption AcceptTimeOut 10
ServerOption ReadTimeOut 10
SicsUser manager ansto 1
SicsUser user sydney 2
SicsUser spy 007 3
MakeDrive
exe batchpath ../batch
exe syspath ../batch
clientput "serverport [get_portnum $::serverport]"

167
site_ansto/instrument/config/anticollider/anticollider_common.tcl Normal file
View File

@@ -0,0 +1,167 @@
# $Revision: 1.2 $
# $Date: 2008-05-30 00:26:54 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by: $Author: ffr $
# TODO Handle sequencing when simultaneously moving multiple axes
# TODO Handle functional dependencies (just write your own tcl script)
# or get the generic acscript to call a user proc
# FIXME The anticollider module does not report the error messages from the
# anticollision script, we currently get around this by using broadcast.
AntiCollisionInstall
namespace eval anticollider {
variable veto_region
}
array unset ::anticollider::veto_region
array set ::anticollider::veto_region ""
##
# @brief Load an anticollider script
proc ::anticollider::loadscript {args} {
variable prog
set prog ""
set fh [open $::cfPath(anticollider)/[lindex $args 0] RDONLY ]
while {[gets $fh line] >= 0} {
# Skip empty lines and comments
if [regexp {^\s*$|^ *#} $line] {
continue
}
lappend prog $line
}
}
##
# @brief Compile compile an anticollider declaration into a veto region table
# for the anticollider script.
#
# @param vprog, an anticollider declaration as a list of quote enclosed lines.
# @return Generates the ::anticollider::veto_region lookup table.
#
# Example\n
# forbid {160 167} for stth when mtth in {87 88}\n
# forbid { {0 15} {20 25} } for stth when mtth in { {80 90} {139.5 140.5} }\n
# for pcx forbid { {80 130} {-inf 10} }\n
# when mom in {0 45} forbid {{0 15} {345 360}} for pcr\n
# for sphi forbid { {0 5} {10 15} } when schi in { {5 10} {15 20} }\n
# forbid {-inf 5} when mtth in {0 10} for sphi\n
# forbid {0 10} for samx whenall { samrot in {0 5} samy in {0 15} }\n
proc ::anticollider::genveto {vprog} {
variable veto_region
array unset veto_region
set lnum 1
foreach line $vprog {
array unset vp
array set vp $line
if [info exists vp(whenall)] {
foreach {mot in range} $vp(whenall) {
if {[llength [join $range]] != 2} {
error "ERROR: $range is not a valid range for $mot. Line $lnum of the veto list"
}
lappend condlist $mot $range
}
lappend veto_region($vp(for)) [list $vp(forbid) @and $condlist]
} elseif [info exists vp(when)] {
lappend veto_region($vp(for)) [list $vp(forbid) $vp(when) $vp(in)]
} else {
lappend veto_region($vp(for)) [list $vp(forbid) @any @all]
}
incr lnum
}
}
##
# @brief Generic anti-collision script for simple collision avoidance.
#
# WARNING: This does not handle sequencing. Only run one motor at a time.
# This script requires that an ::anticollider::veto_region has been generated
# by the ::anticollider::genveto procedure.
#
# The ::anticollider::veto_region is a hash indexed by the names of the motors
# which have been registered with the anticollision module.
proc ::anticollider::acscript {args} {
variable veto_region
foreach {regmot target} $args {
foreach row $veto_region($regmot) {
if { [lindex $row 1] == "@and"} {
set forbid [lindex $row 0]
set no_veto 0
foreach {mot range} [lindex $row 2] {
set pos [SplitReply [$mot]]
foreach {lower upper} $range {}
if {$pos < $lower || $pos > $upper} {
set no_veto 1
break
}
}
if {$no_veto} {
continue
} else {
foreach {min max} $forbid {}
if {$min <= $target && $target <= $max} {
broadcast "ERROR:The range ($forbid) is forbidden for $regmot when [lindex $row 2]"
error "ERROR:The range ($forbid) is forbidden for $regmot when [lindex $row 2]"
}
}
} else {
foreach {forbidden_range obstmot obstrange} $row {
if {$obstmot == "@any"} {
if {$obstrange == "@all"} {
foreach {min max} [join $forbidden_range] {
if {$min <= $target && $target <= $max} {
broadcast "ERROR: $regmot target ($target) is in the forbidden region ($forbidden_range)"
error "ERROR: $regmot target ($target) is in the forbidden region ($forbidden_range)"
}
}
} else {
broadcast "ERROR: veto table must use @all with @any"
error "ERROR: veto table must use @all with @any"
}
} else {
if {$obstrange == "@all"} {
broadcast "ERROR: veto table must use @any with @all"
error "ERROR: veto table must use @any with @all"
} else {
foreach {lower upper} [join $obstrange] {
set pos [SplitReply [$obstmot]]
if {$lower <= $pos && $pos <= $upper} {
foreach {min max} [join $forbidden_range] {
if {$min <= $target && $target <= $max} {
broadcast "ERROR:The range $min to $max is forbidden for $regmot when $obstmot is in this region ($obstrange)"
error "ERROR:The range $min to $max is forbidden for $regmot when $obstmot is in this region ($obstrange)"
}
}
}
}
}
}
}
}
}
anticollision add 0 $regmot $target
}
}
##
# @brief Generate anticollider veto_region and register motors with anticollider
proc ::anticollider::init {} {
variable evp
variable veto_region
if [ catch {
::anticollider::genveto $::anticollider::prog
foreach motor [array names veto_region] {
anticollision register $motor
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
publish ::anticollider::acscript user
anticollision script ::anticollider::acscript

85
site_ansto/instrument/config/commands/commands_common.tcl Normal file
View File

@@ -0,0 +1,85 @@
##
# @file Definition of common command node procs.
################################################################################
# SCAN COMMANDS
namespace eval scan {
command hdb_bmonscan {
text=drivable scan_variable
float scan_start
float scan_increment
int NP
text=monitor,timer mode
float preset
int=0,2 channel
} {
bmonscan clear
# bmonscan configure script
bmonscan add $scan_variable $scan_start $scan_increment
bmonscan setchannel $channel;
set status [catch {bmonscan run $NP $mode $preset} msg]
# bmonscan configure soft
if {$status == 0} {
return $msg
} else {
return -code error "ERROR [info level 0]"
}
}
::scan::hdb_bmonscan -addfb text filename text mode float preset float scan_variable_value int scanpoint int counts text status
::scan::hdb_bmonscan -set feedback status IDLE
command hdb_hmscan {
text=drivable scan_variable
float scan_start
float scan_increment
int NP
text=monitor,timer mode
float preset
int=0,2 channel
} {
hmscan clear
hmscan add $scan_variable $scan_start $scan_increment
hmscan setchannel $channel;
set status [catch {hmscan run $NP $mode $preset} msg]
if {$status == 0} {
return $msg
} else {
return -code error "ERROR [info level 0]"
}
}
::scan::hdb_hmscan -addfb text filename text mode float preset float scan_variable_value int scanpoint int counts text status
::scan::hdb_hmscan -set feedback status IDLE
}
sicslist setatt ::scan::hdb_bmonscan long_name bmonscan
sicslist setatt ::scan::hdb_hmscan long_name hmscan
################################################################################
################################################################################
# MONITOR COMMANDS
namespace eval monitor {
command count {
text=timer,monitor mode
float preset
} {
::monitor::count -set feedback status BUSY
bm setmode $mode
bm count $preset
::monitor::count -set feedback counts [SplitReply [bm getcounts]];
::monitor::count -set feedback status IDLE
}
::monitor::count -addfb int counts text status
::monitor::count -set feedback status IDLE
array set fbarr [::monitor::count -list feedback]
::utility::mkData $fbarr(counts) data monitor privilege user mutable true
array unset fbarr
}
################################################################################

18
site_ansto/instrument/config/counter/counter_common_1.tcl
View File

@@ -1,20 +1,2 @@
#FIXME Nexus path info is coded into this source. This means that if you change the
# monitor data path in the config/hipadaba/common_instrument_dictionary.tcl then
# you may also need to change the paths here
bm SetExponent 0
sicslist setatt bm privilege internal
namespace eval monitor {
command count {text:timer,monitor mode float: preset} {
#FIXME remove dependency on hdb path
::monitor::count -set feedback status BUSY
bm setmode $mode
bm count $preset
::monitor::count -set feedback counts [SplitReply [bm getcounts]];
::monitor::count -set feedback status IDLE
}
::monitor::count -addfb int counts text status
::monitor::count -set feedback status IDLE
array set fbarr [::monitor::count -list feedback]
::utility::mkData $fbarr(counts) data monitor privilege user mutable true
array unset fbarr
}

28
site_ansto/instrument/config/environment/temperature/lakeshore340_common.tcl Normal file
View File

@@ -0,0 +1,28 @@
namespace eval ::environment::temperature { }
# @brief Make a simulated temperature controller object.
#
# @param temp_sobj, name for temperature controller object.
proc ::environment::temperature::mkls340sim {temp_sobj} {
EvFactory new $temp_sobj sim
sicslist setatt $temp_sobj numsensors 4
sicslist setatt $temp_sobj controlsensor sensora
sicslist setatt $temp_sobj sensorlist sensora,sensorb,sensorc,sensord
sicslist setatt $temp_sobj heateron 1
sicslist setatt $temp_sobj range 2
sicslist setatt $temp_sobj units kelvin
sicslist setatt $temp_sobj klass @none
}
# @brief Make a lakeshore340 temperature controller object.
#
# @param temp_sobj, name for temperature controller object
# @param IP, (optional) IP address for temperature controller.
# @param port, (optional) port number for temperature controller.
proc ::environment::temperature::mkls340 {temp_sobj {IP 137.157.201.50} {port 4001}} {
Makeasyncqueue sertemp1 LS340 $IP $port
sertemp1 timeout 2000
EvFactory new $temp_sobj ls340 sertemp1 1 D ABCD
sicslist setatt $temp_sobj units kelvin
sicslist setatt $temp_sobj klass @none
}

167
site_ansto/instrument/config/hipadaba/common_instrument_dictionary.tcl
View File

@@ -32,11 +32,107 @@ set instrument_dictionary [subst {
datatype @none
property {data true control true nxsave false klass NXinstrument type instrument}
}
instrument/status {
instrument/aperture {
privilege spy
sobj {@any plc}
sobj {@any aperture}
datatype @none
property {data false control true nxsave false klass @none type part}
property {data true control true nxsave false klass NXaperture type part}
}
instrument/attenuator {
privilege spy
sobj {@any attenuator}
datatype @none
property {data true control true nxsave false klass NXattenuator type part}
}
instrument/beam_stop {
privilege spy
sobj {@any beam_stop}
datatype @none
property {data true control true nxsave false klass NXbeam_stop type part}
}
instrument/bending_magnet {
privilege spy
sobj {@any bending_magnet}
datatype @none
property {data true control true nxsave false klass NXbending_magnet type part}
}
instrument/crystal {
privilege spy
sobj {@any crystal}
datatype @none
property {data true control true nxsave false klass NXcrystal type part}
}
instrument/disk_chopper {
privilege spy
sobj {@any disk_chopper}
datatype @none
property {data true control true nxsave false klass NXdisk_chopper type part}
}
instrument/fermi_chopper {
privilege spy
sobj {@any fermi_chopper}
datatype @none
property {data true control true nxsave false klass NXfermi_chopper type part}
}
instrument/filter {
privilege spy
sobj {@any filter}
datatype @none
property {data true control true nxsave false klass NXfilter type part}
}
instrument/flipper {
privilege spy
sobj {@any flipper}
datatype @none
property {data true control true nxsave false klass NXflipper type part}
}
instrument/guide {
privilege spy
sobj {@any guide}
datatype @none
property {data true control true nxsave false klass NXguide type part}
}
instrument/insertion_device {
privilege spy
sobj {@any insertion_device}
datatype @none
property {data true control true nxsave false klass NXinsertion_device type part}
}
instrument/mirror {
privilege spy
sobj {@any mirror}
datatype @none
property {data true control true nxsave false klass NXmirror type part}
}
instrument/moderator {
privilege spy
sobj {@any moderator}
datatype @none
property {data true control true nxsave false klass NXmoderator type part}
}
instrument/polarizer {
privilege spy
sobj {@any polarizer}
datatype @none
property {data true control true nxsave false klass NXpolarizer type part}
}
instrument/positioner {
privilege spy
sobj {@any positioner}
datatype @none
property {data true control true nxsave false klass NXpositioner type part}
}
instrument/source {
privilege spy
sobj {@any source}
datatype @none
property {data true control true nxsave false klass NXsource type part}
}
instrument/velocity_selector {
privilege spy
sobj {@any velocity_selector}
datatype @none
property {data true control true nxsave false klass NXvelocity_selector type part}
}
instrument/detector {
privilege spy
@@ -44,29 +140,17 @@ set instrument_dictionary [subst {
datatype @none
property {data true control true nxsave false klass NXdetector type part}
}
sample {
privilege spy
sobj {@any sample}
datatype @none
property {data true control true nxsave false klass NXsample type part}
}
instrument/collimator {
privilege spy
sobj {@any collimator}
datatype @none
property {data true control true nxsave false klass NXcollimator type part}
}
monitor {
privilege spy
sobj {@any monitor}
datatype @none
property {data true control true nxsave false klass NXmonitor type part}
}
instrument/monochromator {
privilege spy
sobj {@any monochromator @any crystal}
sobj {@any monochromator}
datatype @none
property {data true control true nxsave false klass NXcrystal type part}
property {data true control true nxsave false klass NXmonochromator type part}
}
instrument/slits {
privilege spy
@@ -74,17 +158,17 @@ set instrument_dictionary [subst {
datatype @none
property {data true control true nxsave false klass NXfilter type part}
}
user {
sample {
privilege spy
sobj {@any user}
sobj {@any sample @any environment}
datatype @none
property {data true control true nxsave false klass NXuser type part}
property {data true control true nxsave false klass NXsample type part}
}
experiment {
monitor {
privilege spy
sobj {@any experiment}
sobj {@any monitor}
datatype @none
property {data true control true nxsave false klass NXnote type part}
property {data true control true nxsave false klass NXmonitor type part}
}
data {
privilege spy
@@ -92,6 +176,43 @@ set instrument_dictionary [subst {
datatype @none
property {data true control false nxsave false klass NXdata type part datatype UNKNOWN currentfiletype UNKNOWN}
}
event_data {
privilege spy
sobj {@any event_data}
datatype @none
property {data true control false nxsave false klass NXevent_data type part datatype UNKNOWN currentfiletype UNKNOWN}
}
user {
privilege spy
sobj {@any user}
datatype @none
property {data true control true nxsave false klass NXuser type part}
}
process {
privilege spy
sobj {@any process}
datatype @none
property {data true control true nxsave false klass NXprocess type part}
}
characterization {
privilege spy
sobj {@any characterization}
datatype @none
property {data true control true nxsave false klass NXcharacterization type part}
}
experiment {
privilege spy
sobj {@any experiment}
datatype @none
property {data true control true nxsave false klass NXnote type part}
}
instrument/status {
privilege spy
sobj {@any plc}
datatype @none
property {data false control true nxsave false klass @none type part}
}
data/data_set {
privilege spy
datatype @none

804
site_ansto/instrument/config/hipadaba/hipadaba_configuration_common.tcl
View File

@@ -15,8 +15,384 @@ InstallHdb
namespace eval ::hdb {
namespace export buildHDB attlist
set NXlog_template {
NXlog {
$name {
$paramarr(time)
$paramarr(value)
$paramarr(raw_value)
$paramarr(description)
$paramarr(average_value)
$paramarr(average_value_error)
$paramarr(minimum_value)
$paramarr(maximum_value)
$paramarr(duration)
}
}
}
set NXnote_template {
NXnote {
$name {
$paramarr(author)
$paramarr(date)
$paramarr(type)
$paramarr(file_name)
$paramarr(description)
$paramarr(data)
}
}
}
set NXbeam_template {
$name {
$paramarr(distance)
$paramarr(incident_energy)
$paramarr(final_energy)
$paramarr(energy_transfer)
$paramarr(incident_wavelength)
$paramarr(incident_wavelength_spread)
$paramarr(incident_beam_divergence)
$paramarr(final_wavelength)
$paramarr(incident_polarization)
$paramarr(final_polarization)
$paramarr(final_wavelength_spread)
$paramarr(final_beam_divergence)
$paramarr(flux)
}
}
# NOTE: paramarr(offset) was added for Quokka's DetPosYOffsetmm parameter
set NXgeometry_template {
NXgeometry {
geometry {
sobjlist {$paramarr(geomdescription)}
NXshape {
shape {
sobjlist {$paramarr(shape) $paramarr(size)}
}
}
NXtranslation {
position {
sobjlist {$paramarr(position) $paramarr(offset) $paramarr(coordinate_scheme)}
NXgeometry {
geometry {
link {
target {$paramarr(refpos)}
nxalias {$paramarr(position)}
}
}
}
}
}
NXorientation {
orientation {
sobjlist {$paramarr(orientation)}
}
}
}
}
}
set NXaperture_template [subst -novariables {
NXaperture {
$name {
sobjlist {$paramarr(material) $paramarr(description)}
[ set NXgeometry_template ]
}
}
} ]
set NXvelocity_selector_template [subst -novariables {
NXvelocity_selector {
$name {
sobjlist {
$paramarr(type)
$paramarr(rotation_speed)
$paramarr(radius)
$paramarr(spwidth)
$paramarr(length)
$paramarr(num)
$paramarr(twist)
$paramarr(table)
$paramarr(height)
$paramarr(width)
$paramarr(wavelength)
$paramarr(wavelength_spread)
}
[ set NXgeometry_template ]
}
}
} ]
}
proc ::hdb::MakeLog {name klass paramlist} {
variable NXlog_template
array set paramarr $paramlist
set newtable [list]
prune_NX newtable $NXlog_template
::hdb::subtree_macro $name $klass $newtable
}
proc ::hdb::MakeNote {name klass paramlist} {
variable NXnote_template
array set paramarr $paramlist
set newtable [list]
prune_NX newtable $NXnote_template
::hdb::subtree_macro $name $klass $newtable
}
proc ::hdb::MakeBeam {name klass paramlist} {
variable NXbeam_template
array set paramarr $paramlist
set newtable [list]
prune_NX newtable $NXbeam_template
::hdb::subtree_macro $name $klass $newtable
}
proc ::hdb:MakeEnvironment {name klass paramlist} {
variable NXenvironment_template
array set paramarr $paramlist
set newtable [list]
prune_NX newtable $NXenvironment_template
::hdb::subtree_macro $name $klass $newtable
}
proc ::hdb::MakeGeometry {name klass paramlist} {
variable NXgeometry_template
array set paramarr $paramlist
set newtable [list]
prune_NX newtable $NXgeometry_template
::hdb::subtree_macro $name $klass $newtable
}
##
# @brief Generates an hdb subtree macro from a named list of SICS objects.
#
# NOTE: Currently the only SICS objects supported are 'sicsvariable' and 'macro'.
# @param name, This is the name of the aperture.
# @paramlist, A name value list of aperture parameters. All parameters are optional.
proc ::hdb::MakeAperture {name paramlist} {
array set paramarr $paramlist
variable NXaperture_template
set newtable [list]
prune_NX newtable $NXaperture_template
::hdb::subtree_macro $name instrument $newtable
}
proc ::hdb::MakeVelocity_Selector {name paramlist} {
variable NXvelocity_selector_template
array set paramarr $paramlist
set newtable [list]
prune_NX newtable $NXvelocity_selector_template
::hdb::subtree_macro $name instrument $newtable
}
##
# @brief This simplifies a NeXus-class template by removing unnecessary branches.
# A NeXus-class template is a keyed-list which has Tcl variables for some of the nodes,
# if the Tcl variables aren't defined for some branch then that branch is removed.
# All other variables are expanded in place, also all 'sobjlists' are split up into type
# specific lists. This is intended as a helper function for commands which generate
# NeXus-class keyed lists from a simple set of optional parameters.
#
# @param NXklist, This is a keyed list representation of the NeXus class which will be augmented
# with the pruned nx_template. Note this can just be an empty list.
# @param nx_template, The NeXus-class template which will be pruned.
# @param path, (optional, default="") Parent path in recursive calls.
# @param node, (optional, default="") Current node in recursive calls.
# @param level, (optional,default=1) The location of the template parameters in the callstack.
proc prune_NX {NXklist nx_template {path ""} {node ""} {level 1}} {
upvar $NXklist newtable
# puts "[info level 0]\nCallstack depth = [info level]\nRecursion depth = [expr $level-1]"
if {$path == ""} {
set currpath $node
} else {
set currpath $path/$node
}
foreach {n v} $nx_template {
switch $n {
"sobjlist" {
set has_sobj 0
foreach var $v {
if {[string index $var 0] == "$"} {
set vn [string range $var 1 end]
upvar $level $vn lvar
if [info exists lvar] {
foreach sobj $lvar {
lappend [getatt $sobj type]_list $sobj
}
set has_sobj 1
}
} else {
foreach sobj $var {
lappend [getatt $sobj type]_list $sobj
}
set has_sobj 1
}
}
if {$has_sobj} {
if [info exists sicsvariable_list] {
::utility::tabset newtable $currpath/sicsvariable [subst {{$sicsvariable_list}}]
}
if [info exists macro_list] {
::utility::tabset newtable $currpath/macro [subst {{$macro_list}}]
}
} else {
}
}
"link" {
set linktarget ""
array set linkinfo $v
if {[string index $linkinfo(target) 0] == "$"} {
set vn [string range $linkinfo(target) 1 end]
upvar $level $vn lvar
if [info exists lvar] {
set linktarget $lvar
}
} else {
set linktarget $linkinfo(target)
}
if {[string index $linkinfo(nxalias) 0] == "$"} {
set vn [string range $linkinfo(nxalias) 1 end]
upvar $level $vn avar
if [info exists avar] {
set linkname $avar
}
} else {
set linkname $linkinfo(nxalias)
}
if {$linktarget != ""} {
::utility::tabset newtable $currpath/link/target [subst {{$linktarget}}]
::utility::tabset newtable $currpath/link/nxalias [subst {{$linkname}}]
}
}
default {
if {[string range $n 0 1] == "NX"} {
set node $n
} elseif {[string index $n 0] == "$"} {
set vn [string range $n 1 end]
upvar $level $vn lvar
if [info exists lvar] {
set node $lvar
} else {
}
} else {
set node $n
}
prune_NX newtable $v $currpath $node [expr $level+1]
}
}
}
}
##
# @brief Make an aperture
#
# @param args optional name and description variables
#proc MakeAperture {apname nxgeometry args} {
# set nxaperture [::hdb::NXaperture $apname $nxgeometry $args]
# ::hdb::subtree_macro $apname instrument $nxaperture
#}
##
# @brief Generate a subtree macro procedure
#
# @param Name of the subtree macro
# @klass Category which the macro belongs to (usually a NeXus class)
# @klist A keyed list which describes the subtree.
proc ::hdb::subtree_macro {name klass klist} {
set st_macroname ${name}_subtree_macro
proc ::hdb::$st_macroname {} "return [list $klist]"
::hdb::set_subtree_props ::hdb::$st_macroname $klass
}
##
# @brief Publish an hdb_subtree macro and initialise it's property list
#
# @param st_name The name of the hdb_subtree macro
# @param klass Where should the subtree be placed in the hdb heirarchy
# @param control (optional, default=true) Add it to the control interface?
# @param privilege (optional, default=user) Modification privilege.
proc ::hdb::set_subtree_props {st_name klass {control "true"} {privilege "user"} } {
publish $st_name mugger
sicslist setatt $st_name klass $klass
sicslist setatt $st_name control $control
sicslist setatt $st_name privilege $privilege
sicslist setatt $st_name kind "hdb_subtree"
sicslist setatt $st_name long_name "@none"
sicslist setatt $st_name data "true"
sicslist setatt $st_name nxsave "true"
}
# @brief Add a subtree to a given hipadaba path.
#
# @param hpath, Basepath for subtree
# @param object, SICS object name
# @param subtree, A nested Tcl list which represents the subtree
# @param type, the SICS object type if we are adding SICS object node. Optional, default = @none.
# @param makenode, type of node to make. Optional, default = @none.
proc ::hdb::add_subtree {hpath subtree {object @none} {type @none} {makenode @none}} {
set ::errorInfo ""
set SICStypes {sicsvariable macro}
if [catch {
switch $makenode {
"@none" {
foreach {n v} $subtree {
if {[lsearch -exact $::nexus_classes $n] != -1} {
add_subtree $hpath $v $object $n NXclass
} elseif {[lsearch -exact $SICStypes $n] != -1} {
add_subtree $hpath $v $object $n sicsobject
} elseif {$n=="link"} {
add_subtree $hpath $v $object $n link
} else {
error "ERROR:Unknown type, '$n'"
}
}
}
"NXclass" {
foreach {item val} $subtree {
add_hpath $hpath $item
hsetprop $hpath/$item klass $type
add_subtree $hpath/$item $val $object
}
}
"sicsobject" {
foreach item $subtree {
if {$item==$object} {
error "ERROR: Infinite recursion, cannot add $item as a node to it's own hdb subtree"
}
set objtype [getatt $item type]
if {$type != $objtype} {
error "ERROR: Specified type of '$type' doesn't match actual type, '$objtype', for $item"
}
sobjadd $hpath $item
}
}
"link" {
set target [::utility::tabget subtree target]
set nxalias [::utility::tabget subtree nxalias]
foreach l $nxalias t $target {
set refname [getatt $t long_name]
::hdb::add_hpath $hpath $refname
hsetprop $hpath/$refname data "true"
hsetprop $hpath/$refname nxsave "false"
hsetprop $hpath/$refname control "false"
hsetprop $hpath/$refname link $t
hsetprop $hpath/$refname nxalias ${l}_posref
hsetprop $hpath/$refname type nxvgroup
hsetprop $hpath/$refname klass @none
}
}
default {
error "ERROR: Unknown node type, $makenode"
}
}
} message ] {
if {$::errorCode=="NONE"} {return $hpath}
return -code error $message
}
}
##
# @brief Add an hdb path to the hdb tree at the given basePath
#
@@ -87,103 +463,113 @@ proc ::hdb::add_feedback {hpath sobj name} {
proc ::hdb::add_node {basePath args} {
global nodeindex
array unset arg_array
array set arg_array $args;
if {[info exists arg_array(path)] && [info exists arg_array(prop_list)]} {
add_hpath $basePath $arg_array(path)
if {$basePath == "/"} {
set node_path /$arg_array(path)
} else {
set node_path $basePath/$arg_array(path)
}
# if {[info exists arg_array(prop_list)]} {
foreach {prop pval} $arg_array(prop_list) {
hsetprop $node_path $prop $pval
if [ catch {
array set arg_array $args
if {[info exists arg_array(path)] && [info exists arg_array(prop_list)]} {
add_hpath $basePath $arg_array(path)
if {$basePath == "/"} {
set node_path /$arg_array(path)
} else {
set node_path $basePath/$arg_array(path)
}
# }
return $node_path
}
# if {[info exists arg_array(prop_list)]} {
foreach {prop pval} $arg_array(prop_list) {
hsetprop $node_path $prop $pval
}
# }
return $node_path
}
if {![info exists arg_array(dlen)]} {
set arg_array(dlen) ""
}
set gp_path [file dirname $arg_array(node)]
set node_name [file tail $arg_array(node)]
if {$gp_path != "."} {
add_hpath $basePath $gp_path
set basePath $basePath/$gp_path
hsetprop $basePath type part
}
if {[lsearch [hlist $basePath] $node_name] == -1} {
#TODO allow hdb nodes of type drivable countable environment
array set attribute [attlist $node_name]
switch $arg_array(kind) {
command {
# A command is a macro, node=macro name
set command $node_name
set cmd_path [add_command $basePath $command]
set node_path $cmd_path
# The extra arguments for add_node are supplied by the command parameters
# and command feedback procedures.
if {[string length [info procs ${command}_parameters]] > 0} {
${command}_parameters add_node $cmd_path
} else {
$command -map param ::hdb::add_cmd_par $cmd_path
if {![info exists arg_array(dlen)]} {
set arg_array(dlen) ""
}
set gp_path [file dirname $arg_array(node)]
set node_name [file tail $arg_array(node)]
if {$gp_path != "."} {
add_hpath $basePath $gp_path
set basePath $basePath/$gp_path
hsetprop $basePath type part
}
if {[lsearch [hlist $basePath] $node_name] == -1} {
#TODO allow hdb nodes of type drivable countable environment
array set attribute [attlist $node_name]
switch $arg_array(kind) {
command {
# A command is a macro, node=macro name
set command $node_name
set cmd_path [add_command $basePath $command]
set node_path $cmd_path
# The extra arguments for add_node are supplied by the command parameters
# and command feedback procedures.
if {[string length [info procs ${command}_parameters]] > 0} {
${command}_parameters add_node $cmd_path
} else {
$command -map param ::hdb::add_cmd_par $cmd_path
}
if {[string length [info procs ${command}_feedback]] > 0} {
add_hpath $cmd_path feedback
hsetprop $cmd_path/feedback type part
${command}_feedback add_node $cmd_path/feedback
} else {
add_hpath $cmd_path feedback
hsetprop $cmd_path/feedback type part
$command -map feedback ::hdb::add_feedback $cmd_path/feedback
}
}
if {[string length [info procs ${command}_feedback]] > 0} {
add_hpath $cmd_path feedback
hsetprop $cmd_path/feedback type part
${command}_feedback add_node $cmd_path/feedback
} else {
add_hpath $cmd_path feedback
hsetprop $cmd_path/feedback type part
$command -map feedback ::hdb::add_feedback $cmd_path/feedback
hobj {
hattach $basePath $node_name $arg_array(long_name)
set node_path $basePath/$arg_array(long_name)
hsetprop $node_path data [getatt $node_name data]
hsetprop $node_path control [getatt $node_name control]
hsetprop $node_path nxsave [getatt $node_name nxsave]
hsetprop $node_path mutable [getatt $node_name mutable]
hsetprop $node_path klass [getatt $node_name klass]
if [info exists attribute(hdbchain)] {
foreach pmot [split $attribute(hdbchain) ,] {
hchain $node_path [getatt $pmot hdb_path]
}
}
foreach child [hlist $node_path] {
hsetprop $node_path/$child data false
hsetprop $node_path/$child control [getatt $node_name control]
hsetprop $node_path/$child nxsave false
hsetprop $node_path/$child klass [getatt $node_name klass]
}
}
script - getset {
# A r/w pair of scripts, node = a node path
set node_path $basePath/[getatt $node_name long_name]
set data_type [getatt $node_name dtype]
set data_length [getatt $node_name dlen]
if {[getatt $node_name access] == "read_only"} {
hmakescript $node_path $node_name hdbReadOnly $data_type $data_length
} else {
hmakescript $node_path $node_name $node_name $data_type $data_length
}
hsetprop $node_path sicsdev $node_name
hsetprop $node_path nxalias $node_name
hsetprop $node_path data [getatt $node_name data]
hsetprop $node_path control [getatt $node_name control]
hsetprop $node_path klass [getatt $node_name klass]
hsetprop $node_path sdsinfo [getatt $node_name sdsinfo]
hsetprop $node_path savecmd [getatt $node_name savecmd]
#hmakescript $node_path $arg_array(rscript) $arg_array(wscript) $arg_array(dtype) $arg_array(dlen)
}
}
hobj {
hattach $basePath $node_name $arg_array(long_name)
set node_path $basePath/$arg_array(long_name)
hsetprop $node_path data [getatt $node_name data]
hsetprop $node_path control [getatt $node_name control]
hsetprop $node_path nxsave [getatt $node_name nxsave]
hsetprop $node_path klass [getatt $node_name klass]
foreach child [hlist $node_path] {
hsetprop $node_path/$child data false
hsetprop $node_path/$child control [getatt $node_name control]
hsetprop $node_path/$child nxsave false
hsetprop $node_path/$child klass [getatt $node_name klass]
if {[info exists attribute(units)]} {
hsetprop $node_path units $attribute(units)
}
if {[info exists arg_array(prop_list)]} {
foreach {prop pval} $arg_array(prop_list) {
hsetprop $node_path $prop $pval
}
}
script {
# A r/w pair of scripts, node = a node path
set node_path $basePath/[getatt $node_name long_name]
set data_type [getatt $node_name dtype]
set data_length [getatt $node_name dlen]
if {[getatt $node_name access] == "read_only"} {
hmakescript $node_path $node_name hdbReadOnly $data_type $data_length
} else {
hmakescript $node_path $node_name $node_name $data_type $data_length
}
hsetprop $node_path sicsdev $node_name
hsetprop $node_path nxalias $node_name
hsetprop $node_path data true
hsetprop $node_path control false
hsetprop $node_path klass [getatt $node_name klass]
hsetprop $node_path sdsinfo [getatt $node_name sdsinfo]
hsetprop $node_path savecmd [getatt $node_name savecmd]
#hmakescript $node_path $arg_array(rscript) $arg_array(wscript) $arg_array(dtype) $arg_array(dlen)
}
sicslist setatt $node_name hdb_path $node_path
return $node_path
}
if {[info exists attribute(units)]} {
hsetprop $node_path units $attribute(units)
}
if {[info exists arg_array(prop_list)]} {
foreach {prop pval} $arg_array(prop_list) {
hsetprop $node_path $prop $pval
}
}
sicslist setatt $node_name hdb_path $node_path
return $node_path
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
@@ -218,10 +604,15 @@ proc ::hdb::add_command {basePath command} {
# @param sicsobj SICS object name
# @return a list of name value pairs for the sicsobj attributes
proc ::hdb::attlist {sicsobj} {
foreach att [tolower_sicslist $sicsobj] {
lappend atts [split [string range $att 0 end-1] =]
if [ catch {
foreach att [tolower_sicslist $sicsobj] {
lappend atts [split [string range $att 0 end-1] =]
}
return [join $atts]
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
return [join $atts]
}
@@ -273,109 +664,108 @@ proc ::hdb::sobjadd {hpath sobj args} {
# TODO Check if args parameter needs to be here, it might be there in case the function is called
# with more than two arguments.
array unset sobjatt
array set sobjatt [attlist $sobj]
sicslist setatt $sobj id $sobj
switch $sobjatt(type) {
motor - configurablevirtualmotor {
if {[info exists sobjatt(group)]} {
set hpath [add_hpath $hpath $sobjatt(group)]
if {[catch {hsetprop $hpath type part} err]} {clientput $err error}
}
if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} {
set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)]
if {[catch {hsetprop $node_path savecmd $sobjatt(savecmd)} err]} {clientput $err error}
if {[catch {hsetprop $node_path sdsinfo $sobjatt(sdsinfo)} err]} {clientput $err error}
if {[catch {hsetprop $node_path nxalias $sobjatt(nxalias)} err]} {clientput $err error}
if {[catch {hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error}
} else {
clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error
}
}
macro {
# access attribute = ro,rw
if {[info exists sobjatt(group)]} {
set hpath [add_hpath $hpath $sobjatt(group)]
if {[catch {hsetprop $hpath type part} err]} {clientput $err error}
}
if {[lsearch [hlist $hpath] $sobjatt(long_name)] != -1} {
clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error
} else {
set node_path [add_node $hpath kind $sobjatt(kind) node $sobj priv $sobjatt(privilege) ]
if [info exists sobjatt(mutable)] {
if {[catch {hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error}
if [ catch {
array set sobjatt [attlist $sobj]
sicslist setatt $sobj id $sobj
switch $sobjatt(type) {
motor - configurablevirtualmotor {
if {[info exists sobjatt(group)]} {
set hpath [add_hpath $hpath $sobjatt(group)]
if {[catch {hsetprop $hpath type part} err]} {clientput $err error}
}
}
}
sicsvariable {
if {[info exists sobjatt(group)]} {
set hpath [add_hpath $hpath $sobjatt(group)]
if {[catch {hsetprop $hpath type part} err]} {clientput $err error}
}
if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} {
set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)]
if {[catch {hsetprop $node_path sicsdev $sobj} err]} {clientput $err error}
if {[catch {hsetprop $node_path nxalias $sobj} err]} {clientput $err error}
if {[catch {hsetprop $node_path savecmd $sobjatt(savecmd)} err]} {clientput $err error}
if {[catch {hsetprop $node_path sdsinfo $sobjatt(sdsinfo)} err]} {clientput $err error}
if {[catch {hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error}
if {[catch {hsetprop $node_path privilege $sobjatt(privilege)} err]} {clientput $err error}
} else {
clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error
}
}
node {
}
singlecounter {
# TODO
todo_msg "$sobjatt(type) case, add $sobj to $hpath"
}
histmem {
if {[info exists sobjatt(group)]} {
set hpath [add_hpath $hpath $sobjatt(group)]
if {[catch {hsetprop $hpath type part} err]} {clientput $err error}
}
if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} {
if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} {
set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)]
if {[catch {hsetprop $node_path savecmd $sobjatt(savecmd)} err]} {clientput $err error}
if {[catch {hsetprop $node_path sdsinfo $sobjatt(sdsinfo)} err]} {clientput $err error}
if {[catch {hsetprop $node_path nxalias $sobjatt(nxalias)} err]} {clientput $err error}
if {[catch {hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error}
if {[catch {hsetprop $node_path sicsdev $sobj} err]} {clientput $err error}
} else {
clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error
}
} else {
clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error
}
}
macro {
# access attribute = ro,rw
if {[info exists sobjatt(group)]} {
set hpath [add_hpath $hpath $sobjatt(group)]
if {[catch {hsetprop $hpath type part} err]} {clientput $err error}
}
if {[lsearch [hlist $hpath] $sobjatt(long_name)] != -1} {
clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error
} elseif {$sobjatt(kind) == "hdb_subtree"} {
add_subtree $hpath [$sobj]
} else {
set node_path [add_node $hpath kind $sobjatt(kind) node $sobj priv $sobjatt(privilege) ]
if [info exists sobjatt(mutable)] {
if {[catch {hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error}
}
}
}
sicsvariable {
if {[info exists sobjatt(group)]} {
set hpath [add_hpath $hpath $sobjatt(group)]
if {[catch {hsetprop $hpath type part} err]} {clientput $err error}
}
if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} {
set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)]
if {[catch {hsetprop $node_path sicsdev $sobj} err]} {clientput $err error}
if {[catch {hsetprop $node_path nxalias $sobj} err]} {clientput $err error}
if {[catch {hsetprop $node_path savecmd $sobjatt(savecmd)} err]} {clientput $err error}
if {[catch {hsetprop $node_path sdsinfo $sobjatt(sdsinfo)} err]} {clientput $err error}
if {[catch {hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error}
if {[catch {hsetprop $node_path privilege $sobjatt(privilege)} err]} {clientput $err error}
} else {
clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error
}
}
node {
}
singlecounter {
# TODO
todo_msg "$sobjatt(type) case, add $sobj to $hpath"
}
histmem {
if {[info exists sobjatt(group)]} {
set hpath [add_hpath $hpath $sobjatt(group)]
if {[catch {hsetprop $hpath type part} err]} {clientput $err error}
}
if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} {
set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)]
if {[catch {hsetprop $node_path savecmd $sobjatt(savecmd)} err]} {clientput $err error}
if {[catch {hsetprop $node_path sdsinfo $sobjatt(sdsinfo)} err]} {clientput $err error}
if {[catch {hsetprop $node_path nxalias $sobjatt(nxalias)} err]} {clientput $err error}
if {[catch {hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error}
if {[catch {hsetprop $node_path sicsdev $sobj} err]} {clientput $err error}
} else {
clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error
}
}
nxscript {
# TODO
todo_msg "$sobjatt(type) case, add $sobj to $hpath"
}
sicsdata {
# TODO
todo_msg "$sobjatt(type) case, add $sobj to $hpath"
}
scanobject {
# TODO
todo_msg "$sobjatt(type) case, add $sobj to $hpath"
}
environment_controller {
todo_msg "$sobjatt(type) case, add $sobj to $hpath"
}
}
nxscript {
# TODO
todo_msg "$sobjatt(type) case, add $sobj to $hpath"
}
sicsdata {
# TODO
todo_msg "$sobjatt(type) case, add $sobj to $hpath"
}
scanobject {
# TODO
todo_msg "$sobjatt(type) case, add $sobj to $hpath"
}
environment_controller {
if {[info exists sobjatt(group)]} {
set hpath [add_hpath $hpath $sobjatt(group)]
if {[catch {hsetprop $hpath type part} err]} {clientput $err error}
}
if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} {
set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)]
if {[catch { hsetprop $node_path savecmd $sobjatt(savecmd)} err]} {clientput $err error}
if {[catch { hsetprop $node_path sdsinfo $sobjatt(sdsinfo)} err]} {clientput $err error}
if {[catch { hsetprop $node_path nxalias $sobjatt(nxalias)} err]} {clientput $err error}
if {[catch { hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error}
hmakescript $node_path/target "$sobj target" hdbReadOnly float
hsetprop $node_path/target data false
hsetprop $node_path/target control true
} else {
clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error
}
}
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
proc ::hdb::write_poll {pollnode val} {
hsetprop $pollnode poll_interval $val
sicspoll intervall $pollnode $val
}
proc ::hdb::read_poll {pollnode} {
return [getatt $pollnode]
}
##
@@ -388,12 +778,17 @@ proc ::hdb::sobjadd {hpath sobj args} {
# @param given_klass A klass in instdict_specification.tcl
# @see sobjadd
proc ::hdb::sobjtypeadd {hpath sobjtype given_klass} {
foreach {sobj} [sobjlist $sobjtype $given_klass] {
array unset sobjatt
array set sobjatt [attlist $sobj]
if {[info exists sobjatt(privilege)] && $sobjatt(privilege) != "internal"} {
sobjadd $hpath $sobj
if [ catch {
foreach {sobj} [sobjlist $sobjtype $given_klass] {
array unset sobjatt
array set sobjatt [attlist $sobj]
if {[info exists sobjatt(privilege)] && $sobjatt(privilege) != "internal"} {
sobjadd $hpath $sobj
}
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
@@ -453,18 +848,23 @@ proc ::hdb::prune {instdict} {
proc ::hdb::buildHDB {instDict} {
#TODO add data control nxsave nxtyp properties
upvar #0 $instDict dictionary
prune dictionary
foreach {n v} $dictionary {
array unset varr
array set varr $v
array unset property_array
array set property_array $varr(property)
add_node / path $n prop_list $varr(property)
if {[info exists varr(sobj)]} {
foreach {sicstype sobj_klass} $varr(sobj) {
if [ catch {
prune dictionary
foreach {n v} $dictionary {
array unset varr
array set varr $v
array unset property_array
array set property_array $varr(property)
add_node / path $n prop_list $varr(property)
if {[info exists varr(sobj)]} {
foreach {sicstype sobj_klass} $varr(sobj) {
sobjtypeadd /$n $sicstype $sobj_klass
}
}
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}

5
site_ansto/instrument/config/hipadaba/instdict_specification.tcl
View File

@@ -11,14 +11,15 @@ set boolean {true false}
#}
# SICS OBJECTS MUST PROVIDE THE FOLLOWING INFORMATION
set sobj_klass_list {@none aperture attenuator collimator command crystal data detector entry experiment graphics instrument monitor monochromator plc sample scan user}
set sobj_klass_list {@none aperture attenuator collimator command crystal data detector entry environment experiment graphics instrument monitor monochromator plc sample scan sensor user}
set sobj_sicstype_list {environment_controller sicsvariable macro motor configurablevirtualmotor singlecounter histmem nxscript sicsdata scanobject}
# Different kinds of things are added to the hdb in different ways.
# command: This is something a client can run with hset /a/b/c start, it may have parameters and feedback.
# Parameters and feedback should be made available in 'ilists' named after the command.
# script: Supplies an rscript and a wscript to attach to a node for hgets and hsets.
# hobj: Something that can be hattached to a node. {motor sicsvariable histmem}.
set sobj_kind_list {command hobj script}
# hdb_subtree: Is a macro which returns a keyed list that describes a hdb subtree.
set sobj_kind_list {command hobj script hdb_subtree}
set sobj_interfacelist [subst {drivable {$boolean} countable {$boolean} callback {$boolean} environment {$boolean} }]
set privilege_list {spy user manager read_only internal}

1555
site_ansto/instrument/config/hmm/hmm_configuration_common_1.tcl
View File

File diff suppressed because it is too large Load Diff

55
site_ansto/instrument/config/hmm/hmm_cylindrical_detector_configuration.tcl
View File

@@ -9,33 +9,36 @@ namespace eval histogram_memory {
# requires detector_active_width_mm det_radius_mm deg_per_rad
proc two_theta {args} {
variable state
set opt [lindex $args 0]
set arglist [lrange $args 1 end]
set proc_name [namespace origin [lindex [info level 0] 0]]
set det_width_mm [SplitReply [detector_active_width_mm]]
set det_radius_mm [SplitReply [detector_radius_mm]]
set deg_per_radian [SplitReply [deg_per_rad]]
switch -- $opt {
"-centres" - "-boundaries" - "-graph_type" {
return [calc_axis $proc_name @none @none @none $opt $args]
}
"-arrayname" {
set max_b [OAT_TABLE -get X_MAX]
set min_b [OAT_TABLE -get X_MIN]
set scale_factor [expr {$deg_per_radian*($det_width_mm/$det_radius_mm) / ($max_b - $min_b)}]
set offset [::histogram_memory::detector_posn_degrees]
return [calc_axis $proc_name $scale_factor $offset [OAT_TABLE -get X_boundaries] $opt $arglist]
}
"-units" {
return "degrees"
}
default {
set max_b [OAT_TABLE -get X_MAX]
set min_b [OAT_TABLE -get X_MIN]
set scale_factor [expr {$deg_per_radian*($det_width_mm/$det_radius_mm) / ($max_b - $min_b)}]
set offset [::histogram_memory::detector_posn_degrees]
return [calc_axis $proc_name $scale_factor $offset [OAT_TABLE -get X_boundaries] $args]
if [ catch {
set opt [lindex $args 0]
set arglist [lrange $args 1 end]
set proc_name [namespace origin [lindex [info level 0] 0]]
set det_width_mm [SplitReply [detector_active_width_mm]]
set det_radius_mm [SplitReply [detector_radius_mm]]
set deg_per_radian [SplitReply [deg_per_rad]]
switch -- $opt {
"-centres" - "-boundaries" - "-graph_type" {
return [::histogram_memory::calc_axis $proc_name @none @none @none $opt $args]
}
"-arrayname" {
set max_chan [OAT_TABLE X -getdata MAX_CHAN]
set scale_factor [expr {$deg_per_radian*($det_width_mm/$det_radius_mm) / $max_chan}]
set offset [::histogram_memory::detector_posn_degrees]
return [::histogram_memory::calc_axis $proc_name $scale_factor $offset [OAT_TABLE X -getdata BOUNDARIES] $opt $arglist]
}
"-units" {
return "degrees"
}
default {
set max_chan [OAT_TABLE X -getdata MAX_CHAN]
set scale_factor [expr {$deg_per_radian*($det_width_mm/$det_radius_mm) / $max_chan}]
set offset [::histogram_memory::detector_posn_degrees]
return [::histogram_memory::calc_axis $proc_name $scale_factor $offset [OAT_TABLE X -getdata BOUNDARIES] $args]
}
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
set script_name ::histogram_memory::two_theta

520
site_ansto/instrument/config/nexus/nxscripts_common_1.tcl
View File

@@ -5,8 +5,16 @@
MakeNXScript
sicsdatafactory new nxscript_data
#mkVar name type access long_name nxsave klass control data
::utility::mkVar start_seconds int user start_seconds false entry false false
::utility::mkVar estart Text user start_time true entry false true
::utility::mkVar eend Text user end_time true entry false true
::utility::mkVar timestamp int user time_stamp true entry false true
::utility::mkVar data_run_number int user run_number true instrument false true
sicslist setatt data_run_number mutable true
sicslist setatt timestamp mutable true
sicslist setatt timestamp units seconds
namespace eval nexus {
variable data_gp_path "/data"
set exports [list newfile closefile save data]
@@ -32,12 +40,12 @@ namespace eval nexus {
# TODO Put the filetype_spec in a separate file.
variable filetype_spec {
BEAM_MONITOR {
link {axis 1 ::data::gumtree_save_par_run_number}
link {axis 1 data_run_number}
link {data_set ::monitor::count_fb_counts}
save_policy {include @all exclude {hmm hmm_xy hmm_xt hmm_yt hmm_x hmm_y hmm_t}}
}
HISTOGRAM_XYT {
link {axis 1 ::data::gumtree_save_par_run_number}
link {axis 1 data_run_number}
link {axis 2 ::histogram_memory::time_channel}
link {axis 3 ::histogram_memory::vertical_axis}
link {axis 4 ::histogram_memory::horizontal_axis}
@@ -45,40 +53,40 @@ namespace eval nexus {
save_policy {include @all exclude {hmm_xy hmm_xt hmm_yt hmm_x hmm_y hmm_t}}
}
HISTOGRAM_XY {
link {axis 1 ::data::gumtree_save_par_run_number}
link {axis 1 data_run_number}
link {axis 2 ::histogram_memory::vertical_axis}
link {axis 3 ::histogram_memory::horizontal_axis}
link {data_set hmm_xy}
save_policy {include @all exclude {hmm hmm_xt hmm_yt hmm_x hmm_y hmm_t}}
}
HISTOGRAM_XT {
link {axis 1 ::data::gumtree_save_par_run_number}
link {axis 1 data_run_number}
link {axis 2 ::histogram_memory::time_channel}
link {axis 3 ::histogram_memory::horizontal_axis}
link {data_set hmm_xt}
save_policy {include @all exclude {hmm_xy hmm hmm_yt hmm_x hmm_y hmm_t}}
}
HISTOGRAM_YT {
link {axis 1 ::data::gumtree_save_par_run_number}
link {axis 1 data_run_number}
link {axis 2 ::histogram_memory::time_channel}
link {axis 3 ::histogram_memory::vertical_axis}
link {data_set hmm_yt}
save_policy {include @all exclude {hmm_xy hmm_xt hmm hmm_x hmm_y hmm_t}}
}
HISTOGRAM_X {
link {axis 1 ::data::gumtree_save_par_run_number}
link {axis 1 data_run_number}
link {axis 2 ::histogram_memory::horizontal_axis}
link {data_set hmm_x}
save_policy {include @all exclude {hmm_xy hmm_xt hmm_yt hmm hmm_y hmm_t}}
}
HISTOGRAM_Y {
link {axis 1 ::data::gumtree_save_par_run_number}
link {axis 1 data_run_number}
link {axis 2 ::histogram_memory::vertical_axis}
link {data_set hmm_y}
save_policy {include @all exclude {hmm_xy hmm_xt hmm_yt hmm_x hmm hmm_t}}
}
HISTOGRAM_T {
link {axis 1 ::data::gumtree_save_par_run_number}
link {axis 1 data_run_number}
link {axis 2 ::histogram_memory::time_channel}
link {data_set hmm_t}
save_policy {include @all exclude {hmm_xy hmm_xt hmm_yt hmm_x hmm_y hmm}}
@@ -187,25 +195,30 @@ proc newFileName {postfix} {
variable nexusdic
variable state
variable data_gp_path
if {$state(file,open) == "true"} {
error_msg "Can't create a new file because the current file is still open"
} elseif {$state(file,new) == "false"} {
error_msg "This function should only be called when state(file,new) = true"
}
if [ catch {
if {$state(file,open) == "true"} {
error_msg "Can't create a new file because the current file is still open"
} elseif {$state(file,new) == "false"} {
error_msg "This function should only be called when state(file,new) = true"
}
set file_format [SplitReply [SicsDataPostFix]]
array set nxmode [list nx.hdf create5 hdf create5 h5 create5 nx5 create5 xml createxml]
set nxdict_path [::nexus::gen_nxdict $nexusdic]
if {$state(file,namestyle) == "scratch"} {
dataFileName [format "%s/scratch.%s" [::nexus::datapath] $file_format]
} else {
sicsdatanumber incr
dataFileName [newFileName $file_format]
set file_format [SplitReply [SicsDataPostFix]]
array set nxmode [list nx.hdf create5 hdf create5 h5 create5 nx5 create5 xml createxml]
set nxdict_path [::nexus::gen_nxdict $nexusdic]
if {$state(file,namestyle) == "scratch"} {
dataFileName [format "%s/scratch.%s" [::nexus::datapath] $file_format]
} else {
sicsdatanumber incr
dataFileName [newFileName $file_format]
}
hsetprop $data_gp_path currentfiletype [::utility::hgetplainprop $data_gp_path datatype]
nxscript $nxmode($file_format) [SplitReply [dataFileName]] $nxdict_path
set state(file,open) false
set state(file,new) false
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
hsetprop $data_gp_path currentfiletype [::utility::hgetplainprop $data_gp_path datatype]
nxscript $nxmode($file_format) [SplitReply [dataFileName]] $nxdict_path
set state(file,open) false
set state(file,new) false
}
##
@@ -233,10 +246,11 @@ proc ::nexus::isValidFileType {type} {
# state(file,open) true state(file,new) false
# /data/currentfiletype == UNKNOWN
proc ::nexus::newfile {type {namestyle data}} {
variable filetype_spec
variable state
variable data_gp_path
variable filetype_spec
variable state
variable data_gp_path
if [ catch {
set state(file,namestyle) $namestyle
set state(file,new) true
hsetprop $data_gp_path currentfiletype UNKNOWN
@@ -248,7 +262,11 @@ proc ::nexus::newfile {type {namestyle data}} {
} else {
::nexus::process_filetype_policy $type filetype_spec
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
##
# @brief Save data to the currently open file and then close it.
@@ -256,18 +274,29 @@ proc ::nexus::newfile {type {namestyle data}} {
# @param point This is the array index for mutable data elements
#
# This function provides the top level call to the recursive ::nexus::savetree
# function
# function, it should only be called by the ::nexus::save command.
#
# @see ::nexus::savetree
# @see ::nexus::save
proc ::nexus::save_data {point} {
debug_msg "save point $point in [dataFileName]"
::nexus::nxreopenfile
foreach child [hlist /] {
if {[::utility::hgetplainprop /$child data] == "true"} {
::nexus::savetree $child $point
if [ catch {
if {[info level]<2} {
error "ERROR: The [lindex [info level 0] 0] command is for internal use only"
}
set caller [namespace origin [lindex [info level -1] 0]]
if {$caller != "::nexus::save"} {
error "ERROR: [lindex [info level 0] 0] can only be called via the '::nexus::save' command, not by $caller"
}
foreach child [hlist /] {
if {[::utility::hgetplainprop /$child data] == "true"} {
::nexus::savetree $child $point
}
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
::nexus::nxclosefile
}
##
@@ -282,64 +311,105 @@ proc ::nexus::newfile {type {namestyle data}} {
variable state
variable data_gp_path
if {[string is integer $point] == 0} {
error_msg "save index must be an integer"
} elseif {$point < 0} {
error_msg "save index cannot be negative"
}
if [ catch {
if {[string is integer $point] == 0} {
error_msg "save index must be an integer"
} elseif {$point < 0} {
error_msg "save index cannot be negative"
}
::data::gumtree_save -set run_number $point
# ::data::gumtree_save -set run_number $point
data_run_number $point
set isNewFile [expr {$state(file,new) == "true"}]
set currFileType [::utility::hgetplainprop $data_gp_path currentfiletype]
set currDataType [::utility::hgetplainprop $data_gp_path datatype]
set dataTypeChanged [expr {$currFileType != $currDataType}]
if {$currDataType == "UNKNOWN"} {
error_msg "You must set the file type, eg 'newfile BEAM_MONITOR' or 'newfile BEAM_MONITOR scratch' "
}
if {$isNewFile || $dataTypeChanged} {
set state(file,new) true
::nexus::createfile
estart [lindex [sicstime] 1]
eend [lindex [sicstime] 1]
::nexus::save_data $point
::nexus::linkdata
} else {
eend [lindex [sicstime] 1]
::nexus::save_data $point
}
set isNewFile [expr {$state(file,new) == "true"}]
set currFileType [::utility::hgetplainprop $data_gp_path currentfiletype]
set currDataType [::utility::hgetplainprop $data_gp_path datatype]
set dataTypeChanged [expr {$currFileType != $currDataType}]
if {$currDataType == "UNKNOWN"} {
error_msg "You must set the file type, eg 'newfile BEAM_MONITOR' or 'newfile BEAM_MONITOR scratch' "
}
if {$isNewFile || $dataTypeChanged} {
set state(file,new) true
::nexus::createfile
estart [lindex [sicstime] 1]
eend [lindex [sicstime] 1]
start_seconds [clock seconds]
timestamp 0
::nexus::nxreopenfile
::nexus::save_data $point
::nexus::makelinks
::nexus::set_plotdata_info
::nexus::nxclosefile
} else {
eend [lindex [sicstime] 1]
timestamp [expr {[clock seconds] - [SplitReply [start_seconds]]}]
::nexus::nxreopenfile
::nexus::save_data $point
::nexus::nxclosefile
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
return
}
##
# @brief Reopen the current file, close it with nxclosefile
# this should only be called by the ::nexus::save command.
#
# @see nxclosefile
# @see ::nexus::save
proc ::nexus::nxreopenfile {} {
global cfPath
variable state
variable nexusdic
if {$state(file,open) == "false"} {
nxscript reopen [SplitReply [dataFileName]] $cfPath(nexus)/$nexusdic
set state(file,open) true
}
if [ catch {
if {[info level]<2} {
error "ERROR: The [lindex [info level 0] 0] command is for internal use only"
}
set caller [namespace origin [lindex [info level -1] 0]]
if {$caller != "::nexus::save"} {
error "ERROR: [lindex [info level 0] 0] can only be called via the '::nexus::save' command, not by $caller"
}
if {$state(file,open) == "false"} {
nxscript reopen [SplitReply [dataFileName]] $cfPath(nexus)/$nexusdic
set state(file,open) true
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
##
# @brief Close the current file. You can reopen it with nxreopenfile
# this should only be called by the ::nexus::save command.
#
# @see nxreopenfile
# @see ::nexus::save
proc ::nexus::nxclosefile {} {
variable state
if {$state(file,open) == "true"} {
nxscript close
set state(file,open) false
set flist [split [SplitReply [dataFileName]] "/"]
set fname [lindex $flist [expr [llength $flist] - 1] ]
clientput "$fname updated" "event"
}
if [ catch {
if {[info level]<2} {
error "ERROR: The [lindex [info level 0] 0] command is for internal use only"
}
set caller [namespace origin [lindex [info level -1] 0]]
if {$caller != "::nexus::save"} {
error "ERROR: [lindex [info level 0] 0] can only be called via the '::nexus::save' command, not by $caller"
}
if {$state(file,open) == "true"} {
nxscript close
set state(file,open) false
set flist [split [SplitReply [dataFileName]] "/"]
set fname [lindex $flist [expr [llength $flist] - 1] ]
clientput "$fname updated" "event"
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
##
# @brief Records that a given data source should be linked to nexus data target.
@@ -439,25 +509,48 @@ proc ::nexus::newfile {type {namestyle data}} {
}
}
##
# @brief Links data and axis into /data group
# @brief Make dataset links
#
# Sets the "signal" and "axes" attributes on the plottable data
proc ::nexus::makelinks {{hpath /}} {
if [ catch {
foreach child [hlist $hpath] {
if {$hpath == "/"} {
set newpath /$child
} else {
set newpath $hpath/$child
}
# clientput $newpath
array set p_arr [::utility::hlistplainprop $newpath]
if {$p_arr(data) == "true" && $p_arr(nxsave) == "true"} {
if {[info exists p_arr(type)] && $p_arr(type) == "nxvgroup"} {
if {$p_arr(link) != "@none"} {
# clientput "Link $p_arr(nxalias) to $p_arr(link)"
nxscript makelink $p_arr(nxalias) $p_arr(link)
}
}
::nexus::makelinks $newpath
}
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
##
# @brief Sets the "signal" and "axes" attributes on the plottable data
# Also sets the "axis" attribute for each of the axes.
proc ::nexus::linkdata {} {
proc ::nexus::set_plotdata_info {} {
variable data_gp_path
array unset axes
set hpath $data_gp_path
::nexus::nxreopenfile
foreach child [hlist $hpath] {
array set p_arr [::utility::hlistplainprop $hpath/$child]
if {$p_arr(data) == true && $p_arr(nxsave) == true} {
if {[info exists p_arr(nxalias)]} {
if {[info exists p_arr(type)] && $p_arr(type) == "nxvgroup"} {
if {$p_arr(link) != "@none"} {
nxscript makelink $p_arr(nxalias) $p_arr(link)
switch -glob $child {
"axis_*" {
set n [lindex [split $child _] 1]
@@ -468,7 +561,7 @@ proc ::nexus::newfile {type {namestyle data}} {
nxscript putattribute $p_arr(link) signal 1
set data_set_alias $p_arr(link)
}
default {error "ERROR: [info level -1]->linkdata, Unsupported data path $hpath/$child"}
default {error "ERROR: [info level -1]->set_plotdata_info, Unsupported data path $hpath/$child"}
}
}
}
@@ -481,7 +574,6 @@ proc ::nexus::newfile {type {namestyle data}} {
}
nxscript putattribute $data_set_alias axes [join $axes_list :]
}
::nexus::nxclosefile
}
##
@@ -490,25 +582,31 @@ proc ::nexus::newfile {type {namestyle data}} {
# @param hpath path of subtree to save, must not be "/"
# @param pt Current array index for mutable data (optional default=0)
proc ::nexus::savetree {hpath {pt 0}} {
foreach child [hlist /$hpath] {
array unset p_arr
array set p_arr [::utility::hlistplainprop /$hpath/$child]
if {[info exists p_arr(type)] && $p_arr(type) == "nxvgroup"} {
return
}
set data_type [lindex [split [hinfo /$hpath/$child] , ] 0]
if {$p_arr(data) == true && $p_arr(nxsave) == true } {
if {[info exists p_arr(savecmd)] && [info exists p_arr(nxalias)] } {
if {[info exists p_arr(mutable)] && $p_arr(mutable) == "true" } {
$p_arr(savecmd) $p_arr(sicsdev) $p_arr(nxalias) $data_type point $pt
} else {
$p_arr(savecmd) $p_arr(sicsdev) $p_arr(nxalias) $data_type
}
} elseif {[info exists p_arr(savecmd)] || [info exists p_arr(nxalias)]} {
error_msg "/$hpath/$child must have both 'savecmd' and 'nxalias' properties\nThe actual property list for /$hpath/$child is [array get p_arr]"
set ::errorInfo ""
if [ catch {
foreach child [hlist /$hpath] {
array unset p_arr
array set p_arr [::utility::hlistplainprop /$hpath/$child]
if {[info exists p_arr(type)] && $p_arr(type) == "nxvgroup"} {
return
}
::nexus::savetree $hpath/$child $pt
}
set data_type [lindex [split [hinfo /$hpath/$child] , ] 0]
if {$p_arr(data) == true && $p_arr(nxsave) == true } {
if {[info exists p_arr(savecmd)] && [info exists p_arr(nxalias)] } {
if {[info exists p_arr(mutable)] && $p_arr(mutable) == "true" } {
$p_arr(savecmd) $p_arr(sicsdev) $p_arr(nxalias) $data_type point $pt
} else {
$p_arr(savecmd) $p_arr(sicsdev) $p_arr(nxalias) $data_type
}
} elseif {[info exists p_arr(savecmd)] || [info exists p_arr(nxalias)]} {
error_msg "/$hpath/$child must have both 'savecmd' and 'nxalias' properties\nThe actual property list for /$hpath/$child is [array get p_arr]"
}
::nexus::savetree $hpath/$child $pt
}
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
@@ -526,6 +624,7 @@ proc ::nexus::newfile {type {namestyle data}} {
# @see gen_nxdict
proc ::nexus::_gen_nxdict {hpath dictPath name nxc} {
variable nxdictionary
if [ catch {
if {[::utility::hgetplainprop /$hpath data] == "false"} {
debug_msg "$hpath doesn't have a data property"
return
@@ -556,6 +655,10 @@ proc ::nexus::newfile {type {namestyle data}} {
set nxdictionary($alias) "$dictPath/NXVGROUP"
}
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
##
@@ -566,15 +669,16 @@ proc ::nexus::newfile {type {namestyle data}} {
#
# @param nexusdic Name of the nexus dictionary that will be created.
# @return Full path to the nexus dictionary.
proc ::nexus::gen_nxdict {nexusdic} {
global cfPath
variable nxdictionary
set nxdict_path $cfPath(nexus)/$nexusdic
proc ::nexus::gen_nxdict {nexusdic} {
global cfPath
variable nxdictionary
if [ catch {
set nxdict_path $cfPath(nexus)/$nexusdic
array unset nxdictionary
foreach hp [hlist /] {
if {[::utility::hgetplainprop /$hp data] == true} {
set nxclass [::utility::hgetplainprop /$hp klass]
::nexus::_gen_nxdict $hp /entry1,NXentry $hp $nxclass
::nexus::_gen_nxdict $hp /entry1,NXentry $hp $nxclass
}
}
set fh [open $nxdict_path w]
@@ -586,44 +690,57 @@ proc ::nexus::newfile {type {namestyle data}} {
puts $fh "$n = $v"
}
close $fh
return $nxdict_path
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
return $nxdict_path
}
##
# @brief Set SICS object attributes which are required for creating nexus data files.
proc ::nexus::set_sobj_attributes {} {
# SICS commands
sicslist setatt nxscript privilege internal
# SICS data objects
sicslist setatt nxscript_data privilege internal
if [ catch {
# SICS commands
sicslist setatt nxscript privilege internal
# SICS data objects
sicslist setatt nxscript_data privilege internal
foreach sobj [lrange [sicslist type motor] 1 end] {
sicslist setatt $sobj savecmd ::nexus::motor::save
sicslist setatt $sobj sdsinfo ::nexus::motor::sdsinfo
}
foreach sobj [sicslist type configurablevirtualmotor] {
sicslist setatt $sobj savecmd ::nexus::motor::save
sicslist setatt $sobj sdsinfo ::nexus::motor::sdsinfo
}
foreach sobj [sicslist type histmem] {
sicslist setatt $sobj savecmd ::nexus::histmem::save
sicslist setatt $sobj sdsinfo ::nexus::histmem::sdsinfo
}
foreach sobj [sicslist type sicsvariable] {
sicslist setatt $sobj savecmd ::nexus::sicsvariable::save
sicslist setatt $sobj sdsinfo ::nexus::sicsvariable::sdsinfo
}
foreach sobj [sicslist type singlecounter] {
sicslist setatt $sobj savecmd ::nexus::singlecounter::save
sicslist setatt $sobj sdsinfo ::nexus::singlecounter::sdsinfo
}
foreach sobj [sicslist type environment_controller] {
sicslist setatt $sobj savecmd ::nexus::environment_controller::save
sicslist setatt $sobj sdsinfo ::nexus::environment_controller::sdsinfo
}
foreach sobj [sicslist kind script] {
sicslist setatt $sobj savecmd ::nexus::script::save
sicslist setatt $sobj sdsinfo ::nexus::script::sdsinfo
foreach sobj [lrange [sicslist type motor] 1 end] {
sicslist setatt $sobj savecmd ::nexus::motor::save
sicslist setatt $sobj sdsinfo ::nexus::motor::sdsinfo
}
foreach sobj [sicslist type configurablevirtualmotor] {
sicslist setatt $sobj savecmd ::nexus::motor::save
sicslist setatt $sobj sdsinfo ::nexus::motor::sdsinfo
}
foreach sobj [sicslist type histmem] {
sicslist setatt $sobj savecmd ::nexus::histmem::save
sicslist setatt $sobj sdsinfo ::nexus::histmem::sdsinfo
}
foreach sobj [sicslist type sicsvariable] {
sicslist setatt $sobj savecmd ::nexus::sicsvariable::save
sicslist setatt $sobj sdsinfo ::nexus::sicsvariable::sdsinfo
}
foreach sobj [sicslist type singlecounter] {
sicslist setatt $sobj savecmd ::nexus::singlecounter::save
sicslist setatt $sobj sdsinfo ::nexus::singlecounter::sdsinfo
}
foreach sobj [sicslist type environment_controller] {
sicslist setatt $sobj savecmd ::nexus::environment_controller::save
sicslist setatt $sobj sdsinfo ::nexus::environment_controller::sdsinfo
}
foreach sobj [sicslist kind script] {
sicslist setatt $sobj savecmd ::nexus::script::save
sicslist setatt $sobj sdsinfo ::nexus::script::sdsinfo
}
foreach sobj [sicslist kind getset] {
sicslist setatt $sobj savecmd ::nexus::macro::getset_save
sicslist setatt $sobj sdsinfo ::nexus::macro::getset_sdsinfo
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
@@ -729,7 +846,41 @@ proc ::nexus::motor::sdsinfo {motor data_type args} {
return " -type $dtype $units_att $name_att"
}
}
##
# @brief Save data from a 'getset macro'
#
# NOTE: Currently just saves floats
namespace eval ::nexus::macro {}
proc ::nexus::macro::getset_save {sobj nxalias data_type args} {
if {[lindex $args 0] == "point"} {
set index [lindex $args 1]
nxscript_data clear
nxscript_data putfloat 0 [getVal [$sobj] ]
nxscript putslab $nxalias [list $index] [list 1] nxscript_data
} else {
nxscript putfloat $nxalias [SplitReply [$sobj]]
}
}
##
# @brief Define the scientific data set path for the nexus dictionary.
proc ::nexus::macro::getset_sdsinfo {sobj data_type args} {
array set param $args
array set attribute [attlist $sobj]
set dtype [::nexus::hdb2nx_type $data_type]
if {[info exists attribute(units)]} {
set units_att " -attr {units,$attribute(units)} "
} else {
set units_att " "
}
set name_att " -attr {long_name,$attribute(long_name)} "
if {$param(mutable) == true} {
return " -type $dtype -rank 1 -dim {-1} $units_att $name_att"
} else {
return " -type $dtype $units_att $name_att"
}
}
####
proc ::nexus::environment_controller::save {evc nxalias data_type args} {
if {[lindex $args 0] == "point"} {
set index [lindex $args 1]
@@ -806,30 +957,59 @@ proc ::nexus::singlecounter::sdsinfo {counter data_type args} {
#
# The macro must return a 1D associative array when called with -arrayname.
proc ::nexus::script::save {script nxalias data_type args} {
array set attribute [attlist $script]
set darray [$script -arrayname]
set size [array size $darray]
set size [SplitReply [$darray used]]
if {[lindex $args 0] == "point"} {
set index [lindex $args 1]
nxscript putslab $nxalias [list $index 0] [list 1 $size] $darray
if [ catch {
array set attribute [attlist $script]
if {$attribute(klass) == "sensor"} {
if {[lindex $args 0] == "point"} {
set index [lindex $args 1]
nxscript_data clear
nxscript_data putfloat 0 [$script]
nxscript putslab $nxalias [list $index] [list 1] nxscript_data
} else {
nxscript putfloat $nxalias [$script]
}
} else {
nxscript putslab $nxalias [list 0] [list $size] $darray
set darray [$script -arrayname]
set size [array size $darray]
set size [SplitReply [$darray used]]
if {[lindex $args 0] == "point"} {
set index [lindex $args 1]
nxscript putslab $nxalias [list $index 0] [list 1 $size] $darray
} else {
nxscript putslab $nxalias [list 0] [list $size] $darray
}
if {[info exists attribute(units)]} {
nxscript putattribute $nxalias units $attribute(units)
}
}
if {[info exists attribute(units)]} {
nxscript putattribute $nxalias units $attribute(units)
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
proc ::nexus::script::sdsinfo {script data_type args} {
array set param $args
set dtype [::nexus::hdb2nx_type $data_type]
set darray [$script -arrayname]
set size [SplitReply [$darray used]]
if {$param(mutable) == true} {
return " -type $dtype -rank 2 -dim {-1,$size}"
} else {
return " -type $dtype -rank 1 -dim {$size}"
if [ catch {
array set param $args
set dtype [::nexus::hdb2nx_type $data_type]
if {[getatt $script klass] == "sensor"} {
if {$param(mutable) == true} {
return " -type $dtype -rank 1 -dim {-1}"
} else {
return " -type $dtype"
}
} else {
set darray [$script -arrayname]
set size [SplitReply [$darray used]]
if {$param(mutable) == true} {
return " -type $dtype -rank 2 -dim {-1,$size}"
} else {
return " -type $dtype -rank 1 -dim {$size}"
}
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
@@ -850,26 +1030,26 @@ foreach expt $::nexus::exports {
set tmpstr [string map {"$" ""} {$Name: not supported by cvs2svn $}]
set nx_content_release_tag [lindex $tmpstr [expr [llength $tmpstr] - 1]]
set tmpstr [string map {"$" ""} {$Revision: 1.35 $}]
set tmpstr [string map {"$" ""} {$Revision: 1.36 $}]
set nx_content_revision_num [lindex $tmpstr [expr [llength $tmpstr] - 1]]
namespace eval data {
##
# @brief Nexus data save command for gumtree control interface
#
# @param run_number This is the run or scan point number, it serves as the array
# index for nexus data sets which correspond to mutable data
command gumtree_save {int: run_number} {
::nexus::save $run_number
}
sicslist setatt ::data::gumtree_save long_name save
array set param [::data::gumtree_save -list param]
::utility::mkData $param(run_number) run_number instrument privilege READ_ONLY mutable true control false
command gumtree_type {text:nx.hdf,xml type} {
SicsDataPostFix $type
}
sicslist set ::data::gumtree_type long_name file_format
::data::gumtree_type -set type [SplitReply [SicsDataPostFix]]
}
#namespace eval data {
# ##
# # @brief Nexus data save command for gumtree control interface
# #
# # @param run_number This is the run or scan point number, it serves as the array
# # index for nexus data sets which correspond to mutable data
# command gumtree_save {int: run_number} {
# ::nexus::save $run_number
# }
# sicslist setatt ::data::gumtree_save long_name save
# array set param [::data::gumtree_save -list param]
# ::utility::mkData $param(run_number) run_number instrument privilege READ_ONLY mutable true control false
# command gumtree_type {text:nx.hdf,xml type} {
# SicsDataPostFix $type
# }
# sicslist set ::data::gumtree_type long_name file_format
# ::data::gumtree_type -set type [SplitReply [SicsDataPostFix]]
#}
::nexus::init

49
site_ansto/instrument/config/scan/scan_common_1.tcl
View File

@@ -52,7 +52,9 @@ proc ::scan::check_scanvar {sobj uobj} {
set scan_increment [lindex $vlist 2];
if {[getatt $scan_variable type] == "motor"} {
if {[SplitReply [$scan_variable fixed]] >= 0} {
return -code error "Can't drive scan variable, $scan_variable position is set to 'fixed'"
return -code error "ERROR: Can't drive scan variable, $scan_variable position is set to 'fixed'"
} elseif {[SplitReply [$scan_variable thread0]] == -1} {
return -code error "ERROR: Can't scan ${scan_variable}. Thread zero has stopped running on the motion controller"
}
set target [expr $scan_start + $NP * $scan_increment]
if [catch {
@@ -130,6 +132,7 @@ proc ::scan::hmm_count {sobj uobj point mode preset} {
::histogram_memory::start block
}
#TODO rangescan: drive to original position for rangescans, not the start position.
proc ::scan::hmm_scan_finish {sobj uobj} {
variable save_filetype
variable reset_position
@@ -273,50 +276,6 @@ hmscan function count ::scan::hmm_count
hmscan function prepare ::scan::hmm_scan_prepare
hmscan function finish ::scan::hmm_scan_finish
namespace eval scan {
command hdb_bmonscan { text:drivable scan_variable float: scan_start float: scan_increment int: NP text:monitor,timer mode float: preset int:0,2 channel} {
bmonscan clear
# bmonscan configure script
bmonscan add $scan_variable $scan_start $scan_increment
bmonscan setchannel $channel;
set status [catch {bmonscan run $NP $mode $preset} msg]
# bmonscan configure soft
if {$status == 0} {
return $msg
} else {
return -code error "ERROR [info level 0]"
}
}
::scan::hdb_bmonscan -addfb text filename text mode float preset float scan_variable_value int scanpoint int counts text status
::scan::hdb_bmonscan -set feedback status IDLE
command hdb_hmscan { text:drivable scan_variable float: scan_start float: scan_increment int: NP text:monitor,timer mode float: preset int:0,2 channel} {
hmscan clear
hmscan add $scan_variable $scan_start $scan_increment
hmscan setchannel $channel;
set status [catch {hmscan run $NP $mode $preset} msg]
if {$status == 0} {
return $msg
} else {
return -code error "ERROR [info level 0]"
}
}
::scan::hdb_hmscan -addfb text filename text mode float preset float scan_variable_value int scanpoint int counts text status
::scan::hdb_hmscan -set feedback status IDLE
}
sicslist setatt ::scan::hdb_bmonscan long_name bmonscan
sicslist setatt ::scan::hdb_hmscan long_name hmscan
namespace eval scan {
namespace export runscan
VarMake ::scan::runscan_reset_position Text internal

8
site_ansto/instrument/deploySICS.sh
View File

@@ -1,8 +1,8 @@
#!/bin/sh
# $Revision: 1.26 $
# $Date: 2008-05-29 04:57:42 $
# $Revision: 1.27 $
# $Date: 2008-05-30 00:26:54 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by $Author: dcl $
# Last revision by $Author: ffr $
# Deploys SICServer and configuration files to
# an instrument control computer.
@@ -187,7 +187,7 @@ INSTSPEC=$(for f in $(cat $INSTSRC/MANIFEST.TXT); do echo -n "$INSTSRC/$f "; don
SCRIPT_VALIDATOR=$(for f in $(cat $INSTSRC/script_validator/MANIFEST.TXT); do echo -n "$INSTSRC/script_validator/$f "; done)
# Create Instrument Control Server directories and copy SICS configs to the 'server' directory
mkdir -p $TEMPDIR/$DESTDIR/{batch,server,data,log,tmp}
mkdir -p $TEMPDIR/$DESTDIR/{batch,server,log,tmp}
copy_server_config server
cp -a --preserve=timestamps ../SICServer $TEMPDIR/$DESTDIR/server

7
site_ansto/instrument/hipd/DMC2280/controller1.txt
View File

@@ -1,10 +1,11 @@
' WOMBAT - CONTROLLER 1
'
' $Revision: 1.10 $
' $Date: 2008-04-13 23:50:38 $
' $Revision: 1.11 $
' $Name: not supported by cvs2svn $
' $Date: 2008-05-30 00:26:55 $
' Author: Dan Bartlett
' Airpad control added by Doug Clowes
' Last revision by: $Author: dcl $
' Last revision by: $Author: ffr $
'
' A-MONOCHROMATOR UPPER TILT
' B-MONOCHROMATOR LOWER TILT

7
site_ansto/instrument/hipd/DMC2280/controller2.txt
View File

@@ -1,10 +1,11 @@
' WOMBAT - CONTROLLER 2
'
' $Revision: 1.6 $
' $Date: 2008-03-07 05:12:47 $
' $Revision: 1.7 $
' $Name: not supported by cvs2svn $
' $Date: 2008-05-30 00:26:55 $
' Author: Dan Bartlett
' Airpad control added by Doug Clowes
' Last revision by: $Author: dcl $
' Last revision by: $Author: ffr $
'
' A-SAMPLE UPPER TILT
' B-SAMPLE LOWER TILT

7
site_ansto/instrument/hipd/DMC2280/controller3.txt
View File

@@ -1,10 +1,11 @@
' WOMBAT - CONTROLLER 3
'
' $Revision: 1.4 $
' $Date: 2008-03-07 05:12:47 $
' $Revision: 1.5 $
' $Name: not supported by cvs2svn $
' $Date: 2008-05-30 00:26:55 $
' Author: Dan Bartlett
' Limit switch HOME routine added by Ferdi Franceschini
' Last revision by: $Author: dcl $
' Last revision by: $Author: ffr $
'
' A-MONOCHROMATOR FOCUS
' B-MONOCHROMATOR FOCUS

7
site_ansto/instrument/hipd/DMC2280/controller4.txt
View File

@@ -1,10 +1,11 @@
' WOMBAT - CONTROLLER 4
'
' $Revision: 1.3 $
' $Date: 2008-03-07 05:12:47 $
' $Revision: 1.4 $
' $Name: not supported by cvs2svn $
' $Date: 2008-05-30 00:26:55 $
' Author: Dan Bartlett
' Limit switch HOME routine added by Ferdi Franceschini
' Last revision by: $Author: dcl $
' Last revision by: $Author: ffr $
'
' A-SPARE
' B-SPARE

2
site_ansto/instrument/hipd/MANIFEST.TXT
View File

@@ -1,4 +1,6 @@
sics_ports.tcl
script_validator_ports.tcl
instrument_vars.tcl
wombat_configuration.tcl
config
util

3
site_ansto/instrument/hipd/config/INSTCFCOMMON.TXT
View File

@@ -1,5 +1,7 @@
config/anticollider/anticollider_common.tcl
config/plc/plc_common_1.tcl
config/counter/counter_common_1.tcl
config/environment/temperature/lakeshore340_common.tcl
config/hipadaba/hipadaba_configuration_common.tcl
config/hipadaba/common_instrument_dictionary.tcl
config/hipadaba/instdict_specification.tcl
@@ -9,3 +11,4 @@ config/hmm/anstohm_linked.xml
config/scan/scan_common_1.hdd
config/scan/scan_common_1.tcl
config/nexus/nxscripts_common_1.tcl
config/commands/commands_common.tcl

16
site_ansto/instrument/hipd/config/anticollider/acscript.txt Normal file
View File

@@ -0,0 +1,16 @@
# This script is loaded automatically by anticollider.tcl when SICS is launched
# TODO Allow sequencing
# TODO Allow functional dependencies
#
# Examples
# for pcx forbid { {80 130} {10 20} }
# when stth in { {0 10} {20 30} } forbid { {10 20} {90 100} } for mtth
#
## The next example forbids movement when both schi and sx are in the given ranges
# forbid {0 10} for sphi whenall {schi in {10 15} sx {10 11} }
for stth forbid {20 30} when mtth in {44 45}
for stth forbid {-120 -100} when mtth in {99 100}
for mtth forbid {90 100} when stth in {-120 -119}
for mtth forbid {45 55} when stth in {29 30}

7
site_ansto/instrument/hipd/config/anticollider/anticollider.tcl Normal file
View File

@@ -0,0 +1,7 @@
# $Revision: 1.2 $
# $Date: 2008-05-30 00:26:55 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by: $Author: ffr $
source $cfPath(anticollider)/anticollider_common.tcl
::anticollider::loadscript acscript.txt

1
site_ansto/instrument/hipd/config/commands/commands.tcl Normal file
View File

@@ -0,0 +1 @@
source $cfPath(commands)/commands_common.tcl

24
site_ansto/instrument/hipd/config/environment/temperature/lakeshore340.tcl Normal file
View File

@@ -0,0 +1,24 @@
source $cfPath(environment)/temperature/lakeshore340_common.tcl
# @brief Adds a lakeshore 340 temperature controller object.
#
# This must be called when the instrument configuration is loaded and before\n
# the buildHDB function is called. Currently there is no way to add and remove\n
# environment controllers and their hdb paths at runtime.
proc ::environment::temperature::add_ls340 {} {
set sim_mode [SplitReply [environment_simulation]]
if {$sim_mode == "true"} {
::environment::temperature::mkls340sim tc1
} else {
::environment::temperature::mkls340 tc1
tc1 tolerance 1
tc1 Settle 30
tc1 range 2
tc1 UpperLimit 500
tc1 LowerLimit 4
}
sicslist setatt tc1 environment_name tempone
sicslist setatt tc1 long_name control_sensor_reading
::environment::mkenvinfo tc1 {heateron {priv user} range {priv manager} }
}

144
site_ansto/instrument/hipd/config/hmm/hmm_configuration.tcl
View File

@@ -2,51 +2,119 @@ source $cfPath(hmm)/hmm_configuration_common_1.tcl
source $cfPath(hmm)/hmm_cylindrical_detector_configuration.tcl
set sim_mode [SplitReply [hmm_simulation]]
##\brief Return the detector position
proc ::histogram_memory::init_OAT_TABLE {} {
if [ catch {
# We don't need a MAX_CHAN parameter for time because the time channel
# is scaled by calling the ::histogram_memory::clock_scale function
OAT_TABLE X -setdata MAX_CHAN 3872
OAT_TABLE X -setdata MAX_CHAN_PERSEG 992
OAT_TABLE Y -setdata MAX_CHAN 512
OAT_TABLE X -setdata ALLOWED_RESOLUTIONS {1 2 4 8 16 32}
OAT_TABLE X -setdata BMIN -0.5
OAT_TABLE X -setdata BMAX 991.5
OAT_TABLE Y -setdata BMIN -0.5
OAT_TABLE Y -setdata BMAX 511.5
# x bin range 0, 3871
# y bin range 0, 511
FAT_TABLE -set MULTI_HOST_HISTO_STITCH_OVERLAP 32
OAT_TABLE -set X { 991.5 990.5 } NXC 992 Y { 511.5 510.5 } NYC 512 T { 0 2000 } NTC 1
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
##
# @brief Returns the oat table bin boundaries.
proc ::histogram_memory::oat_bins {axis} {
array set channID {X NXC Y NYC T NTC}
if [ catch {
if {$axis == "X"} {
foreach {bb0 bb1} [OAT_TABLE -get $axis] {}
set bstep [expr $bb1 - $bb0]
if {$bstep < 0} {
set nch_perseg [OAT_TABLE -get $channID($axis)]
set overlap [FAT_TABLE -get MULTI_HOST_HISTO_STITCH_OVERLAP]
set bb0 [expr 4*$nch_perseg - 3*$overlap + $bstep/2.0]
set bb1 [expr $bb0+$bstep]
###########
# set overlap [FAT_TABLE -get MULTI_HOST_HISTO_STITCH_OVERLAP]
# set bb0 [expr 4*$bb0 - 3*($overlap-1)]
# set bb1 [expr $bb0+$bstep]
}
return [list $bb0 $bb1]
} else {
return [OAT_TABLE -get $axis]
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
##
# @brief Returns the current number of channels for a given axis.
proc ::histogram_memory::number_of_channels {axis} {
array set channID {X NXC Y NYC T NTC}
if [ catch {
if {$axis == "X"} {
set nch_perseg [OAT_TABLE -get $channID($axis)]
set overlap [FAT_TABLE -get MULTI_HOST_HISTO_STITCH_OVERLAP]
set nch [expr 4*$nch_perseg - 3*$overlap]
return $nch
} else {
return [OAT_TABLE -get $channID($axis)]
}
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
##
# @brief Return the detector position
proc ::histogram_memory::detector_posn_degrees {} {
return [SplitReply [stth]]
if [ catch {
return [SplitReply [stth]]
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
proc ::histogram_memory::pre_count {} {}
proc ::histogram_memory::post_count {} {}
proc ::histogram_memory::initialize {} {
if {$::sim_mode == "true"} {
hmm configure oat_ntc_eff 1
hmm configure oat_nyc_eff 512
hmm configure oat_nxc_eff [expr 480*8 - 1]
}
::histogram_memory::_initialize
::histogram_memory::two_theta -boundaries
if [ catch {
if {$::sim_mode == "true"} {
hmm configure oat_ntc_eff 1
hmm configure stitch_nyc 512
hmm configure stitch_nxc [expr 480*8 - 1]
}
BAT_TABLE -init
CAT_TABLE -init
SAT_TABLE -init
OAT_TABLE -init
FAT_TABLE -init MULTI_HOST_HISTO_STITCH_OVERLAP
::histogram_memory::_initialize
::histogram_memory::two_theta -boundaries
detector_active_height_mm 200
detector_active_width_mm 500
detector_radius_mm 700.0
set x_bb0 991.5; set xbbmax -0.5
set y_bb0 0; set ybbmax 511.5
hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0
hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax
hmm configure FAT_SIMULATED_EVENT_X0 $x_bb0
hmm configure FAT_SIMULATED_EVENT_X1 $xbbmax
set x_binwidth 1
if {[expr {$xbbmax - $x_bb0}] > 0} {
set x_bb1 [expr {$x_bb0+$x_binwidth}]
} else {
set x_bb1 [expr {$x_bb0-$x_binwidth}]
}
set y_binwidth 1
if {[expr {$ybbmax - $y_bb0}] > 0} {
set y_bb1 [expr {$y_bb0+$y_binwidth}]
} else {
set y_bb1 [expr {$y_bb0-$y_binwidth}]
}
OAT_TABLE -init X_MIN $x_bb0 X_MAX $xbbmax Y_MIN $y_bb0 Y_MAX $ybbmax
# We default to one big bin for time
set t_bb0 [OAT_TABLE -get T_MIN]
set t_bb1 [OAT_TABLE -get T_MAX]
OAT_TABLE X "$x_bb0 $x_bb1" Y "$y_bb0 $y_bb1" T "$t_bb0 $t_bb1"
::histogram_memory::upload_config Filler_defaults
detector_active_height_mm 200
detector_active_width_mm 500
detector_radius_mm 700.0
::nexus::data alias ::histogram_memory::vertical_axis ::histogram_memory::y_pixel_offset
::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::two_theta
# hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0
# hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax
# hmm configure FAT_SIMULATED_EVENT_X0 $x_bb0
# hmm configure FAT_SIMULATED_EVENT_X1 $xbbmax
::histogram_memory::init_OAT_TABLE
::histogram_memory::upload_config Filler_defaults
::nexus::data alias ::histogram_memory::vertical_axis ::histogram_memory::y_pixel_offset
::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::two_theta
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
proc histmem {cmd args} {

8
site_ansto/instrument/hipd/config/motors/motor_configuration.tcl
View File

@@ -1,7 +1,8 @@
# $Revision: 1.20 $
# $Date: 2008-05-29 04:53:32 $
# $Revision: 1.21 $
# $Date: 2008-05-30 00:26:55 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by: $Author: dcl $
# Last revision by: $Author: ffr $
source $cfPath(anticollider)/anticollider.tcl
# START MOTOR CONFIGURATION
@@ -642,3 +643,4 @@ make_gap_motors ss2hg gap ss2ho offset ss2r ss2l mm $slit2HGroup
proc motor_set_sobj_attributes {} {
}
# END MOTOR CONFIGURATION
::anticollider::init

3
site_ansto/instrument/hipd/instrument_vars.tcl Normal file
View File

@@ -0,0 +1,3 @@
VarMake deg_per_rad Float Internal
deg_per_rad 57.29577951308232
deg_per_rad lock

4
site_ansto/instrument/hipd/script_validator_ports.tcl Normal file
View File

@@ -0,0 +1,4 @@
set quieckport quieck-val-wombat
set serverport server-val-wombat
set interruptport interrupt-val-wombat
set telnetport telnet-val-wombat

70
site_ansto/instrument/hipd/wombat_configuration.tcl
View File

@@ -1,5 +1,5 @@
# $Revision: 1.19 $
# $Date: 2007-11-07 04:57:40 $
# $Revision: 1.20 $
# $Date: 2008-05-30 00:26:55 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by: $Author: ffr $
@@ -12,9 +12,6 @@ Instrument lock
source util/dmc2280/dmc2280_util.tcl
source sics_ports.tcl
source server_config.tcl
VarMake deg_per_rad Float Internal
deg_per_rad 57.29577951308232
deg_per_rad lock
#END SERVER CONFIGURATION SECTION
########################################
@@ -22,61 +19,36 @@ deg_per_rad lock
fileeval $cfPath(motors)/motor_configuration.tcl
########
# Parameters set above the restore command will be clobbered by
# the values in the status.tcl file
restore
source instrument_vars.tcl
source $cfPath(hipadaba)/hipadaba_configuration.tcl
fileeval $cfPath(plc)/plc.tcl
fileeval $cfPath(counter)/counter.tcl
#TODO Provide method for choosing environment controller
fileeval $cfPath(environment)/temperature/lakeshore340.tcl
fileeval $cfPath(hmm)/hmm_configuration.tcl
fileeval $cfPath(nexus)/nxscripts.tcl
fileeval $cfPath(scan)/scan.tcl
source $cfPath(hipadaba)/hipadaba_configuration.tcl
fileeval $cfPath(commands)/commands.tcl
source gumxml.tcl
########
# Parameters set above the restore command will be clobbered by
# the values in the status.tcl file
# BIG WARNING: DON'T PUT 'restore' IN A CATCH BLOCK BECAUSE IT RETURNS
# AN ERROR IF THERE IS NO ../log/status.tcl FILE.
restore
::histogram_memory::initialize
#::environment::temperature::add_ls340
VarMake detector_layout Text Mugger
detector_layout cylinder
VarMake detector_angle_deg Float User
detector_angle_deg 120.0
VarMake detector_angle_rad Float User
detector_angle_rad [expr [SplitReply [detector_angle_deg]]/[SplitReply [deg_per_rad]] ]
VarMake crystal_type Text User
VarMake crystal_wavelength_A Float User
VarMake bmon_distance Float User
## Number of last pixel on vertical axis
VarMake detector_last_vert_pixel Float User
detector_last_vert_pixel 511
## Number of last pixel on horizontal axis
VarMake detector_last_hor_pixel Float User
detector_last_hor_pixel [expr 480 * 8 - 1]
## Row number at beam centre
VarMake detector_zero_row Float User
detector_zero_row 255.5
## Column number at beam centre for a detector rotation of 0 degrees
VarMake detector_zero_col Float User
detector_zero_col [SplitReply [detector_last_hor_pixel]]
## Row offset for region of interest
VarMake detector_ROI_row_offset Float User
detector_ROI_row_offset 0
## Column offset for region of interest
VarMake detector_ROI_col_offset Float User
detector_ROI_col_offset 0
detector_type He-3 position sensitive detector
detector_type lock
detector_description 8 curved multiwire segments
detector_description lock
MakeStateMon hmscan
fileeval extraconfig.tcl
if [file exists extraconfig.tcl] {
fileeval extraconfig.tcl
} else {
clientput "extraconfig.tcl not found. continueing"
}
server_set_sobj_attributes
buildHDB instrument_dictionary

7
site_ansto/instrument/hrpd/DMC2280/controller1.txt
View File

@@ -1,10 +1,11 @@
' ECHIDNA - CONTROLLER 1
'
' $Revision: 1.8 $
' $Date: 2008-04-13 23:50:38 $
' $Revision: 1.9 $
' $Name: not supported by cvs2svn $
' $Date: 2008-05-30 00:26:55 $
' Author: Dan Bartlett
' Airpad control added by Doug Clowes
' Last revision by: $Author: dcl $
' Last revision by: $Author: ffr $
'
' A-MONOCHROMATOR UPPER TILT (mphi) - TILT 1
' B-MONOCHROMATOR LOWER TILT (mchi) - TILT 2

7
site_ansto/instrument/hrpd/DMC2280/controller2.txt
View File

@@ -1,10 +1,11 @@
' ECHIDNA - CONTROLLER 2
'
' $Revision: 1.6 $
' $Date: 2008-04-13 23:50:38 $
' $Revision: 1.7 $
' $Name: not supported by cvs2svn $
' $Date: 2008-05-30 00:26:55 $
' Author: Dan Bartlett
' Airpad control added by Doug Clowes
' Last revision by: $Author: dcl $
' Last revision by: $Author: ffr $
'
' A-SAMPLE UPPER TILT (sphi) - TILT 1
' B-SAMPLE LOWER TILT (schi) - TILT 2

7
site_ansto/instrument/hrpd/DMC2280/controller3.txt
View File

@@ -1,10 +1,11 @@
' ECHIDNA - CONTROLLER 3
'
' $Revision: 1.10 $
' $Date: 2008-05-08 06:48:32 $
' $Revision: 1.11 $
' $Name: not supported by cvs2svn $
' $Date: 2008-05-30 00:26:55 $
' Author: Dan Bartlett
' Limit switch HOME routine added by Ferdi Franceschini
' Last revision by: $Author: dcl $
' Last revision by: $Author: ffr $
'
' A-MONOCHROMATOR FOCUS
' B-SPARE

7
site_ansto/instrument/hrpd/DMC2280/controller4.txt
View File

@@ -1,10 +1,11 @@
' ECHIDNA - CONTROLLER 4
'
' $Revision: 1.10 $
' $Date: 2008-04-30 01:56:22 $
' $Revision: 1.11 $
' $Name: not supported by cvs2svn $
' $Date: 2008-05-30 00:26:55 $
' Author: Dan Bartlett
' Limit switch HOME routine added by Ferdi Franceschini
' Last revision by: $Author: dcl $
' Last revision by: $Author: ffr $
'
' A-SPARE
' B-SPARE

2
site_ansto/instrument/hrpd/MANIFEST.TXT
View File

@@ -1,4 +1,6 @@
sics_ports.tcl
script_validator_ports.tcl
instrument_vars.tcl
echidna_configuration.tcl
config
util

3
site_ansto/instrument/hrpd/config/INSTCFCOMMON.TXT
View File

@@ -1,5 +1,7 @@
config/anticollider/anticollider_common.tcl
config/plc/plc_common_1.tcl
config/counter/counter_common_1.tcl
config/environment/temperature/lakeshore340_common.tcl
config/hipadaba/hipadaba_configuration_common.tcl
config/hipadaba/common_instrument_dictionary.tcl
config/hipadaba/instdict_specification.tcl
@@ -9,3 +11,4 @@ config/hmm/anstohm_linked.xml
config/scan/scan_common_1.hdd
config/scan/scan_common_1.tcl
config/nexus/nxscripts_common_1.tcl
config/commands/commands_common.tcl

18
site_ansto/instrument/hrpd/config/anticollider/acscript.txt Normal file
View File

@@ -0,0 +1,18 @@
# This script is loaded automatically by anticollider.tcl when SICS is launched
# TODO Allow sequencing
# TODO Allow functional dependencies
#
# Examples
# for pcx forbid { {80 130} {10 20} }
# when stth in { {0 10} {20 30} } forbid { {10 20} {90 100} } for mtth
#
## The next example forbids movement when both schi and sx are in the given ranges
# forbid {0 10} for sphi whenall {schi in {10 15} sx {10 11} }
for pcx forbid {80 130}
for pcr forbid {-inf inf} when mom in {45 50}
for stth forbid {160 167} when mtth in {87 88}
for stth forbid {0 15} when mtth in {139.5 140.5}
for mtth forbid {87 100} when stth in {166 167}
for mtth forbid {130 140.5} when stth in {0 1}

8
site_ansto/instrument/hrpd/config/anticollider/anticollider.tcl Normal file
View File

@@ -0,0 +1,8 @@
# $Revision: 1.2 $
# $Date: 2008-05-30 00:26:56 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by: $Author: ffr $
source $cfPath(anticollider)/anticollider_common.tcl
::anticollider::loadscript acscript.txt

1
site_ansto/instrument/hrpd/config/commands/commands.tcl Normal file
View File

@@ -0,0 +1 @@
source $cfPath(commands)/commands_common.tcl

24
site_ansto/instrument/hrpd/config/environment/temperature/lakeshore340.tcl Normal file
View File

@@ -0,0 +1,24 @@
source $cfPath(environment)/temperature/lakeshore340_common.tcl
# @brief Adds a lakeshore 340 temperature controller object.
#
# This must be called when the instrument configuration is loaded and before\n
# the buildHDB function is called. Currently there is no way to add and remove\n
# environment controllers and their hdb paths at runtime.
proc ::environment::temperature::add_ls340 {} {
set sim_mode [SplitReply [environment_simulation]]
if {$sim_mode == "true"} {
::environment::temperature::mkls340sim tc1
} else {
::environment::temperature::mkls340 tc1
tc1 tolerance 1
tc1 Settle 30
tc1 range 2
tc1 UpperLimit 500
tc1 LowerLimit 4
}
sicslist setatt tc1 environment_name tempone
sicslist setatt tc1 long_name control_sensor_reading
::environment::mkenvinfo tc1 {heateron {priv user} range {priv manager} }
}

86
site_ansto/instrument/hrpd/config/hmm/hmm_configuration.tcl
View File

@@ -2,51 +2,63 @@ source $cfPath(hmm)/hmm_configuration_common_1.tcl
source $cfPath(hmm)/hmm_cylindrical_detector_configuration.tcl
set sim_mode [SplitReply [hmm_simulation]]
##\brief Return the detector position
proc ::histogram_memory::init_OAT_TABLE {} {
if [ catch {
# We don't need a MAX_CHAN parameter for time because the time channel
# is scaled by calling the ::histogram_memory::clock_scale function
OAT_TABLE X -setdata MAX_CHAN 128
OAT_TABLE Y -setdata MAX_CHAN 512
OAT_TABLE X -setdata BMIN -0.5
OAT_TABLE X -setdata BMAX 127.5
OAT_TABLE Y -setdata BMIN -0.5
OAT_TABLE Y -setdata BMAX 511.5
OAT_TABLE -set X { 127.5 126.5 } NXC 128 Y { -0.5 0.5 } NYC 512 T { 0 2000 } NTC 1
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
##
# @brief Return the detector position
proc ::histogram_memory::detector_posn_degrees {} {
return [SplitReply [stth]]
}
proc ::histogram_memory::pre_count {} {}
proc ::histogram_memory::post_count {} {}
proc ::histogram_memory::initialize {} {
if {$::sim_mode == "true"} {
hmm configure oat_ntc_eff 1
hmm configure oat_nyc_eff 1024
hmm configure oat_nxc_eff 64
}
::histogram_memory::_initialize
::histogram_memory::two_theta -boundaries
if [ catch {
if {$::sim_mode == "true"} {
hmm configure oat_ntc_eff 1
hmm configure oat_nyc_eff 1024
hmm configure oat_nxc_eff 64
}
BAT_TABLE -init
CAT_TABLE -init
SAT_TABLE -init
OAT_TABLE -init
FAT_TABLE -init
::histogram_memory::_initialize
::histogram_memory::two_theta -boundaries
detector_active_height_mm 335
detector_active_width_mm 500
detector_radius_mm 1250.0
set x_bb0 -0.5; set xbbmax 63.5
set y_bb0 -0.5; set ybbmax 1023.5
hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0
hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax
hmm configure FAT_SIMULATED_EVENT_X0 $x_bb0
hmm configure FAT_SIMULATED_EVENT_X1 $xbbmax
set x_binwidth 1
if {[expr {$xbbmax - $x_bb0}] > 0} {
set x_bb1 [expr {$x_bb0+$x_binwidth}]
} else {
set x_bb1 [expr {$x_bb0-$x_binwidth}]
}
set y_binwidth 1
if {[expr {$ybbmax - $y_bb0}] > 0} {
set y_bb1 [expr {$y_bb0+$y_binwidth}]
} else {
set y_bb1 [expr {$y_bb0-$y_binwidth}]
}
OAT_TABLE -init X_MIN $x_bb0 X_MAX $xbbmax Y_MIN $y_bb0 Y_MAX $ybbmax
# We default to one big bin for time
set t_bb0 [OAT_TABLE -get T_MIN]
set t_bb1 [OAT_TABLE -get T_MAX]
OAT_TABLE X "$x_bb0 $x_bb1" Y "$y_bb0 $y_bb1" T "$t_bb0 $t_bb1"
::histogram_memory::upload_config Filler_defaults
detector_active_height_mm 335
detector_active_width_mm 500
detector_radius_mm 1250.0
::nexus::data alias ::histogram_memory::vertical_axis ::histogram_memory::y_pixel_offset
::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::two_theta
# hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0
# hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax
# hmm configure FAT_SIMULATED_EVENT_X0 $x_bb0
# hmm configure FAT_SIMULATED_EVENT_X1 $xbbmax
::histogram_memory::init_OAT_TABLE
::histogram_memory::upload_config Filler_defaults
::nexus::data alias ::histogram_memory::vertical_axis ::histogram_memory::y_pixel_offset
::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::two_theta
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
proc histmem {cmd args} {

10
site_ansto/instrument/hrpd/config/motors/motor_configuration.tcl
View File

@@ -1,7 +1,8 @@
# $Revision: 1.23 $
# $Date: 2008-05-29 04:54:06 $
# $Revision: 1.24 $
# $Date: 2008-05-30 00:26:56 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by: $Author: dcl $
# Last revision by: $Author: ffr $
source $cfPath(anticollider)/anticollider.tcl
# START MOTOR CONFIGURATION
@@ -256,7 +257,6 @@ mtth blockage_ratio 5
mtth backlash_offset -1
mtth creep_offset 90
mtth creep_precision 0.02
#mtth debug 1
mtth part crystal
mtth long_name takeoff_angle
@@ -445,7 +445,6 @@ stth blockage_ratio 1.5
stth backlash_offset -0.1
stth creep_offset 0.1
stth creep_precision 0.00002
stth debug 1
stth part sample
stth long_name azimuthal_angle
@@ -695,3 +694,4 @@ make_gap_motors ss2hg gap ss2ho offset ss2r ss2l mm $slit2HGroup
proc motor_set_sobj_attributes {} {
}
# END MOTOR CONFIGURATION
::anticollider::init

70
site_ansto/instrument/hrpd/echidna_configuration.tcl
View File

@@ -1,5 +1,5 @@
# $Revision: 1.26 $
# $Date: 2007-11-05 02:28:46 $
# $Revision: 1.27 $
# $Date: 2008-05-30 00:26:55 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by: $Author: ffr $
@@ -12,9 +12,6 @@ Instrument lock
source util/dmc2280/dmc2280_util.tcl
source sics_ports.tcl
source server_config.tcl
VarMake deg_per_rad Float Internal
deg_per_rad 57.29577951308232
deg_per_rad lock
#END SERVER CONFIGURATION SECTION
########################################
@@ -22,61 +19,36 @@ deg_per_rad lock
fileeval $cfPath(motors)/motor_configuration.tcl
########
# Parameters set above the restore command will be clobbered by
# the values in the status.tcl file
restore
source instrument_vars.tcl
source $cfPath(hipadaba)/hipadaba_configuration.tcl
fileeval $cfPath(plc)/plc.tcl
fileeval $cfPath(counter)/counter.tcl
#TODO Provide method for choosing environment controller
fileeval $cfPath(environment)/temperature/lakeshore340.tcl
fileeval $cfPath(hmm)/hmm_configuration.tcl
fileeval $cfPath(nexus)/nxscripts.tcl
fileeval $cfPath(scan)/scan.tcl
source $cfPath(hipadaba)/hipadaba_configuration.tcl
fileeval $cfPath(commands)/commands.tcl
source gumxml.tcl
########
# Parameters set above the restore command will be clobbered by
# the values in the status.tcl file
# BIG WARNING: DON'T PUT 'restore' IN A CATCH BLOCK BECAUSE IT RETURNS
# AN ERROR IF THERE IS NO ../log/status.tcl FILE.
restore
::histogram_memory::initialize
#::environment::temperature::add_ls340
VarMake detector_layout Text Mugger
detector_layout cylinder
VarMake detector_angle_deg Float User
detector_angle_deg 158.75
VarMake detector_angle_rad Float User
detector_angle_rad [expr [SplitReply [detector_angle_deg]]/[SplitReply [deg_per_rad]] ]
VarMake crystal_type Text User
VarMake crystal_wavelength_A Float User
VarMake bmon_distance Float User
## Number of last pixel on vertical axis
VarMake detector_last_vert_pixel Float User
detector_last_vert_pixel 511
## Number of last pixel on horizontal axis
VarMake detector_last_hor_pixel Float User
detector_last_hor_pixel 127
## Row number at beam centre
VarMake detector_zero_row Float User
detector_zero_row 255.5
## Column number at beam centre for a detector rotation of 0 degrees
VarMake detector_zero_col Float User
detector_zero_col 124
## Row offset for region of interest
VarMake detector_ROI_row_offset Float User
detector_ROI_row_offset 0
## Column offset for region of interest
VarMake detector_ROI_col_offset Float User
detector_ROI_col_offset 0
detector_type He-3 position sensitive detector, tube active length=335+/-5mm, tube diameter=25.4 +/- 0.8mm
detector_type lock
detector_description 128 He-3 proportional counter detector tubes (GE Energy Reuter Stokes Inc. item=RS-P4-0814-217)
detector_description lock
MakeStateMon hmscan
fileeval extraconfig.tcl
if [file exists extraconfig.tcl] {
fileeval extraconfig.tcl
} else {
clientput "extraconfig.tcl not found. continueing"
}
server_set_sobj_attributes
buildHDB instrument_dictionary

74
site_ansto/instrument/hrpd/extraconfig.tcl
View File

@@ -1,70 +1,6 @@
# Put extra config info here.
# Just some examples for now
bmon_distance -1.0
Title "precommissioning tests"
Sample "No Sample"
# Selected wavelength in Angstroms
crystal_wavelength_A "0.0"
crystal_type "Unknown"
## LAKESHORE
# @file Put extra configuration info here.
#
# NOTE TO DEVELOPERS,\n
# Do not put this file name in the MANIFEST.TXT, it should not be automatically\n
# deployed to an instrument.
#source util/dmc2280/dmc2280_util.tcl
#First Lakshore340 tempcontroller creation
MakeRS232Controller sertemp1 127.0.0.1 4001
sertemp1 timeout 20000
sertemp1 sendterminator 0xd
sertemp1 replyterminator 0xd
EvFactory new tc1 lakeshore340 sertemp1 1 1
tc1 tolerance 0.2
tc1 UpperLimit 500
tc1 LowerLimit 4
tc1 sensor 3
tc1 control 3
#Second Lakshore340 tempcontroller creation
MakeRS232Controller sertemp2 127.0.0.1 4002
sertemp2 timeout 20000
sertemp2 sendterminator 0xd
sertemp2 replyterminator 0xd
EvFactory new tc2 lakeshore340 sertemp2 1 1
tc2 tolerance 0.2
tc2 UpperLimit 500
tc2 LowerLimit 4
tc2 sensor 3
tc2 control 3
#First Julabo tempcontroller creation
MakeRS232Controller sertemp3 127.0.0.1 4003
sertemp3 timeout 20000
sertemp3 sendterminator 0xd 0xa
sertemp3 replyterminator 0xd
EvFactory new tc3 lh45 sertemp3 1 1
tc3 tolerance 0.5
tc3 UpperLimit 110
tc3 LowerLimit -30
#Second Julabo tempcontroller creation
MakeRS232Controller sertemp4 127.0.0.1 4004
sertemp4 timeout 20000
sertemp4 sendterminator 0xd 0xa
sertemp4 replyterminator 0xd
EvFactory new tc4 lh45 sertemp4 1 1
tc4 tolerance 0.5
tc4 UpperLimit 110
tc4 LowerLimit -30
sicslist setatt tc1 long_name tempone
sicslist setatt tc2 long_name temptwo
sicslist setatt tc3 long_name tempthree
sicslist setatt tc4 long_name tempfour
#END SERVER CONFIGURATION SECTION
sicslist setatt tc1 units kelvin
sicslist setatt tc2 units kelvin
sicslist setatt tc3 units Celsius
sicslist setatt tc4 units Celsius
sicslist setatt tc1 savecmd ::nexus::evcontroller::save
sicslist setatt tc1 sdsinfo ::nexus::evcontroller::sdsinfo
sicslist setatt tc2 savecmd ::nexus::evcontroller::save
sicslist setatt tc2 sdsinfo ::nexus::evcontroller::sdsinfo
sicslist setatt tc3 savecmd ::nexus::evcontroller::save
sicslist setatt tc3 sdsinfo ::nexus::evcontroller::sdsinfo
sicslist setatt tc4 savecmd ::nexus::evcontroller::save
sicslist setatt tc4 sdsinfo ::nexus::evcontroller::sdsinfo

9
site_ansto/instrument/hrpd/instrument_vars.tcl Normal file
View File

@@ -0,0 +1,9 @@
# @file This file defines the instrument variables.
VarMake deg_per_rad Float Internal
deg_per_rad 57.29577951308232
deg_per_rad lock

4
site_ansto/instrument/hrpd/script_validator_ports.tcl Normal file
View File

@@ -0,0 +1,4 @@
set quieckport quieck-val-echidna
set serverport server-val-echidna
set interruptport interrupt-val-echidna
set telnetport telnet-val-echidna

7
site_ansto/instrument/reflectometer/DMC2280/controller1.txt
View File

@@ -1,9 +1,10 @@
' PLATYPUS - CONTROLLER 1
'
' $Revision: 1.11 $
' $Date: 2008-04-30 01:57:55 $
' $Revision: 1.12 $
' $Name: not supported by cvs2svn $
' $Date: 2008-05-30 00:26:56 $
' Author: Dan Bartlett
' Last revision by: $Author: dcl $
' Last revision by: $Author: ffr $
'
' A-BEAM SHADE RAISE
' B-COLLIMATOR TRANSLATE A=7350364, B=6529772, C=6941582

7
site_ansto/instrument/reflectometer/DMC2280/controller2.txt
View File

@@ -1,9 +1,10 @@
' PLATYPUS - CONTROLLER 2
'
' $Revision: 1.6 $
' $Date: 2008-04-30 01:57:55 $
' $Revision: 1.7 $
' $Name: not supported by cvs2svn $
' $Date: 2008-05-30 00:26:56 $
' Author: Dan Bartlett
' Last revision by: $Author: dcl $
' Last revision by: $Author: ffr $
'
' A-SAMPLE TILT 1
' B-SAMPLE TILT 2

7
site_ansto/instrument/reflectometer/DMC2280/controller3.txt
View File

@@ -1,9 +1,10 @@
' PLATYPUS - CONTROLLER 3
'
' $Revision: 1.6 $
' $Date: 2008-04-30 01:57:55 $
' $Revision: 1.7 $
' $Name: not supported by cvs2svn $
' $Date: 2008-05-30 00:26:56 $
' Author: Dan Bartlett
' Last revision by: $Author: dcl $
' Last revision by: $Author: ffr $
'
' A-SLIT S1 WEST BLADE
' B-SLIT S1 EAST BLADE

7
site_ansto/instrument/reflectometer/DMC2280/controller4.txt
View File

@@ -1,9 +1,10 @@
' PLATYPUS - CONTROLLER 4
'
' $Revision: 1.6 $
' $Date: 2008-04-30 01:57:55 $
' $Revision: 1.7 $
' $Name: not supported by cvs2svn $
' $Date: 2008-05-30 00:26:56 $
' Author: Dan Bartlett
' Last revision by: $Author: dcl $
' Last revision by: $Author: ffr $
'
' A-SLIT S3 BOTTOM BLADE
' B-SLIT S3 TOP BLADE

2
site_ansto/instrument/reflectometer/MANIFEST.TXT
View File

@@ -1,4 +1,6 @@
platypus_configuration.tcl
sics_ports.tcl
script_validator_ports.tcl
extraconfig.tcl
config
util

2
site_ansto/instrument/reflectometer/config/INSTCFCOMMON.TXT
View File

@@ -1,3 +1,4 @@
config/anticollider/anticollider_common.tcl
config/plc/plc_common_1.tcl
config/counter/counter_common_1.tcl
config/hipadaba/hipadaba_configuration_common.tcl
@@ -8,3 +9,4 @@ config/hmm/anstohm_linked.xml
config/scan/scan_common_1.hdd
config/scan/scan_common_1.tcl
config/nexus/nxscripts_common_1.tcl
config/commands/commands_common.tcl

3
site_ansto/instrument/reflectometer/config/anticollider/acscript.txt Normal file
View File

@@ -0,0 +1,3 @@
# Forbid detector motion when the detector voltage is on
forbid {-inf inf} for dy when dhv1 in {20 inf}
forbid {-inf inf} for dz when dhv1 in {20 inf}

8
site_ansto/instrument/reflectometer/config/anticollider/anticollider.tcl Normal file
View File

@@ -0,0 +1,8 @@
# $Revision: 1.2 $
# $Date: 2008-05-30 00:26:56 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by: $Author: ffr $
source $cfPath(anticollider)/anticollider_common.tcl
::anticollider::loadscript acscript.txt

1
site_ansto/instrument/reflectometer/config/commands/commands.tcl Normal file
View File

@@ -0,0 +1 @@
source $cfPath(commands)/commands_common.tcl

9
site_ansto/instrument/reflectometer/config/hipadaba/hipadaba_configuration.tcl
View File

@@ -1 +1,10 @@
source $cfPath(hipadaba)/hipadaba_configuration_common.tcl
set sobj_klass_list [concat $sobj_klass_list junk]
set instrument_dictionary [concat $instrument_dictionary {
junk {
sobj {@any junk}
privilege spy
datatype @none
property {data true control true nxsave true klass NXnote type part}
}
} ]

18
site_ansto/instrument/reflectometer/config/hmm/detector.tcl Normal file
View File

@@ -0,0 +1,18 @@
# Detector voltage controller
set sim_mode [SplitReply [detector_simulation]]
if {$::sim_mode == "true"} {
EvFactory new dhv1 sim
} else {
clientput "Detector Voltage control not yet available"
# makeasyncqueue acq NHQ200 xxxxxxxxxxxxxx yyyy
# evfactory new dhv1 nhqvps acq
# dhv1 lowerlimit xxx
# dhv1 upperlimit xxx
# dhv1 tolerance xxx
# dhv1 max xxx
# dhv1 rate xxx
# dhv1 lock
}

90
site_ansto/instrument/reflectometer/config/hmm/hmm_configuration.tcl
View File

@@ -1,46 +1,55 @@
source $cfPath(hmm)/hmm_configuration_common_1.tcl
set sim_mode [SplitReply [hmm_simulation]]
proc ::histogram_memory::init_OAT_TABLE {} {
if [ catch {
# We don't need a MAX_CHAN parameter for time because the time channel
# is scaled by calling the ::histogram_memory::clock_scale function
OAT_TABLE X -setdata MAX_CHAN 421
OAT_TABLE Y -setdata MAX_CHAN 221
OAT_TABLE X -setdata BMIN -210.5
OAT_TABLE X -setdata BMAX 210.5
OAT_TABLE Y -setdata BMIN -110.5
OAT_TABLE Y -setdata BMAX 110.5
OAT_TABLE -set X { -210.5 -209.5 } NXC 421 Y { -110.5 -109.5 } NYC 221 T { 0 2000 } NTC 1
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
proc ::histogram_memory::pre_count {} {}
proc ::histogram_memory::post_count {} {}
proc ::histogram_memory::initialize {} {
if {$::sim_mode == "true"} {
hmm configure oat_ntc_eff 1
hmm configure oat_nyc_eff 210
hmm configure oat_nxc_eff 210
}
::histogram_memory::_initialize
if [ catch {
if {$::sim_mode == "true"} {
hmm configure oat_ntc_eff 1
hmm configure oat_nyc_eff 210
hmm configure oat_nxc_eff 210
}
BAT_TABLE -init
CAT_TABLE -init
SAT_TABLE -init
OAT_TABLE -init
FAT_TABLE -init
::histogram_memory::_initialize
detector_active_height_mm 257.5
detector_active_width_mm 500
detector_active_height_mm 257.5
detector_active_width_mm 500
set x_bb0 -210.5; set xbbmax 210.5
set y_bb0 -110.5; set ybbmax 110.5
hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0
hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax
hmm configure FAT_SIMULATED_EVENT_X0 $x_bb0
hmm configure FAT_SIMULATED_EVENT_X1 $xbbmax
set x_binwidth 1
if {[expr {$xbbmax - $x_bb0}] > 0} {
set x_bb1 [expr {$x_bb0+$x_binwidth}]
} else {
set x_bb1 [expr {$x_bb0-$x_binwidth}]
}
set y_binwidth 1
if {[expr {$ybbmax - $y_bb0}] > 0} {
set y_bb1 [expr {$y_bb0+$y_binwidth}]
} else {
set y_bb1 [expr {$y_bb0-$y_binwidth}]
}
OAT_TABLE -init X_MIN $x_bb0 X_MAX $xbbmax Y_MIN $y_bb0 Y_MAX $ybbmax
# We default to one big bin for time
set t_bb0 [OAT_TABLE -get T_MIN]
set t_bb1 [OAT_TABLE -get T_MAX]
OAT_TABLE X "$x_bb0 $x_bb1" Y "$y_bb0 $y_bb1" T "$t_bb0 $t_bb1"
::histogram_memory::upload_config Filler_defaults
# hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0
# hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax
# hmm configure FAT_SIMULATED_EVENT_X0 $x_bb0
# hmm configure FAT_SIMULATED_EVENT_X1 $xbbmax
::histogram_memory::init_OAT_TABLE
::histogram_memory::upload_config Filler_defaults
::nexus::data alias ::histogram_memory::vertical_axis ::histogram_memory::y_bin
::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::x_bin
::nexus::data alias ::histogram_memory::vertical_axis ::histogram_memory::y_bin
::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::x_bin
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
##
@@ -50,8 +59,9 @@ proc ::histogram_memory::tochfreq {} {
::chopper::ready?
set chfreq [::chopper::get_frequency]
::histogram_memory::set_frame_freq $chfreq EXTERNAL
} errmsg ] {
return -code error $errmsg
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
@@ -71,11 +81,13 @@ proc histmem {cmd args} {
::histogram_memory::tochfreq
}
default {
eval "_histmem $cmd $args"
set reply [eval "_histmem $cmd $args"]
}
}
} errmsg ] {
return -code error $errmsg
return $reply
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
publish histmem user

28
site_ansto/instrument/reflectometer/config/parameters/parameters.tcl Normal file
View File

@@ -0,0 +1,28 @@
##
# @brief Instrument parameters
# TODO There should be an NXgeometry entry for each distance, and linked to an NXgeometry
# entry for the chopper [SICS-108]. We put them in a junk entry for now to avoid holding up
# testing and development.
foreach vn {
detector_distance
detector_base
slit4_distance
slit4_base
sample_distance
sample_base
slit3_distance
slit3_base
} {
::utility::mkVar $vn float manager $vn true junk true true
}
detector_distance 10000
detector_base 300
slit4_distance 6000
slit4_base 20
sample_distance 5800
sample_base 50
slit3_distance 5600
slit3_base 20

36
site_ansto/instrument/reflectometer/platypus_configuration.tcl
View File

@@ -1,5 +1,5 @@
# $Revision: 1.14 $
# $Date: 2007-10-31 06:07:10 $
# $Revision: 1.15 $
# $Date: 2008-05-30 00:26:56 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by: $Author: ffr $
@@ -17,25 +17,37 @@ source server_config.tcl
########################################
# INSTRUMENT SPECIFIC CONFIGURATION
source $cfPath(hipadaba)/hipadaba_configuration.tcl
fileeval $cfPath(parameters)/parameters.tcl
fileeval $cfPath(motors)/motor_configuration.tcl
fileeval $cfPath(plc)/plc.tcl
fileeval $cfPath(counter)/counter.tcl
fileeval $cfPath(hmm)/hmm_configuration.tcl
fileeval $cfPath(hmm)/detector.tcl
fileeval $cfPath(nexus)/nxscripts.tcl
fileeval $cfPath(scan)/scan.tcl
fileeval $cfPath(chopper)/chopper.tcl
fileeval $cfPath(commands)/commands.tcl
fileeval $cfPath(anticollider)/anticollider.tcl
source gumxml.tcl
########
# Parameters set above the restore command will be clobbered by
# the values in the status.tcl file
# BIG WARNING: DON'T PUT 'restore' IN A CATCH BLOCK BECAUSE IT RETURNS
# AN ERROR IF THERE IS NO ../log/status.tcl FILE.
restore
fileeval $cfPath(plc)/plc.tcl
fileeval $cfPath(counter)/counter.tcl
fileeval $cfPath(hmm)/hmm_configuration.tcl
fileeval $cfPath(nexus)/nxscripts.tcl
fileeval $cfPath(scan)/scan.tcl
fileeval $cfPath(chopper)/chopper.tcl
source $cfPath(hipadaba)/hipadaba_configuration.tcl
source gumxml.tcl
::histogram_memory::initialize
MakeStateMon hmscan
fileeval extraconfig.tcl
if [file exists extraconfig.tcl] {
fileeval extraconfig.tcl
} else {
clientput "extraconfig.tcl not found. continueing"
}
::anticollider::init
server_set_sobj_attributes
buildHDB instrument_dictionary

4
site_ansto/instrument/reflectometer/script_validator_ports.tcl Normal file
View File

@@ -0,0 +1,4 @@
set quieckport quieck-val-platypus
set serverport server-val-platypus
set interruptport interrupt-val-platypus
set telnetport telnet-val-platypus

7
site_ansto/instrument/rsd/DMC2280/controller1.txt
View File

@@ -1,10 +1,11 @@
' KOWARI - CONTROLLER 1
'
' $Revision: 1.6 $
' $Date: 2008-04-14 00:28:07 $
' $Revision: 1.7 $
' $Name: not supported by cvs2svn $
' $Date: 2008-05-30 00:26:56 $
' Author: Dan Bartlett
' Airpad control added by Doug Clowes
' Last revision by: $Author: dcl $
' Last revision by: $Author: ffr $
'
' A-MONOCHROMATOR UPPER TILT
' B-MONOCHROMATOR LOWER TILT

5
site_ansto/instrument/rsd/DMC2280/controller2.txt
View File

@@ -1,9 +1,10 @@
NO TE: KOWARI - CONTROLLER 2
NO TE:
NO TE: $Revision:
NO TE: $Date: 2008-05-08 06:50:32 $
NO TE: $Name: not supported by cvs2svn $
NO TE: $Date: 2008-05-30 00:26:56 $
NO TE: Author: Dan Bartlett
NO TE: Last revision by: $Author: dcl $
NO TE: Last revision by: $Author: ffr $
NO TE:
NO TE: GALIL 31 BIT FIRMWARE IS REQUIRED FOR THIS CODE
NO TE: A-SAMPLE RAISE FIRST SECTION

7
site_ansto/instrument/rsd/DMC2280/controller3.txt
View File

@@ -1,9 +1,10 @@
NO TE: KOWARI - CONTROLLER 3
NO TE:
NO TE: $Revision: 1.3 $
NO TE: $Date: 2008-05-08 06:50:04 $
NO TE: $Revision: 1.4 $
NO TE: $Name: not supported by cvs2svn $
NO TE: $Date: 2008-05-30 00:26:56 $
NO TE: Author: Dan Bartlett
NO TE: Last revision by: $Author: dcl $
NO TE: Last revision by: $Author: ffr $
NO TE:
NO TE: A-MONOCHROMATOR FOCUS 1
NO TE: B-MONOCHROMATOR FOCUS 2

7
site_ansto/instrument/rsd/DMC2280/controller4.txt
View File

@@ -1,9 +1,10 @@
NO TE: KOWARI - CONTROLLER 4
NO TE:
NO TE: $Revision: 1.2 $
NO TE: $Date: 2007-09-24 01:25:23 $
NO TE: $Revision: 1.3 $
NO TE: $Name: not supported by cvs2svn $
NO TE: $Date: 2008-05-30 00:26:56 $
NO TE: Author: Dan Bartlett
NO TE: Last revision by: $Author: dbx $
NO TE: Last revision by: $Author: ffr $
NO TE:
NO TE: A-PRE SAMPLE COLLIMATOR X (ACROSS BEAM)
NO TE: B-PRE SAMPLE COLLIMATOR Y (ALONG BEAM)

1
site_ansto/instrument/rsd/MANIFEST.TXT
View File

@@ -1,4 +1,5 @@
sics_ports.tcl
script_validator_ports.tcl
kowari_configuration.tcl
extraconfig.tcl
config

2
site_ansto/instrument/rsd/config/INSTCFCOMMON.TXT
View File

@@ -1,3 +1,4 @@
config/anticollider/anticollider_common.tcl
config/plc/plc_common_1.tcl
config/counter/counter_common_1.tcl
config/hipadaba/hipadaba_configuration_common.tcl
@@ -8,3 +9,4 @@ config/hmm/anstohm_linked.xml
config/scan/scan_common_1.hdd
config/scan/scan_common_1.tcl
config/nexus/nxscripts_common_1.tcl
config/commands/commands_common.tcl

10
site_ansto/instrument/rsd/config/anticollider/acscript.txt Normal file
View File

@@ -0,0 +1,10 @@
# This script is loaded automatically by anticollider.tcl when SICS is launched
# TODO Allow sequencing
# TODO Allow functional dependencies
#
# Examples
# for mphi forbid {-inf inf} when mchi in {{85 87} {93 95}}
# when stth in { {0 10} {20 30} } forbid { {10 20} {90 100} } for mtth
#
## The next example forbids movement when both schi and sx are in the given ranges
# forbid {0 10} for sphi whenall {schi in {10 15} sx {10 11} }

8
site_ansto/instrument/rsd/config/anticollider/anticollider.tcl Normal file
View File

@@ -0,0 +1,8 @@
# $Revision: 1.2 $
# $Date: 2008-05-30 00:26:56 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by: $Author: ffr $
source $cfPath(anticollider)/anticollider_common.tcl
::anticollider::loadscript acscript.txt

1
site_ansto/instrument/rsd/config/commands/commands.tcl Normal file
View File

@@ -0,0 +1 @@
source $cfPath(commands)/commands_common.tcl

69
site_ansto/instrument/rsd/config/hmm/hmm_configuration.tcl
View File

@@ -2,47 +2,48 @@
source $cfPath(hmm)/hmm_configuration_common_1.tcl
set sim_mode [SplitReply [hmm_simulation]]
proc ::histogram_memory::init_OAT_TABLE {} {
# We don't need a MAX_CHAN parameter for time because the time channel
# is scaled by calling the ::histogram_memory::clock_scale function
OAT_TABLE X -setdata MAX_CHAN 421
OAT_TABLE Y -setdata MAX_CHAN 421
OAT_TABLE X -setdata BMIN -210.5
OAT_TABLE X -setdata BMAX 210.5
OAT_TABLE Y -setdata BMIN -210.5
OAT_TABLE Y -setdata BMAX 210.5
OAT_TABLE -set X { -210.5 -209.5 } NXC 421 Y { -210.5 -209.5 } NYC 421 T { 0 2000 } NTC 1
}
proc ::histogram_memory::pre_count {} {}
proc ::histogram_memory::post_count {} {}
proc ::histogram_memory::initialize {} {
if {$::sim_mode == "true"} {
hmm configure oat_ntc_eff 1
hmm configure oat_nyc_eff 421
hmm configure oat_nxc_eff 421
}
::histogram_memory::_initialize
if [ catch {
if {$::sim_mode == "true"} {
hmm configure oat_ntc_eff 1
hmm configure oat_nyc_eff 421
hmm configure oat_nxc_eff 421
}
BAT_TABLE -init
CAT_TABLE -init
SAT_TABLE -init
OAT_TABLE -init
FAT_TABLE -init
::histogram_memory::_initialize
detector_active_height_mm 500
detector_active_width_mm 500
# hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0
# hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax
# hmm configure FAT_SIMULATED_EVENT_X0 $x_bb0
# hmm configure FAT_SIMULATED_EVENT_X1 $xbbmax
::histogram_memory::init_OAT_TABLE
::histogram_memory::upload_config Filler_defaults
set x_bb0 -210.5; set xbbmax 210.5
set y_bb0 -210.5; set ybbmax 210.5
hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0
hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax
hmm configure FAT_SIMULATED_EVENT_X0 $x_bb0
hmm configure FAT_SIMULATED_EVENT_X1 $xbbmax
set x_binwidth 1
if {[expr {$xbbmax - $x_bb0}] > 0} {
set x_bb1 [expr {$x_bb0+$x_binwidth}]
} else {
set x_bb1 [expr {$x_bb0-$x_binwidth}]
::nexus::data alias ::histogram_memory::vertical_axis ::histogram_memory::y_pixel_offset
::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::x_pixel_offset
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
set y_binwidth 1
if {[expr {$ybbmax - $y_bb0}] > 0} {
set y_bb1 [expr {$y_bb0+$y_binwidth}]
} else {
set y_bb1 [expr {$y_bb0-$y_binwidth}]
}
OAT_TABLE -init X_MIN $x_bb0 X_MAX $xbbmax Y_MIN $y_bb0 Y_MAX $ybbmax
# We default to one big bin for time
set t_bb0 [OAT_TABLE -get T_MIN]
set t_bb1 [OAT_TABLE -get T_MAX]
OAT_TABLE X "$x_bb0 $x_bb1" Y "$y_bb0 $y_bb1" T "$t_bb0 $t_bb1"
::histogram_memory::upload_config Filler_defaults
::nexus::data alias ::histogram_memory::vertical_axis ::histogram_memory::y_pixel_offset
::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::x_pixel_offset
}
proc histmem {cmd args} {

21
site_ansto/instrument/rsd/config/motors/motor_configuration.tcl
View File

@@ -1,7 +1,7 @@
# $Revision: 1.23 $
# $Date: 2008-05-29 04:55:49 $
# $Revision: 1.24 $
# $Date: 2008-05-30 00:26:56 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by: $Author: dcl $
# Last revision by: $Author: ffr $
# START MOTOR CONFIGURATION
@@ -62,8 +62,7 @@ set sx_Home 9067806
set sy_Home 18782188
set som_Home 23164850
#set stth_Home 28686300
set stth_Home 29446192
set stth_Home 28686300
#set psho_home 542093
set psho_home 7576691
@@ -381,18 +380,18 @@ Motor stth $motor_driver_type [params \
asyncqueue mc2\
axis F\
units degrees\
hardlowerlim -90\
hardupperlim 120\
hardlowerlim 30\
hardupperlim 150\
maxSpeed 0.5\
maxAccel 0.1\
maxDecel 0.1\
stepsPerX 25000\
absEnc 1\
absEncHome $stth_Home\
cntsPerX -8192]
stth softlowerlim -90
stth softupperlim 120
stth home 0
cntsPerX -93207]
stth softlowerlim 30
stth softupperlim 150
stth home 90
stth speed 0.5
stth movecount $move_count
stth precision 0.01

47
site_ansto/instrument/rsd/kowari_configuration.tcl
View File

@@ -1,5 +1,5 @@
# $Revision: 1.9 $
# $Date: 2007-11-05 02:29:31 $
# $Revision: 1.10 $
# $Date: 2008-05-30 00:26:56 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by: $Author: ffr $
@@ -19,42 +19,33 @@ source server_config.tcl
fileeval $cfPath(motors)/motor_configuration.tcl
########
# Parameters set above the restore command will be clobbered by
# the values in the status.tcl file
restore
source $cfPath(hipadaba)/hipadaba_configuration.tcl
fileeval $cfPath(plc)/plc.tcl
fileeval $cfPath(counter)/counter.tcl
fileeval $cfPath(hmm)/hmm_configuration.tcl
fileeval $cfPath(nexus)/nxscripts.tcl
fileeval $cfPath(scan)/scan.tcl
source $cfPath(hipadaba)/hipadaba_configuration.tcl
fileeval $cfPath(commands)/commands.tcl
fileeval $cfPath(anticollider)/anticollider.tcl
source gumxml.tcl
########
# Parameters set above the restore command will be clobbered by
# the values in the status.tcl file
# BIG WARNING: DON'T PUT 'restore' IN A CATCH BLOCK BECAUSE IT RETURNS
# AN ERROR IF THERE IS NO ../log/status.tcl FILE.
restore
::histogram_memory::initialize
VarMake crystal_type Text User
VarMake crystal_wavelength_A Float User
VarMake bmon_distance Float User
## Column number at beam centre
VarMake detector_zero_row Float User
detector_zero_row 255.5
## Row number at beam centre for a detector rotation of 0 degrees
VarMake detector_zero_col Float User
detector_zero_col 100
detector_type Kowari detector
detector_type lock
detector_description This detects Kowaris
detector_description lock
MakeStateMon hmscan
MakeStateMon hmscan
fileeval extraconfig.tcl
if [file exists extraconfig.tcl] {
fileeval extraconfig.tcl
} else {
clientput "extraconfig.tcl not found. continueing"
}
::anticollider::init
server_set_sobj_attributes
buildHDB instrument_dictionary

4
site_ansto/instrument/rsd/script_validator_ports.tcl Normal file
View File

@@ -0,0 +1,4 @@
set quieckport quieck-val-kowari
set serverport server-val-kowari
set interruptport interrupt-val-kowari
set telnetport telnet-val-kowari

7
site_ansto/instrument/sans/DMC2280/controller1.txt
View File

@@ -1,9 +1,10 @@
NO TE: QUOKKA - CONTROLLER 1
NO TE:
NO TE: $Revision: 1.8 $
NO TE: $Date: 2007-09-24 01:10:59 $
NO TE: $Revision: 1.9 $
NO TE: $Name: not supported by cvs2svn $
NO TE: $Date: 2008-05-30 00:26:57 $
NO TE: Author: Dan Bartlett
NO TE: Last revision by: $Author: dbx $
NO TE: Last revision by: $Author: ffr $
NO TE:
NO TE: A-SAMPLE UPPER TILT
NO TE: B-SAMPLE LOWER TILT

7
site_ansto/instrument/sans/DMC2280/controller2.txt
View File

@@ -1,9 +1,10 @@
NO TE: QUOKKA - CONTROLLER 2
NO TE:
NO TE: $Revision: 1.5 $
NO TE: $Date: 2007-09-24 01:10:59 $
NO TE: $Revision: 1.6 $
NO TE: $Name: not supported by cvs2svn $
NO TE: $Date: 2008-05-30 00:26:57 $
NO TE: Author: Dan Bartlett
NO TE: Last revision by: $Author: dbx $
NO TE: Last revision by: $Author: ffr $
NO TE:
NO TE: A-COLLIMATION OPTICS - CHAMBER 1
NO TE: B-COLLIMATION OPTICS - CHAMBER 2

7
site_ansto/instrument/sans/DMC2280/controller3.txt
View File

@@ -1,9 +1,10 @@
NO TE: QUOKKA - CONTROLLER 3
NO TE:
NO TE: $Revision: 1.5 $
NO TE: $Date: 2007-09-24 01:10:59 $
NO TE: $Revision: 1.6 $
NO TE: $Name: not supported by cvs2svn $
NO TE: $Date: 2008-05-30 00:26:57 $
NO TE: Author: Dan Bartlett
NO TE: Last revision by: $Author: dbx $
NO TE: Last revision by: $Author: ffr $
NO TE:
NO TE: A-COLLIMATION OPTICS - CHAMBER 9
NO TE: B-COLLIMATION OPTICS - CHAMBER 10

7
site_ansto/instrument/sans/DMC2280/controller4.txt
View File

@@ -1,9 +1,10 @@
NO TE: QUOKKA - CONTROLLER 4
NO TE:
NO TE: $Revision: 1.7 $
NO TE: $Date: 2007-09-24 01:10:59 $
NO TE: $Revision: 1.8 $
NO TE: $Name: not supported by cvs2svn $
NO TE: $Date: 2008-05-30 00:26:57 $
NO TE: Author: Dan Bartlett
NO TE: Last revision by: $Author: dbx $
NO TE: Last revision by: $Author: ffr $
NO TE:
NO TE: A-BEAM STOPS TRANS. X (ACCROSS BEAM) +VE=WEST
NO TE: B-BEAM STOPS TRANSLATION - RAISE

2
site_ansto/instrument/sans/MANIFEST.TXT
View File

@@ -1,6 +1,6 @@
quokka_configuration.tcl
velsel.tcl
sics_ports.tcl
script_validator_ports.tcl
extraconfig.tcl
config
util

2
site_ansto/instrument/sans/config/INSTCFCOMMON.TXT
View File

@@ -1,3 +1,4 @@
config/anticollider/anticollider_common.tcl
config/plc/plc_common_1.tcl
config/counter/counter_common_1.tcl
config/hipadaba/hipadaba_configuration_common.tcl
@@ -8,3 +9,4 @@ config/hmm/anstohm_linked.xml
config/scan/scan_common_1.hdd
config/scan/scan_common_1.tcl
config/nexus/nxscripts_common_1.tcl
config/commands/commands_common.tcl

3
site_ansto/instrument/sans/config/anticollider/acscript.txt Normal file
View File

@@ -0,0 +1,3 @@
# Forbid detector motion when the detector voltage is on
forbid {-inf inf} for det when dhv1 in {20 inf}
forbid {-inf inf} for detoff when dhv1 in {20 inf}

8
site_ansto/instrument/sans/config/anticollider/anticollider.tcl Normal file
View File

@@ -0,0 +1,8 @@
# $Revision: 1.2 $
# $Date: 2008-05-30 00:26:57 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by: $Author: ffr $
source $cfPath(anticollider)/anticollider_common.tcl
::anticollider::loadscript acscript.txt

65
site_ansto/instrument/sans/config/commands/commands.tcl Normal file
View File

@@ -0,0 +1,65 @@
source $cfPath(commands)/commands_common.tcl
namespace eval sample {
command select {int=0:8 sampid} {
SampleNum $sampid
}
}
namespace eval optics {
VarMake ::optics::select::section text user
VarMake ::optics::polarizer::in text user
VarMake ::optics::lens::selection text user
command rotary_attenuator {int=0,15,45,90,180 angle} {
AttRotDeg $angle
}
command entrance_aperture {
int=0,45,90,135,180,270 angle
text=circ,squ,open,rect shape
} {
RotApDeg $angle
RotApShape $shape
}
command sample_aperture {
int=25,50 size
text=circ,squ,open,rect shape
} {
SApXmm $size
SApZmm $size
SApShape $shape
}
##############################
##
# @brief set_guide uses a lookup table to setup the collimation system
# @param row, selects a row from the guide configuration table
#
# eg\n
# set_guide HIRES
command guide "
text=[join [array names ::optics::guide_configuration] , ] configuration
" {
variable guide_configuration
variable guide_configuration_columns
array set c1_map {G 1 MT 2 P 3}
array set c2_map {MT 1 G 2 A 3}
array set c3_map {MT 1 G 2 A 3}
array set c4_map {MT 1 G 2 A 3}
array set c5_map {MT 1 G 2 A 3}
array set c6_map {MT 1 G 2 A 3}
array set c7_map {MT 1 G 2 A 3}
array set c8_map {MT 1 G 2 A 3}
array set c9_map {LP 1 MT 2 G 3 A 4 L 5}
foreach el $guide_configuration($configuration) guide $guide_configuration_columns {
lappend to_config $guide
lappend to_config [set ${guide}_map($el)]
}
eval "drive $to_config"
}
}

17
site_ansto/instrument/sans/config/hmm/detector.tcl Normal file
View File

@@ -0,0 +1,17 @@
# Detector voltage controller
set sim_mode [SplitReply [detector_simulation]]
if {$::sim_mode == "true"} {
EvFactory new dhv1 sim
} else {
makeasyncqueue acq ORHVPS 137.157.202.85 4001
evfactory new dhv1 orhvps acq
dhv1 lowerlimit 0
dhv1 upperlimit 2400
dhv1 tolerance 19
dhv1 max 2400
dhv1 rate 10
dhv1 lock
}

73
site_ansto/instrument/sans/config/hmm/hmm_configuration.tcl
View File

@@ -1,41 +1,56 @@
source $cfPath(hmm)/hmm_configuration_common_1.tcl
set sim_mode [SplitReply [hmm_simulation]]
proc ::histogram_memory::init_OAT_TABLE {} {
if [ catch {
# We don't need a MAX_CHAN parameter for time because the time channel
# is scaled by calling the ::histogram_memory::clock_scale function
OAT_TABLE X -setdata MAX_CHAN 128
OAT_TABLE Y -setdata MAX_CHAN 128
OAT_TABLE X -setdata BMIN -0.5
OAT_TABLE X -setdata BMAX 127.5
OAT_TABLE Y -setdata BMIN -0.5
OAT_TABLE Y -setdata BMAX 127.5
OAT_TABLE -set X { 127.5 126.5 } NXC 128 Y { -0.5 0.5 } NYC 127 T { 0 2000 } NTC 1
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
proc ::histogram_memory::pre_count {} {}
proc ::histogram_memory::post_count {} {}
proc ::histogram_memory::initialize {} {
::histogram_memory::_initialize
if [ catch {
if {$::sim_mode == "true"} {
hmm configure oat_ntc_eff 1
hmm configure oat_nyc_eff 127
hmm configure oat_nxc_eff 127
}
BAT_TABLE -init
CAT_TABLE -init
SAT_TABLE -init
OAT_TABLE -init
FAT_TABLE -init
::histogram_memory::_initialize
detector_active_height_mm 192
detector_active_width_mm 192
detector_active_height_mm 257.5
detector_active_width_mm 500
set x_bb0 -0.5; set xbbmax 191.5
set y_bb0 -0.5; set ybbmax 191.5
hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0
hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax
hmm configure FAT_SIMULATED_EVENT_X0 $x_bb0
hmm configure FAT_SIMULATED_EVENT_X1 $xbbmax
set x_binwidth 1
if {[expr {$xbbmax - $x_bb0}] > 0} {
set x_bb1 [expr {$x_bb0+$x_binwidth}]
} else {
set x_bb1 [expr {$x_bb0-$x_binwidth}]
# hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0
# hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax
# hmm configure FAT_SIMULATED_EVENT_X0 $x_bb0
# hmm configure FAT_SIMULATED_EVENT_X1 $xbbmax
::histogram_memory::init_OAT_TABLE
::histogram_memory::upload_config Filler_defaults
::nexus::data alias ::histogram_memory::vertical_axis ::histogram_memory::y_bin
::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::x_bin
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
set y_binwidth 1
if {[expr {$ybbmax - $y_bb0}] > 0} {
set y_bb1 [expr {$y_bb0+$y_binwidth}]
} else {
set y_bb1 [expr {$y_bb0-$y_binwidth}]
}
OAT_TABLE -init X_MIN $x_bb0 X_MAX $xbbmax Y_MIN $y_bb0 Y_MAX $ybbmax
# We default to one big bin for time
set t_bb0 [OAT_TABLE -get T_MIN]
set t_bb1 [OAT_TABLE -get T_MAX]
OAT_TABLE X "$x_bb0 $x_bb1" Y "$y_bb0 $y_bb1" T "$t_bb0 $t_bb1"
::histogram_memory::upload_config Filler_defaults
::nexus::data alias ::histogram_memory::vertical_axis ::histogram_memory::y_pixel_offset
::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::x_pixel_offset
}
proc histmem {cmd args} {

42
site_ansto/instrument/sans/config/motors/motor_configuration.tcl
View File

@@ -1,7 +1,7 @@
# $Revision: 1.15 $
# $Date: 2008-02-19 04:27:19 $
# $Revision: 1.16 $
# $Date: 2008-05-30 00:26:57 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by: $Author: dcl $
# Last revision by: $Author: ffr $
# START MOTOR CONFIGURATION
@@ -959,39 +959,3 @@ make_coll_motor_1 c8 section_8 pc9 $vc_units
make_coll_motor_1 c9 section_9 pc10 $vc_units
unset vc_units
namespace eval guide {
VarMake ::guide::select::section text user
VarMake ::guide::polarizer::in text user
VarMake ::guide::lens::selection text user
#TODO Set aperture size variable.
command select {int:0,1,2,3,4,5,6,7,8,9 section} {
set empty {2 1 1 1 1 1 1 1 2}
set aperture {2 3 3 3 3 3 3 3 4}
set guide {1 2 2 2 2 2 2 2 3}
array set lens {left 1 right 5 none 2}
set target $empty
if {$section > 0} {
set gr [lrange $guide 0 [expr $section -1]]
set er [lrange $empty $section 8]
set target [list $gr $er]
if {[SplitReply [::guide::polarizer::in]] == "yes"} {
lset target 0 3
}
} else {
lset target 8 $lens([SplitReply [::guide::lens::selection]])
}
set fh [open junk.txt w]
for {set i 1} {$i <= 9} {incr i} {
puts $fh "run vc0$i [lindex target [expr {$i-1}]]"
}
close $fh
}
command polarizer {text:yes,no in} {
::guide::polarizer::in $in
}
command lens {text:left,right,none selection} {
::guide::lens::selection $selection
}
}

77
site_ansto/instrument/sans/config/optics/guide_configuration.tcl
View File

@@ -10,30 +10,30 @@ namespace eval optics {
# configuration parameters
# Rows can be of mixed type
array set guide_configuration {
GA {MT A A A A A A A A }
MT {MT MT MT MT MT MT MT MT MT }
LP {MT MT MT MT MT MT MT MT LP }
LENS {MT MT MT MT MT MT MT MT L }
P1 {P A MT MT MT MT MT MT MT }
P1LP {P A MT MT MT MT MT MT LP }
P1LENS {P A MT MT MT MT MT MT L }
G1 {G A MT MT MT MT MT MT MT }
P2 {P G A MT MT MT MT MT MT }
G2 {G G A MT MT MT MT MT MT }
P3 {P G G A MT MT MT MT MT }
G3 {G G G A MT MT MT MT MT }
P4 {P G G G A MT MT MT MT }
G4 {G G G G A MT MT MT MT }
P5 {P G G G G A MT MT MT }
G5 {G G G G G A MT MT MT }
P6 {P G G G G G A MT MT }
G6 {G G G G G G A MT MT }
P7 {P G G G G G G A MT }
G7 {G G G G G G G A MT }
P8 {P G G G G G G G A }
G8 {G G G G G G G G A }
P9 {P G G G G G G G G }
G9 {G G G G G G G G G }
ga {MT A A A A A A A A }
mt {MT MT MT MT MT MT MT MT MT }
lp {MT MT MT MT MT MT MT MT LP }
lens {MT MT MT MT MT MT MT MT L }
p1 {P A MT MT MT MT MT MT MT }
p1lp {P A MT MT MT MT MT MT LP }
p1lens {P A MT MT MT MT MT MT L }
g1 {G A MT MT MT MT MT MT MT }
p2 {P G A MT MT MT MT MT MT }
g2 {G G A MT MT MT MT MT MT }
p3 {P G G A MT MT MT MT MT }
g3 {G G G A MT MT MT MT MT }
p4 {P G G G A MT MT MT MT }
g4 {G G G G A MT MT MT MT }
p5 {P G G G G A MT MT MT }
g5 {G G G G G A MT MT MT }
p6 {P G G G G G A MT MT }
g6 {G G G G G G A MT MT }
p7 {P G G G G G G A MT }
g7 {G G G G G G G A MT }
p8 {P G G G G G G G A }
g8 {G G G G G G G G A }
p9 {P G G G G G G G G }
g9 {G G G G G G G G G }
}
# This list maps the motor names to columns of the
@@ -49,32 +49,3 @@ namespace eval optics {
variable guide_configuration_columns
namespace export set_guide
}
##
# @brief set_guide uses a lookup table to setup the collimation system
# @param row, selects a row from the guide configuration table
#
# eg\n
# set_guide HIRES
proc ::optics::set_guide {row} {
variable guide_configuration
variable guide_configuration_columns
array set c1_map {G 1 MT 2 P 3}
array set c2_map {MT 1 G 2 A 3}
array set c3_map {MT 1 G 2 A 3}
array set c4_map {MT 1 G 2 A 3}
array set c5_map {MT 1 G 2 A 3}
array set c6_map {MT 1 G 2 A 3}
array set c7_map {MT 1 G 2 A 3}
array set c8_map {MT 1 G 2 A 3}
array set c9_map {LP 1 MT 2 G 3 A 4 L 5}
foreach el $guide_configuration($row) guide $guide_configuration_columns {
lappend to_config $guide
lappend to_config [set ${guide}_map($el)]
}
eval "drive $to_config"
}
namespace import ::optics::set_guide
publish set_guide user

294
site_ansto/instrument/sans/config/parameters/parameters.tcl Normal file
View File

@@ -0,0 +1,294 @@
##
# @brief We can't change the coordinate scheme at runtime because this would require
# restructuring the hdb tree, but we should save it.
foreach {var nxname} {
VelSelCoordScheme coordinate_scheme
SApCoordScheme coordinate_scheme
EApCoordScheme coordinate_scheme
SampleCoordScheme coordinate_scheme
DetCoordScheme coordinate_scheme
BeamstopCoordScheme coordinate_scheme
CollCoordScheme coordinate_scheme
} {
::utility::mkVar $var text readonly $nxname true @none false true
$var Cartesian
$var lock
}
##
# @brief User privilege text variables
#
# TODO SICS-117 Redo as get/set macros like the "kind=command" macros but kind=getset and it is saveable
# The set parameter will have a domain. If the param is readonly then the hdb privilege is readonly
# Pros, GumTree will know the data type of the parameter (text params will have a list of valid values).
# Cons, There is no "instant" feedback, macros are polled on the hdb tree.
foreach {var nxname priv} {
EApShape shape user
RotApshape shape readonly
SApShape shape readonly
BSShape shape user
} {
::utility::mkVar $var text $priv $nxname true @none true true
}
# The velocity selector position is used as the reference for other instrument
# component positions. For simplicity we set it as the origin x=y=z=0.
foreach {var nxname units} {
VelSelPosXmm x mm
VelSelPosYmm y mm
VelSelPosZmm z mm
EndFacePosYmm y mm
RotApPosYmm y mm
} {
::utility::mkVar $var float readonly $nxname true @none true true
if {$units != 1} {
sicslist setatt $var units $units
}
}
::utility::mkVar SampleNum int readonly changer_position true sample true true
foreach {var nxname units priv} {
LambdaA wavelength nm user
LambdaResFWHM% wavelength_spread 1 user
VSdeg twist degrees user
VSrpm rotation_speed rpm user
AttRotDeg AttRotDeg degrees readonly
PleXmm x mm user
RotApXmm x mm user
RotApZmm z mm user
RotApDeg RotApDeg degrees readonly
EApXmm x mm user
EApYmm y mm user
EApZmm z mm user
EApPosYmm y mm user
SApXmm x mm readonly
SApZmm z mm readonly
SApPosXmm x mm user
SApPosYmm y mm user
SApPosZmm z mm user
SamplePosXmm x mm user
SamplePosYmm y mm user
SamplePosZmm z mm user
SampleRotDeg SampleRotDeg degrees user
SampleTiltXdeg SampleTiltXdeg degrees user
SampleTiltYdeg SampleTiltYdeg degrees user
DetPosYOffsetmm detposyoffset mm user
BSXmm x mm user
BSZmm z mm user
} {
::utility::mkVar $var float $priv $nxname true @none true true
if {$units != 1} {
sicslist setatt $var units $units
}
}
proc sicsmsgfmt {args} {return "[info level -1] = $args"}
::utility::macro::getset float L1mm {} {
set efpy [SplitReply [EndFacePosYmm]]
set sapy [SplitReply [SApPosYmm]]
set eapy [SplitReply [EApPosYmm]]
return [sicsmsgfmt [expr {$efpy + $sapy - $eapy}]]
}
sicslist setatt L1mm klass sample
sicslist setatt L1mm long_name eap_sap_dist
sicslist setatt L1mm units mm
::utility::macro::getset float L2mm {} {
set detpy [SplitReply [DetPosYmm]]
set detpyos [SplitReply [DetPosYOffsetmm]]
set sapy [SplitReply [SApPosYmm]]
return [sicsmsgfmt [expr {$detpyos + $detpyos - $sapy}]]
}
sicslist setatt L2mm klass detector
sicslist setatt L2mm long_name sample_det_dist
sicslist setatt L2mm units mm
foreach {pname motor hdbname units} {
DetPosXmm detoff x mm
DetPosYmm det y mm
BSPosXmm bsx x mm
BSPosZmm bsz z mm
} {
::utility::macro::getset float $pname {} [subst -nocommands {
return [sicsmsgfmt [SplitReply [$motor]]]
}]
sicslist setatt $pname units $units
sicslist setatt $pname long_name $hdbname
}
################################################################################
##
# @brief This is the position of the velocity selector bunker face. It is used
# as the reference for other positions. x=y=z=0.
::hdb::MakeVelocity_Selector velocity_selector {
wavelength LambdaA
wavelength_spread LambdaResFWHM%
coordinate_scheme VelSelCoordScheme
position {VelSelPosXmm VelSelPosYmm VelSelPosZmm}
}
::hdb::MakeAperture sample_aperture {
shape SApShape
size {SApXmm SApZmm}
coordinate_scheme SApCoordScheme
position {SApPosXmm SApPosYmm SApPosZmm}
refpos {VelSelPosXmm EndFacePosYmm VelSelPosZmm}
}
::hdb::MakeAperture entrance_aperture {
shape EApShape
size {EApXmm EApYmm EApZmm}
coordinate_scheme EApCoordScheme
position EApPosYmm
refpos VelSelPosYmm
}
::hdb::MakeAperture rotary_aperture {
shape RotApShape
size {RotApXmm RotApZmm}
position RotApPosYmm
orientation RotApDeg
refpos VelSelPosYmm
}
::hdb::MakeGeometry sample_geometry sample {
coordinate_scheme SampleCoordScheme
position {SamplePosXmm SamplePosYmm SamplePosZmm}
orientation {SampleTiltXdeg SampleTiltYdeg SampleRotDeg}
refpos {VelSelPosXmm EndFacePosYmm VelSelPosZmm}
}
::hdb::MakeGeometry detector_geometry detector {
coordinate_scheme DetCoordScheme
position {DetPosXmm DetPosYmm}
offset DetPosYOffsetmm
refpos {VelSelPosXmm EndFacePosYmm}
}
::hdb::MakeGeometry collimator_geometry collimator {
coordinate_scheme CollCoordScheme
position EndFacePosYmm
refpos VelSelPosYmm
}
::hdb::MakeGeometry beamstop_geometry beam_stop {
shape BSShape
position {BSPosXmm BSPosZmm}
size {BSXmm BSZmm}
}
# INITIALISE PARAMETERS
# The collimation system aperture positions
# Reference position is outer wall of velocity selector bunker, ie VelSelPosYmm
array set collapposmm {
inputguide 633
apwheel 675
ap1 4929
ap2 6934
ap3 8949
ap4 10955
ap5 12943
ap6 14970
ap7 16971
ap9 19925
}
VelSelPosXmm 0.0
VelSelPosYmm 0.0
VelSelPosZmm 0.0
EndFacePosYmm 20095
RotApPosYmm 675
################################################################################
# Check Config
##
# @brief List undefined parameters
proc missingparams {} {
set paramlist {
AttFactor
AttRotDeg
BS1
BS2
BS3
BS4
BS5
BSPosXmm
BSPosZmm
BSShape
BSXmm
BSZmm
C1
C2
C3
C4
C5
C6
C7
C8
C9
DetPosXmm
DetPosYmm
DetPosYmm
DetPosYOffsetmm
EApPosYmm
EApShape
EApXmm
EApYmm
EApZmm
EndFacePosYmm
L1mm
L2mm
LambdaA
LambdaResFWHM%
Pent
Plexmm
RotApDeg
RotApShape
RotApXmm
RotApZmm
SampleAttributes
SampleComments
SampleName
SampleNum
SamplePosXmm
SamplePosYmm
SamplePosYmm
SamplePosZmm
SampleRotDeg
SampleTiltXDeg
SampleTiltYDeg
SampleTitle
SApPosXmm
SApPosYmm
SApPosYmm
SApPosZmm
SApShape
SApXmm
SApZmm
VSdeg
VSrpm
}
set num 0
foreach param $paramlist {
if {[sicslist match $param] == " "} {
clientput $param
incr num
}
}
if {$num > 0} {
clientput "There are $num missing parameters"
}
}
##
# @brief Check list
proc check {args} {
switch $args {
"missing" {
missingparams
}
}
}
publish check user

8
site_ansto/instrument/sans/extraconfig.tcl
View File

@@ -1,11 +1,3 @@
makeasyncqueue acq ORHVPS 137.157.202.85 4001
evfactory new dhv1 orhvps acq
dhv1 lowerlimit 0
dhv1 upperlimit 2400
dhv1 tolerance 19
dhv1 max 2400
dhv1 rate 10
proc TrimReply { str } {
set reply [string trim $str " :"]
return $reply

34
site_ansto/instrument/sans/quokka_configuration.tcl
View File

@@ -1,5 +1,5 @@
# $Revision: 1.6 $
# $Date: 2007-10-23 02:42:52 $
# $Revision: 1.7 $
# $Date: 2008-05-30 00:26:56 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by: $Author: ffr $
@@ -17,26 +17,38 @@ source server_config.tcl
########################################
# INSTRUMENT SPECIFIC CONFIGURATION
source $cfPath(hipadaba)/hipadaba_configuration.tcl
fileeval $cfPath(nexus)/nxscripts.tcl
fileeval $cfPath(parameters)/parameters.tcl
fileeval $cfPath(velsel)/velsel.tcl
fileeval $cfPath(motors)/motor_configuration.tcl
########
# Parameters set above the restore command will be clobbered by
# the values in the status.tcl file
restore
fileeval $cfPath(plc)/plc.tcl
fileeval $cfPath(optics)/optics.tcl
fileeval $cfPath(counter)/counter.tcl
fileeval $cfPath(hmm)/hmm_configuration.tcl
fileeval $cfPath(nexus)/nxscripts.tcl
fileeval $cfPath(hmm)/detector.tcl
fileeval $cfPath(scan)/scan.tcl
source $cfPath(hipadaba)/hipadaba_configuration.tcl
fileeval $cfPath(commands)/commands.tcl
fileeval $cfPath(anticollider)/anticollider.tcl
source gumxml.tcl
########
# Parameters set above the restore command will be clobbered by
# the values in the status.tcl file
# BIG WARNING: DON'T PUT 'restore' IN A CATCH BLOCK BECAUSE IT RETURNS
# AN ERROR IF THERE IS NO ../log/status.tcl FILE.
restore
::histogram_memory::initialize
MakeStateMon hmscan
fileeval extraconfig.tcl
if [file exists extraconfig.tcl] {
fileeval extraconfig.tcl
} else {
clientput "extraconfig.tcl not found. continueing"
}
::anticollider::init
server_set_sobj_attributes
buildHDB instrument_dictionary

4
site_ansto/instrument/sans/script_validator_ports.tcl Normal file
View File

@@ -0,0 +1,4 @@
set quieckport quieck-val-quokka
set serverport server-val-quokka
set interruptport interrupt-val-quokka
set telnetport telnet-val-quokka

157
site_ansto/instrument/server_config.tcl
View File

@@ -1,30 +1,104 @@
# SICS common configuration
# $Revision: 1.32 $
# $Date: 2007-11-05 02:09:06 $
# $Revision: 1.33 $
# $Date: 2008-05-30 00:26:54 $
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
# Last revision by $Author: ffr $
#set sicsroot /usr/local/sics
set sicsroot ../
VarMake opal_simulation Text internal
opal_simulation false
VarMake detector_simulation Text internal
detector_simulation false
VarMake hmm_simulation Text internal
hmm_simulation false
VarMake environment_simulation Text internal
environment_simulation false
VarMake counter_simulation Text internal
counter_simulation false
VarMake motor_simulation Text internal
motor_simulation false
VarMake chopper_simulation Text internal
chopper_simulation false
VarMake plc_simulation Text internal
plc_simulation false
VarMake sics_fullsimulation Text internal
source util/utility.tcl
proc syncbackup {file} {
backup motorSave
backup $file
backup motorSave
}
publish syncbackup Spy
if {[info exists env(SICS_SIMULATION)] != 1} {
set sicsroot ../
source sics_ports.tcl
sics_fullsimulation false
} else {
switch $env(SICS_SIMULATION) {
"full" {
set sicsroot ../
source sics_ports.tcl
sics_fullsimulation true
}
"script_validator" {
VarMake sics_script_validator Text internal
sics_script_validator true
set sicsroot ../script_validator/
source script_validator_ports.tcl
sics_fullsimulation true
MakeSync localhost [expr [get_portnum $serverport ]-10] spy 007 ../log/syncfile.tcl
}
default {
error "ERROR: SICS_SIMULATION must be full or script_validator, not $env(SICS_SIMULATION)"
}
}
}
if {[string trim [lindex [split [sics_fullsimulation] =] 1]] == "true"} {
opal_simulation true
detector_simulation true
hmm_simulation true
counter_simulation true
environment_simulation true
motor_simulation true
chopper_simulation true
plc_simulation true
}
set cfParent config
#WARNING Make sure there are no spaces after the back-slashes
array set cfPath [list\
motors $cfParent/motors\
optics $cfParent/optics\
counter $cfParent/counter\
chopper $cfParent/chopper\
hmm $cfParent/hmm\
scan $cfParent/scan\
velsel $cfParent/velsel\
nexus $cfParent/nexus\
hipadaba $cfParent/hipadaba\
plc $cfParent/plc]
parameters $cfParent/parameters\
anticollider $cfParent/anticollider\
motors $cfParent/motors\
optics $cfParent/optics\
counter $cfParent/counter\
chopper $cfParent/chopper\
environment $cfParent/environment\
hmm $cfParent/hmm\
scan $cfParent/scan\
velsel $cfParent/velsel\
nexus $cfParent/nexus\
hipadaba $cfParent/hipadaba\
plc $cfParent/plc\
commands $cfParent/commands\
]
ServerOption LogFileBaseName $sicsroot/log/serverlog
installprotocolhandler
source util/utility.tcl
ServerOption statusfile $sicsroot/log/status.tcl
ServerOption RedirectFile $sicsroot/log/stdout
@@ -41,7 +115,7 @@ SicsUser manager ansto 1
SicsUser user sydney 2
SicsUser spy 007 3
MakeDataNumber SicsDataNumber $sicsroot/data/DataNumber
MakeDataNumber SicsDataNumber $sicsroot/DataNumber
#Instrument specific configs must set the Instrument variable
::utility::mkVar SicsDataPrefix Text internal
@@ -51,13 +125,13 @@ SicsDataPrefix [SplitReply [Instrument]]
SicsDataPostFix nx.hdf
::utility::mkVar sics_release Text internal
::utility::mkVar sics_release Text manager sics_release true entry true true
set tmpstr [string map {"$" ""} {$Name: not supported by cvs2svn $}]
sics_release [lindex $tmpstr [expr [llength $tmpstr] - 1]]
sics_release lock
::utility::mkVar sics_revision_num Text internal
set tmpstr [string map {"$" ""} {$Revision: 1.32 $}]
set tmpstr [string map {"$" ""} {$Revision: 1.33 $}]
sics_revision_num [lindex $tmpstr [expr [llength $tmpstr] - 1]]
sics_revision_num lock
@@ -65,7 +139,9 @@ sics_revision_num lock
SicsDataPath $sicsroot/data/
SicsDataPath lock
::utility::mkVar Title Text user title true experiment true true
::utility::mkVar Sample Text user description true sample true true
::utility::mkVar SampleDescription Text user description true sample true true
::utility::mkVar SampleName Text user name true sample true true
::utility::mkVar SampleTitle Text user short_title true sample true true
::utility::mkVar User Text user name true user true true
::utility::mkVar Email Text user email true user true true
::utility::mkVar Phone Text user phone true user true true
@@ -75,38 +151,11 @@ MakeDrive
exe batchpath ../batch
exe syspath ../batch
::utility::mkVar detector_type Text internal
::utility::mkVar detector_description Text internal
::utility::mkVar dataFileName Text user file_name true experiment true true
::utility::mkVar hmm_simulation Text internal
hmm_simulation false
::utility::mkVar counter_simulation Text internal
counter_simulation false
::utility::mkVar motor_simulation Text internal
motor_simulation false
::utility::mkVar chopper_simulation Text internal
chopper_simulation false
::utility::mkVar plc_simulation Text internal
plc_simulation false
::utility::mkVar sics_fullsimulation Text internal
sics_fullsimulation false
if {[SplitReply [sics_fullsimulation]] == "true"} {
hmm_simulation true
counter_simulation true
motor_simulation true
chopper_simulation true
plc_simulation true
}
proc server_set_sobj_attributes {} {
if [ catch {
motor_set_sobj_attributes
::utility::set_motor_attributes
::utility::set_histomem_attributes
@@ -119,4 +168,20 @@ proc server_set_sobj_attributes {} {
## TODO move the following to the new ansto gumxml.tcl
sicslist setatt getgumtreexml privilege internal
clientput "serverport [get_portnum $::serverport]"
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
# Make the opal status info object
set sim_mode [SplitReply [opal_simulation]]
if {$sim_mode == "true"} {
proc opal {args} {
clientput "REACTOR POWER = 20 (woohoooooo!!!)"
}
publish opal user
} else {
MakeAsyncQueue lss_chan LSS 137.157.204.67 31250
MakeLSSMonitor opal lss_chan 0
}

33
site_ansto/instrument/util/check/README.TXT Normal file
View File

@@ -0,0 +1,33 @@
listsobj motor { klass { detector}}
listsobj motor {-not klass { detector}}
listsobj motor { type {-not @any}}
listsobj motor { type @any}
listsobj motor { control false type @any}
listsobj motor { type @missing}
listsobj motor { control false type @missing}
listsobj motor { data true type {part instrument nxvgroup}}
listsobj motor { data true sicsdev @any type {part instrument nxvgroup}}
listsobj motor {-not data true sicsdev @any type {part instrument nxvgroup}}
listsobj motor {-not mutable {true false} privilege {spy user manager read_only internal} kind {command event hobj ilist script} drivable {true false} countable {true false} callback {true false} environment {true false} nxalias {text} units {alpha}}
listsobj motor {mutable {true false} }
listsobj motor {mutable {a true} }
listsobj sicsvariable {control false data false}
listnode / {sicsdev ::histogram_memory::y_pixel_offset}
listnode / {sicsdev ::histogram_memory::}
listnode / {sicsdev ::histogram_memory::*}
listnode / {sicsdev @any}
listnode / {control true type {command}}
listnode / {type {command}}
listnode / {type {-not command}}
listnode / {type {part instrument nxvgroup commandset}}
listnode / { data false type {part instrument nxvgroup}}
listnode / { data true sicsdev @any type {part instrument nxvgroup}}
listnode / {-not klass command}
listnode / { control false type @missing}
listnode / { data true type {part}}
listnode / {-not data true sicsdev @any type {part instrument nxvgroup}}
listnode /instrument/sample {-not mutable {true false} privilege {spy user manager read_only internal} kind {command event hobj ilist script} drivable {true false} countable {true false} callback {true false} environment {true false} nxalias {text} units {alpha}}
listnode / {data true sicsdev @any type @any}
# To find which node the hmm has been added under do
listnode / {sicsdev hmm}

40
site_ansto/instrument/util/check/check_hdb.tcl Normal file
View File

@@ -0,0 +1,40 @@
## \file
# Must be loaded into an instance of SICS with fileeval
# eg
# fileeval tests/query_sics.tcl
fileeval util/check/query_sics.tcl
set hdb_prop_list {
{control data} {true false}
}
proc checknode {node} {
global hdb_prop_list
foreach {att v} $hdb_prop_list {
foreach a $att {
set query "$a @missing"
if {[query_propval $node $query]} {
clientput "$node: $a is missing"
continue
}
set query "$a \{$v\}"
if {![query_propval $node $query]} {
clientput "$node: $a should be one of ($v) not [::utility::hgetplainprop $node $a]"
}
}
}
}
proc checkhdb {{hpath "/"}} {
global hdb_prop_list
if {$hpath == "/"} {
foreach hp [hlist /] {
checknode /$hp
checkhdb /$hp
}
clientput OK
} else {
foreach hp [hlist $hpath] {
checknode $hpath/$hp
checkhdb $hpath/$hp
}
}
}
publish checkhdb user

38
site_ansto/instrument/util/check/check_sobj.tcl Normal file
View File

@@ -0,0 +1,38 @@
fileeval util/check/query_sics.tcl
proc checksobj {} {
global sobj_sicstype_list
foreach sicstype $sobj_sicstype_list {
global ${sicstype}_attlist
clientput "Check $sicstype"
foreach sobj [tolower_sicslist type $sicstype] {
array unset sobj_attarray
array set sobj_attarray [attlist $sobj]
# Skip it if privilege is missing or set to "internal"
if {[info exists sobj_attarray(privilege)]} {
if {$sobj_attarray(privilege) == "internal"} {
continue
}
} else {
continue
}
foreach {att v} [set ${sicstype}_attlist] {
foreach a $att {
set attlist "$a @missing"
if {[query_attval $sobj $attlist]} {
clientput "$sobj: $a is missing"
continue
}
set attlist "$a \{$v\}"
if {![query_attval $sobj $attlist]} {
clientput "$sobj: $a should be one of ($v) not [getatt $sobj $a]"
}
}
}
}
}
}
publish checksobj user

118
site_ansto/instrument/util/check/query_sics.tcl Normal file
View File

@@ -0,0 +1,118 @@
proc query_nameval {query nameval_list} {
if {[lindex $query 0] == "-not"} {
return [expr { ! [_query_nameval [lrange $query 1 end] $nameval_list] }]
} else {
return [_query_nameval $query $nameval_list]
}
}
proc _query_nameval {query nameval_list} {
array set proparr $nameval_list
foreach {prop val} $query {
if {[lindex $val 0] == "-not"} {
set test 0
set val [lrange $val 1 end]
} else {
set test 1
}
if {[info exists proparr($prop)]} {
if {$val == "@missing"} {
return 0
}
if {$val == "@any"} {
continue
}
} else {
if {$val == "@missing"} {
continue
} else {
return 0
}
}
switch $val {
"alpha" {
if {[string is alpha $proparr($prop)] == $test} {
continue
} else {
return 0
}
}
"text" {
if {[string is wordchar $proparr($prop)] == $test} {
continue
} else {
return 0
}
}
"print" {
if {[string is print $proparr($prop)] == $test} {
continue
} else {
return 0
}
}
"float" {
if {[string is double $proparr($prop)] == $test} {
continue
} else {
return 0
}
}
"int" {
if {[string is internal $proparr($prop)] == $test} {
continue
} else {
return 0
}
}
default {
if {([lsearch $val $proparr($prop)] >= 0) == $test} {
continue
} else {
return 0
}
}
}
}
return 1
}
proc query_propval {hp query} {
return [ query_nameval $query [::utility::hlistplainprop $hp] ]
}
proc query_attval {sobj query} {
return [ query_nameval $query [attlist $sobj] ]
}
##
# prop_list list of property name value pairs
# value can be a @any @missing a single value or a list optionally preceded by -not
# listnode / {data true sicsdev @missing type {-not part instrument nxvgroup}}
proc listnode {hpath prop_list} {
if {$hpath == "/"} {
foreach hp [hlist /] {
if [query_propval /$hp $prop_list] {
clientput "/$hp"
}
listnode /$hp $prop_list
}
} else {
foreach hp [hlist $hpath] {
if [query_propval $hpath/$hp $prop_list] {
clientput "$hpath/$hp"
}
listnode $hpath/$hp $prop_list
}
}
}
proc listsobj {sicstype att_list} {
foreach sobj [sicslist type $sicstype] {
if [query_attval $sobj $att_list] {
clientput "$sobj"
}
}
}
publish query_propval user
publish query_attval user
publish listnode user
publish listsobj user

12
site_ansto/instrument/util/command.tcl
View File

@@ -21,7 +21,7 @@ proc command {acmdName arglist body} {
# puts "cmdName: $cmdName"
foreach {type_spec var} $arglist {
lappend params $var
foreach {type domain} [split $type_spec :] {}
foreach {type domain} [split $type_spec "="] {}
lappend ${cmdName}_param_list $var ${cmdName}_par_$var
set sicsvar [lindex [set ${cmdName}_param_list] end]
# Make var with priv=user so we can use sicslist on it
@@ -41,9 +41,13 @@ proc command {acmdName arglist body} {
}
} else {
sicslist setatt $sicsvar argtype $type
foreach {min max} [split $domain ,] {}
sicslist setatt $sicsvar min $min
sicslist setatt $sicsvar max $max
if [string match -nocase {*:*} $domain] {
foreach {min max} [split $domain :] {}
sicslist setatt $sicsvar min $min
sicslist setatt $sicsvar max $max
} else {
sicslist setatt $sicsvar values $domain
}
}
}
sicslist setatt $sicsvar long_name $var

13
site_ansto/instrument/util/dmc2280/ckmd5.sh Executable file
View File

@@ -0,0 +1,13 @@
#!/bin/sh
# Strip all horizontal and vertical whitespace from the galil controller programs
# and compare md5 sums.
instrument=${HOSTNAME#ics1-}
i=1
for f in controller*.md5
do
name=`basename $f .md5`
echo -n "$name "
./getDMCprog.tcl -host mc${i}-$instrument -port pmc${i}-$instrument |tr -d '[:space:]'|md5sum -c $f 2> /dev/null
let i++
done

8
site_ansto/instrument/util/dmc2280/mkmd5.sh Executable file
View File

@@ -0,0 +1,8 @@
#!/bin/sh
# Strip all horizontal and vertical whitespace from the galil controller programs
# and generate md5 sums.
for f in controller*.txt
do
name=`basename $f .txt`
cat $f |tr -d '[:space:]'|md5sum > $name.md5
done

72
site_ansto/instrument/util/extra_utility.tcl
View File

@@ -1,5 +1,72 @@
# Many of these functions are also useful in test and debug code
# running on an external Tcl interpreter.
set errorInfo ""
set errorCode NONE
set errorContext ""
set callStack ""
proc callinfo {args} {
if {$args == "errors"} {
set msg "ERROR CONTEXT\n$::errorContext\n\nCALLSTACK\n$::callStack"
} else {
set msg "CALLSTACK\n$::callStack"
}
return $msg
}
publish callinfo user
# @brief Reset error information variables when entering a catch command
proc entercatch {args} {
uplevel {
global errorCode errorContext callStack
if {[info level] > 0} {
set errorCode NONE
# set errorContext ""
# set callStack ""
}
}
}
# @brief Set the errorContext and build the callStack when leaving a catch command
#
# ::errorContext is set to ::errorInfo
# ::callStack is a stack of command calls showing the argument values
proc leavecatch {args} {
uplevel {
global callStack errorContext errorCode errorInfo
if {[info level] > 0} {
if {$errorCode=="NONE"} {
set callStack ""
set errorContext ""
} else {
append callStack "\t[info level 0]\n"
}
}
}
}
# @brief Set the ::errorCode to "ERROR" when ::errorInfo is modified.
#
# NOTE\n
# Tcl always sets errorCode=NONE when there is no additional information\n
# about an error, as well as when there is no error! However when a command\n
# returns with an error it always writes to errorInfo.
proc errorInfowrite {args} {
uplevel {
global errorContext errorCode errorInfo
if {[info level] > 0} {
if {$errorInfo != ""} {
append errorContext $errorInfo
set errorCode ERROR
}
}
}
}
trace add variable errorInfo write errorInfowrite
trace add execution catch enter entercatch
trace add execution catch leave leavecatch
# LIST FUNCTIONS
proc head {args} {lindex [join $args] 0}
@@ -66,8 +133,13 @@ proc isoneof {element setb} {
# Returns 'sicslist' output in lower case, this may be useful in macros.
# This function is used a lot in the hdbbuilder
proc tolower_sicslist {args} {
if [ catch {
set result [eval sicslist $args]
return [string tolower $result];
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
}
}
# \brief Enables or disables the debug_msg command

Some files were not shown because too many files have changed in this diff Show More