From 67745b7f99daef69ffe7fa9de66cafd14ce58e84 Mon Sep 17 00:00:00 2001 From: Ferdi Franceschini Date: Tue, 7 Nov 2006 08:34:20 +1100 Subject: [PATCH] hipadaba prototype support files. They generate hipadaba paths for devices along with the xml description. r1236 | ffr | 2006-11-07 08:34:20 +1100 (Tue, 07 Nov 2006) | 3 lines --- site_ansto/instrument/hipadaba/ParList.tcl | 49 ++++++++++ .../instrument/hipadaba/gen_hipadaba.tcl | 20 +++++ .../instrument/hipadaba/gen_hpdbxml.tcl | 25 ++++++ .../instrument/hipadaba/hipadaba_support.tcl | 34 +++++++ site_ansto/instrument/hipadaba/hpdbxml.tcl | 90 +++++++++++++++++++ 5 files changed, 218 insertions(+) create mode 100644 site_ansto/instrument/hipadaba/ParList.tcl create mode 100644 site_ansto/instrument/hipadaba/gen_hipadaba.tcl create mode 100755 site_ansto/instrument/hipadaba/gen_hpdbxml.tcl create mode 100644 site_ansto/instrument/hipadaba/hipadaba_support.tcl create mode 100644 site_ansto/instrument/hipadaba/hpdbxml.tcl diff --git a/site_ansto/instrument/hipadaba/ParList.tcl b/site_ansto/instrument/hipadaba/ParList.tcl new file mode 100644 index 00000000..0a7f85e8 --- /dev/null +++ b/site_ansto/instrument/hipadaba/ParList.tcl @@ -0,0 +1,49 @@ +set countParList [list \ + setpreset USER Float\ + getpreset READ_ONLY Float\ + setexponent USER Float\ + getexponent READ_ONLY Float\ + setmode USER Float\ + getmode READ_ONLY Float\ + setexponent USER Float\ + getcounts READ_ONLY Float\ + getmonitor READ_ONLY Float\ + count USER Float\ + status READ_ONLY Text\ + gettime READ_ONLY Float\ + getthreshold READ_ONLY Float\ + setthreshold USER Float\ + send MANAGER Text\ +] + +set motParList [list \ + position USER Float\ + accesscode MANAGER Float\ + failafter MANAGER Float\ + fixed USER Float\ + hardlowerlim MANAGER Float\ + hardupperlim MANAGER Float\ + ignorefault MANAGER Float\ + interruptmode MANAGER Float\ + maxretry MANAGER Float\ + movecount MANAGER Float\ + precision MANAGER Float\ + sign MANAGER Float\ + softlowerlim USER Float\ + softupperlim USER Float\ + softzero USER Float\ + accel USER Float\ + decel USER Float\ + home MANAGER Float\ + maxaccel READ_ONLY Float\ + maxdecel READ_ONLY Float\ + maxspeed READ_ONLY Float\ + speed USER Float\ +] + +set virtmotParList [list \ + position USER Float\ +] + +set hmParList [list \ +] diff --git a/site_ansto/instrument/hipadaba/gen_hipadaba.tcl b/site_ansto/instrument/hipadaba/gen_hipadaba.tcl new file mode 100644 index 00000000..985d26dc --- /dev/null +++ b/site_ansto/instrument/hipadaba/gen_hipadaba.tcl @@ -0,0 +1,20 @@ +# $Revision: 1.1 $ +# $Date: 2006-11-06 21:34:20 $ +# Author: Ferdi Franceschini (ffr@ansto.gov.au) +# Last revision by: $Author: ffr $ + +source hipadaba_support.tcl +#------------------------------------------------------------------------- +# Install the SICS Hipadaba +#------------------------------------------------------------------------- +InstallHdb +source hipadaba_configuration.tcl + +proc xhlist {opt args} { +set fh [open InstXML.tcl]; +set InstXML [read $fh]; +close $fh; +clientput $InstXML "value" +} +publish xhlist spy + diff --git a/site_ansto/instrument/hipadaba/gen_hpdbxml.tcl b/site_ansto/instrument/hipadaba/gen_hpdbxml.tcl new file mode 100755 index 00000000..e77c396c --- /dev/null +++ b/site_ansto/instrument/hipadaba/gen_hpdbxml.tcl @@ -0,0 +1,25 @@ +#!/usr/bin/tclsh + +set instName [lindex $argv 0]; + +proc clientput {msg code} {puts $msg} +source hipadaba/ParList.tcl +source hipadaba/hpdbxml.tcl +array set accesscode [list 0 READ_ONLY 1 MANAGER 2 USER 3 SPY ]; + +proc genXML {instrument} { + global doc; + array set instPath [list Echidna hrpd Wombat hipd]; + + instrumentXML $instrument; + source $instPath($instrument)/hipadaba_configuration.tcl; + set fh [open $instPath($instrument)/InstXML.tcl w]; + puts -nonewline $fh ""; + puts -nonewline $fh [$doc asXML -indent none]; + close $fh; +} + + +if {$tcl_interactive==0} { + genXML $instName; +} diff --git a/site_ansto/instrument/hipadaba/hipadaba_support.tcl b/site_ansto/instrument/hipadaba/hipadaba_support.tcl new file mode 100644 index 00000000..ae7a1b18 --- /dev/null +++ b/site_ansto/instrument/hipadaba/hipadaba_support.tcl @@ -0,0 +1,34 @@ +# Makes hipadaba scripts for sics devices. +source ParList.tcl + +proc makeHdbCounter {hpath treename sicsname} { + global countParList; + append Name $hpath "/" $treename + eval hmake $Name spy none + foreach {name priv type} $countParList { + set parName [format "%s/%s" $Name $name] + eval hmakescript $parName \"$sicsname $name\" \"$sicsname $name\" float + } +} +proc makeHdbMotor {hpath treename sicsname} { + global motParList; + append motName $hpath "/" $treename + eval hmake $motName spy none + eval hmakescript "$motName/position" \"$sicsname\" \"run $sicsname\" float + foreach {name priv type} $motParList { + set parName [format "%s/%s" $motName $name] + eval hmakescript $parName \"$sicsname $name\" \"$sicsname $name\" float + } +} +proc makeHdbVirtMotor {hpath treename sicsname} { + append motName $hpath "/" $treename + eval hmake $motName spy none + eval hmakescript "$motName/position" \"$sicsname\" \"run $sicsname\" float +} +#FIXME implement makeHdbHM +proc makeHdbHM {hpath treename sicsname} { +} +#------------------------------------------------------------------------ +proc hdbReadOnly {} { + error "Parameter is READ ONLY" +} diff --git a/site_ansto/instrument/hipadaba/hpdbxml.tcl b/site_ansto/instrument/hipadaba/hpdbxml.tcl new file mode 100644 index 00000000..cb74a91d --- /dev/null +++ b/site_ansto/instrument/hipadaba/hpdbxml.tcl @@ -0,0 +1,90 @@ +package require tdom; +set tags [list part device property]; +foreach tag $tags {dom createNodeCmd elementNode $tag} + +# hmake path priv dataType [length] +proc hmake {hpath priv dataType args} { + global doc root part; + set parent $root; + foreach pid [split [string trimleft $hpath /] /] { + set node [eval "$parent selectNodes {//part\[@id='$pid'\]}"]; + if {$node == ""} { + set child [$doc createElement part]; + $child setAttribute id $pid; + $parent appendChild $child; + set parent $child; + } else { + set parent $node; + } + } +} + +proc instrumentXML {instrument} { + global doc root + set doc [dom createDocumentNS commonj.sdo sdo:datagraph]; + set root [$doc createElementNS http://www.psi.ch/sics/hipadaba hipadaba:Instrument]; + $root setAttribute label $instrument; + [$doc documentElement] appendChild $root; +} + +# Return node corresponding to hpath +proc hpathNode {hpath} { + global root; + set partsList [split [string trimleft $hpath /] /]; +# make selectNodes argumet + set snarg "{/"; + foreach pid $partsList { + set p [subst -nocommand {/part[@id='$pid']}]; + set snarg [append snarg $p]; + } + set snarg [append snarg "}"]; + set node [eval "$root selectNodes $snarg"]; + return $node; +} +proc makeHdbMotor {hpath treename sicsname} { + global motParList; + set node [hpathNode $hpath]; + if {$node == ""} { + clientput "$hpath doesn't exist" error; + return 1; + } + $node appendFromScript { + device id $treename { + foreach {name priv type} $motParList { + property privilege $priv dataType $type id $name; + } + } + } +} + +proc makeHdbVirtMotor {hpath treename sicsname} { + global virtmotParList; + set node [hpathNode $hpath]; + if {$node == ""} { + clientput "$hpath doesn't exist" error; + return 1; + } + $node appendFromScript { + device id $treename { + foreach {name priv type} $virtmotParList { + property privilege $priv dataType $type id $name; + } + } + } +} + +proc makeHdbHM {hpath treename sicsname} { + global hmParList; + set node [hpathNode $hpath]; + if {$node == ""} { + clientput "$hpath doesn't exist" error; + return 1; + } + $node appendFromScript { + device id $treename { + foreach {name priv type} $hmParList { + property privilege $priv dataType $type id $name; + } + } + } +}