From 22b22ffa25ee29f44ebdb015008ce5c4ec01e5a9 Mon Sep 17 00:00:00 2001 From: Jing Chen Date: Wed, 20 Apr 2011 12:29:55 +1000 Subject: [PATCH] add Pelican r3108 | jgn | 2011-04-20 12:29:55 +1000 (Wed, 20 Apr 2011) | 1 line --- .../instrument/pelican/DMC2280/README.txt | 1 + .../pelican/DMC2280/controller4.txt | 80 + .../pelican/DMC2280/controller5.txt | 67 + site_ansto/instrument/pelican/MANIFEST.TXT | 5 + site_ansto/instrument/pelican/Makefile | 5 + .../pelican/config/INSTCFCOMMON.TXT | 17 + site_ansto/instrument/pelican/config/Makefile | 4 + .../pelican/config/anticollider/acscript.txt | 4 + .../config/anticollider/anticollider.tcl | 14 + .../pelican/config/commands/commands.tcl | 91 + .../pelican/config/counter/counter.tcl | 28 + .../config/environment/environment.tcl | 55 + .../environment/temperature/lakeshore340.tcl | 51 + .../hipadaba/hipadaba_configuration.tcl | 1 + .../pelican/config/hmm/detector.tcl | 6 + .../pelican/config/hmm/hmm_configuration.tcl | 49 + .../config/motors/motor_configuration.tcl | 791 ++++++++ .../motors/positmotor_configuration.tcl | 60 + .../instrument/pelican/config/nexus/Makefile | 3 + .../pelican/config/nexus/nxscripts.tcl | 4 + .../pelican/config/optics/README.TXT | 1 + .../pelican/config/optics/optics.tcl | 2 + .../instrument/pelican/config/plc/plc.tcl | 8 + .../instrument/pelican/config/scan/scan.tcl | 6 + .../pelican/config/source/source.tcl | 8 + .../config/tasmad/sicscommon/ASCIIplot.tcl | 77 + .../config/tasmad/sicscommon/andorhm.tcl | 112 ++ .../config/tasmad/sicscommon/astrium.tcl | 524 +++++ .../config/tasmad/sicscommon/backup.tcl | 32 + .../config/tasmad/sicscommon/batch.tcl | 29 + .../config/tasmad/sicscommon/ccdwww.tcl | 169 ++ .../pelican/config/tasmad/sicscommon/debsics | 1 + .../config/tasmad/sicscommon/deltatau.tcl | 357 ++++ .../config/tasmad/sicscommon/el734.tcl | 488 +++++ .../config/tasmad/sicscommon/el737sec.tcl | 321 +++ .../config/tasmad/sicscommon/el755.tcl | 97 + .../config/tasmad/sicscommon/fourcircle.tcl | 1773 +++++++++++++++++ .../config/tasmad/sicscommon/fsync.jar | Bin 0 -> 6108 bytes .../config/tasmad/sicscommon/hdbutil.tcl | 944 +++++++++ .../config/tasmad/sicscommon/kt.sinqbck | Bin 0 -> 498 bytes .../config/tasmad/sicscommon/motorhp.tcl | 82 + .../config/tasmad/sicscommon/nxsupport.tcl | 126 ++ .../config/tasmad/sicscommon/phytron.tcl | 311 +++ .../config/tasmad/sicscommon/pimotor.tcl | 177 ++ .../config/tasmad/sicscommon/secsim.tcl | 66 + .../config/tasmad/sicscommon/simhm.tcl | 91 + .../config/tasmad/sicscommon/sinqhttp.tcl | 152 ++ .../config/tasmad/sicscommon/stddrive.tcl | 100 + .../config/tasmad/sicscommon/syncwrapper.pag | 8 + .../config/tasmad/sicscommon/table.tcl | 317 +++ .../pelican/config/tasmad/sicscommon/tecs.tcl | 23 + .../config/tasmad/taspub_sics/nxtas.tcl | 348 ++++ .../pelican/config/tasmad/taspub_sics/tas.dic | 83 + .../pelican/config/tasmad/taspub_sics/tas.hdd | 19 + .../config/tasmad/taspub_sics/tasp.tcl | 286 +++ .../config/tasmad/taspub_sics/taspubcom.tcl | 47 + .../config/tasmad/taspub_sics/tasscript.tcl | 1517 ++++++++++++++ .../config/tasmad/taspub_sics/tasub.dic | 138 ++ .../pelican/script_validator/MANIFEST.TXT | 2 + .../config/counter/counter.tcl | 4 + .../config/hmm/hmm_configuration.tcl | 27 + .../pelican/script_validator/sics_ports.tcl | 4 + .../pelican/script_validator_ports.tcl | 4 + site_ansto/instrument/pelican/sics_ports.tcl | 4 + .../pelican/taipan_configuration.tcl | 53 + .../util/dmc2280/troubleshoot_setup.tcl | 19 + 66 files changed, 10293 insertions(+) create mode 100644 site_ansto/instrument/pelican/DMC2280/README.txt create mode 100644 site_ansto/instrument/pelican/DMC2280/controller4.txt create mode 100644 site_ansto/instrument/pelican/DMC2280/controller5.txt create mode 100644 site_ansto/instrument/pelican/MANIFEST.TXT create mode 100644 site_ansto/instrument/pelican/Makefile create mode 100644 site_ansto/instrument/pelican/config/INSTCFCOMMON.TXT create mode 100644 site_ansto/instrument/pelican/config/Makefile create mode 100644 site_ansto/instrument/pelican/config/anticollider/acscript.txt create mode 100644 site_ansto/instrument/pelican/config/anticollider/anticollider.tcl create mode 100644 site_ansto/instrument/pelican/config/commands/commands.tcl create mode 100644 site_ansto/instrument/pelican/config/counter/counter.tcl create mode 100644 site_ansto/instrument/pelican/config/environment/environment.tcl create mode 100644 site_ansto/instrument/pelican/config/environment/temperature/lakeshore340.tcl create mode 100644 site_ansto/instrument/pelican/config/hipadaba/hipadaba_configuration.tcl create mode 100644 site_ansto/instrument/pelican/config/hmm/detector.tcl create mode 100644 site_ansto/instrument/pelican/config/hmm/hmm_configuration.tcl create mode 100644 site_ansto/instrument/pelican/config/motors/motor_configuration.tcl create mode 100644 site_ansto/instrument/pelican/config/motors/positmotor_configuration.tcl create mode 100644 site_ansto/instrument/pelican/config/nexus/Makefile create mode 100644 site_ansto/instrument/pelican/config/nexus/nxscripts.tcl create mode 100644 site_ansto/instrument/pelican/config/optics/README.TXT create mode 100644 site_ansto/instrument/pelican/config/optics/optics.tcl create mode 100644 site_ansto/instrument/pelican/config/plc/plc.tcl create mode 100644 site_ansto/instrument/pelican/config/scan/scan.tcl create mode 100644 site_ansto/instrument/pelican/config/source/source.tcl create mode 100644 site_ansto/instrument/pelican/config/tasmad/sicscommon/ASCIIplot.tcl create mode 100644 site_ansto/instrument/pelican/config/tasmad/sicscommon/andorhm.tcl create mode 100644 site_ansto/instrument/pelican/config/tasmad/sicscommon/astrium.tcl create mode 100644 site_ansto/instrument/pelican/config/tasmad/sicscommon/backup.tcl create mode 100644 site_ansto/instrument/pelican/config/tasmad/sicscommon/batch.tcl create mode 100644 site_ansto/instrument/pelican/config/tasmad/sicscommon/ccdwww.tcl create mode 100644 site_ansto/instrument/pelican/config/tasmad/sicscommon/debsics create mode 100644 site_ansto/instrument/pelican/config/tasmad/sicscommon/deltatau.tcl create mode 100644 site_ansto/instrument/pelican/config/tasmad/sicscommon/el734.tcl create mode 100644 site_ansto/instrument/pelican/config/tasmad/sicscommon/el737sec.tcl create mode 100644 site_ansto/instrument/pelican/config/tasmad/sicscommon/el755.tcl create mode 100644 site_ansto/instrument/pelican/config/tasmad/sicscommon/fourcircle.tcl create mode 100644 site_ansto/instrument/pelican/config/tasmad/sicscommon/fsync.jar create mode 100644 site_ansto/instrument/pelican/config/tasmad/sicscommon/hdbutil.tcl create mode 100644 site_ansto/instrument/pelican/config/tasmad/sicscommon/kt.sinqbck create mode 100644 site_ansto/instrument/pelican/config/tasmad/sicscommon/motorhp.tcl create mode 100644 site_ansto/instrument/pelican/config/tasmad/sicscommon/nxsupport.tcl create mode 100644 site_ansto/instrument/pelican/config/tasmad/sicscommon/phytron.tcl create mode 100644 site_ansto/instrument/pelican/config/tasmad/sicscommon/pimotor.tcl create mode 100644 site_ansto/instrument/pelican/config/tasmad/sicscommon/secsim.tcl create mode 100644 site_ansto/instrument/pelican/config/tasmad/sicscommon/simhm.tcl create mode 100644 site_ansto/instrument/pelican/config/tasmad/sicscommon/sinqhttp.tcl create mode 100644 site_ansto/instrument/pelican/config/tasmad/sicscommon/stddrive.tcl create mode 100644 site_ansto/instrument/pelican/config/tasmad/sicscommon/syncwrapper.pag create mode 100644 site_ansto/instrument/pelican/config/tasmad/sicscommon/table.tcl create mode 100644 site_ansto/instrument/pelican/config/tasmad/sicscommon/tecs.tcl create mode 100644 site_ansto/instrument/pelican/config/tasmad/taspub_sics/nxtas.tcl create mode 100644 site_ansto/instrument/pelican/config/tasmad/taspub_sics/tas.dic create mode 100644 site_ansto/instrument/pelican/config/tasmad/taspub_sics/tas.hdd create mode 100644 site_ansto/instrument/pelican/config/tasmad/taspub_sics/tasp.tcl create mode 100644 site_ansto/instrument/pelican/config/tasmad/taspub_sics/taspubcom.tcl create mode 100644 site_ansto/instrument/pelican/config/tasmad/taspub_sics/tasscript.tcl create mode 100644 site_ansto/instrument/pelican/config/tasmad/taspub_sics/tasub.dic create mode 100644 site_ansto/instrument/pelican/script_validator/MANIFEST.TXT create mode 100644 site_ansto/instrument/pelican/script_validator/config/counter/counter.tcl create mode 100644 site_ansto/instrument/pelican/script_validator/config/hmm/hmm_configuration.tcl create mode 100644 site_ansto/instrument/pelican/script_validator/sics_ports.tcl create mode 100644 site_ansto/instrument/pelican/script_validator_ports.tcl create mode 100644 site_ansto/instrument/pelican/sics_ports.tcl create mode 100644 site_ansto/instrument/pelican/taipan_configuration.tcl create mode 100644 site_ansto/instrument/pelican/util/dmc2280/troubleshoot_setup.tcl diff --git a/site_ansto/instrument/pelican/DMC2280/README.txt b/site_ansto/instrument/pelican/DMC2280/README.txt new file mode 100644 index 00000000..d2112a58 --- /dev/null +++ b/site_ansto/instrument/pelican/DMC2280/README.txt @@ -0,0 +1 @@ +Programs for the DMC2280 controllers. diff --git a/site_ansto/instrument/pelican/DMC2280/controller4.txt b/site_ansto/instrument/pelican/DMC2280/controller4.txt new file mode 100644 index 00000000..9fdc0927 --- /dev/null +++ b/site_ansto/instrument/pelican/DMC2280/controller4.txt @@ -0,0 +1,80 @@ +NO TE: TAIPAN - CONTROLLER 4 +NO TE: +NO TE: $Revision: 1.2 $ +NO TE: $Date: 2007-09-24 01:28:42 $ +NO TE: Author: Dan Bartlett +NO TE: Last revision by: $Author: dbx $ +NO TE: +NO TE: A-SPARE +NO TE: B-SPARE +NO TE: C-SPARE +NO TE: D-SPARE +NO TE: E-VIRTUAL SOURCE RIGHT, +VE OPEN, 6mm/TURN +NO TE: F-VIRTUAL SOURCE LEFT, -VE OPEN, 6mm/TURN +NO TE: G-SPARE +NO TE: H-SPARE +NO TE: 55mm GAP AT LIMITS, EQUAL ABOUT BEAM CL +NO ---------------------------------------- +#AUTO +NO TE: THIS IS THE PROGRAM THAT RUNS AUTOMATICALLY ON CONTROLLER STARTUP +MT-2,-2,-2,-2,-2,-2,-2,-2;'CONFIGURES ALL AXES AS STEPPER +MO;' FIRST TIME MOTOR OFF +CN 1;' CONFIGURES LIMIT SWITCHES TO ACCEPT NC CONTACTS +II 8,,,0;' CONFIGURES THE 8TH INPUT TO ACTIVATE THE #ININT ROUTINE +OP 65280;' SETS OUTPUTS 9-16 ON = RELAYS OFF +IA 137,157,203,134;' CONFIGURES IP ADDRESS +AC ,,,,25000,25000,,;' SET ACELERATION +DC ,,,,25000,25000,,;' SET DECELERATION +SP ,,,,12500,12500,,;' SET SPEED +JS #THREAD0 +EN +NO ---------------------------------------- +#THREAD0 +NO TE: THERE MUST BE A THREAD RUNNING FOR #LIMSWI, #TCPERR AND #ININT TO WORK +NO TE: CHECKS IF SPEEDS ARE ABOVE MAXIMUM ALLOWED +NO IF (_SPA>50000) +NO SPA=50000 +NO ENDIF +NO IF (_SPB>50000) +NO SPB=50000 +NO ENDIF +NO IF (_SPC>50000) +NO SPC=50000 +NO ENDIF +NO IF (_SPD>50000) +NO SPD=50000 +NO ENDIF +IF (_SPE<>12500) +SPE=12500 +ENDIF +IF (_SPF<>12500) +SPF=12500 +ENDIF +NO IF (_SPG>50000) +NO SPG=50000 +NO ENDIF +NO IF (_SPH>50000) +NO SPH=50000 +NO ENDIF +NO TE: CHECKS TO SEE IF DECELERATIONS OK +IF (_DCE<>25000) +DCE=25000 +ENDIF +IF (_DCF<>25000) +DCF=25000 +ENDIF +JP #THREAD0 +EN +NO ---------------------------------------- +#TCPERR +NO TE: EMPTY ROUTINE FOR A TCP ERROR +RE +NO ---------------------------------------- +#ININT +NO TE: INTERUPT ROUTINE TO STOP ALL AXES +NO TE: WHEN SAFETY & INTERLOCK SYSTEM REQUESTS IT +STA,B,C,D,E,F,G,H +AM +MO +RI +NO ---------------------------------------- diff --git a/site_ansto/instrument/pelican/DMC2280/controller5.txt b/site_ansto/instrument/pelican/DMC2280/controller5.txt new file mode 100644 index 00000000..52c2e079 --- /dev/null +++ b/site_ansto/instrument/pelican/DMC2280/controller5.txt @@ -0,0 +1,67 @@ +NO TE: TAIPAN - CONTROLLER 5 +NO TE: +NO TE: $Revision: 1.2 $ +NO TE: $Date: 2007-09-24 01:29:31 $ +NO TE: Author: Dan Bartlett +NO TE: Last revision by: $Author: dbx $ +NO TE: +NO TE: A-SECONDARY SHUTTER, +VE OPEN, 6mm/TURN +NO TE: ONE AXIS CONTROLLER ONLY +NO ---------------------------------------- +#AUTO +NO TE: THIS IS THE PROGRAM THAT RUNS AUTOMATICALLY ON CONTROLLER STARTUP +SHA +MTA=-2;'CONFIGURES ALL AXES AS STEPPER +CN 1;' CONFIGURES LIMIT SWITCHES TO ACCEPT NC CONTACTS +IA 137,157,203,135;' CONFIGURES IP ADDRESS +ACA=100000;' SET ACELERATION +DCA=100000;' SET DECELERATION +SPA=50000;' SET SPEED +JS #THREAD0 +EN +NO ---------------------------------------- +#THREAD0 +NO TE: CONTROLS THE SECONDARY SHUTTER +NO TE: INPUT 5=SECONDARY SHUTTER CLOSE SIGNAL 1 +NO TE: INPUT 6=SECONDARY SHUTTER CLOSE SIGNAL 2 +NO TE: INPUT 7=SECONDARY SHUTTER OPEN SIGNAL 1 +NO TE: INPUT 8=SECONDARY SHUTTER OPEN SIGNAL 2 +IF ((_TI0&192)=0)&(_BGA=0)&(_LFA=1) +NO TE: INPUTS 7,8 EXCLUSIVELY ACTIVE(0) & NOT MOVING & NOT ALREADY OPEN +NO TE: SECONDARY SHUTTER COMMANDED TO OPEN +NO TE: INPUTS 1,2,3 AND 4 ARE MASKED OUT BY THE &192 +PRA=580000;'APROX 140mm +BGA +ENDIF +IF ((_TI0&192<>0)&(_LRA=1) +NO TE: INPUTS 7,8 NOT EXCLUSIVELY ACTIVE(0) & NOT ALREADY CLOSED +NO TE: SECONDARY SHUTTER COMMANDED TO CLOSE +NO TE: INPUTS 1,2,3 AND 4 ARE MASKED OUT BY THE &192 +STA;' STOP ANY MOTION +AMA;' AFTER MOTION IS STOPPED +PRA=-580000;' APROX 140mm +BGA;' DRIVE SHUTTER CLOSED TO LIMIT SWITCH +AMA +ENDIF +JP #THREAD0 +EN +NO ---------------------------------------- +#TCPERR +NO TE: EMPTY ROUTINE FOR A TCP ERROR +RE +NO ---------------------------------------- +#CMDERR +NO TE: THIS IS A ROUTINE TO HANDLE COMMAND ERRORS +ZS0;' ZERO STACK +EN1 +NO ---------------------------------------- +#MONSWI +NO TE: THIS IS A ROUTINE TO MONITOR THE POSITION +NO TE: OF THE SECONDARY SHUTTER +IF (_LFA=1)&(_LRA=1) +MG {EA}, "SS NOT OPEN, NOT CLOSED" +WT200 +ENDIF +JP #MONSWI +EN +NO ---------------------------------------- \ No newline at end of file diff --git a/site_ansto/instrument/pelican/MANIFEST.TXT b/site_ansto/instrument/pelican/MANIFEST.TXT new file mode 100644 index 00000000..a3a79d90 --- /dev/null +++ b/site_ansto/instrument/pelican/MANIFEST.TXT @@ -0,0 +1,5 @@ +taipan_configuration.tcl +sics_ports.tcl +script_validator_ports.tcl +config +util diff --git a/site_ansto/instrument/pelican/Makefile b/site_ansto/instrument/pelican/Makefile new file mode 100644 index 00000000..2077f983 --- /dev/null +++ b/site_ansto/instrument/pelican/Makefile @@ -0,0 +1,5 @@ +all: + make -C config + +clean: + make -C config clean diff --git a/site_ansto/instrument/pelican/config/INSTCFCOMMON.TXT b/site_ansto/instrument/pelican/config/INSTCFCOMMON.TXT new file mode 100644 index 00000000..eeee47e2 --- /dev/null +++ b/site_ansto/instrument/pelican/config/INSTCFCOMMON.TXT @@ -0,0 +1,17 @@ +config/source/source_common.tcl +config/anticollider/anticollider_common.tcl +config/plc/plc_common_1.tcl +config/counter/counter_common_1.tcl +config/hipadaba/hipadaba_configuration_common.tcl +config/hipadaba/common_instrument_dictionary.tcl +config/hipadaba/instdict_specification.tcl +config/hmm/hmm_configuration_common_1.tcl +config/hmm/hmm_object.tcl +config/hmm/anstohm_linked.xml +config/hmm/sct_orhvps_common.tcl +config/scan/scan_common_1.hdd +config/scan/scan_common_1.tcl +config/nexus/nxscripts_common_1.tcl +config/commands/commands_common.tcl +config/motors/sct_positmotor_common.tcl +config/motors/sct_jogmotor_common.tcl diff --git a/site_ansto/instrument/pelican/config/Makefile b/site_ansto/instrument/pelican/config/Makefile new file mode 100644 index 00000000..b711f394 --- /dev/null +++ b/site_ansto/instrument/pelican/config/Makefile @@ -0,0 +1,4 @@ +all: + + +clean: diff --git a/site_ansto/instrument/pelican/config/anticollider/acscript.txt b/site_ansto/instrument/pelican/config/anticollider/acscript.txt new file mode 100644 index 00000000..8ab23c54 --- /dev/null +++ b/site_ansto/instrument/pelican/config/anticollider/acscript.txt @@ -0,0 +1,4 @@ +# Forbid detector motion when the detector voltage is on +# comment out -- Jing +#forbid {-inf inf} for det when dhv1 in {800 inf} +#forbid {-inf inf} for detoff when dhv1 in {800 inf} diff --git a/site_ansto/instrument/pelican/config/anticollider/anticollider.tcl b/site_ansto/instrument/pelican/config/anticollider/anticollider.tcl new file mode 100644 index 00000000..db8cb21a --- /dev/null +++ b/site_ansto/instrument/pelican/config/anticollider/anticollider.tcl @@ -0,0 +1,14 @@ +# Author: Ferdi Franceschini (ffr@ansto.gov.au) + +source $cfPath(anticollider)/anticollider_common.tcl + +# NOTE: This is called with a list of motorname target pairs +proc ::anticollider::enable {args} { + if {[SplitReply [::anticollider::protect_detector]] == "false"} { + return "false" + } else { + return "true" + } +} + +::anticollider::loadscript acscript.txt diff --git a/site_ansto/instrument/pelican/config/commands/commands.tcl b/site_ansto/instrument/pelican/config/commands/commands.tcl new file mode 100644 index 00000000..ab06046d --- /dev/null +++ b/site_ansto/instrument/pelican/config/commands/commands.tcl @@ -0,0 +1,91 @@ +# Author : Jing Chen (jgn@ansto.gov.au) + +source $cfPath(commands)/commands_common.tcl + +namespace eval motor { +# is_homing_list = comma separated list of motors which are safe to send "home" + variable is_homing_list "" +} + +#namespace eval sample { +# command select {int=0:8 sampid} { +# SampleNum $sampid +# } +#} + + +#namespace eval beamstops { +# command selbsn {int=1,2,3,4,5,6 bs} { +# selbs $bs "UNDEF" "UNDEF" +# } +# command selbsxz {int=1,2,3,4,5,6 bs float bx float bz} { +# selbs $bs $bx $bz +# } +#} + +#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} { +# drive att $angle +# } + +# command entrance_aperture { +# int=0,45,90,135,180,270 angle +# } { +# drive srce $angle +# } + +# TODO Do we need this +# command sample_aperture { +# int=25,50 size +# text=circ,squ,open,rect shape +# } { +# SApXmm $size +# SApZmm $size +# SApShape $shape +# } + +############################## +## +# @brief The "guide" command uses a lookup table to setup the collimation system +# @param row, selects a row from the guide configuration table +# +# eg\n +# guide ga +# command guide " +# text=[join [array names ::optics::guide_configuration] , ] configuration +# " { +# +# variable guide_configuration +# variable guide_configuration_columns +# +# if [ catch { +# +# foreach {compselection position} $guide_configuration($configuration) { +# foreach el $compselection guide $guide_configuration_columns { +# lappend to_config $guide +# lappend to_config [set ::optics::${guide}_map($el)] +# } +# ::optics::guide -set feedback status BUSY +# set msg [eval "drive $to_config"] +# EApPosY $position +# } +# GuideConfig $configuration +# } message ] { +# ::optics::guide -set feedback status IDLE +# if {$::errorCode=="NONE"} {return $message} +# return -code error $message +# } +# ::optics::guide -set feedback status IDLE +# } +# ::optics::guide -addfb text status +# ::optics::guide -set feedback status IDLE +#} + + +proc ::commands::isc_initialize {} { + ::commands::ic_initialize +} diff --git a/site_ansto/instrument/pelican/config/counter/counter.tcl b/site_ansto/instrument/pelican/config/counter/counter.tcl new file mode 100644 index 00000000..3ae86d84 --- /dev/null +++ b/site_ansto/instrument/pelican/config/counter/counter.tcl @@ -0,0 +1,28 @@ +source $cfPath(counter)/counter_common_1.tcl + +## TODO Put all the counter macros in the counter namespace +namespace eval counter { + variable isc_numchannels + variable isc_monitor_address + variable isc_portlist + variable isc_beam_monitor_list + proc set_sobj_attributes {} { + } +} + +proc ::counter::isc_initialize {} { + if [catch { + variable isc_numchannels + variable isc_monitor_address + variable isc_portlist + variable isc_beam_monitor_list {MONITOR_1 MONITOR_2 MONITOR_3} + + set isc_monitor_address "das1-[SplitReply [instrument]]" + set isc_portlist [list 30000 30001 30002 30003 30004 30005 30006 30007] + set isc_numchannels [llength $isc_beam_monitor_list] + ::counter::ic_initialize + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error "$message" + } +} diff --git a/site_ansto/instrument/pelican/config/environment/environment.tcl b/site_ansto/instrument/pelican/config/environment/environment.tcl new file mode 100644 index 00000000..4dd78bed --- /dev/null +++ b/site_ansto/instrument/pelican/config/environment/environment.tcl @@ -0,0 +1,55 @@ +proc select_environment_controller {envtemp} { +if [ catch { +puts "selecting $envtemp for environment control" +switch $envtemp { + "lh45" { + add_lh45 tc1 ca5-taipan 4003 1 + proc ::histogram_memory::pre_count {} { + hset /sample/tc1/sensor/start_temperature [hval /sample/tc1/sensor/value] + hset /sample/tc1/sensor/end_temperature [hval /sample/tc1/sensor/value] + } + proc ::histogram_memory::post_count {} { + hset /sample/tc1/sensor/end_temperature [hval /sample/tc1/sensor/value] + } + } + "rhqc" { + puts "Configuring RHQC" + # 9600 8 1 None None Enable + add_sct_ls340 tc1 ca5-[instname] 4001 "\r" 0.5 5.0 +# TODO Set controlsensor +# if { [SplitReply [environment_simulation]] == "false"} { +# tc1 controlsensor sensorB +# } +# puts "Added tc1 with [tc1 controlsensor]" + # 9600 8 1 None None Enable + add_sct_ls340 tc2 ca5-[instname] 4002 "\r" 0.5 5.0 +# TODO Set controlsensor +# if { [SplitReply [environment_simulation]] == "false"} { +# tc2 controlsensor sensorD +# } +# puts "Added tc2 with [tc2 controlsensor]" + } + "11TMagnet" { + puts "Configuring 11TMagnet" + add_sct_ls340 tc2 ca5-[instname] 4001 "\r" 0.5 5.0 + if { [SplitReply [environment_simulation]] == "false"} { + ::utility::macro::getset float temperature {} { + return [sicsmsgfmt [hval /sample/tc2/sensor/sensorValueA]] + } + sicslist setatt temperature long_name temperature + sicslist setatt temperature klass sample + sicslist setatt temperature units K +# TODO Set controlsensor +# tc1 controlsensor sensorA +# } + add_ips120 ips120 ca5-taipan 4004 0.001 + + } + default { + clientput "Unknown environment controller $envtemp" + } +} +} msg ] { + puts "Failed to configure $envtemp: $msg" +} +} diff --git a/site_ansto/instrument/pelican/config/environment/temperature/lakeshore340.tcl b/site_ansto/instrument/pelican/config/environment/temperature/lakeshore340.tcl new file mode 100644 index 00000000..31c49bbd --- /dev/null +++ b/site_ansto/instrument/pelican/config/environment/temperature/lakeshore340.tcl @@ -0,0 +1,51 @@ +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. +# +# @param tcn temperature controller name, the hdb name will be tcn_cntrl +# @param mport, the moxa RS232 port number, ie 1,2,3,4 +# +# Optional parameters, see lakeshore340_common.tcl for defaults in tc_dfltPar +# @param tolerance, temperature controller tolerance +# @param settle, settling time in seconds +# @param range, lakeshore range +# @param upperlimit, upper temperature limit Kelvin +# @param lowerlimit, lower temperature limit Kelvin +proc ::environment::temperature::add_ls340 {tcn tc_dfltURL mport args} { + variable tc_dfltPar + variable moxaPortMap + if [catch { + if {$tcn == "" || $mport == ""} { + error "ERROR: You must provide a temperature controller name and moxa port number" + } + + array set tc_param [array get tc_dfltPar] + + if {$args != ""} { + array set tc_param $args + foreach {nm v} $args { + set tc_param($nm) $v + } + } + set sim_mode [SplitReply [environment_simulation]] + if {$sim_mode == "true"} { + ::environment::temperature::mkls340sim $tcn + } else { + ::environment::temperature::mkls340 $tcn $tc_dfltURL $moxaPortMap($mport) + foreach nm [array names tc_param] { + $tcn $nm $tc_param($nm) + } + } + + sicslist setatt $tcn environment_name ${tcn}_cntrl + sicslist setatt $tcn long_name control_sensor_reading + ::environment::mkenvinfo $tcn {heateron {priv user} range {priv manager} } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } +} diff --git a/site_ansto/instrument/pelican/config/hipadaba/hipadaba_configuration.tcl b/site_ansto/instrument/pelican/config/hipadaba/hipadaba_configuration.tcl new file mode 100644 index 00000000..3aaa4d83 --- /dev/null +++ b/site_ansto/instrument/pelican/config/hipadaba/hipadaba_configuration.tcl @@ -0,0 +1 @@ +source $cfPath(hipadaba)/hipadaba_configuration_common.tcl diff --git a/site_ansto/instrument/pelican/config/hmm/detector.tcl b/site_ansto/instrument/pelican/config/hmm/detector.tcl new file mode 100644 index 00000000..a1d67364 --- /dev/null +++ b/site_ansto/instrument/pelican/config/hmm/detector.tcl @@ -0,0 +1,6 @@ +# Detector voltage controller +fileeval $cfPath(hmm)/sct_orhvps_common.tcl +::scobj::dethvps::init ca1-taipan 4001 4.1 +dhv1 max 2600 +dhv1 lower 19 +dhv1 upper 57 diff --git a/site_ansto/instrument/pelican/config/hmm/hmm_configuration.tcl b/site_ansto/instrument/pelican/config/hmm/hmm_configuration.tcl new file mode 100644 index 00000000..4f4f9e51 --- /dev/null +++ b/site_ansto/instrument/pelican/config/hmm/hmm_configuration.tcl @@ -0,0 +1,49 @@ +# Author Jing Chen (jgn@ansto.gove.au) +# Note: all following functions's bodies need to be implemented in real Taipan deployment + +source $cfPath(hmm)/hmm_configuration_common_1.tcl +set sim_mode [SplitReply [hmm_simulation]] + +proc ::histogram_memory::init_OAT_TABLE {} { +} + +proc ::histogram_memory::pre_count {} {} +proc ::histogram_memory::post_count {} {} +proc ::histogram_memory::isc_initialize {} { + # Instrument specific X and Y dimension names + #variable INST_NXC "oat_nxc_eff" + #variable INST_NYC "oat_nyc_eff" + + if [ catch { + ::histogram_memory::init_hmm_objs + if {$::sim_mode == "true"} { + #hmm configure oat_ntc_eff 1 + #hmm configure $INST_NYC 127 + #hmm configure $INST_NXC 127 + } + #BAT_TABLE -init + #CAT_TABLE -init + #SAT_TABLE -init + #OAT_TABLE -init + #FAT_TABLE -init + ::histogram_memory::ic_initialize + + #detector_active_height_mm [expr 5.08 * 192] + #detector_active_width_mm [expr 5.08 * 192] + #detector_active_height_mm lock + #detector_active_width_mm lock + + ::histogram_memory::init_OAT_TABLE + ::histogram_memory::upload_config Filler_defaults + + #set ::histogram_memory::histmem_axes(HOR) /instrument/detector/x_pixel_offset + #set ::histogram_memory::histmem_axes(VER) /instrument/detector/y_pixel_offset + } message ] { + return -code error $message + } +} + +proc histmem {cmd args} { + eval "_histmem $cmd $args" +} +publish histmem user diff --git a/site_ansto/instrument/pelican/config/motors/motor_configuration.tcl b/site_ansto/instrument/pelican/config/motors/motor_configuration.tcl new file mode 100644 index 00000000..5231e4a5 --- /dev/null +++ b/site_ansto/instrument/pelican/config/motors/motor_configuration.tcl @@ -0,0 +1,791 @@ +# Author: Jing Chen (jgn@ansto.gov.au) + +# START MOTOR CONFIGURATION +::utility::mkVar FastShutter text manager FastShutter false instrument true false + +# SET TO 1 TO USE THE TILT STAGE ie sample phi and chi +set use_tiltstage 0 + +set animal taipan +set sim_mode [SplitReply [motor_simulation]] + +# Setup addresses of Galil DMC2280 controllers. +set dmc2280_controller1(host) mc1-$animal +set dmc2280_controller1(port) pmc1-$animal + +set dmc2280_controller2(host) mc2-$animal +set dmc2280_controller2(port) pmc2-$animal + +set dmc2280_controller3(host) mc3-$animal +set dmc2280_controller3(port) pmc3-$animal + +set dmc2280_controller4(host) mc4-$animal +set dmc2280_controller4(port) pmc4-$animal + +set dmc2280_controller6(host) mc6-$animal +set dmc2280_controller6(port) pmc6-$animal + +if {$sim_mode == "true"} { + set motor_driver_type asim +} else { + set motor_driver_type DMC2280 + MakeAsyncQueue mc1 DMC2280 $dmc2280_controller1(host) $dmc2280_controller1(port) + MakeAsyncQueue mc2 DMC2280 $dmc2280_controller2(host) $dmc2280_controller2(port) + MakeAsyncQueue mc3 DMC2280 $dmc2280_controller3(host) $dmc2280_controller3(port) + MakeAsyncQueue mc4 DMC2280 $dmc2280_controller4(host) $dmc2280_controller4(port) +} + +#Measured absolute encoder reading at home position +set samchi_Home 7808328 +set samphi_Home 7675008 +set samx_Home 7420441 +set samy_Home 7101486 +set samz_Home 9944901 +set samthet_Home 23004075 +set det_Home 7055209 +set detoff_Home 6857213 + +set srce_Home 7281463 +set apx_Home 12965422 +set apz_Home 7500000 +set att_Home 24782942 + + + +#Measured or computed step/count rates for collimator translation +set coll_StepsPerX [expr -25000.0/6.0] +set coll_CntsPerX [expr 8192.0/6.0] + +#Measured or computed step rate for samz (Sample Raise) +#Copied from Reflectometer then divided by 2.0 for SANS +# Motor:25000/turn, gear:1/25, screw:5mm/turn +set samzStepRate [expr -((25000.0*25.0)/5.0)/2.0] +#set samzCountRate [expr -(8192.0/5.0/0.932)] +# 8192 count encoder, 5mm/Turn screw, 14:15 gearing? +set samzCountRate [expr -((8192.0/5.0)/(14.0/15.0))/2.0] + +# set movecount high to reduce the frequency of +# hnotify messages to a reasonable level +set move_count 100 + +############################ +# Motor Controller 1 +# Motor Controller 1 +# Motor Controller 1 +############################ +# + +# Dummy translation motor, useful for testing scans + +Motor dummy_motor asim [params \ + asyncqueue mc1\ + host mc1-taipan\ + port pmc1-taipan\ + axis C\ + units mm\ + hardlowerlim -500\ + hardupperlim 500\ + maxSpeed 1\ + maxAccel 5\ + maxDecel 5\ + stepsPerX [expr 25000.0/5.0]\ + absEnc 1\ + absEncHome $samx_Home\ + cntsPerX [expr 8192.0/5.0]] +dummy_motor part instrument +dummy_motor long_name dummy_motor +dummy_motor softlowerlim -500 +dummy_motor softupperlim 500 +dummy_motor home 0 + +#if $use_tiltstage { +# mc1: Monochromator crystal selection rotation/Tilt +Motor mtilt $motor_driver_type [params \ + asyncqueue mc1\ + host mc1-taipan\ + port pmc1-taipan\ + axis A\ + units degrees\ + hardlowerlim -5\ + hardupperlim 5\ + maxSpeed 5000\ + maxAccel 2048\ + maxDecel 2048\ + stepsPerX 4096\ + absEnc 1\ + absEncHome $samchi_Home\ + cntsPerX 4096] +mtilt part sample +mtilt long_name mtilt +mtilt softlowerlim -5 +mtilt softupperlim 5 +mtilt home 0 +#} + +set atest mtilt + +# mc1: Monochromator Linear (Translate) +Motor mtrans $motor_driver_type [params \ + asyncqueue mc1\ + host mc1-taipan\ + port pmc1-taipan\ + axis B\ + units degrees\ + hardlowerlim -10\ + hardupperlim 195\ + maxSpeed 20000\ + maxAccel 2048\ + maxDecel 2048\ + stepsPerX 4096\ + absEnc 1\ + absEncHome $samphi_Home\ + cntsPerX 4096] +mtrans part sample +mtrans long_name mtrans +mtrans softlowerlim -10 +mtrans softupperlim 195 +mtrans home 0 + +# mc1: Fight Tube Rotate +Motor m2 $motor_driver_type [params \ + asyncqueue mc1\ + host mc1-taipan\ + port pmc1-taipan\ + axis F\ + units degrees\ + hardlowerlim -32.5\ + hardupperlim 53\ + maxSpeed 75000\ + maxAccel 25000\ + maxDecel 25000\ + stepsPerX 8192\ + absEnc 1\ + absEncHome $samx_Home\ + cntsPerX 4096] +m2 part sample +m2 long_name m2 +m2 softlowerlim -32.5 +m2 softupperlim 53 +m2 home 0 + +# mc1: Detector Rotate +Motor a2 $motor_driver_type [params \ + asyncqueue mc1\ + host mc1-taipan\ + port pmc1-taipan\ + axis H\ + units degrees\ + hardlowerlim -55\ + hardupperlim 55\ + maxSpeed 100000\ + maxAccel 32768\ + maxDecel 32768\ + stepsPerX 8192\ + absEnc 1\ + absEncHome $samy_Home\ + cntsPerX 4096] +a2 part sample +a2 long_name a2 +a2 softlowerlim -55 +a2 softupperlim 55 +a2 home 0 + + +############################ +# Motor Controller 2 +# Motor Controller 2 +# Motor Controller 2 +############################ +# + +# mc2: Sample Tilt 1 +Motor sgu $motor_driver_type [params \ + asyncqueue mc2\ + host mc2-taipan\ + port pmc2-taipan\ + axis A\ + units degrees\ + hardlowerlim -18\ + hardupperlim 19\ + maxSpeed 12500\ + maxAccel 32768\ + maxDecel 32768\ + stepsPerX 8192\ + absEnc 1\ + absEncHome $samz_Home\ + cntsPerX 4096] +sgu part sample +sgu long_name sgu +sgu softlowerlim -18 +sgu softupperlim 19 +sgu home 0 + +# mc2: Sample Tilt 2 +Motor sgl $motor_driver_type [params \ + asyncqueue mc2\ + host mc2-taipan\ + port pmc2-taipan\ + axis B\ + units degrees\ + hardlowerlim -18\ + hardupperlim 18\ + maxSpeed 25000\ + maxAccel 25000\ + maxDecel 25000\ + stepsPerX 8192\ + absEnc 1\ + absEncHome $samthet_Home\ + cntsPerX 4096] +sgl part sample +sgl long_name sgl +sgl softlowerlim -18 +sgl softupperlim 18 +sgl home 0 + +# mc2: Sample Up Tanslation +Motor stu $motor_driver_type [params \ + asyncqueue mc2\ + host mc2-taipan\ + port pmc2-taipan\ + axis C\ + units degrees\ + hardlowerlim -15\ + hardupperlim 15\ + maxSpeed 30000\ + maxAccel 32768\ + maxDecel 32768\ + stepsPerX 8192\ + absEnc 1\ + absEncHome $samthet_Home\ + cntsPerX 4096] +stu part sample +stu long_name stu +stu softlowerlim -15 +stu softupperlim 15 +stu home 0 + +# mc2: Sample Lower Tanslation +Motor stl $motor_driver_type [params \ + asyncqueue mc2\ + host mc2-taipan\ + port pmc2-taipan\ + axis D\ + units degrees\ + hardlowerlim -15\ + hardupperlim 15\ + maxSpeed 30000\ + maxAccel 32768\ + maxDecel 32768\ + stepsPerX 8192\ + absEnc 1\ + absEncHome $samthet_Home\ + cntsPerX 4096] +stl part sample +stl long_name stl +stl softlowerlim -15 +stl softupperlim 15 +stl home 0 + +# mc2: Sample Rotate +Motor s1 $motor_driver_type [params \ + asyncqueue mc2\ + host mc2-taipan\ + port pmc2-taipan\ + axis E\ + units degrees\ + hardlowerlim -185\ + hardupperlim 124\ + maxSpeed 25000\ + maxAccel 25000\ + maxDecel 25000\ + stepsPerX 8192\ + absEnc 1\ + absEncHome $samthet_Home\ + cntsPerX 4096] +s1 part sample +s1 long_name s1 +s1 softlowerlim -185 +s1 softupperlim 124 +s1 home 0 + +# mc2: Analyser Detector Rotate -- Sample Scattering Angle +Motor s2 $motor_driver_type [params \ + asyncqueue mc2\ + host mc2-taipan\ + port pmc2-taipan\ + axis F\ + units degrees\ + hardlowerlim -128\ + hardupperlim 3\ + maxSpeed 100000\ + maxAccel 25000\ + maxDecel 25000\ + stepsPerX 8192\ + absEnc 1\ + absEncHome $samthet_Home\ + cntsPerX 4096] +s2 part sample +s2 long_name s2 +s2 softlowerlim -128 +s2 softupperlim 3 +s2 home 0 + +# mc2: Analyser Horizontal Focus +Motor ahfocus $motor_driver_type [params \ + asyncqueue mc2\ + host mc2-taipan\ + port pmc2-taipan\ + axis G\ + units degrees\ + hardlowerlim -360\ + hardupperlim 360\ + maxSpeed 2000\ + maxAccel 1000\ + maxDecel 1000\ + stepsPerX 8192\ + absEnc 1\ + absEncHome $samthet_Home\ + cntsPerX 4096] +ahfocus part sample +ahfocus long_name ahfocus +ahfocus softlowerlim -360 +ahfocus softupperlim 360 +ahfocus home 0 + +# mc2: Analyser Vertical Focus +Motor avfocus $motor_driver_type [params \ + asyncqueue mc2\ + host mc2-taipan\ + port pmc2-taipan\ + axis H\ + units degrees\ + hardlowerlim -200\ + hardupperlim 0\ + maxSpeed 30000\ + maxAccel 60000\ + maxDecel 60000\ + stepsPerX 8192\ + absEnc 1\ + absEncHome $samthet_Home\ + cntsPerX 4096] +avfocus part sample +avfocus long_name avfocus +avfocus softlowerlim -200 +avfocus softupperlim 0 +avfocus home 0 + +# mc3: Monochromator Vertical Focus +Motor mvfocus $motor_driver_type [params \ + asyncqueue mc3\ + host mc3-taipan\ + port pmc3-taipan\ + axis A\ + units degrees\ + hardlowerlim 0\ + hardupperlim 240\ + maxSpeed 25000\ + maxAccel 8192\ + maxDecel 4096\ + stepsPerX 4096\ + absEnc 1\ + absEncHome $samthet_Home\ + cntsPerX 4096] +mvfocus part sample +mvfocus long_name mvfocus +mvfocus softlowerlim 0 +mvfocus softupperlim 240 +mvfocus home 0 + +# mc3: Monochromator Horizontal Focus +Motor mhfocus $motor_driver_type [params \ + asyncqueue mc3\ + host mc3-taipan\ + port pmc3-taipan\ + axis B\ + units degrees\ + hardlowerlim -180\ + hardupperlim 275\ + maxSpeed 25000\ + maxAccel 8192\ + maxDecel 4096\ + stepsPerX 4096\ + absEnc 1\ + absEncHome $samthet_Home\ + cntsPerX 4096] +mhfocus part sample +mhfocus long_name mhfocus +mhfocus softlowerlim 0 +mhfocus softupperlim 240 +mhfocus home 0 + +# mc3: Monochromator Rotate +Motor m1 $motor_driver_type [params \ + asyncqueue mc3\ + host mc3-taipan\ + port pmc3-taipan\ + axis E\ + units degrees\ + hardlowerlim 5\ + hardupperlim 40\ + maxSpeed 75000\ + maxAccel 25000\ + maxDecel 25000\ + stepsPerX 4096\ + absEnc 1\ + absEncHome $samthet_Home\ + cntsPerX 4096] +m1 part sample +m1 long_name m1 +m1 softlowerlim 5 +m1 softupperlim 40 +m1 home 0 + +# mc4: Analyzer Tilt 1 -- Two-theta Angle +Motor atilt $motor_driver_type [params \ + asyncqueue mc4\ + host mc4-taipan\ + port pmc4-taipan\ + axis A\ + units degrees\ + hardlowerlim -5\ + hardupperlim 5\ + maxSpeed 100000\ + maxAccel 32768\ + maxDecel 32768\ + stepsPerX 8192\ + absEnc 1\ + absEncHome $samthet_Home\ + cntsPerX 4096] +atilt part sample +atilt long_name atilt +atilt softlowerlim -5 +atilt softupperlim 5 +atilt home 0 + +# mc4: Analyzer Translate +Motor atrans $motor_driver_type [params \ + asyncqueue mc4\ + host mc4-taipan\ + port pmc4-taipan\ + axis C\ + units degrees\ + hardlowerlim -1\ + hardupperlim 22\ + maxSpeed 100000\ + maxAccel 32768\ + maxDecel 32768\ + stepsPerX 8192\ + absEnc 1\ + absEncHome $samthet_Home\ + cntsPerX 4096] +atrans part sample +atrans long_name atrans +atrans softlowerlim -1 +atrans softupperlim 22 +atrans home 0 + +# mc4: Analyzer Rotate +Motor a1 $motor_driver_type [params \ + asyncqueue mc4\ + host mc4-taipan\ + port pmc4-taipan\ + axis D\ + units degrees\ + hardlowerlim -5.1\ + hardupperlim 30\ + maxSpeed 50000\ + maxAccel 32768\ + maxDecel 32768\ + stepsPerX 8192\ + absEnc 1\ + absEncHome $samthet_Home\ + cntsPerX 4096] +a1 part sample +a1 long_name a1 +a1 softlowerlim -5.1 +a1 softupperlim 30 +a1 home 0 + +# mc4: Virtural Source Left Translation +Motor VS_left $motor_driver_type [params \ + asyncqueue mc4\ + host mc4-taipan\ + port pmc4-taipan\ + axis E\ + units mm\ + hardlowerlim 2\ + hardupperlim 35\ + maxSpeed 12500\ + maxAccel 25000\ + maxDecel 25000\ + stepsPerX 8192\ + absEnc 1\ + absEncHome $samthet_Home\ + cntsPerX 4096] +VS_left part sample +VS_left long_name VS_left +VS_left softlowerlim 2 +VS_left softupperlim 35 +VS_left home 0 + +# mc4: Virtural Source Right Translation +Motor VS_right $motor_driver_type [params \ + asyncqueue mc4\ + host mc4-taipan\ + port pmc4-taipan\ + axis F\ + units mm\ + hardlowerlim -35\ + hardupperlim -2\ + maxSpeed 12500\ + maxAccel 25000\ + maxDecel 25000\ + stepsPerX 8192\ + absEnc 1\ + absEncHome $samthet_Home\ + cntsPerX 4096] +VS_right part sample +VS_right long_name VS_right +VS_right softlowerlim -35 +VS_right softupperlim -2 +VS_right home 0 + +# mc4: Filter Rotate +Motor mfilter $motor_driver_type [params \ + asyncqueue mc4\ + host mc4-taipan\ + port pmc4-taipan\ + axis G\ + units degrees\ + hardlowerlim 0\ + hardupperlim 360\ + maxSpeed 30000\ + maxAccel 60000\ + maxDecel 60000\ + stepsPerX 8192\ + absEnc 1\ + absEncHome $samthet_Home\ + cntsPerX 4096] +mfilter part sample +mfilter long_name mfilter +mfilter softlowerlim 0 +mfilter softupperlim 360 +mfilter home 0 + +# mc4: Primary collimator Translate +Motor collimator $motor_driver_type [params \ + asyncqueue mc4\ + host mc4-taipan\ + port pmc4-taipan\ + axis H\ + units mm\ + hardlowerlim -112\ + hardupperlim 112\ + maxSpeed 12500\ + maxAccel 25000\ + maxDecel 25000\ + stepsPerX 4096\ + absEnc 1\ + absEncHome $samthet_Home\ + cntsPerX 4096] +mfilter part sample +mfilter long_name collimator +mfilter softlowerlim -112 +mfilter softupperlim 112 +mfilter home 0 + +# mc6: Pre-sample right aperture -- Slit s1 right Blade +Motor ps_right $motor_driver_type [params \ + asyncqueue mc6\ + host mc6-taipan\ + port pmc6-taipan\ + axis A\ + units mm\ + hardlowerlim -27\ + hardupperlim -2\ + maxSpeed 30000\ + maxAccel 60000\ + maxDecel 60000\ + stepsPerX 4096\ + absEnc 1\ + absEncHome $samthet_Home\ + cntsPerX 4096] +ps_right part sample +ps_right long_name ps_right +ps_right softlowerlim -27 +ps_right softupperlim -2 +ps_right home 0 + +# mc6: Pre-sample left aperture -- Slit s1 left Blade +Motor ps_left $motor_driver_type [params \ + asyncqueue mc6\ + host mc6-taipan\ + port pmc6-taipan\ + axis B\ + units mm\ + hardlowerlim -27\ + hardupperlim -2\ + maxSpeed 30000\ + maxAccel 60000\ + maxDecel 60000\ + stepsPerX 4096\ + absEnc 1\ + absEncHome $samthet_Home\ + cntsPerX 4096] +ps_left part sample +ps_left long_name ps_left +ps_left softlowerlim -27 +ps_left softupperlim -2 +ps_left home 0 + +# mc6: Pre-sample top aperture -- Slit s1 top Blade +Motor ps_top $motor_driver_type [params \ + asyncqueue mc6\ + host mc6-taipan\ + port pmc6-taipan\ + axis C\ + units mm\ + hardlowerlim -200\ + hardupperlim -2\ + maxSpeed 30000\ + maxAccel 60000\ + maxDecel 60000\ + stepsPerX 4096\ + absEnc 1\ + absEncHome $samthet_Home\ + cntsPerX 4096] +ps_top part sample +ps_top long_name ps_top +ps_top softlowerlim -200 +ps_top softupperlim -2 +ps_top home 0 + +# mc6: Pre-sample bottom aperture -- Slit s1 bottom Blade +Motor ps_bottom $motor_driver_type [params \ + asyncqueue mc6\ + host mc6-taipan\ + port pmc6-taipan\ + axis D\ + units mm\ + hardlowerlim -200\ + hardupperlim -2\ + maxSpeed 30000\ + maxAccel 60000\ + maxDecel 60000\ + stepsPerX 4096\ + absEnc 1\ + absEncHome $samthet_Home\ + cntsPerX 4096] +ps_bottom part sample +ps_bottom long_name ps_bottom +ps_bottom softlowerlim -200 +ps_bottom softupperlim -2 +ps_bottom home 0 + +# mc6: Pre-sample right aperture -- Slit s2 right Blade +Motor pa_right $motor_driver_type [params \ + asyncqueue mc6\ + host mc6-taipan\ + port pmc6-taipan\ + axis E\ + units mm\ + hardlowerlim -26\ + hardupperlim 2\ + maxSpeed 30000\ + maxAccel 60000\ + maxDecel 60000\ + stepsPerX 4096\ + absEnc 1\ + absEncHome $samthet_Home\ + cntsPerX 4096] +pa_right part sample +pa_right long_name pa_right +pa_right softlowerlim -26 +pa_right softupperlim 2 +pa_right home 0 + +# mc6: Pre-sample left aperture -- Slit s2 left Blade +Motor pa_left $motor_driver_type [params \ + asyncqueue mc6\ + host mc6-taipan\ + port pmc6-taipan\ + axis F\ + units mm\ + hardlowerlim -26\ + hardupperlim 2\ + maxSpeed 30000\ + maxAccel 60000\ + maxDecel 60000\ + stepsPerX 4096\ + absEnc 1\ + absEncHome $samthet_Home\ + cntsPerX 4096] +pa_left part sample +pa_left long_name pa_left +pa_left softlowerlim -26 +pa_left softupperlim 2 +pa_left home 0 + +# mc6: Pre-sample top aperture -- Slit s2 top Blade +Motor pa_top $motor_driver_type [params \ + asyncqueue mc6\ + host mc6-taipan\ + port pmc6-taipan\ + axis G\ + units mm\ + hardlowerlim -200\ + hardupperlim 0\ + maxSpeed 30000\ + maxAccel 60000\ + maxDecel 60000\ + stepsPerX 4096\ + absEnc 1\ + absEncHome $samthet_Home\ + cntsPerX 4096] +pa_left part sample +pa_left long_name pa_top +pa_left softlowerlim -200 +pa_left softupperlim 0 +pa_left home 0 + +# mc6: Pre-sample bottom aperture -- Slit s2 bottom Blade +Motor pa_bottom $motor_driver_type [params \ + asyncqueue mc6\ + host mc6-taipan\ + port pmc6-taipan\ + axis H\ + units mm\ + hardlowerlim -200\ + hardupperlim 0\ + maxSpeed 30000\ + maxAccel 60000\ + maxDecel 60000\ + stepsPerX 4096\ + absEnc 1\ + absEncHome $samthet_Home\ + cntsPerX 4096] +pa_bottom part sample +pa_bottom long_name pa_bottom +pa_bottom softlowerlim -200 +pa_bottom softupperlim 0 +pa_bottom home 0 + +proc motor_set_sobj_attributes {} { +} +# END MOTOR CONFIGURATION + +# According to http://www.nexusformat.org/Design units must conform to +# http://www.unidata.ucar.edu/software/udunits/udunits-1/udunits.txt +# So we use "count" for dimensionless decimal numbers +#set vc_units count +#make_coll_motor_2 c1 section_1 pc1 pc2 $vc_units +#make_coll_motor_1 c2 section_2 pc3 $vc_units +#make_coll_motor_1 c3 section_3 pc4 $vc_units +#make_coll_motor_1 c4 section_4 pc5 $vc_units +#make_coll_motor_1 c5 section_5 pc6 $vc_units +#make_coll_motor_1 c6 section_6 pc7 $vc_units +#make_coll_motor_1 c7 section_7 pc8 $vc_units +#make_coll_motor_1 c8 section_8 pc9 $vc_units +#make_coll_motor_1 c9 section_9 pc10 $vc_units +#unset vc_units + diff --git a/site_ansto/instrument/pelican/config/motors/positmotor_configuration.tcl b/site_ansto/instrument/pelican/config/motors/positmotor_configuration.tcl new file mode 100644 index 00000000..6f383fc0 --- /dev/null +++ b/site_ansto/instrument/pelican/config/motors/positmotor_configuration.tcl @@ -0,0 +1,60 @@ +# Author: Jing Chen (jgn@ansto.gov.au) + +source $cfPath(motors)/sct_positmotor_common.tcl + +set port1 [portnum pmc1-taipan] +set port2 [portnum pmc2-taipan] +set port3 [portnum pmc3-taipan] +set port4 [portnum pmc4-taipan] +set port5 [portnum pmc5-taipan] +set port6 [portnum pmc6-taipan] + +makesctcontroller sct_mc1 std mc1-taipan:$port1 +makesctcontroller sct_mc2 std mc2-taipan:$port2 +makesctcontroller sct_mc3 std mc3-taipan:$port3 +makesctcontroller sct_mc4 std mc4-taipan:$port4 +makesctcontroller sct_mc5 std mc5-taipan:$port5 +makesctcontroller sct_mc6 std mc6-taipan:$port6 + +# label pos +#index position +set 20sample_table { + 1 453.7 + 2 411.7 + 3 369.7 + 4 327.7 + 5 285.7 + 6 203.7 + 7 161.7 + 8 119.7 + 9 77.7 + 10 35.7 + 11 -46.3 + 12 -88.3 + 13 -130.3 + 14 -172.3 + 15 -214.3 + 16 -296.3 + 17 -338.3 + 18 -380.3 + 19 -422.3 + 20 -464.3 +} + +#mkPosit sct_mc1 sampleNum float samx sample $20sample_table + +#diameter position +set auto_ap_table { + 2.5 0 + 5.0 -23 + 7.5 -47 + 10.0 -72 + 12.5 -98 + 15.0 -125 + 17.5 -153 + 20.0 -183 + 25.0 -215 + 30.0 -250 +} +#mkPosit sct_mc3 diameter float apx sample $auto_ap_table + diff --git a/site_ansto/instrument/pelican/config/nexus/Makefile b/site_ansto/instrument/pelican/config/nexus/Makefile new file mode 100644 index 00000000..7af3113c --- /dev/null +++ b/site_ansto/instrument/pelican/config/nexus/Makefile @@ -0,0 +1,3 @@ +all: + +clean: diff --git a/site_ansto/instrument/pelican/config/nexus/nxscripts.tcl b/site_ansto/instrument/pelican/config/nexus/nxscripts.tcl new file mode 100644 index 00000000..5f4166ab --- /dev/null +++ b/site_ansto/instrument/pelican/config/nexus/nxscripts.tcl @@ -0,0 +1,4 @@ +source $cfPath(nexus)/nxscripts_common_1.tcl +proc ::nexus::isc_initialize {} { + ::nexus::ic_initialize +} diff --git a/site_ansto/instrument/pelican/config/optics/README.TXT b/site_ansto/instrument/pelican/config/optics/README.TXT new file mode 100644 index 00000000..bd84ac14 --- /dev/null +++ b/site_ansto/instrument/pelican/config/optics/README.TXT @@ -0,0 +1 @@ +Optical Components: Neutron Guides, Apertures, Polariser, Focussing Lenses and Prisms diff --git a/site_ansto/instrument/pelican/config/optics/optics.tcl b/site_ansto/instrument/pelican/config/optics/optics.tcl new file mode 100644 index 00000000..2b08fab4 --- /dev/null +++ b/site_ansto/instrument/pelican/config/optics/optics.tcl @@ -0,0 +1,2 @@ +#fileeval $cfPath(optics)/guide_configuration.tcl +#fileeval $cfPath(optics)/aperture_configuration.tcl diff --git a/site_ansto/instrument/pelican/config/plc/plc.tcl b/site_ansto/instrument/pelican/config/plc/plc.tcl new file mode 100644 index 00000000..b3d685ba --- /dev/null +++ b/site_ansto/instrument/pelican/config/plc/plc.tcl @@ -0,0 +1,8 @@ +set sim_mode [SplitReply [plc_simulation]] +if {$sim_mode == "false"} { +# MakeAsyncQueue plc_chan SafetyPLC 137.157.204.79 31001 +# MakeSafetyPLC plc plc_chan 0 +} + +source $cfPath(plc)/plc_common_1.tcl + diff --git a/site_ansto/instrument/pelican/config/scan/scan.tcl b/site_ansto/instrument/pelican/config/scan/scan.tcl new file mode 100644 index 00000000..dd396f62 --- /dev/null +++ b/site_ansto/instrument/pelican/config/scan/scan.tcl @@ -0,0 +1,6 @@ +source $cfPath(scan)/scan_common_1.tcl +proc ::scan::pre_hmm_scan_prepare {} {} + +proc ::scan::isc_initialize {} { + ::scan::ic_initialize +} diff --git a/site_ansto/instrument/pelican/config/source/source.tcl b/site_ansto/instrument/pelican/config/source/source.tcl new file mode 100644 index 00000000..50967ab8 --- /dev/null +++ b/site_ansto/instrument/pelican/config/source/source.tcl @@ -0,0 +1,8 @@ +# Author Jing Chen (jgn@ansto.gov.au) + +source $cfPath(source)/source_common.tcl + +proc ::source::isc_initialize {} { + ::source::ic_initialize "thermal" +} + diff --git a/site_ansto/instrument/pelican/config/tasmad/sicscommon/ASCIIplot.tcl b/site_ansto/instrument/pelican/config/tasmad/sicscommon/ASCIIplot.tcl new file mode 100644 index 00000000..a505448b --- /dev/null +++ b/site_ansto/instrument/pelican/config/tasmad/sicscommon/ASCIIplot.tcl @@ -0,0 +1,77 @@ +proc AsciiPlot_findScale {ydatalist scale baseline} { +upvar $scale sc +upvar $baseline bl + set min +99999999.99 + set max -99999999.99 + foreach yval $ydatalist { + if {$yval > $max} { + set max $yval + } + if {$yval < $min} { + set min $yval + } + } + set sc [expr 61./($max-$min)] + set bl [expr int(-$min*$sc+1.)] + +} + +proc AsciiPlot_clearLine {line} { +upvar $line Zeile + for {set i 0} {$i < 64} {incr i} { + set Zeile($i) " " + } + set Zeile(64) "\n" +} + +proc AsciiPlot_printLine {xtxt line} { +upvar $line Zeile + set txtline "" + set txtline "$txtline$xtxt" + for {set i 0} {$i <= 64} {incr i} { + set txtline "$txtline$Zeile($i)" + } + ClientPut $txtline +} + +proc AsciiPlot_list {xdata ydata} { + AsciiPlot_findScale $ydata scale baseValue + set xty 0 + set avgy 0 + foreach xval $xdata yval $ydata { + set xty [expr $xty+$xval*$yval] + set avgy [expr $avgy+$yval] + AsciiPlot_clearLine line + set line(0) "!" + set height [expr int($yval*$scale+$baseValue)] + if {$height >= 1} { + if {$height < 69} { + set line($height) "*" + } else { + set line(68) "*" + } + } + AsciiPlot_printLine [format %+#1.3e $xval] line + } + ClientPut "\ncenter of gravity = [expr 1.*$xty/$avgy]\n" +} + +proc AsciiPlot_xydata2list {xydatalist xdata ydata} { +upvar $xdata xd +upvar $ydata yd +set xd {} +set yd {} +set xydl [$xydatalist list] + foreach {x y} $xydl { + lappend xd $x + lappend yd $y + } +} + +proc AsciiPlot {data} { +AsciiPlot_xydata2list $data xdata ydata +AsciiPlot_list $xdata $ydata +} + +Publish AsciiPlot Spy +alias asciiplot AsciiPlot diff --git a/site_ansto/instrument/pelican/config/tasmad/sicscommon/andorhm.tcl b/site_ansto/instrument/pelican/config/tasmad/sicscommon/andorhm.tcl new file mode 100644 index 00000000..17b4e743 --- /dev/null +++ b/site_ansto/instrument/pelican/config/tasmad/sicscommon/andorhm.tcl @@ -0,0 +1,112 @@ +#-------------------------------------------------------------- +# This is the initialisation code for the ANDOR iKon-M +# camera and the CDDWWW WWW-server. It got separated into +# a separate file in order to support moving that camera around. +# +# Mark Koennecke, November 2010 +#-------------------------------------------------------------- + +#source $scripthome/ccdwww.tcl + +#--------------------------------------------------------------- +set ccdwww::initnodes [list daqmode camerano accucycle accucounts \ + triggermode temperature imagepar shutterlevel \ + shuttermode openingtime closingtime flip rotate \ + hspeed vspeed vamp] +#-------------------------------------------------------------- +proc writecooler {} { + set target [sct target] + set status [ccdwww::httpsend "/ccd/cooling?status=$target"] + andisct queue /sics/andi/cooler read read + andisct queue /sics/andi/temperature read read +} +#-------------------------------------------------------------- +proc readcooler {} { + sct send "/ccd/iscooling" + return coolerreply +} +#--------------------------------------------------------------- +proc coolerreply {} { + set reply [sct result] + set status [catch {ccdwww::httptest $reply} data] + if {$status != 0} { + sct geterror $data + clientput $data + } else { + catch {hdelprop [sct] geterror} + if {$data == 0} { + sct update off + } else { + sct update on + } + } + return idle +} +#--------------------------------------------------------- +proc readtemp {} { + ccdwww::httpsend "/ccd/temperature" + return tempreply +} +#-------------------------------------------------------- +proc tempreply {} { + set reply [sct result] + set status [catch {ccdwww::httptest $reply} data] + if {$status != 0} { + sct geterror $data + clientput $data + } else { + catch {hdelprop [sct] geterror} + sct update $data + } + return idle +} +#------------------------------------------------------------- +proc MakeAndorHM {name host } { + ccdwww::MakeCCDWWW $name $host "ccdwww::initscript $name" + hfactory /sics/$name/daqmode plain mugger text + hset /sics/$name/daqmode single + hfactory /sics/$name/camerano plain mugger int + hset /sics/$name/camerano 0 + hfactory /sics/$name/accucycle plain mugger int + hset /sics/$name/accucycle 20 + hfactory /sics/$name/accucounts plain mugger int + hset /sics/$name/accucounts 5 + hfactory /sics/$name/triggermode plain mugger int + hset /sics/$name/triggermode 0 + hfactory /sics/$name/temperature plain mugger int + hset /sics/$name/temperature -30 + hfactory /sics/$name/imagepar plain mugger intar 6 + hset /sics/$name/imagepar 1 1 1 1024 1 1024 + hfactory /sics/$name/shutterlevel plain mugger int + hset /sics/$name/shutterlevel 0 + hfactory /sics/$name/shuttermode plain mugger int + hset /sics/$name/shuttermode 0 + hfactory /sics/$name/openingtime plain mugger int + hset /sics/$name/openingtime 20 + hfactory /sics/$name/closingtime plain mugger int + hset /sics/$name/closingtime 20 + hfactory /sics/$name/flip plain mugger intar 2 + hset /sics/$name/flip 0 1 + hfactory /sics/$name/rotate plain mugger int + hset /sics/$name/rotate 0 + hfactory /sics/$name/hspeed plain mugger int + hset /sics/$name/hspeed 2 + hfactory /sics/$name/vspeed plain mugger int + hset /sics/$name/vspeed 0 + hfactory /sics/$name/vamp plain mugger int + hset /sics/$name/vamp 1 + hfactory /sics/$name/cooler plain mugger text + hset /sics/$name/cooler off + hsetprop /sics/$name/cooler write writecooler + hsetprop /sics/$name/cooler httpreply ccdwww::httpreply + hsetprop /sics/$name/cooler read readcooler + hsetprop /sics/$name/cooler coolerreply coolerreply + ${name}sct write /sics/$name/cooler + ${name}sct poll /sics/$name/cooler 30 + hfactory /sics/$name/sensor_temperature plain mugger float + hsetprop /sics/$name/sensor_temperature read readtemp + hsetprop /sics/$name/sensor_temperature tempreply tempreply + ${name}sct poll /sics/$name/sensor_temperature 30 + $name dim 1024 1024 + $name init +} diff --git a/site_ansto/instrument/pelican/config/tasmad/sicscommon/astrium.tcl b/site_ansto/instrument/pelican/config/tasmad/sicscommon/astrium.tcl new file mode 100644 index 00000000..b6230a59 --- /dev/null +++ b/site_ansto/instrument/pelican/config/tasmad/sicscommon/astrium.tcl @@ -0,0 +1,524 @@ +#-------------------------------------------------------------- +# This is a new style driver for the Astrium chopper systems in +# the new sicsobj/scriptcontext based system. Please note that +# actual implementations may differ in the number of choppers +# and the address of the chopper on the network. +# +# copyright: see file COPYRIGHT +# +# SCRIPT CHAINS: +# - reading parameters: +# astchopread - readastriumchopperpar - readastriumchopperpar - ... +# - writing +# astchopwrite - astchopwritereply +# +# Another remark: +# In order for chosta to work properly, the chopperparlist and +# chopperlonglist must be aligned. +# +# Mark Koennecke, February 2009 +# +# If something goes wrong with this, the following things ought +# to be checked: +# - Is the standard Tcl scan command been properly renamed to stscan? +# - Is a communication possible with the chopper via telnet? +# This may not be the case because of other SICS servers blocking +# things or the old driver being active and capturing the terminal +# server port in SerPortServer. Scriptcontext then fails silently. +# But may be we will fix the latter. +# - The other thing which happens is that the parameter list of +# the chopper differs in little ways between instances. +# +# Mark Koennecke, April 2009 +#-------------------------------------------------------------- +MakeSICSObj choco AstriumChopper +#------------------------------------------------------------- +proc astriumchopperputerror {txt} { + global choppers chopperparlist + foreach chopper $choppers { + foreach par $chopperparlist { + set path /sics/choco/${chopper}/${par} + hsetprop $path geterror $txt + } + } +} +#-------------------------------------------------------------- +# Paramamters look like: name value, entries for parameters are +# separated by ; +#--------------------------------------------------------------- +proc astriumsplitreply {chopper reply} { + set parlist [split [string trim $reply] ";"] + foreach par $parlist { + catch {stscan $par "%s %s" token val} count + if {[string first ERROR $count] < 0 && $count == 2} { + set val [string trim $val] + set token [string trim $token] + catch {hupdate /sics/choco/${chopper}/${token} $val} + catch {hdelprop /sics/choco/${chopper}/${token} geterror} + } else { +#-------- special fix for dphas and averl + if {[string first dphas $par] >= 0} { + set val [string range $par 5 end] + if {$val > 360} { + set val [expr $val -360.] + } + hupdate /sics/choco/${chopper}/dphas $val + hdelprop /sics/choco/${chopper}/dphas geterror + } + if {[string first averl $par] >= 0} { + set val [string range $par 5 end] + hupdate /sics/choco/${chopper}/averl $val + hdelprop /sics/choco/${chopper}/averl geterror + } + } + } +} +#------------------------------------------------------------- +# update those parameters which are dependent on the chopper +# status just read. Some of them may or may not be there, this +# is why this is protected by catch'es. +#------------------------------------------------------------- +proc astcopydependentpar {} { + global choppers + foreach chop $choppers { + set val [hval /sics/choco/${chop}/aspee] + catch {hupdate /sics/choco/${chop}/speed $val} + set val [hval /sics/choco/${chop}/nphas] + set dp [hval /sics/choco/${chop}/dphas] + set val [expr $val + $dp] + catch {hupdate /sics/choco/${chop}/phase $val} + } +} +#-------------------------------------------------------------- +proc readastriumchopperpar {} { + global choppers + set reply [sct result] + if {[string first ERR $reply] >= 0} { + astriumchopperputerror $reply + return idle + } + if {[string first "not valid" $reply] >= 0 } { + astriumchopperputerror "ERROR: chopper responded with not valid" + return idle + } + set count [sct replycount] + if {$count == -1} { + sct send @@NOSEND@@ + sct replycount 0 + hupdate /sics/choco/asyst "" + hdelprop /sics/choco/asyst geterror + return astchoppar + } else { + set oldval [hval /sics/choco/asyst] + hupdate /sics/choco/asyst "$oldval $reply" + astriumsplitreply [lindex $choppers $count] $reply + incr count + sct replycount $count + if {$count < [llength $choppers] } { + sct send @@NOSEND@@ + return astchoppar + } else { + astcopydependentpar + return idle + } + } +} +#-------------------------------------------------------------- +proc astchopread {} { + sct send "asyst 1" + sct replycount -1 + return astchoppar +} +#--------------------------------------------------------------- +proc astriumMakeChopperParameters {} { + global choppers chopperparlist + foreach chopper $choppers { + hfactory /sics/choco/${chopper} plain spy none + foreach par $chopperparlist { + set path /sics/choco/${chopper}/${par} + hfactory $path plain internal text + chocosct connect $path + } + } + hfactory /sics/choco/asyst plain user text + hsetprop /sics/choco/asyst read astchopread + hsetprop /sics/choco/asyst astchoppar readastriumchopperpar + hfactory /sics/choco/stop plain user int + chocosct poll /sics/choco/asyst 60 +#--------- This is for debugging +# chocosct poll /sics/choco/asyst 10 +} +#=================== write support ============================== +proc astchopwrite {prefix} { + set val [sct target] + sct send "$prefix $val" + sct writestart 1 + hupdate /sics/choco/stop 0 + return astchopwritereply +} +#---------------------------------------------------------------- +# Make sure to send a status request immediatly after a reply in +# order to avoid timing problems +#---------------------------------------------------------------- +proc astchopwritereply {} { + set reply [sct result] + if {[string first ERR $reply] >= 0} { + sct print $reply + hupdate /sics/choco/stop 1 + return idle + } + if {[string first "chopper error" $reply] >= 0} { + sct print "ERROR: $reply" + hupdate /sics/choco/stop 1 + return idle + } + if {[string first "not valid" $reply] >= 0 } { + sct print "ERROR: chopper responded with not valid" + hupdate /sics/choco/stop 1 + return idle + } + set state [sct writestart] + if {$state == 1} { + sct writestart 0 + sct send "asyst 1" + sct replycount -1 + return astchopwritereply + } else { + set status [readastriumchopperpar] + if {[string first idle $status] >= 0} { + return idle + } else { + return astchopwritereply + } + } +} +#-------------------------------------------------------------------- +proc astchopcompare {path1 path2 delta} { + set v1 [hval $path1] + set v2 [hval $path2] + if {abs($v1 - $v2) < $delta} { + return 1 + } else { + return 0 + } +} +#-------------------------------------------------------------------- +proc astchopcheckspeed {chopper} { + set stop [hval /sics/choco/stop] + if {$stop == 1} { + return fault + } + chocosct queue /sics/choco/asyst progress read + set tg [sct target] + set p1 /sics/choco/${chopper}/nspee + set p2 /sics/choco/${chopper}/aspee + set tst [astchopcompare $p1 $p2 50] + if {$tst == 1 } { + wait 1 + return idle + } else { + return busy + } +} +#--------------------------------------------------------------------- +proc astchopcheckphase {chopper} { + set stop [hval /sics/choco/stop] + if {$stop == 1} { + return fault + } + chocosct queue /sics/choco/asyst progress read + set p2 [hval /sics/choco/${chopper}/dphas] + if {abs($p2) < .03} { + wait 15 + return idle + } else { + return busy + } +} +#--------------------------------------------------------------------- +proc astchopcheckratio {} { + global choppers + set stop [hval /sics/choco/stop] + if {$stop == 1} { + return fault + } + set ch1 [lindex $choppers 0] + set ch2 [lindex $choppers 1] + chocosct queue /sics/choco/asyst progress read + set p1 [hval /sics/choco/${ch1}/aspee] + set p2 [hval /sics/choco/${ch2}/aspee] + set target [sct target] + if {$p2 < 10} { + return busy + } + if {abs($p1/$p2 - $target*1.) < .3} { + set tst 1 + } else { + set tst 0 + } + if {$tst == 1 } { + wait 1 + return idle + } else { + return busy + } +} +#---------------------------------------------------------------------- +proc astchopstop {} { + sct print "No real way to stop choppers but I will release" + sct send @@NOSEND@@ + hupdate /sics/choco/stop 1 + return idle +} +#--------------------------------------------------------------------- +proc astspeedread {chopper} { + set val [hval /sics/choco/${chopper}/aspee] + sct update $val + sct send @@NOSEND@@ + return idle +} +#--------------------------------------------------------------------- +proc astchopspeedlimit {chidx} { + global choppers maxspeed + set chname [lindex $choppers $chidx] + set val [sct target] + if {$val < 0 || $val > $maxspeed} { + error "Desired chopper speed out of range" + } + if {$chidx > 0} { + set state [hval /sics/choco/${chname}/state] + if {[string first async $state] < 0} { + error "Chopper in wrong state" + } + } + return OK +} +#---------------------------------------------------------------------- +proc astMakeChopperSpeed1 {var} { + global choppers + set ch [lindex $choppers 0] + set path /sics/choco/${ch}/speed + hfactory $path plain mugger float + hsetprop $path read astspeedread $ch + hsetprop $path write astchopwrite "nspee 1 " + hsetprop $path astchopwritereply astchopwritereply + chocosct write $path + hsetprop $path checklimits astchopspeedlimit 0 + hsetprop $path halt astchopstop + hsetprop $path checkstatus astchopcheckspeed $ch + hsetprop $path priv manager + makesctdriveobj $var $path DriveAdapter chocosct +} +#---------------------------------------------------------------------- +proc astMakeChopperSpeed2 {var} { + global choppers + set ch [lindex $choppers 1] + set path /sics/choco/${ch}/speed + hfactory $path plain mugger float + hsetprop $path read astspeedread $ch + hsetprop $path write astchopwrite "nspee 2 " + hsetprop $path astchopwritereply astchopwritereply + chocosct write $path + hsetprop $path checklimits astchopspeedlimit 0 + hsetprop $path halt astchopstop + hsetprop $path checkstatus astchopcheckspeed $ch + hsetprop $path priv manager + makesctdriveobj $var $path DriveAdapter chocosct +} +#----------------------------------------------------------------------- +proc astchopphaselimit {} { + set val [sct target] + if {$val < -359.9 || $val > 359.9} { + error "chopper phase out of range" + } + return OK +} +#--------------------------------------------------------------------- +proc astphaseread {chopper} { + set val [hval /sics/choco/${chopper}/aphas] + sct update $val + sct send @@NOSEND@@ + return idle +} +#----------------------------------------------------------------------- +proc astMakeChopperPhase1 {var} { + global choppers + set ch [lindex $choppers 0] + set path /sics/choco/${ch}/phase + hfactory $path plain mugger float + hsetprop $path read astphaseread $ch + hsetprop $path write astchopwrite "nphas 1 " + hsetprop $path astchopwritereply astchopwritereply + chocosct write $path + hsetprop $path checklimits astchopphaselimit + hsetprop $path halt astchopstop + hsetprop $path checkstatus astchopcheckphase $ch + hsetprop $path priv manager + makesctdriveobj $var $path DriveAdapter chocosct +} +#----------------------------------------------------------------------- +proc astMakeChopperPhase2 {var} { + global choppers + set ch [lindex $choppers 1] + set path /sics/choco/${ch}/phase + hfactory $path plain mugger float + hsetprop $path read astphaseread $ch + hsetprop $path write astchopwrite "nphas 2 " + hsetprop $path astchopwritereply astchopwritereply + chocosct write $path + hsetprop $path checklimits astchopphaselimit + hsetprop $path halt astchopstop + hsetprop $path checkstatus astchopcheckphase $ch + hsetprop $path priv manager + makesctdriveobj $var $path DriveAdapter chocosct +} +#---------------------------------------------------------------------- +proc astchopratiolimit {} { + set val [sct target] + if {$val < 1} { + error "Ratio out of range" + } + return OK +} +#----------------------------------------------------------------------- +proc astMakeChopperRatio {var} { + global choppers + set ch [lindex $choppers 1] + set path /sics/choco/${ch}/Ratio + hdel $path + hfactory $path plain mugger float + chocosct connect $path + hsetprop $path write astchopwrite "ratio 2 " + hsetprop $path astchopwritereply astchopwritereply + chocosct write $path + hsetprop $path checklimits astchopratiolimit + hsetprop $path halt astchopstop + hsetprop $path checkstatus astchopcheckratio + makesctdriveobj $var $path DriveAdapter chocosct +} +#------------------------------------------------------------------------ +proc chosta {} { + global chopperlonglist chopperparlist choppers chopperheader + set result "$chopperheader\n" + append line [format "%-20s " ""] + set count 1 + foreach ch $choppers { + append line [format "%-20s " $ch] + incr count + } + append result $line "\n" + set nchop [llength $choppers] + set len [llength $chopperlonglist] + for {set i 0} {$i < $len} {incr i} { + set line "" + set par [lindex $chopperlonglist $i] + append line [format "%-20s " $par] + for {set n 0} {$n < $nchop} {incr n} { + set chname [lindex $choppers $n] + set parname [lindex $chopperparlist $i] + set val [hval /sics/choco/${chname}/${parname}] + append line [format "%-20s " $val] + } + append result $line "\n" + } + return $result +} +#======================= Configuration Section ========================== + +if {$amor == 1} { + set choppers [list chopper1 chopper2] + set chopperparlist [list amode aspee nspee nphas dphas averl ratio vibra t_cho \ + durch vakum valve sumsi spver state] + set chopperlonglist [list "Chopper Mode" "Actual Speed" "Set Speed" "Phase" "Phase Error" \ + "Loss Current" Ratio Vibration Temperature "Water Flow" Vakuum \ + Valve Sumsi] + set chopperheader "AMOR Chopper Status" + makesctcontroller chocosct std ${ts}:3014 "\r\n" 60 +# makesctcontroller chocosct std localhost:8080 "\r\n" 60 + chocosct debug -1 + set maxspeed 5000 + set minphase 0 + astriumMakeChopperParameters + astMakeChopperSpeed1 chopperspeed + astMakeChopperPhase2 chopper2phase + Publish chosta Spy +} + +#----------------------------- POLDI ----------------------------------------- +if {$poldi == 1} { + + proc poldiastchopphaselimit {} { + set val [sct target] + if {$val < 80 || $val > 100} { + error "chopper phase out of range" + } + return OK + } +#------- + proc poldispeedwrite {} { + set val [sct target] + set l [split [config myrights] =] + set rights [string trim [lindex $l 1]] + if {$rights == 2} { + if {$val < 4990 || $val > 15000} { + clientput "ERROR: Users may only drive the chopper between 5000 - 15000 RPM" + hupdate /sics/choco/stop 1 + return idle + } + } + return [astchopwrite "nspee 1 "] + } +#----------- + set choppers [list chopper] + set chopperparlist [list amode aspee nspee nphas dphas averl ratio vibra vibax t_cho \ + flowr vakum valve sumsi spver state] + set chopperlonglist [list "Chopper Mode" "Actual Speed" "Set Speed" "Phase" "Phase Error" \ + "Loss Current" Ratio Vibration "Actual Vibration" Temperature "Water Flow" Vakuum \ + Valve Sumsi] + set chopperheader "POLDI Chopper Status" + makesctcontroller chocosct std lnsts13:3005 "\r\n" 60 +# makesctcontroller chocosct std localhost:8080 "\r\n" 60 + chocosct debug -1 + set maxspeed 15000 + set minphase 80 + astriumMakeChopperParameters +# astMakeChopperSpeed1 chopperspeed + + set path /sics/choco/chopper/speed + hfactory $path plain user float + hsetprop $path read astspeedread chopper + hsetprop $path write poldispeedwrite + hsetprop $path astchopwritereply astchopwritereply + chocosct write $path + hsetprop $path checklimits astchopspeedlimit 0 + hsetprop $path halt astchopstop + hsetprop $path checkstatus astchopcheckspeed chopper + hsetprop $path priv user + makesctdriveobj chopperspeed $path DriveAdapter chocosct + + astMakeChopperPhase1 chopperphase + hsetprop /sics/choco/chopper/phase checklimit poldiastchopphaselimit + Publish chosta Spy +} +#----------------------------- FOCUS ----------------------------------------------------- +if {$focus == 1} { + set choppers [list fermi disk] + set chopperparlist [list state amode aspee nspee nphas dphas averl ratio vibra t_cho \ + durch vakum valve sumsi] + set chopperlonglist [list "Chopper State" "Chopper Mode" "Actual Speed" "Set Speed" \ + "Phase" "Phase Error" \ + "Loss Current" Ratio Vibration Temperature "Water Flow" \ + Vakuum Valve Sumsi] + set chopperheader "FOCUS Chopper Status" + makesctcontroller chocosct std psts227:3008 "\r\n" 60 +# makesctcontroller chocosct std localhost:8080 "\r\n" 60 + chocosct debug -1 + set maxspeed 20000 + set minphase 0 + astriumMakeChopperParameters + astMakeChopperSpeed1 fermispeed + astMakeChopperSpeed2 diskspeed + astMakeChopperRatio ratio + astMakeChopperPhase2 phase + Publish chosta Spy +} diff --git a/site_ansto/instrument/pelican/config/tasmad/sicscommon/backup.tcl b/site_ansto/instrument/pelican/config/tasmad/sicscommon/backup.tcl new file mode 100644 index 00000000..483df21a --- /dev/null +++ b/site_ansto/instrument/pelican/config/tasmad/sicscommon/backup.tcl @@ -0,0 +1,32 @@ +proc nextBackupTime {now period last} { + upvar $last l + set l [expr $now / $period * $period] + return [expr $l + $period] +} + +proc backupCron {path {minutes 10} {days 1}} { + global next_backup + set now [clock seconds] + set minutes [expr $minutes * 60] + set days [expr $days * 24*3600] + if {! [info exists next_backup]} { + set next_backup(min) [nextBackupTime $now $minutes last] + set next_backup(day) [nextBackupTime $now $days last] + set file [clock format $now -format "$path/backupd-%m-%d.tcl"] + if {![file exists $file]} { + backup $file + } + } + if {$now > $next_backup(min)} { + set next_backup(min) [nextBackupTime $now $minutes last] + set file [clock format $last -format "$path/backup-%Hh%M.tcl"] + } else { + return 1 + } + if {$now > $next_backup(day)} { + set next_backup(day) [nextBackupTime $now $days last] + set file [clock format $last -format "$path/backupd-%m-%d.tcl"] + } + backup $file + return 1 +} diff --git a/site_ansto/instrument/pelican/config/tasmad/sicscommon/batch.tcl b/site_ansto/instrument/pelican/config/tasmad/sicscommon/batch.tcl new file mode 100644 index 00000000..795a77f6 --- /dev/null +++ b/site_ansto/instrument/pelican/config/tasmad/sicscommon/batch.tcl @@ -0,0 +1,29 @@ +#-------------------------------------------- +# The old batchrun, batchroot pair +# Mark Koennecke, since 1996 +#-------------------------------------------- + +if { [info exists batchinit] == 0 } { + set batchinit 1 + Publish batchroot Spy + Publish batchrun User +} + +proc SplitReply { text } { + set l [split $text =] + return [lindex $l 1] +} +#--------------------- +proc batchrun file { + exe [string trim [SplitReply [batchroot]]/$file] +} +#--------------------- +proc batchroot args { + if {[llength $args] > 1} { + exe batchpath [lindex $args 0] + return OK + } else { + set bp [SplitReply [exe batchpath]] + return "batchroot = $bp" + } +} diff --git a/site_ansto/instrument/pelican/config/tasmad/sicscommon/ccdwww.tcl b/site_ansto/instrument/pelican/config/tasmad/sicscommon/ccdwww.tcl new file mode 100644 index 00000000..b882c42d --- /dev/null +++ b/site_ansto/instrument/pelican/config/tasmad/sicscommon/ccdwww.tcl @@ -0,0 +1,169 @@ +#------------------------------------------------------ +# This is SICS HM driver code for the CCDWWW CCD camera +# WWW server as used at SINQ. It uses, of course, the +# scriptcontext asynchronous I/O system +# +# Mark Koennecke, September 2010 +#------------------------------------------------------- + +namespace eval ccdwww {} +#------------------------------------------------------- +# This is a default init script. The user has to initialise +# a list of nodes to send to the CCD in XML format as +# variable ccdwww::initnodes +#-------------------------------------------------------- +proc ccdwww::initscript {name} { + global ccdwww::initnodes + + append confdata "\n" + foreach var $ccdwww::initnodes { + set val [hval /sics/${name}/${var}] + append confdata "<$var>$val\n" + } + return $confdata +} +#------------------------------------------------------- +proc ccdwww::httpsend {url} { + sct send $url + return httpreply +} +#------------------------------------------------------- +proc ccdwww::httpsendstart {url} { + sct send $url + return httpstartreply +} +#-------------------------------------------------------- +proc ccdwww::httptest {data} { + if {[string first ASCERR $data] >= 0} { + error $data + } + if {[string first ERROR $data] >= 0} { + error $data + } + return $data +} +#-------------------------------------------------------- +proc ccdwww::httpreply {} { + set reply [sct result] + set status [catch {httptest $reply} data] + if {$status != 0} { + sct geterror $data + clientput $data + } else { + hdelprop [sct] geterror + } + return idle +} +#--------------------------------------------------------- +proc ccdwww::httpstartreply {} { + set reply [sct result] + set status [catch {httptest $reply} data] + if {$status != 0} { + sct geterror $data + } else { + hdelprop [sct] geterror + } + clientput $data + after 100 + return idle +} +#--------------------------------------------------------- +# A CCD works like a camera. When exposing, it cannot be stopped, +# paused or anything. This is why the appropriate methods +# here have no implementation +#---------------------------------------------------------- +proc ccdwww::httpcontrol {} { + set target [sct target] + switch $target { + 1000 { + set path [file dirname [sct]] + set preset [hval $path/preset] + set ret [ccdwww::httpsendstart "/ccd/expose?time=$preset"] + hupdate $path/status run + [sct controller] queue $path/status progress read + return $ret + } + 1001 {} + 1002 {} + 1003 {} + 1005 { + set path [file dirname [sct]] + set script [hval $path/initscript] + set confdata [eval $script] + clientput $confdata + return [ccdwww::httpsend "post:/ccd/configure:$confdata"] + } + default { + sct print "ERROR: bad start target $target given to control" + return idle + } + } +} +#--------------------------------------------------------- +proc ccdwww::httpdata {name} { + set path "/sics/${name}/data" + set com [format "node:%s:/ccd/data" $path] + sct send $com + return httpdatareply +} +#-------------------------------------------------------- +proc ccdwww::httpdatareply {} { + set status [catch {httpreply} txt] + if {$status == 0} { + set path [file dirname [sct]] + hdelprop $path/data geterror + } + return idle +} +#-------------------------------------------------------- +proc ccdwww::httpstatus {} { + sct send /ccd/locked + return httpevalstatus +} +#------------------------------------------------------- +proc ccdwww::httpstatusdata {} { + catch {httpdatareply} + sct update idle + return idle +} +#--------------------------------------------------------- +proc ccdwww::httpevalstatus {name} { + set reply [sct result] + set status [catch {httptest $reply} data] + if {$status != 0} { + sct geterror $data + clientput $data + sct update error + return idle + } + hdelprop [sct] geterror + if {$data == 0} { + httpdata $name + return httpstatusdata + } else { + sct update run + [sct controller] queue [sct] progress read + return idle + } +} +#--------------------------------------------------------- +proc ccdwww::MakeCCDWWW {name host initscript} { + sicsdatafactory new ${name}transfer + makesctcontroller ${name}sct sinqhttpopt $host ${name}transfer 600 + MakeSecHM $name 2 + hsetprop /sics/${name}/control write ccdwww::httpcontrol + hsetprop /sics/${name}/control httpreply ccdwww::httpreply + hsetprop /sics/${name}/control httpstartreply ccdwww::httpstartreply + ${name}sct write /sics/${name}/control + + hsetprop /sics/${name}/data read ccdwww::httpdata $name + hsetprop /sics/${name}/data httpdatareply ccdwww::httpdatareply + + hsetprop /sics/${name}/status read ccdwww::httpstatus + hsetprop /sics/${name}/status httpevalstatus ccdwww::httpevalstatus $name + hsetprop /sics/${name}/status httpstatusdata ccdwww::httpstatusdata + ${name}sct poll /sics/${name}/status 60 + + hfactory /sics/${name}/initscript plain mugger text + hset /sics/${name}/initscript $initscript +} diff --git a/site_ansto/instrument/pelican/config/tasmad/sicscommon/debsics b/site_ansto/instrument/pelican/config/tasmad/sicscommon/debsics new file mode 100644 index 00000000..9ba834d9 --- /dev/null +++ b/site_ansto/instrument/pelican/config/tasmad/sicscommon/debsics @@ -0,0 +1 @@ +gdb -d /afs/psi.ch/user/k/koennecke/src/workspace/sics -d /afs/psi.ch/user/k/koennecke/src/workspace/sics/psi SICServer $* diff --git a/site_ansto/instrument/pelican/config/tasmad/sicscommon/deltatau.tcl b/site_ansto/instrument/pelican/config/tasmad/sicscommon/deltatau.tcl new file mode 100644 index 00000000..10bba7d7 --- /dev/null +++ b/site_ansto/instrument/pelican/config/tasmad/sicscommon/deltatau.tcl @@ -0,0 +1,357 @@ +#--------------------------------------------------------------- +# These are the scripts for the delta-tau PMAC motor +# controller. +# +# !!!!!!!!! Script Chains !!!!!!!!!!! +# -- For reading parameters: +# sendpmacread code -- pmacreadreply +# -- For setting standard parameters +# sendpmacwrite code -- pmacreadreply +# -- For reading limits +# sendpmaclim -- readpmaclim +# -- For reading the status +# pmacsendaxer --- pmacrcvaxerr -- pmacrcvpos -- pmacrcvstat +# This means we check for an axis error first, then update the position, +# then check the axis status itself. +# -- For setting the position +# pmacsendhardpos -- pmacrcvhardpos -- pmacrcvhardax +# This means, we send the positioning command, read the reply and read the +# axisstatus until the axis has started +# +# copyright: see file COPYRIGHT +# +# Mark Koennecke, December 2008, March 2009 +#--------------------------------------------------------------- +proc translatePMACError {key} { + set pmacerr(ERR001) "Command not allowed while executing" + set pmacerr(ERR002) "Password error" + set pmacerr(ERR003) "Unrecognized command" + set pmacerr(ERR004) "Illegal character" + set pmacerr(ERR005) "Command not allowed" + set pmacerr(ERR006) "No room in buffer for command" + set pmacerr(ERR007) "Buffer already in use" + set pmacerr(ERR008) "MACRO auxiliary communication error" + set pmacerr(ERR009) "Bad program in MCU" + set pmacerr(ERR010) "Both HW limits set" + set pmacerr(ERR011) "Previous move did not complete" + set pmacerr(ERR012) "A motor is open looped" + set pmacerr(ERR013) "A motor is not activated" + set pmacerr(ERR014) "No motors" + set pmacerr(ERR015) "No valid program in MCU" + set pmacerr(ERR016) "Bad program in MCU" + set pmacerr(ERR017) "Trying to resume after H or Q" + set pmacerr(ERR018) "Invalid operation during move" + set pmacerr(ERR019) "Illegal position change command during move" + return $pmacerr($key) +} +#------------------------------------------------------------------ +proc translateAxisError {key} { + switch [string trim $key] { + 0 {return "no error"} + 1 { return "limit violation"} + 2 - + 3 - + 4 { return "jog error"} + 5 {return "command not allowed"} + 6 {return "watchdog triggered"} + 7 {return "current limit reached"} + 8 - + 9 {return "Air cushion error"} + 10 {return "MCU lim reached"} + 11 {return "following error triggered"} + 12 {return "EMERGENCY STOP ACTIVATED"} + 13 {return "Driver electronics error"} + default { return "Unknown axis error $key"} + } +} +#--------------------------------------------------------------------- +proc evaluateAxisStatus {key} { +#----- Tcl does not like negative numbers as keys. + if {$key < 0} { + set key [expr 50 + abs($key)] + } + switch $key { + 0 - + 14 {return idle} + 1 - + 2 - + 3 - + 4 - + 5 - + 6 - + 7 - + 8 - + 9 - + 10 - + 56 - + 11 {return run} + 55 {error "Axis is deactivated"} + 54 {error "emergency stop activated, please release"} + 53 {error "Axis inhibited"} + 51 - + 52 {error "Incoming command is blocked"} + } +} +#----------------------------------------------------------------------- +proc checkpmacresult {} { + set data [sct result] + if {[string first ASCERR $data] >= 0} { + error $data + } + if {[string first ERR $data] >= 0} { + error [translatePMACError $data] + } + return [string trim $data] +} +#------------------------------------------------------------------------ +proc sendpmacread {code} { + sct send $code + return pmacreadreply +} +#------------------------------------------------------------------------ +proc pmacreadreply {} { + set status [catch {checkpmacresult} data] + if {$status != 0} { + sct geterror $data + } else { + sct update $data + } + return idle +} +#---------------------------------------------------------------------- +proc sendpmaclim {code} { + sct send $code + return pmacreadlim +} +#----------------------------------------------------------------------- +proc pmacreadlim {motname} { + set status [catch {checkpmacresult} data] + if {$status != 0} { + sct geterror $data + } else { + set scale [hval /sics/${motname}/scale_factor] + sct update [expr $data * $scale] + } + return idle +} +#------------------------------------------------------------------------ +proc sendpmacwrite {code} { + set value [sct target] + sct send "$code=$value" + return pmacwritereply +} +#------------------------------------------------------------------------ +proc pmacwritereply {} { + set status [catch {checkpmacresult} data] + if {$status != 0} { + sct geterror $data + sct print "ERROR: $data" + } else { + set con [sct controller] + $con queue [sct] read read + } + return idle +} +#------------------------------------------------------------------------- +proc configurePMACPar {name par code sct} { + set path /sics/$name/$par + hsetprop $path read "sendpmacread $code" + hsetprop $path pmacreadreply pmacreadreply + $sct poll $path 30 + hsetprop $path write "sendpmacwrite $code" + hsetprop $path pmacwritereply pmacwritereply + $sct write $path +} +#------------------------------------------------------------------------- +proc makePMACPar {name par code sct priv} { + set path /sics/$name/$par + hfactory $path plain $priv float + configurePMACPar $name $par $code $sct +} +#========================== status functions ============================= +proc pmacsendaxerr {num} { + sct send "P${num}01" + return rcvaxerr +} +#------------------------------------------------------------------------ +proc pmacrcvaxerr {motname num} { + set status [catch {checkpmacresult} data] + if {$status != 0} { + clientput "ERROR: $motname : $data" + sct update error + sct geterror $data + return idle + } + hupdate /sics/$motname/axiserror $data + if {$data != 0 } { + set err [translateAxisError $data] + if {[string first following $err] >= 0} { + clientput "WARNING: $motname : $err" + sct update poserror + } else { + clientput "ERROR: $motname : $err" + sct update error + } + return idle + } + hupdate /sics/$motname/axiserror $data + sct send "Q${num}10" + return rcvpos +} +#------------------------------------------------------------------------ +proc pmacrcvpos {motname num} { + set status [catch {checkpmacresult} data] + if {$status != 0} { + clientput "ERROR: $motname : $data" + sct geterror $data + sct update error + return idle + } + hupdate /sics/$motname/hardposition $data + sct send "P${num}00" + return rcvstat +} +#------------------------------------------------------------------------ +proc pmacrcvstat {motname num sct} { + set status [catch {checkpmacresult} data] + if {$status != 0} { + clientput "ERROR: $motname : $data" + sct update error + return idle + } + set status [catch {evaluateAxisStatus $data} msg] + if {$status != 0} { + sct update error + } else { + sct update $msg + switch $msg { + idle { + # force an update of the motor position + $sct queue /sics/$motname/hardposition progress read + } + run { + # force an update of ourselves, while running + $sct queue /sics/$motname/status progress read + } + } + } + return idle +} +#------------------------------------------------------------------------- +proc configurePMACStatus {motname num sct} { + set path /sics/$motname/status + hsetprop $path read "pmacsendaxerr $num" + hsetprop $path rcvaxerr "pmacrcvaxerr $motname $num" + hsetprop $path rcvpos "pmacrcvpos $motname $num" + hsetprop $path rcvstat "pmacrcvstat $motname $num $sct" + $sct poll $path 60 +} +#======================= setting hard position =========================== +proc pmacsendhardpos {motname num} { + hupdate /sics/$motname/status run + set value [sct target] + sct send [format "P%2.2d23=0 Q%2.2d01=%12.4f M%2.2d=1" $num $num $value $num] + return rcvhardpos +} +#------------------------------------------------------------------------- +proc pmacrcvhardpos {num} { + set status [catch {checkpmacresult} data] + if {$status != 0} { + clientput "ERROR: $data" + sct seterror $data + return idle + } + sct send "P${num}00" + return rcvhardax +} +#------------------------------------------------------------------------ +proc pmacrcvhardax {motname num sct} { + set status [catch {checkpmacresult} data] + if {$status != 0} { + clientput "ERROR: $motname : $data" + sct seterror $data + return idle + } + set status [catch {evaluateAxisStatus $data} msg] + if {$status != 0} { + clientput "ERROR: $motname : $msg" + sct seterror $msg + return idle + } + switch $msg { + idle { + sct send "P${num}00" + return rcvhardax + } + run { + $sct queue /sics/$motname/status progress read + return idle + } + } +} +#------------------------------------------------------------------------ +proc configurePMAChardwrite {motname num sct} { + set path /sics/$motname/hardposition + hsetprop $path write "pmacsendhardpos $motname $num" + hsetprop $path rcvhardpos "pmacrcvhardpos $num" + hsetprop $path rcvhardax "pmacrcvhardax $motname $num $sct" +} +#======================= Halt ============================================= +proc pmacHalt {sct num} { + $sct send "M${num}=8" halt + return OK +} +#==================== Reference Run ======================================= +proc pmacrefrun {motorname sct num} { + set path /sics/${motorname}/status + $sct send "M${num}=9" + hupdate /sics/${motorname}/status run + set motstat run + wait 3 + while {[string compare $motstat run] == 0} { + $sct queue $path progress read + wait 1 + set motstat [string trim [hval $path]] + } + return "Done" +} +#-------------------------------------------------------------------------- +proc MakeDeltaTau {name sct num} { + MakeSecMotor $name + hsetprop /sics/${name}/hardupperlim read "sendpmaclim I${num}13" + hsetprop /sics/${name}/hardupperlim pmacreadlim "pmacreadlim $name" + $sct poll /sics/${name}/hardupperlim 180 + hsetprop /sics/${name}/hardlowerlim read "sendpmaclim I${num}14" + hsetprop /sics/${name}/hardlowerlim pmacreadlim "pmacreadlim $name" + $sct poll /sics/${name}/hardlowerlim 180 + +# configurePMACPar $name hardlowerlim "Q${num}09" $sct +# configurePMACPar $name hardupperlim "Q${num}08" $sct + + configurePMACPar $name hardposition "Q${num}10" $sct + configurePMAChardwrite $name $num $sct + hfactory /sics/$name/numinmcu plain internal int + hupdate /sics/$name/numinmcu ${num} + makePMACPar $name enable "M${num}14" $sct mugger + makePMACPar $name scale_factor "Q${num}00" $sct mugger + makePMACPar $name maxspeed "Q${num}03" $sct mugger + makePMACPar $name commandspeed "Q${num}04" $sct mugger + makePMACPar $name maxaccel "Q${num}05" $sct mugger + makePMACPar $name commandedaccel "Q${num}06" $sct mugger + makePMACPar $name offset "Q${num}07" $sct mugger + makePMACPar $name axisstatus "P${num}00" $sct internal + makePMACPar $name axiserror "P${num}01" $sct internal + makePMACPar $name poshwlimitactive "M${num}21" $sct internal + makePMACPar $name neghwlimitactive "M${num}22" $sct internal + makePMACPar $name liftaircushion "M${num}96" $sct internal + configurePMACStatus $name $num $sct + $name makescriptfunc halt "pmacHalt $sct $num" user + $name makescriptfunc refrun "pmacrefrun $name $sct $num" user + set parlist [list scale_factor hardposition maxspeed \ + commandspeed maxaccel offset axisstatus axiserror status poshwlimitactive \ + neghwlimitactive liftaircushion hardlowerlim hardupperlim] +# $sct send [format "M%2.2d14=1" $num] + foreach par $parlist { + $sct queue /sics/$name/$par progress read + } +} diff --git a/site_ansto/instrument/pelican/config/tasmad/sicscommon/el734.tcl b/site_ansto/instrument/pelican/config/tasmad/sicscommon/el734.tcl new file mode 100644 index 00000000..ca717cba --- /dev/null +++ b/site_ansto/instrument/pelican/config/tasmad/sicscommon/el734.tcl @@ -0,0 +1,488 @@ +#-------------------------------------------------------- +# This is a scriptcontext based driver for the EL734 +# motor controller. This is part of an ongoing effort to +# expire older drivers and to consolidate on the new +# scriptcontext system. +# +# Scriptchains: +# Rather then having long script chains many of the +# intricacies of the EL734 are handled via a command +# processing state machine. See the docs below for +# details +# +# copyright: see file COPYRIGHT +# +# Mark Koennecke, February 2011 +#-------------------------------------------------------- + +namespace eval el734 {} + +#--------------------------------------------------------- +# The EL734 is a a tricky thing. Some special conditions +# apply: +# - On emergency stop an *ES is sent. But only the second +# response of this kind is valid because there can be +# spurious *ES on the line even when the emergency stop +# has been released. +# - If someone fingers the EL734 or after startup it is in +# local mode. Then two commands have to be sent in order to +# make it go into remote mode before retrying the command. +# - In some echo modes of the controller it sends a echo +# of the command. This has to be ignored in order to get at +# the real problem +# +# In order to deal with all this, el734::command is implemented +# as a state machine which calls another script when a valid +# reponse has actually been found. +# The state of the current command processing +# is saved in a node property comstate. The actual command to send +# is in the property comstring. The script to call if we actually +# have a valid response is stored in the property comresponse +#--------------------------------------------------------------- +proc el734::setcommand {command responsescript {motno 0}} { + sct comresponse $responsescript + sct comstate start + sct comstring $command + sct commotno $motno + return command +} +#--------------------------------------------------------------- +# As implemented now this can go in an endless loop if switching +# to local fails repeatedly. TODO: test if this happens with the +# real device +#--------------------------------------------------------------- +proc el734::command {} { + set state [sct comstate] + switch $state { + start { + set com [sct comstring] + sct send $com + sct comstate waitresponse + } + waitstart { + wait 1 + sct comstate start + return [el734::command] + } + waitresponse { + set reply [sct result] + if {[string first "*ES" $reply] >= 0} { + set com [sct comstring] + sct send $com + sct comstate waitES + return command + } + if {[string first "?LOC" $reply] >= 0} { + sct send "RMT 1" + sct comstate waitrmt + return command + } + if {[string first "?BSY" $reply] >= 0} { + set mot [sct commotno] + if {$mot != 0} { + set com [format "S %d" $mot] + } else { + set com "S" + } + sct send $com + sct comstate waitstart + return command + } + set com [sct comstring] + set idx [string first $com $reply] + if {[string first $com $reply] >= 0} { + sct send @@NOSEND@@ + sct comstate waitresponse + return command + } + set responsescript [sct comresponse] + return [eval $responsescript] + } + waitES { + set reply [sct result] + if {[string first "*ES" $reply] >= 0} { + clientput "Emergency STOP ENGAGED, release to continue" + error "Emergency Stop ENGAGED" + } + set responsescript [sct comresponse] + return [eval $responsescript] + } + waitrmt { + sct send "ECHO 0" + sct comstate start + } + } + return command +} +#------------------------------------------------------------------- +proc el734::checkerror {} { + set err(?ADR) "Bad address" + set err(?CMD) "Bad command" + set err(?PAR) "Bad parameter" + set err(?RNG) "Parameter out of range" + set err(?BSY) "Motor busy" + set err(*MS) "Bad step" + set err(*ES) "Emergency stop engaged" + + set reply [string trim [sct result]] + set errlist [array names err] + foreach entry $errlist { + if {[string first $entry $reply] >= 0} { + error $err($entry) + } + } + return $reply +} +#========================== Position =============================== +proc el734::readpos {num} { + set com [format "u %d" $num] + return [el734::setcommand $com el734::posresponse] +} +#------------------------------------------------------------------- +proc el734::posresponse {} { + set stat [catch {checkerror} reply] + if {$stat == 0} { + sct update $reply + return idle + } else { + clientput $reply + return idle + } +} +#------------------------------------------------------------------- +proc el734::setpos {name num} { + set newpos [sct target] + set com [format "p %d %f" $num $newpos] + hupdate /sics/${name}/status run + hupdate /sics/${name}/oredmsr 3 + hupdate /sics/${name}/runfault 0 + hupdate /sics/${name}/posfault 0 + return [el734::setcommand $com "el734::setposresponse $name"] +} +#------------------------------------------------------------------- +proc el734::setposresponse {name} { + set stat [catch {checkerror} reply] + if {$stat == 0} { + [sct controller] queue /sics/${name}/status progress read + return idle + } else { + clientput $reply + return idle + } +} +#===================== Limits ===================================== +proc el734::getlim {name num} { + set com [format "H %d" $num] + return [el734::setcommand $com "el734::limresponse $name"] +} +#----------------------------------------------------------------- +proc el734::limresponse {name} { + set stat [catch {checkerror} reply] + if {$stat == 0} { + stscan $reply "%f %f" low high + hupdate /sics/${name}/hardlowerlim $low + hupdate /sics/${name}/hardupperlim $high + return idle + } else { + clientput $reply + return idle + } +} +#------------------------------------------------------------------ +proc el734::setlim {controller name num low high} { + set com [format "H %d %f %f" $num $low $high] + $controller send $com + $controller queue /sics/${name}/hardlowerlim progress read + wait 1 + return Done +} +#======================== status ================================ +proc el734::decodemsr {name msr} { + set oredata(0x02) idle:none + set oredata(0x10) error:lowlim + set oredata(0x20) error:hilim + set oredata(0x80) posfault:runfault + set oredata(0x200) posfault:posfault + set oredata(0x1000) "error:air cushion" + set oredata(0x40) "error:bad step" + set oredata(0x100) error:positionfault + set oredata(0x400) error:positionfault + + set msrdata(0x20) hilim + set msrdata(0x10) lowlim + set msrdata(0x1000) "air cushion" + set msrdata(0x40) "Bad step" + set msrdata(0x100) posfault + set msrdata(0x400) posfault + + set oredmsr [hval /sics/${name}/oredmsr] + if {$msr == 0} { +#-------- FINISHED + set pos [hval /sics/${name}/posfault] + set run [hval /sics/${name}/runfault] + if {$pos > 0 || $run > 0} { + return posfault + } + + set orlist [array names oredata] + foreach code $orlist { + if {$oredmsr & $code} { + set l [split $oredata($code) :] + set txt [lindex $l 1] + set ret [lindex $l 0] + hupdate /sics/${name}/lasterror $txt + if {[string compare $ret error] == 0} { + clientput "ERROR: $txt on motor $name" + } + return $ret + } + } + if {$oredmsr == 0} { + return idle + } + } else { +#------------ Still Running......... + set msrlist [array names msrdata] + foreach code $msrlist { + if {$msr & $code} { + clientput "ERROR: $msrdata($code) on motor $name" + return error + } + } + if {$msr & 0x80} { + set val [hval /sics/${name}/runfault] + incr val + hupdate /sics/${name}/runfault $val + } + if {$msr & 0x200} { + set val [hval /sics/${name}/posfault] + incr val + hupdate /sics/${name}/posfault $val + } + + hupdate /sics/${name}/oredmsr [expr $oredmsr | $msr] + return run + } +} +#---------------------------------------------------------------- +proc el734::readstatus {num name} { + set com [format "msr %d" $num] + return [el734::setcommand $com "el734::statresponse $name $num"] +} +#---------------------------------------------------------------- +proc el734::statresponse {name num} { + set stat [catch {checkerror} reply] + if {$stat == 0} { + stscan $reply "%d" msr + set status [el734::decodemsr $name $msr] + sct update $status + switch $status { + run { + set con [sct controller] + $con queue /sics/${name}/hardposition progress read + $con queue /sics/${name}/status progress read + } + idle { + set com [format "u %d" $num] + return [el734::setcommand $com "el734::posstat $name" ] + } + } + return idle + } else { + clientput $reply + return idle + } +} +#---------------------------------------------------------------- +proc el734::posstat {name} { + set stat [catch {checkerror} reply] + if {$stat == 0} { + hupdate /sics/${name}/hardposition $reply + return idle + } else { + clientput $reply + return idle + } +} +#========================== Halt ================================= +proc el734::halt {controller no} { + set com [format "S %d" $no] + $controller send $com + return Done +} +#========================= Speed ================================ +proc el734::readspeed {num} { + set com [format "J %d" $num] + return [el734::setcommand $com el734::speedresponse] +} +#------------------------------------------------------------------- +proc el734::speedresponse {} { + set stat [catch {checkerror} reply] + if {$stat == 0} { + sct update $reply + return idle + } else { + clientput $reply + return idle + } +} +#------------------------------------------------------------------- +proc el734::setspeed {name num} { + set newpos [sct target] + set com [format "J %d %d" $num $newpos] + return [el734::setcommand $com "el734::setspeedresponse $name $num"] +} +#------------------------------------------------------------------- +proc el734::setspeedresponse {name num} { + set stat [catch {checkerror} reply] + if {$stat == 0} { + return [el734::readspeed $num] + } else { + clientput $reply + return idle + } +} +#========================= refnull ================================ +proc el734::readref {num} { + set com [format "V %d" $num] + return [el734::setcommand $com el734::refresponse] +} +#------------------------------------------------------------------- +proc el734::refresponse {} { + set stat [catch {checkerror} reply] + if {$stat == 0} { + sct update $reply + return idle + } else { + clientput $reply + return idle + } +} +#------------------------------------------------------------------- +proc el734::setref {name num} { + set newpos [sct target] + set com [format "V %d %d" $num $newpos] + return [el734::setcommand $com "el734::setrefresponse $name $num"] +} +#------------------------------------------------------------------- +proc el734::setrefresponse {name num} { + set stat [catch {checkerror} reply] + if {$stat == 0} { + return [el734::readref $num] + } else { + clientput $reply + return idle + } +} +#============================= SS ================================= +proc el734::readss {num} { + set com [format "SS %d" $num] + sct send $com + return ssread +} +#----------------------------------------------------------------- +proc el734::ssread {} { + sct update [sct result] + return idle +} +#======================== setpos ================================ +proc el734::forcepos {controller name num newpos} { + set com [format "U %d %f" $num $newpos] + $controller send $com + $controller queue /sics/${name}/hardposition progress read + wait 1 + return Done +} +#======================= refrun ================================== +proc el734::refrun {controller name num} { + clientput "Starting reference run" + $controller send [format "R %d" $num] + $controller queue /sics/${name}/ss progress read + while {1} { + wait 2 + set ss [hval /sics/${name}/ss] + if { [string first ?BSY $ss] < 0} { + break + } + set rupt [getint] + if { [string compare $rupt continue] != 0} { + error "Refererence run interrupted" + } + $controller queue /sics/${name}/ss progress read + } + $controller queue /sics/${name}/hardposition progress read + wait 2 + return "Reference run Finished" +} +#================================================================ +proc el734::reset {name} { + set x [hval /sics/${name}/hardlowerlim] + hupdate /sics/${name}/softlowerlim $x + set x [hval /sics/${name}/hardupperlim] + hupdate /sics/${name}/softupperlim $x + hupdate /sics/${name}/softzero 0 + hupdate /sics/${name}/fixed -1 +} +#========================= Make ================================== +proc el734::make {name no controller} { + MakeSecMotor $name + + hfactory /sics/${name}/oredmsr plain internal int + hfactory /sics/${name}/runfault plain internal int + hfactory /sics/${name}/posfault plain internal int + hfactory /sics/${name}/lasterror plain internal text + + hsetprop /sics/${name}/hardposition read el734::readpos $no + hsetprop /sics/${name}/hardposition command el734::command + + hsetprop /sics/${name}/hardposition write el734::setpos $name $no + hsetprop /sics/${name}/hardposition command el734::command + $controller write /sics/${name}/hardposition + + hsetprop /sics/${name}/hardlowerlim read el734::getlim $name $no + hsetprop /sics/${name}/hardlowerlim command el734::command + $controller poll /sics/${name}/hardlowerlim 120 + + hsetprop /sics/${name}/status read el734::readstatus $no $name + hsetprop /sics/${name}/status command el734::command + $controller poll /sics/${name}/status 40 + + hfactory /sics/${name}/speed plain user int + hsetprop /sics/${name}/speed read el734::readspeed $no + hsetprop /sics/${name}/speed command el734::command + $controller poll /sics/${name}/speed 120 + + hsetprop /sics/${name}/speed write el734::setspeed $name $no + hsetprop /sics/${name}/speed command el734::command + $controller write /sics/${name}/speed + + $name makescriptfunc halt "el734::halt $controller $no" user + $name makescriptfunc reset "el734::reset $name" user + + $name makescriptfunc sethardlim "el734::setlim $controller $name $no" mugger + hfactory /sics/${name}/sethardlim/low plain mugger float + hfactory /sics/${name}/sethardlim/high plain mugger float + + hfactory /sics/${name}/motno plain internal int + hupdate /sics/${name}/motno $no + +} +#------------------------------------------------------------------------------- +proc el734::addrefstuff {name no controller} { + hfactory /sics/${name}/refnull plain user int + hsetprop /sics/${name}/refnull read el734::readref $no + hsetprop /sics/${name}/refnull command el734::command + $controller poll /sics/${name}/refnull 300 + + hsetprop /sics/${name}/refnull write el734::setref $name $no + hsetprop /sics/${name}/refnull command el734::command + $controller write /sics/${name}/refnull + + hfactory /sics/${name}/ss plain internal text + hsetprop /sics/${name}/ss read el734::readss $no + hsetprop /sics/${name}/ss ssread el734::ssread + $controller poll /sics/${name}/ss 300 + + $name makescriptfunc refrun "el734::refrun $controller $name $no" user + +} diff --git a/site_ansto/instrument/pelican/config/tasmad/sicscommon/el737sec.tcl b/site_ansto/instrument/pelican/config/tasmad/sicscommon/el737sec.tcl new file mode 100644 index 00000000..be77890a --- /dev/null +++ b/site_ansto/instrument/pelican/config/tasmad/sicscommon/el737sec.tcl @@ -0,0 +1,321 @@ +#----------------------------------------------------- +# This is a second generation counter driver for +# the PSI EL737 counter boxes using scriptcontext +# communication. +# +# copyright: see file COPYRIGHT +# +# Scriptchains: +# start: el737sendstart - el737cmdreply +# pause,cont, stop: el737sendcmd - el737cmdreply +# status: el737readstatus - el737status +# \ el737statval - el737statread +# values: el737readvalues - el737val +# threshold write: el737threshsend - el737threshrcv - el737cmdreply +# +# Mark Koennecke, February 2009 +#----------------------------------------------------- +proc el737error {reply} { + if {[string first ERR $reply] >= 0} { + error $reply + } + if {[string first ? $reply] < 0} { + return ok + } + if {[string first "?OV" $reply] >= 0} { + error overflow + } + if {[string first "?1" $reply] >= 0} { + error "out of range" + } + if {[string first "?2" $reply] >= 0} { + error "bad command" + } + if {[string first "?3" $reply] >= 0} { + error "bad parameter" + } + if {[string first "?4" $reply] >= 0} { + error "bad counter" + } + if {[string first "?5" $reply] >= 0} { + error "parameter missing" + } + if {[string first "?6" $reply] >= 0} { + error "to many counts" + } + return ok +} +#--------------------------------------------------- +proc el737cmdreply {} { + set reply [sct result] + set status [catch {el737error $reply} err] + if {$status != 0} { + sct geterror $err + set data [sct send] + if {[string first overflow $err] >= 0} { + clientput "WARNING: trying to fix $err on command = $data" + sct send $data + return el737cmdreply + } else { + clientput "ERROR: $err, command = $data" + } + } + return idle +} +#--------------------------------------------------- +proc sctroot {} { + set path [sct] + return [file dirname $path] +} +#---------------------------------------------------- +proc el737sendstart {} { + set obj [sctroot] + set mode [string tolower [string trim [hval $obj/mode]]] + set preset [string trim [hval $obj/preset]] + hdelprop [sct] geterror + switch $mode { + timer { + set cmd [format "TP %.2f" $preset] + } + default { + set cmd [format "MP %d" [expr int($preset)]] + } + } + sct send $cmd + set con [sct controller] + $con queue $obj/status progress read + catch {hupdate $obj/status run} + catch {hupdate $obj/values 0 0 0 0 0 0 0 0} + return el737cmdreply +} +#---------------------------------------------------- +proc el737sendcmd {cmd} { + hdelprop [sct] geterror + sct send $cmd + return el737cmdreply +} +#--------------------------------------------------- +proc el737control {} { + set target [sct target] + switch $target { + 1000 {return [el737sendstart] } + 1001 {return [el737sendcmd S] } + 1002 {return [el737sendcmd PS] } + 1003 {return [el737sendcmd CO] } + default { + sct print "ERROR: bad start target $target given to control" + return idle + } + } + +} +#---------------------------------------------------- +proc el737readstatus {} { + hdelprop [sct] geterror + sct send RS + return el737status +} +#------------------------------------------------- +proc el737statval {} { + el737readvalues + return el737statread +} +#------------------------------------------------- +proc el737statread {} { + el737val + sct update idle + return idle +} +#-------------------------------------------------- +proc el737status {} { + set reply [sct result] + set status [catch {el737error $reply} err] + if {$status != 0} { + sct geterror $err + sct update error + sct print "ERROR: $err" + return idle + } + set path [sct] + set con [sct controller] + hupdate [sctroot]/RS $reply + switch [string trim $reply] { + 0 { + return el737statval + } + 1 - + 2 { + sct update run + $con queue $path progress read + } + 5 - + 6 { + sct update nobeam + $con queue $path progress read + } + default { + sct update pause + $con queue $path progress read + } + } + set count [sct moncount] + if {$count >= 10} { + set root [sctroot] + $con queue $root/values progress read + sct moncount 0 + } else { + incr count + sct moncount $count + } + return idle +} +#------------------------------------------------ +proc el737readvalues {} { + hdelprop [sct] geterror + sct send RA + return el737val +} +#-------------------------------------------------- +proc swapFirst {l} { + set m1 [lindex $l 0] + set cts [lindex $l 1] + lappend res $cts $m1 + for {set i 2} {$i < [llength $l]} {incr i} { + lappend res [lindex $l $i] + } + return $res +} +#--------------------------------------------------- +# There are two types of reponses to the RA command: +# the old form with 5 values and the new one +# with 9 values +#--------------------------------------------------- +proc el737val {} { + set reply [sct result] + set status [catch {el737error $reply} err] + if {$status != 0} { + sct geterror $err + sct print "ERROR: $err" + return idle + } + hupdate [sctroot]/RA $reply + set l [split $reply] + set root [sctroot] + if {[llength $l] > 5} { + set l2 [lrange $l 1 end] + set l2 [swapFirst $l2] + catch {hupdate ${root}/values [join $l2]} + catch {set time [lindex $l 0]} + catch {hupdate ${root}/time $time} + } else { + set last [expr [llength $l] - 1] + set l2 [lrange $l 0 $last] + set l2 [swapFirst $l2] + hupdate ${root}/values [join $l2] + set time [lindex $l $last] + hupdate ${root}/time $time + } + set mode [hval ${root}/mode] + switch $mode { + timer { + hupdate ${root}/control $time + } + default { + set mon [lindex $l2 1] + hupdate ${root}/control $time + } + } + return idle +} +#---------------------------------------------- +proc el737threshsend {} { + set val [string trim [sct target]] + set root [sctroot] + set cter [string trim [hval $root/thresholdcounter]] + sct send [format "DL %1.1d %f" $cter $val] + return el737threshrecv +} +#--------------------------------------------- +proc el737threshrecv {} { + set reply [sct result] + set status [catch {el737error $reply} err] + if {$status != 0} { + sct geterror $err + sct print "ERROR: $err" + } + set root [sctroot] + set cter [string trim [hval $root/thresholdcounter]] + sct send [format "DR %1.1d" $cter] + set sctcon [sct controller] + $sctcon queue [sct] progress read + return el737cmdreply +} +#--------------------------------------------- +proc el737threshread {} { + set root [sctroot] + set cter [string trim [hval $root/thresholdcounter]] + sct send [format "DL %1.1d" $cter] + return el737thresh +} +#---------------------------------------------- +proc el737thresh {} { + set reply [sct result] + set status [catch {el737error $reply} err] + if {$status != 0} { + sct geterror $err + sct print "ERROR: $err" + return idle + } + stscan $reply "%f" val + sct update $val + return idle +} +#---------------------------------------------- +proc el737func {controller path} { + $controller queue $path write +} +#============================================ +proc MakeSecEL737 {name netaddr} { + MakeSecCounter $name 8 + set conname ${name}sct + makesctcontroller $conname std $netaddr "\r" 10 + $conname send "RMT 1" + $conname send "RMT 1" + $conname send "ECHO 2" + + set path /sics/${name}/values + hsetprop $path read el737readvalues + hsetprop $path el737val el737val + $conname poll $path 60 + + set path /sics/${name}/status + hsetprop $path read el737readstatus + hsetprop $path el737status el737status + hsetprop $path el737statval el737statval + hsetprop $path el737statread el737statread + hsetprop $path moncount 0 + $conname poll $path 60 + + set path /sics/${name}/control + hsetprop $path write el737control + hsetprop $path el737cmdreply el737cmdreply + $conname write $path + + hfactory /sics/${name}/thresholdcounter plain mugger int + hsetprop /sics/${name}/thresholdcounter __save true + set path /sics/${name}/threshold + hfactory $path plain mugger float + hsetprop $path write el737threshsend + hsetprop $path el737threshrcv el737threshrcv + hsetprop $path el737cmdreply el737cmdreply + $conname write $path + hsetprop $path read el737threshread + hsetprop $path el737thresh el737thresh +# $conname poll $path 60 + + hfactory /sics/${name}/RS plain internal int + hfactory /sics/${name}/RA plain internal intvarar 8 + + $conname debug -1 + +} diff --git a/site_ansto/instrument/pelican/config/tasmad/sicscommon/el755.tcl b/site_ansto/instrument/pelican/config/tasmad/sicscommon/el755.tcl new file mode 100644 index 00000000..0eddccf5 --- /dev/null +++ b/site_ansto/instrument/pelican/config/tasmad/sicscommon/el755.tcl @@ -0,0 +1,97 @@ +#------------------------------------------------------------- +# This is a scriptcontext driver for the PSI EL755 magnet +# controller. +# +# scriptchains: +# read - readreply +# write - writereply - writereadback +# +# copyright: see file COPYRIGHT +# +# Mark Koennecke, November 2009 +#-------------------------------------------------------------- + +namespace eval el755 {} + +#-------------------------------------------------------------- +proc el755::read {num} { + sct send [format "I %d" $num] + return readreply +} +#-------------------------------------------------------------- +proc el755::readreply {num} { + set reply [sct result] + if {[string first ? $reply] >= 0} { + if {[string first ?OV $reply] >= 0} { + sct send [format "I %d" $num] +# clientput "EL755 did an overflow...." + return readreply + } + error $reply + } + set n [stscan $reply "%f %f" soll ist] + if {$n < 2} { + sct send [format "I %d" $num] + clientput "Invalid response $reply from EL755" + return readreply + } + sct update $ist + return idle +} +#------------------------------------------------------------------ +proc el755::write {num} { + set cur [sct target] + sct send [format "I %d %f" $num $cur] + return writereply +} +#------------------------------------------------------------------ +proc el755::writereply {num} { + set reply [sct result] + if {[string first ? $reply] >= 0} { + if {[string first ?OV $reply] >= 0} { + set cur [sct target] + sct send [format "I %d %f" $num $cur] +# clientput "EL755 did an overflow...." + return writereply + } + error $reply + } + sct send [format "I %d" $num] + return writereadback +} +#-------------------------------------------------------------------- +proc el755::writereadback {num} { + set reply [sct result] + if {[string first ? $reply] >= 0} { + if {[string first ?OV $reply] >= 0} { + set cur [sct target] + sct send [format "I %d" $num] +# clientput "EL755 did an overflow...." + return writereadback + } + error $reply + } + set n [stscan $reply "%f %f" soll ist] + if {$n < 2} { + sct send [format "I %d" $num] + clientput "Invalid response $reply from EL755" + return writereadback + } + set cur [sct target] + if {abs($cur - $soll) < .1} { + return idle + } + return el755::write $num +} +#-------------------------------------------------------------------- +proc el755::makeel755 {name num sct} { + stddrive::makestddrive $name EL755Magnet $sct + set path /sics/${name} + hsetprop $path read el755::read $num + hsetprop $path readreply el755::readreply $num + hsetprop $path write el755::write $num + hsetprop $path writereply el755::writereply $num + hsetprop $path writereadback el755::writereadback $num + $sct poll $path 60 + $sct write $path +} diff --git a/site_ansto/instrument/pelican/config/tasmad/sicscommon/fourcircle.tcl b/site_ansto/instrument/pelican/config/tasmad/sicscommon/fourcircle.tcl new file mode 100644 index 00000000..513eec3b --- /dev/null +++ b/site_ansto/instrument/pelican/config/tasmad/sicscommon/fourcircle.tcl @@ -0,0 +1,1773 @@ +#---------------------------------------------------------- +# This is a file full of support functions for four +# circle diffraction in the new four circle system. This +# is the common, shared stuff. There should be another +# file which contains the instrument specific adaptions. +# +# Mark Koennecke, August 2008, November 2008, February 2009 +#---------------------------------------------------------- +if { [info exists __singlexinit] == 0 } { + set __singlexinit 1 + MakeSingleX + Publish projectdir Spy + Publish cell Spy + Publish ub Spy + Publish spgrp Spy + Publish calcang Spy + Publish calchkl Spy + Publish calctth Spy + Publish refclear User + Publish reflist Spy +# Publish refang User + Publish refdel User + Publish refhkl User + Publish refang User +# Publish refhklang User + Publish refadd User + Publish refindex User + Publish calcub User + Publish recoub User + Publish centerlist User + Publish indexhkl Spy + Publish coneconf User + Publish tablist Spy + Publish tabclear User + Publish tabadd User + Publish tabdel User + Publish tabsave User + Publish tabload user + Publish loadx User + Publish testx User + Publish collconf User + Publish hkllimit Spy + Publish hklgen User + Publish indw User + Publish indsave Spy + Publish indsort User + Publish indlist Spy + Publish indexconf User + Publish index User + Publish indexub User + Publish indexdirax User + Publish ubrefine User + Publish refshow User + Publish loadub User + Publish refload User + Publish refsave User + Publish confsearch User + Publish confsearchnb User + Publish search User + Publish findpeaksinscan User + Publish psiscan User + MakeConfigurableMotor psi + psi drivescript noop + psi readscript noopr + Publish messprepare User + Publish messcollect User + Publish psidrive User + Publish psiprepare User + Publish psicollect User + Publish bitonb User + Publish savexxx Spy + set __collectrun 0 + Publish ubrefinehdb User + Publish runindex user + SicsAlias refshow ubshow + SicsAlias loadub ubload + SicsAlias calcub ubcalc + SicsAlias recoub ubrecover +} +#--------------------------------------------------------- +# support function for handling ranges in measuring +# reflections. This is tricky: When calculating if a +# reflection is scannable one has to take the range of +# the scan into account. SICS goes to great pain to calculate +# reflections in spite of restrictions. It tweaks ome, searches +# psi etc. In order to arrive at a scannable position for +# calculations and initial driving, the ranges in om and stt +# have to be corrected to include the scan range. These support +# functions take care of this. +#---------------------------------------------------------- +set __fmessomup 0 +set __fmessomlow 0 +set __fmsttup 0 +set __fmsttlow 0 +#----------------------------------------------------------- +proc savefmesslim {} { + global __fmessomup __fmessomlow __fmsttup __fmsttlow + set ommot [singlex motnam om] + set __fmessomup [string trim [SplitReply [$ommot softupperlim]]] + set __fmessomlow [string trim [SplitReply [$ommot softlowerlim]]] + set sttmot [singlex motnam stt] + set __fmsttup [string trim [SplitReply [$sttmot softupperlim]]] + set __fmsttlow [string trim [SplitReply [$sttmot softlowerlim]]] +} +#------------------------------------------------------------ +proc setfmesslim {h k l } { + global __fmessomup __fmessomlow __fmsttup __fmsttlow + set ommot [singlex motnam om] + set sttmot [singlex motnam stt] + set status [catch {singlex sttub $h $k $l} refstt] + if {$status != 0} { + error "Failed to calculate two-theta" + } + set scanlist [split [fmess scanpar $refstt] ,] + set range [expr ([lindex $scanlist 2]/2.) * [lindex $scanlist 1]] + $ommot softlowerlim [expr $__fmessomlow + $range] + $ommot softupperlim [expr $__fmessomup - $range] + if {[string first o2t [lindex $scanlist 0]] >= 0} { + $sttmot softlowerlim [expr $__fmsttlow + 2.*$range] + $sttmot softupperlim [expr $__fmsttup - 2.*$range] + } else { + $sttmot softlowerlim $__fmsttlow + $sttmot softupperlim $__fmsttup + } +} +#---------------------------------------------------------- +proc restorefmesslim {} { + global __fmessomup __fmessomlow __fmsttup __fmsttlow + set ommot [singlex motnam om] + set sttmot [singlex motnam stt] + $ommot softlowerlim $__fmessomlow + $ommot softupperlim $__fmessomup + $sttmot softlowerlim $__fmsttlow + $sttmot softupperlim $__fmsttup +} +#---------------------------------------------------------- +proc projectdir { {dir NULL} } { + if {[string compare $dir NULL] == 0} { + set dir [SplitReply [exe batchpath]] + return "projectdir = $dir" + } else { + exe batchpath $dir + return OK + } +} +#----------------------------------------------------------- +proc cell args { + if {[llength $args] < 6} { + set val [SplitReply [singlex cell]] + return "cell = $val" + } else { + singlex cell $args + return OK + } +} +#----------------------------------------------------------- +proc ub args { + if {[llength $args] < 9} { + set val [SplitReply [singlex ub]] + return "ub = $val" + } else { + singlex ub $args + return OK + } +} +#----------------------------------------------------------- +proc spgrp args { + if {[llength $args] < 1} { + set val [SplitReply [singlex spacegroup]] + return "spgrp = $val" + } else { + singlex spacegroup [join $args] + return OK + } +} +#------------------------------------------------------------ +proc calcang {h k l} { + set status [catch {hkl calc $h $k $l} res] + if {$status != 0} { + error $res + } + return $res +} +#----------------------------------------------------------- +proc getsetangles {} { + set mo [string trim [SplitReply [singlex mode]]] + switch $mo { + bi { + lappend res [singlex motval stt] + lappend res [singlex motval om] + lappend res [singlex motval chi] + lappend res [singlex motval phi] + } + nb { + lappend res [singlex motval stt] + lappend res [singlex motval om] + lappend res [singlex motval nu] + } + tas { + lappend res [singlex motval om] + lappend res [singlex motval stt] + lappend res [singlex motval sgu] + lappend res [singlex motval sgl] + } + } + return $res +} +#------------------------------------------------------------ +proc calchkl args { + set mo [string trim [SplitReply [singlex mode]]] + switch $mo { + bi { + if {[llength $args] < 4} { + set stt [singlex motval stt] + set om [singlex motval om] + set chi [singlex motval chi] + set phi [singlex motval phi] + } else { + set stt [lindex $args 0] + set om [lindex $args 1] + set chi [lindex $args 2] + set phi [lindex $args 3] + } + } + nb { + if {[llength $args] < 3} { + set stt [singlex motval stt] + set om [singlex motval om] + set chi [singlex motval nu] + set phi 0 + } else { + set stt [lindex $args 0] + set om [lindex $args 1] + set chi [lindex $args 2] + set phi 0 + } + } + tas { + if {[llength $args] < 4} { + set stt [singlex motval om] + set om [singlex motval stt] + set chi [singlex motval sgu] + set phi [singlex motval sgl] + } else { + set stt [lindex $args 0] + set om [lindex $args 1] + set chi [lindex $args 2] + set phi [lindex $args 3] + } + } + } + return [hkl fromangles $stt $om $chi $phi] +} +#---------------------------------------------------------------- +proc calctth {h k l} { + return [hkl calctth $h $k $l] +} +#--------------------------------------------------------------- +proc refclear {} { + ref clear + return OK +} +#-------------------------------------------------------------- +proc reflist {} { + ref print +} +#---------------------------------------------------------------------------- +proc refload {filename} { + append fname [string trim [SplitReply [exe batchpath]]] / $filename + set status [catch {open $fname r} in] + if {$status != 0} { + error "Failed to open $fname" + } + ref clear + set count 0 + while {[gets $in line] > 0} { + eval ref addax $line + incr count + } + close $in + return "$count reflections loaded from $fname" +} +#------------------------------------------------------------ +proc refsave {filename} { + append fname [string trim [SplitReply [exe batchpath]]] / $filename + set status [catch {open $fname w} in] + if {$status != 0} { + error "Failed to open $fname" + } + set reflist [split [ref names] \n] + foreach ref $reflist { + if {[string length $ref] < 2} { + continue + } + set txt [ref show [string trim $ref]] + set txtlist [split $txt] + set outlist [lrange $txtlist 2 end] + puts $in [join $outlist] + } + close $in + return "Saved" +} +#------------------------------------------------------------- +proc refadd args { + if {[llength $args] < 1} { + error "ERROR: need at lest keyword for refadd" + } + set key [lindex $args 0] + switch $key { + ang { return [eval refadang [lrange $args 1 end]]} + idx { return [eval refidx [lrange $args 1 end]]} + idxang {return [eval refhklang [lrange $args 1 end]]} + } +} +#-------------------------------------------------------------- +proc refadang args { + if {[llength $args] < 3} { + set ang [getsetangles] + } else { + set ang $args + } + eval ref adda $ang + return OK +} +#--------------------------------------------------------------- +proc refidx {h k l} { + ref addx $h $k $l + return OK +} +#------------------------------------------------------------- +proc refdel {id} { + return [ref del $id] +} +#-------------------------------------------------------------- +proc refhkl {id h k l } { + return [ref setx $id $h $k $l] +} +#------------------------------------------------------------- +proc refang args { + set len [llength $args] + if {$len < 1} { + error "Need at least id to set angles" + } + set mo [string trim [SplitReply [singlex mode]]] + switch $mo { + tas - + bi { + set reflen 4 + } + nb { + set reflen 3 + } + } + if {$len >= $reflen +1} { + set anglist [lrange $args 1 end] + } else { + set anglist [getsetangles] + } + return [eval ref seta [lindex $args 0] $anglist] +} +#------------------------------------------------------------- +proc refhklang args { + set len [llength $args] + if {$len < 3} { + error "Need at least hkl" + } + set mo [string trim [SplitReply [singlex mode]]] + switch $mo { + bi { + set reflen 4 + } + nb { + set reflen 3 + } + tas { + set reflen 4 + } + } + if {$len >= $reflen +3} { + set anglist [lrange $args 3 end] + } else { + set anglist [getsetangles] + } + return [eval ref addax [lindex $args 0] [lindex $args 1] [lindex $args 2] \ + $anglist] +} +#------------------------------------------------------------- +proc refindex {} { + return [simidx idxref] +} +#------------------------------------------------------------- +proc calcub args { + set len [llength $args] + if {$len < 2} { + error "Not enough indices to calculate UB" + } + if {$len == 2} { + set status [catch {ubcalcint ub2ref [lindex $args 0] \ + [lindex $args 1]} msg] + } else { + set status [catch {ubcalcint ub3ref [lindex $args 0] \ + [lindex $args 1] [lindex $args 2]} msg] + } + if {$status == 0} { + ubcalcint activate + return OK + } else { + error $msg + } +} +#---------------------------------------------------------------- +proc recoub {} { + return [singlex recoverub] +} +#----------------------------------------------------------------- +proc centerlist {preset {mode monitor} {skip 0} } { + set reflist [split [ref names] \n] + foreach refid $reflist { + if {[string length $refid] < 1} { + continue + } + if {$skip > 0} { + incr skip -1 + continue + } + set val [split [ref show $refid]] + set h [lindex $val 2] + set k [lindex $val 3] + set l [lindex $val 4] + clientput "Processing reflection $refid = $h $k $l" + set stt [lindex $val 5] + if {$stt > .0} { + set mo [string trim [SplitReply [singlex mode]]] + switch $mo { + bi { + set om [lindex $val 6] + set chi [lindex $val 7] + set phi [lindex $val 8] + set status [catch {drive stt $stt om $om chi $chi phi $phi} msg] + } + nb { + set om [lindex $val 6] + set nu [lindex $val 7] + set status [catch {drive stt $stt om $om nu $nu} msg] + } + } + } else { + set status [catch {drive h $h k $k l $l} msg] + } + if { $status == 0} { + set status [catch {centerref $preset $mode} msg] + if {$status == 0} { + refang $refid + set ompos [string trim [SplitReply [om]]] + cscan om $ompos .1 20 $preset + drive om $ompos + } else { + set rupt [getint] + if {[string compare $rupt abortop] == 0} { + setint "continue" + clientput "WARNING: aborted reflection $refid because of driving problem" + continue + } + if {[string compare $rupt continue] != 0} { + error $msg + } + clientput "ERROR: failed to center $refid with $msg" + continue + } + } else { + set rupt [getint] + if {[string compare $rupt abortop] == 0} { + clientput "WARNING: aborted reflection $refid because of driving problem" + setint "continue" + continue + } + if {[string compare $rupt continue] != 0} { + error $msg + } + clientput "ERROR: failed to drive $refid with $msg" + continue + } + } + return "Done centering [expr [llength $reflist] -1] reflections" +} +#---------------------------------------------------------------------- +proc indexhkl args { + if {[llength $args] > 0} { + ubcalcint index [lindex $args 0] + } else { + ubcalcint index + } +} +#----------------------------------------------------------------------- +proc coneconf args { + if {[llength $args] < 4} { + append result "coneconf = " [SplitReply [cone center]] + append result " " [SplitReply [cone target]] + append result " " [SplitReply [cone qscale]] + return $result + } + set cid [lindex $args 0] + set h [lindex $args 1] + set k [lindex $args 2] + set l [lindex $args 3] + if {[llength $args] > 4} { + set qscale [lindex $args 4] + } else { + set qscale 1.0 + } + cone center $cid + cone target $h $k $l + cone qscale $qscale + return OK +} +#--------------------------------------------------------------------------- +proc tablist {} { + return [fmess table print] +} +#--------------------------------------------------------------------------- +proc tabclear {} { + return [fmess table clear] +} +#--------------------------------------------------------------------------- +proc tabadd {sttend scanvar step np preset } { + return [fmess table addrow $sttend $scanvar $step $np $preset] +} +#--------------------------------------------------------------------------- +proc tabdel {no} { + set id [format "%4.4d" $no] + [return fmess del $id] +} +#---------------------------------------------------------------------------- +proc tabsave {filename} { + append fname [string trim [SplitReply [exe batchpath]]] / $filename + set status [catch {open $fname w} out] + if {$status != 0} { + error "Failed to open $fname" + } + set table [fmess table print] + set tblist [split $table "\n"] + for {set i 1} {$i < [llength $tblist]} {incr i} { + set line [lindex $tblist $i] + set line [string trim [regsub -all "\\s+" $line " "]] + set l [split $line] + puts $out [join [lrange $l 1 end]] + } + close $out + return Done +} +#--------------------------------------------------------------------------- +proc tabload {filename} { + append fname [string trim [SplitReply [exe batchpath]]] / $filename + set status [catch {open $fname r} in] + if {$status != 0} { + error "Failed to open $fname" + } + fmess table clear + while {[gets $in line] > 0} { + eval fmess table addrow $line + } + close $in + return Done +} +#---------------------------------------------------------------------------- +proc loadx {filename} { + global __collectrun + + if {$__collectrun == 1} { + error "Cannot load reflections while data collection running" + } + append fname [string trim [SplitReply [exe batchpath]]] / $filename + set status [catch {open $fname r} in] + if {$status != 0} { + error "Failed to open $fname" + } + messref clear + set count 0 + while {[gets $in line] > 0} { + set status [stscan $line " %f %f %f" h k l] + if {$status >= 3} { + messref addx $h $k $l + incr count + } else { + clientput "Skipped invalid entry $line" + } + } + close $in + return "$count reflections loaded from $fname" +} +#----------------------------------------------------------- +proc testRef {h k l} { +#-- first test: can I calculate the reflection + set status [catch {hkl calc $h $k $l} msg] + if {$status != 0} { + return 0 + } +#--- second test: is the scan range accessible + set l1 [split $msg ,] + set stt [string trim [SplitReply [lindex $l1 0]]] + set om [string trim [SplitReply [lindex $l1 1]]] + set scanpar [fmess scanpar $stt] + set scanlist [split $scanpar ,] + set range [expr ([lindex $scanlist 2]/2.) * [lindex $scanlist 1]] + set sttmot [singlex motnam stt] + set ommot [singlex motnam om] + set status [catch {sicsbounds $ommot [expr $om - $range]} msg] + if {$status != 0} { +# clientput "om scanbounds broken" + return 0 + } + set status [catch {sicsbounds $ommot [expr $om + $range]} msg] + if {$status != 0} { +# clientput "om scanbounds broken" + return 0 + } + if {[string first o2t [lindex $scanlist 0]] >= 0} { + set status [catch {sicsbounds $sttmot [expr $stt - $range*2.]} msg] + if {$status != 0} { +# clientput "stt scanbounds broken" + return 0 + } + set status [catch {sicsbounds $sttmot [expr $stt + $range*2.]} msg] + if {$status != 0} { +# clientput "stt scanbounds broken" + return 0 + } + } + set status [catch {sicsbounds $sttmot $stt} msg] + if {$status != 0} { +# clientput "stt violated: $stt" + return 0 + } + set status [catch {sicsbounds $ommot $om} msg] + if {$status != 0} { +# clientput "om violated" + return 0 + } + set mo [string trim [SplitReply [singlex mode]]] + switch $mo { + bi { + set chi [string trim [SplitReply [lindex $l1 2]]] + set chimot [singlex motnam chi] + set status [catch {sicsbounds $chimot $chi} msg] + if {$status != 0} { +# clientput "chi violated" + return 0 + } + set phi [string trim [SplitReply [lindex $l1 3]]] + set phimot [singlex motnam phi] + set status [catch {sicsbounds $phimot $phi} msg] + if {$status != 0} { +# clientput "phi violated" + return 0 + } + } + nb { + set nu [string trim [SplitReply [lindex $l1 2]]] + set numot [singlex motnam nu] + set status [catch {sicsbounds $numot $nu} msg] + if {$status != 0} { +# clientput "nu violated" + return 0 + } + } + } + return 1; +} +#------------------------------------------------------------ +proc testRefNew {h k l } { + return [catch {hkl calc $h $k $l} msg] +} +#------------------------------------------------------------ +proc testx args { + set delete 0 + set symsearch 0 + foreach txt $args { + if {[string compare $txt del] == 0} { + set delete 1 + } + if {[string compare $txt sym] == 0} { + set symsearch 1 + } + } + set reflist [split [messref names] \n] + savefmesslim + + foreach ref $reflist { + if {[string length $ref] < 1} { + continue + } + set data [split [messref show $ref]] + set h [lindex $data 2] + set k [lindex $data 3] + set l [lindex $data 4] + catch {setfmesslim $h $k $l} message + + if {[testRefNew $h $k $l] == 1} { + if {$symsearch == 1} { + set test [catch {singlex symref $h $k $l} msg] + if {$test == 0} { + set hkllist [split $msg ,] + set hn [lindex $hkllist 0] + set kn [lindex $hkllist 1] + set ln [lindex $hkllist 2] + if {[testRefNew $hn $kn $ln] == 0} { + messref setx $ref $hn $kn $ln + clientput "$h $k $l replaced by reachable $hn $kn $ln" + } else { + lappend badref $ref + clientput "Nor reflection $h $k $l or equivalent scannable" + } + } else { + lappend badref $ref + clientput "Nor reflection $h $k $l or equivalent scannable" + } + } else { + lappend badref $ref + clientput "Reflection $h $k $l not scannable" + } + } + } + set total [llength $reflist] + if {[info exists badref] == 1} { + set bad [llength $badref] + } else { + set bad 0 + } + incr total -1 + clientput "$bad out of $total reflections are bad" + if {$delete == 1 && $bad > 0} { + foreach ref $badref { + messref del $ref + } + clientput "$bad reflections deleted" + set total [expr $total - $bad] + } + restorefmesslim + return "Still $total reflections in list" +} +#----------------------------------------------------- +proc collconf args { + set modelist [list monitor timer] + if {[llength $args] < 4} { + append res [SplitReply [fmess mode]] + append res [SplitReply [fmess fast]] + append res " " [SplitReply [fmess weak]] + append res " " [SplitReply [fmess weakthreshold]] + return $res + } else { + set mode [lindex $args 0] + if {[lsearch $modelist $mode] < 0} { + error "CountMode $mode not recognized" + } + fmess mode $mode + fmess fast [lindex $args 1] + fmess weak [lindex $args 2] + fmess weakthreshold [lindex $args 3] + return OK + } +} +#--------------------------------------------------------------------------- +proc messprepare {obj userdata} { + global stdscangraph + fmess prepare $obj $userdata + catch {hupdate $stdscangraph/dim} +} +#-------------------------------------------------------------------------- +proc messcollect {obj userdata np} { + global stdscangraph + stdscan silentcollect $obj $userdata $np + catch {hupdate $stdscangraph/scan_variable} + catch {hupdate $stdscangraph/counts} +} +#---------------------------------------------------------------------------- +proc configuremessscan {} { + xxxscan configure script + xxxscan function writeheader donothing + xxxscan function prepare messprepare + set fast [hval /sics/fmess/fast] + if {$fast == 1} { + xxxscan function drive stdscan fastdrive + } else { + xxxscan function drive stdscan drive + } + xxxscan function count stdscan count + xxxscan function collect messcollect + xxxscan function writepoint donothing + xxxscan function finish donothing +} +#------------------------------------------------------------ +proc scanref {ref} { + set ommot [singlex motnam om] + set sttmot [singlex motnam stt] + set stt [SplitReply [eval $sttmot]] + set om [SplitReply [eval $ommot]] + set scanpar [split [fmess scanpar $stt] ,] + if {[string first "Not" $scanpar] >= 0} { + error "Scan parameters not found" + } + set scanvar [lindex $scanpar 0] + set step [lindex $scanpar 1] + set np [lindex $scanpar 2] + set preset [lindex $scanpar 3] + xxxscan clear + set range [expr $np/2. *$step] + set start [expr $om - $range] + xxxscan add $ommot $start $step + if {[string first o2t $scanvar] >= 0} { + set start [expr $stt - 2*$range] + xxxscan add $sttmot $start [expr $step * 2.] + } + set mode [string trim [SplitReply [fmess mode]]] + xxxscan run $np $mode $preset +# set weak [string trim [SplitReply [fmess weak]]] +# if {$weak == 1} { +# xxxscan run $np $mode [expr $preset*4] +# } +} +#------------------------------------------------------------- +proc hkllimit args { + if {[llength $args] < 8} { + append res "indconf = " + append res [SplitReply [fmess hkllim]] " " + append res [SplitReply [fmess sttlim]] + return $res + } else { + fmess hkllim [lrange $args 0 5] + fmess sttlim [lrange $args 6 end] + return OK + } +} +#------------------------------------------------------------- +proc hklgen { {sup no} } { + global __collectrun + + if {$__collectrun == 1} { + error "Cannot generate reflection while data collection running" + } + append res "Generating Indices with the Parameters:\n" + append res "Spacegroup = " [SplitReply [spgrp]] \n + append res "Cell = " [SplitReply [singlex cell]] \n + append res "HKL Limits = " [SplitReply [fmess hkllim]] \n + append res "Two Theta Limits = " [SplitReply [fmess sttlim]] \n + switch $sup { + no { + set suppress 0 + } + opp { + set suppress 2 + } + default { + set suppress 1 + } + } + append res [fmess indgen $suppress] +# fmess indsort + return $res +} +#---------------------------------------------------------------- +proc indw {hw kw lw} { + return [fmess genw $hw $kw $lw] +} +#---------------------------------------------------------------- +proc indsave {filename} { + set fullname [string trim [SplitReply [exe batchpath]]]/$filename + set out [open $fullname w] + set reflist [split [messref names] \n] + foreach ref $reflist { + if {[string length $ref] < 1} { + continue + } + set idxlist [split [messref show $ref]] + puts $out [format " %12.6f %12.6f %12.6f" [lindex $idxlist 2] \ + [lindex $idxlist 3] [lindex $idxlist 4]] + + } + close $out + return "Done" +} +#--------------------------------------------------------------- +proc indsort {} { + return [fmess indsort] +} +#--------------------------------------------------------------- +proc indlist {} { + return [messref print] +} +#-------------------------------------------------------------- +proc indexconf args { + if {[llength $args] < 2} { + append res "simidxconf = " + append res [SplitReply [simidx sttlim]] ", " + append res [SplitReply [simidx anglim]] " " + return $res + } else { + simidx sttlim [lindex $args 0] + simidx anglim [lindex $args 1] + ubcalcint difftheta [lindex $args 0] + } + return OK +} +#--------------------------------------------------------------- +proc index {} { + simidx run + return Done +} +#--------------------------------------------------------------- +proc indexub {idx} { + return [simidx choose $idx] +} +#------------------------------------------------------------- +proc indexdirax {} { + set path [SplitReply [exe batchpath]] + simidx dirax $path/sics.idx +} +#---------------------------------------------------------- +proc writerafincell {out cellflag} { + set lat [string trim [SplitReply [singlex lattice]]] + set cell [string trim [SplitReply [singlex cell]]] + set cellist [split $cell] + set a [lindex $cellist 0] + set b [lindex $cellist 1] + set c [lindex $cellist 2] + set alpha [lindex $cellist 3] + set beta [lindex $cellist 4] + set gamma [lindex $cellist 5] +#----------- by default: do not refine cell constants + if {[string compare $cellflag NULL] == 0} { + puts $out "0 $a 0 $b 0 $c 0 $alpha 0 $beta 0 $gamma" + return + } + switch $lat { + 0 - + 1 { + puts $out "1 $a 1 $b 1 $c 1 $alpha 1 $beta 1 $gamma" + } + 2 { + puts $out "1 $a 1 $b 1 $c 0 90 1 $beta 0 90" + } + 3 { + puts $out "1 $a 1 $b 1 $c 0 90 0 90 0 90" + } + 4 { + puts $out "1 $a 2 $b 1 $c 0 90 0 90 0 90" + } + 5 { + puts $out "1 $a 2 $b 2 $c 1 $alpha 2 $beta 2 $gamma" + } + 6 { + puts $out "1 $a 2 $b 1 $c 0 90 0 90 0 120" + } + 7 { + puts $out "1 $a 2 $b 2 $c 0 90 0 90 0 90" + } + } +} +#---------------------------------------------------------- +proc writerafinref {out} { + set ref [ref names] + set idlist [split $ref \n] + foreach id $idlist { + if {[string length $id] < 1} { + continue + } + set status [catch {ref show $id} refdat] + if {$status != 0} { + continue + } + set refli [split $refdat] + set rd [lrange $refli 2 end] + if {[llength $rd] > 6} { + puts $out [format "%9.4f %9.4f %9.4f %8.3f %8.3f %8.3f %8.3f" \ + [lindex $rd 0] [lindex $rd 1] [lindex $rd 2] \ + [lindex $rd 3] [lindex $rd 4] \ + [lindex $rd 5] [lindex $rd 6]] + } else { + puts $out [format "%9.4f %9.4f %9.4f %8.3f %8.3f %8.3f" \ + [lindex $rd 0] [lindex $rd 1] [lindex $rd 2] \ + [lindex $rd 3] [lindex $rd 4] \ + [lindex $rd 5]] + } + } +} +#----------------------------------------------------------- +proc writerafinfile {filename cell} { + set out [open $filename w] + set tit [SplitReply [title]] + set sam [SplitReply [sample]] + puts $out "$tit, $sam" + puts $out "2 1 0 0 45 3 4 1 .5 0" + set wav [SplitReply [singlex lambda]] + puts $out "0 $wav" + puts $out "0 .0 0 .0 0 .0" + writerafincell $out $cell + writerafinref $out + puts $out "" + puts $out "-1" + close $out + catch {file attributes $filename -permissions 00664} +} +#----------------------------------------------------------- +proc writerafnbfile {filename cell} { + set out [open $filename w] + set tit [SplitReply [title]] + set sam [SplitReply [sample]] + puts $out "$tit, $sam" + puts $out "2 1 0 0 45 3 4 1 .5 0" + set wav [SplitReply [singlex lambda]] + puts $out "0 $wav" + puts $out "0 .0 0 .0 0 .0" + writerafincell $out $cell + writerafinref $out + puts $out "" + puts $out "-1" + close $out + catch {file attributes $filename -permissions 00664} +} +#--------------------------------------------------------- +proc checkResult {filename} { + set f [open $filename r] + while {[gets $f line] >= 0} { + if {[string first ERROR $line] >= 0} { + close $f + error $line + } + } + return OK +} +#---------------------------------------------------------- +proc runrafin {filename cell} { + global rafinprog + writerafinfile $filename $cell + set path [string trim [SplitReply [projectdir]]] + set olddir [pwd] + cd $path + set status [catch {exec $rafinprog >& rafin.lis} msg] + cd $olddir + if {$status == 0} { + checkResult $path/rafin.lis + } else { + error $msg + } +} +#---------------------------------------------------------- +proc runrafnb {filename cell} { + global rafnbprog + writerafnbfile $filename $cell + set path [string trim [SplitReply [projectdir]]] + set olddir [pwd] + cd $path + catch {file delete -force rafnb.tmp} + set status [catch {exec $rafnbprog >& rafnb.lis} msg] + cd $olddir + if {$status == 0} { + checkResult $path/rafnb.lis + } else { + error $msg + } +} +#------------------------------------------------------------ +proc ubrefine {{cell NULL}} { + set path [string trim [SplitReply [projectdir]]] + set filename $path/rafin.dat + set nbfile $path/rafnb.dat + set mode [string trim [SplitReply [singlex mode]]] + switch $mode { + bi { runrafin $filename $cell} + nb { runrafnb $nbfile $cell} + default { error "No UB refinement in this mode" } + } + return [refshow] +} +#---------------------------------------------------------- +proc refshow {} { + set res "" + set path [string trim [SplitReply [projectdir]]] + set mode [string trim [SplitReply [singlex mode]]] + switch $mode { + bi { set filename $path/rafin.lis} + nb { set filename $path/rafnb.lis} + default { error "No UB refinement in this mode" } + } + set status [catch {open $filename r} in] + if {$status != 0} { + error "No refinement ever ran, or rafin.lis not found" + } + set dataappend 0 + while {[gets $in line] >= 0} { + if {[string first ERROR $line] >= 0} { + close $in + error $line + } + if {[string first 0RESULTS $line] >= 0} { + set dataappend 1 + } + if {$dataappend == 1} { + append res $line "\n" + } + } + close $in + return $res +} +#------------------------------------------------------- +proc loadub {} { + set path [string trim [SplitReply [projectdir]]] + set mode [string trim [SplitReply [singlex mode]]] + switch $mode { + bi { set filename $path/rafin.lis} + nb { set filename $path/rafnb.lis} + default { + error "No UB refinement in this mode" + } + } + set status [catch {open $filename r} in] + if {$status != 0} { + error "No refinement ever ran, or rafin,nb.lis not found" + } + while {[gets $in line] >= 0} { + if {[string first "0FINAL ORIENT" $line] >= 0} { + gets $in line + stscan $line "%f %f %f" u11 u12 u13 + gets $in line + gets $in line + stscan $line "%f %f %f" u21 u22 u23 + gets $in line + gets $in line + stscan $line "%f %f %f" u31 u32 u33 + singlex ub $u11 $u12 $u13 $u21 $u22 $u23 $u31 $u32 $u33 + } + if {[string first "0DIRECT CELL" $line] >= 0} { + stscan $line "%s %s %f %f %f %f %f %f" junk junk2 a b c alpha beta gamma + singlex cell $a $b $c $alpha $beta $gamma + } + } + close $in + return "Loaded!" +} +#-------------------------------------------------------------------- +proc confsearch args { + set varlist [list min2t step2t max2t stepchi stepphi chimin chimax phimin phimax] + #-------- alternative syntax: confsearch var [value] + if {[llength $args] > 0} { + set idx [lsearch $varlist [lindex $args 0]] + if {$idx >= 0} { + if {[llength $args] > 1} { + set var [lindex $varlist $idx] + set val [lindex $args 1] + singlex peaksearch/$var $val + return OK + } else { + set var [lindex $varlist $idx] + set val [SplitReply [singlex peaksearch/$var]] + return "$var = $val" + } + } + } +#-------- normal syntsax, print or set all + if {[llength $args] < 3} { + foreach var $varlist { + set val [SplitReply [singlex peaksearch/$var]] + append result "$var = $val," + } + return [string trim $result ,] + } else { + for {set i 0} \ + {$i < [llength $args] && $i < [llength $varlist] } {incr i} { + set var [lindex $varlist $i] + set val [lindex $args $i] + singlex peaksearch/$var $val + } + return "Done" + } +} +#-------------------------------------------------------------------- +proc confsearchnb args { + set varlist [list min2t step2t max2t stepom stepnu] + if {[llength $args] < 5} { + foreach var $varlist { + set val [SplitReply [singlex peaksearch/$var]] + append result "$var = $val," + } + return [string trim $result ,] + } else { + for {set i 0} {$i < 5} {incr i} { + set var [lindex $varlist $i] + set val [lindex $args $i] + singlex peaksearch/$var $val + } + return "Done" + } +} +#------------------------------------------------------------------- +proc removeduplicatesold {peaklist} { + if {[llength $peaklist] < 1} { + return "" + } + lappend final [lindex $peaklist 0] + foreach peak $peaklist { + set valid 1 + foreach fp $final { + if {abs($fp - $peak) < 2.} { + set valid 0 + } + } + if {$valid == 1} { + lappend final $peak + } + } + return [join $final ,] +} +#---------------------------------------------------------------- +# This one strives to locate the maximum peak with a window of 2.0 +#----------------------------------------------------------------- +proc removeduplicates {peaklist countlist} { + if {[llength $peaklist] < 1} { + return "" + } + set ptr 0 + set peaks($ptr) [lindex $peaklist 0] + set counts($ptr) [lindex $countlist 0] + for {set i 0} {$i < [llength $peaklist]} {incr i} { + set pos [lindex $peaklist $i] + set count [lindex $countlist $i] + if {abs($pos - $peaks($ptr)) < 2.} { + if {$count > $counts($ptr)} { + set peaks($ptr) $pos + set counts($ptr) $count + } + } else { + incr ptr + set peaks($ptr) $pos + set counts($ptr) $count + } + } + set keys [array names peaks] + foreach k $keys { + lappend final $peaks($k) + } + return $final +} +#-------------------------------------------------------------------- +# Do not be confused by the use of phi. This is also used for finding +# peaks in omega in NB +#-------------------------------------------------------------------- +proc findpeaksinscan {} { + set counts [split [string trim [SplitReply [xxxscan getcounts]]]] + set counts [lrange $counts 1 [expr [llength $counts] -1]] + set phiraw [SplitReply [xxxscan getvardata 0]] + foreach p $phiraw { + lappend phi [string trim $p] + } + set len [llength $counts] + for {set i 3} {$i < $len - 3} {incr i} { + set sum .0 + for {set j [expr $i -3]} {$j < [expr $i + 3]} {incr j} { + if {$j != 4} { + set sum [expr $sum + [lindex $counts $j]] + } + } + set average [expr $sum/6.] + set thresh [expr sqrt($average) * 8.] + set count [lindex $counts $i] + if {$count > $thresh} { + lappend peaks [lindex $phi $i] + lappend peakcounts $count + } + } + if {[info exists peaks]} { + return [removeduplicates $peaks $peakcounts] + } else { + return "" + } +} +#---------------------------------------------------------------------- +proc search {preset maxpeak {mode monitor} } { + set difmode [string trim [SplitReply [singlex mode]]] + switch $difmode { + bi { + return [searchbi $preset $mode $maxpeak] + } + nb { + return [searchnb $preset $mode $maxpeak] + } + default { + error "Peaksearch not supported in $difmode mode" + } + } +} +#----------------------------------------------------------------------- +proc searchbi {preset mode maxpeak} { + set sttmot [singlex motnam stt] + set ommot [singlex motnam om] + set chimot [singlex motnam chi] + set phimot [singlex motnam phi] + set min2t [SplitReply [singlex peaksearch/min2t]] + set chimin [SplitReply [singlex peaksearch/chimin]] + set chimax [SplitReply [singlex peaksearch/chimax]] + set phimin [SplitReply [singlex peaksearch/phimin]] + set phimax [SplitReply [singlex peaksearch/phimax]] + refclear + set chistep [SplitReply [singlex peaksearch/stepchi]] + set chinp [expr int(($chimax - $chimin)/ $chistep)] + set sttstep [SplitReply [singlex peaksearch/step2t]] + set sttnp [expr int([SplitReply [singlex peaksearch/max2t]]/$sttstep)] + set phistep [SplitReply [singlex peaksearch/stepphi]] + set phinp [expr int(($phimax - $phimin)/ $phistep)] + set detmode [string trim [SplitReply [detmode]]] + set count 0 + for {set i 0} { $i < $sttnp} {incr i} { + set sttpos [expr $min2t + $i * $sttstep] + set status [catch {run $sttmot $sttpos $ommot [expr $sttpos / 2.]} msg] + if {$status != 0} { + clientput "WARNING: Cannot reach two-theta $sttpos, skipping" + continue + } + clientput "Searching at two theta: $sttpos" + for {set j 0} {$j < $chinp} {incr j} { + set chipos [expr $chimin + $j*$chistep] + set status [catch {run $chimot $chipos} msg] + if {$status != 0} { + clientput "WARNING: Cannot reach chi $chipos, skipping" + continue + } + clientput "Searching at chi: $chipos" + success + switch $detmode { + single { + xxxscan clear + xxxscan add $phimot $phimin $phistep + catch {xxxscan run $phinp $mode $preset} msg + set interrupt [getint] + if {[string first continue $interrupt] < 0} { + error $msg + } + set peaks [findpeaksinscan] + if {[llength $peaks] > 0} { + foreach p $peaks { + drive $phimot $p + centerref $preset $mode + refadd ang + incr count + if {$count >= $maxpeak} { + return "Found $maxpeak reflections, terminating..." + } + } + } + } + area { + xxxscan clear + xxxscan add $phimot 0 $phistep + catch {xxxscan run $phinp $mode $preset} msg + set interrupt [getint] + if {[string first continue $interrupt] < 0} { + error $msg + } +#--------- Do I need to extract peaks from the area detector data or is this to be +# left to anatric? + } + default { + error "Reflection search not supported for this detector mode" + } + } + } + } +} +#----------------------------------------------------------------------- +# cos(gamma) = cos(tth)/cos(nu) +#----------------------------------------------------------------------- +proc calcGamma {stt nu} { + set RD 57.30 + set stt [expr $stt/$RD] + set nu [expr $nu/$RD] + set val [expr cos($stt)/cos($nu)] + if {$val > 1.} { + error "Not reachable" + } + set gamma [expr acos($val)] + return [expr $gamma * $RD] +} +#----------------------------------------------------------------------- +proc searchnb {preset mode maxpeak} { + set sttmot [singlex motnam stt] + set ommot [singlex motnam om] + set numot [singlex motnam nu] + set min2t [SplitReply [singlex peaksearch/min2t]] + set omstart [SplitReply [$ommot softlowerlim]] + set omend [SplitReply [$ommot softupperlim]] + set omstep [SplitReply [singlex peaksearch/stepom]] + set omnp [expr int(($omend - $omstart)/$omstep)] + set nustart [SplitReply [$numot softlowerlim]] + set nuend [SplitReply [$numot softupperlim]] + set nustep [SplitReply [singlex peaksearch/stepnu]] + set nunp [expr ($nuend - $nustart)/$nustep] + set sttstep [SplitReply [singlex peaksearch/step2t]] + set sttnp [expr int([SplitReply [singlex peaksearch/max2t]]/$sttstep)] + refclear + set detmode [string trim [SplitReply [detmode]]] + set count 0 + for {set i 0} { $i < $sttnp} {incr i} { + set sttpos [expr $min2t + $i * $sttstep] + for {set j 0} {$j < $nunp} {incr j} { + set nupos [expr $nustart + $j * $nustep] + clientput "Searching at stt: $sttpos, nu = $nupos" + if {[catch {calcGamma $sttpos $nupos} gamma] != 0} { + clientput "NB search at stt: $sttpos, nu = $nupos not reachable" + continue + } + if {[catch {drive $sttmot $gamma $numot $nupos} msg] != 0} { + clientput "Failed to reach gamma = $gamma, nu = $nupos with $msg, skipping " + continue + } + switch $detmode { + single { + xxxscan clear + xxxscan add $ommot $omstart $omstep + catch {xxxscan run $omnp $mode $preset} msg + set interrupt [getint] + if {[string first continue $interrupt] < 0} { + error $msg + } + clientput "scan completed" + set peaks [split [findpeaksinscan] ,] + clientput "findpeakscan completed" + if {[llength $peaks] > 0} { + foreach p $peaks { + drive $ommot $p + centerref $preset $mode + refadd ang + incr count + if {$count >= $maxpeak} { + return "Found $maxpeak reflections, terminating..." + } + } + } + } + area { + xxxscan clear + xxxscan add $ommot $omstart $omstep + catch {xxxscan run $omnp $mode $preset} msg + set interrupt [getint] + if {[string first continue $interrupt] < 0} { + error $msg + } + } + default { + error "Reflection search not supported for this detector mode" + } + } + } + } +} +#-------------------------------------------------------------------------------------- +proc noop argv { + error "Operation not supported" +} +#-------------------------------------------------------------------------------------- +proc noopr {} { + error "Operation not supported" +} +#------------------------------------------------------------------------------------- +proc psidrive {target} { + global __psihkl __psitarget + set h [lindex $__psihkl 0] + set k [lindex $__psihkl 1] + set l [lindex $__psihkl 2] + set __psitarget $target + set status [catch {hkl calc $h $k $l $target} result] + if {$status != 0} { + clienput "Cannot drive to $h, $k, $l, psi = $target" + setint aportop + } + set l [split $result ,] + set result "" + set val [string trim [SplitReply [lindex $l 0]]] + set mot [singlex motnam stt] + append result "$mot=$val" + set val [string trim [SplitReply [lindex $l 1]]] + set mot [singlex motnam om] + append result ",$mot=$val" + set val [string trim [SplitReply [lindex $l 2]]] + set mot [singlex motnam chi] + append result ",$mot=$val" + set val [string trim [SplitReply [lindex $l 3]]] + set mot [singlex motnam phi] + append result ",$mot=$val" + return $result +} +#------------------------------------------------------------------------------------- +proc psiread {} { + global __psitarget + if {[info exists __psitarget] } { + return $__psitarget + } else { + return 0 + } +} +#--------------------------------------------------------------------------------- +proc psiprepare {obj userdata} { + global stdscangraph + stdscan noncheckprepare $obj $userdata + catch {hupdate $stdscangraph/dim} +} +#-------------------------------------------------------------------------- +proc psicollect {obj userdata np} { + global stdscangraph + stdscan collect $obj $userdata $np + catch {hupdate $stdscangraph/scan_variable} + catch {hupdate $stdscangraph/counts} +} +#---------------------------------------------------------------------------- +proc configurepsiscan {} { + xxxscan configure script + xxxscan function writeheader stdscan writeheader + xxxscan function prepare psiprepare + xxxscan function drive stdscan drive + xxxscan function count stdscan count + xxxscan function collect psicollect + xxxscan function writepoint stdscan writepoint + xxxscan function finish stdscan finish +} +#--------------------------------------------------------------------------------------- +# This version is for well positioning instruments +#--------------------------------------------------------------------------------------- +proc psiscanold {h k l step preset {countmode NULL}} { + global __psihkl __psistep + + set mode [SplitReply [singlex mode]] + if {[string first bi $mode] < 0} { + error "PSI scans are only supported in bisecting mode" + } + set detmode [string trim [SplitReply [detmode]]] + if {[string first single $detmode] < 0} { + error "PSI scans are only supported in single detector mode" + } + + set np [expr int((360./$step) + 1)] + if {[string compare $countmode NULL] == 0} { + set countmode [string trim [SplitReply [counter getmode]]] + } + set __psihkl [list $h $k $l] + set __psistep $step + psi drivescript psidrive + psi readscript psiread + xxxscan clear + configurepsiscan + xxxscan add psi 0 $step + xxxscan log [singlex motnam stt] + xxxscan log [singlex motnam om] + xxxscan log [singlex motnam chi] + xxxscan log [singlex motnam phi] + set status [catch {xxxscan run $np $countmode $preset} result] + psi drivescript noop + psi readscript noopr + configurestdscan + if {$status != 0} { + error $result + } else { + return $result + } +} +#--------------------------------------------------------------------------------------- +# This is a new version which performs a cscan in om at each point in psi and +# stores the result into a ccl file. +#--------------------------------------------------------------------------------------- +proc psiscan {h k l step stepom omnp preset {countmode NULL}} { + set mode [SplitReply [singlex mode]] + if {[string first bi $mode] < 0} { + error "PSI scans are only supported in bisecting mode" + } + set detmode [string trim [SplitReply [detmode]]] + if {[string first single $detmode] < 0} { + error "PSI scans are only supported in single detector mode" + } + + set np [expr int((360./$step) + 1)] + if {[string compare $countmode NULL] == 0} { + set countmode [string trim [SplitReply [counter getmode]]] + } + xxxscan clear + configuremessscan + fmess start [newFileName] + set np [expr int(360./$step) + 1] + for {set i 0} {$i < $np} {incr i} { + set psi [expr $i * $step] + set status [catch {hkl drive $h $k $l $psi} msg] + if {$status != 0 || [string first ERROR $msg] >= 0 } { + set rupt [getint] + switch $rupt { + continue - + abortop { + setint continue + clientput "Cannot reach psi: $psi, skipping" + continue + } + default { + clientput $msg + break + } + } + } + clientput "Scanning at $psi" + set ompos [string trim [SplitReply [om]]] + set status [catch {cscan om $ompos $stepom $omnp $preset} msg] + if {$status != 0} { + set rupt [getint] + if {[string compare $rupt continue] != 0} { + clientput $msg + break + } else { + clientput "ERROR: $msg while scanning" + } + } + set stt [SplitReply [stt]] + set chi [SplitReply [chi]] + set phi [SplitReply [phi]] + fmess storeextra $h $k $l $stt $ompos $chi $phi $psi + } + fmess close + configurestdscan + return Done +} +#--------------------------------------------------------------------------- +proc bitonb {stt om chi phi} { + return [hkl bitonb $stt $om $ch $phi] +} +#--------------------------------------------------------------------------- +proc varToCom {var} { + set reply [$var] + return [string map {= " "} $reply] +} +#--------------------------------------------------------------------------- +proc savexxx {filename} { + append fname [string trim [SplitReply [exe batchpath]]] / $filename + set status [catch {open $fname w} out] + if {$status != 0} { + error "Failed to open $fname" + } + puts $out [varToCom title] + puts $out [varToCom sample] + puts $out [varToCom lambda] + puts $out [varToCom cell] + puts $out [varToCom spgrp] + puts $out [varToCom ub] + + puts $out [varToCom coneconf] + set reply [SplitReply [indexconf]] + puts $out "indexconf $reply" + set reply [SplitReply [hkllimit]] + puts $out "hkllimit $reply" + + puts $out refclear + set reflist [split [ref names] \n] + foreach ref $reflist { + if {[string length $ref] < 2} { + continue + } + set txt [ref show [string trim $ref]] + set txtlist [split $txt] + set outlist [lrange $txtlist 2 end] + puts $out "ref addax [join $outlist]" + } + + puts $out "fmess table clear" + set table [fmess table print] + set tblist [split $table "\n"] + for {set i 1} {$i < [llength $tblist]} {incr i} { + set line [lindex $tblist $i] + set line [string trim [regsub -all "\\s+" $line " "]] + if {[string length $line] < 2} { + continue + } + set l [split $line] + puts $out "fmess table addrow [join [lrange $l 1 end]]" + } + + + close $out + return "Done" +} +#====================================================================================== +# Stuff to support Hipadaba +#====================================================================================== +proc ubrefinehdb args { + set path /instrument/reflection_list/ubrefresult + set status [catch {ubrefine} msg] + if {[string length $msg] < 10} { + set msg "ubrefine produced no output, check raf*.lis in projectdir yourself!" + } + hset $path $msg +} +#-------------------------------------------------------------------------------------- +proc runindex {sttlim anglim} { + indexconf $sttlim $anglim + catch {capture simidx run} result + set result [string map {ERROR PROBLEM} $result] + hupdate /instrument/reflection_list/indexresult $result + return Done +} +#----------------------------------------------------------------------------------------- +proc makeHipadabaReflectionList {} { + hfactory /instrument/reflection_list plain spy none + hfactory /instrument/reflection_list/list link ref + hsetprop /instrument/reflection_list/list viewer mountaingumui.TableEditor + hsetprop /instrument/reflection_list/list type part + hsetprop /instrument/reflection_list/list/addrow sicscommand "ref addrow" + hsetprop /instrument/reflection_list/list/clear sicscommand "ref clear" + hsetprop /instrument/reflection_list/list/del sicscommand "ref del" + hsetprop /instrument/reflection_list/list sicscommand ref + hfactory /instrument/reflection_list/list/calcub command calcub + hsetprop /instrument/reflection_list/list/calcub type command + hsetprop /instrument/reflection_list/list/calcub priv user + hsetprop /instrument/reflection_list/list/calcub tablecommand true + hsetprop /instrument/reflection_list/list/calcub sicscommand calcub + hfactory /instrument/reflection_list/list/calcub/args plain user text + + hfactory /instrument/reflection_list/ubrefine command ubrefinehdb + hsetprop /instrument/reflection_list/ubrefine viewer mountaingumui.ubrefine + hsetprop /instrument/reflection_list/ubrefine type command + hsetprop /instrument/reflection_list/ubrefine priv user + hsetprop /instrument/reflection_list/ubrefine sicscommand ubrefinehdb + + hfactory /instrument/reflection_list/ubrefresult plain user text + hsetprop /instrument/reflection_list/ubrefresult visible false + + hfactory /instrument/reflection_list/loadub command loadub + hsetprop /instrument/reflection_list/loadub type command + hsetprop /instrument/reflection_list/loadub priv user + hsetprop /instrument/reflection_list/loadub sicscommand loadub + hsetprop /instrument/reflection_list/loadub visible false + + + set names [hlist /instrument/reflection_list/list] + set l [split $names '\n'] + foreach n $l { + if {[string compare $n data] != 0} { + hsetprop /instrument/reflection_list/list/${n} visible false + } + } + hdelprop /instrument/reflection_list/list visible + + hfactory /instrument/reflection_list/index command runindex + hsetprop /instrument/reflection_list/index viewer mountaingumui.index + hsetprop /instrument/reflection_list/index type command + hsetprop /instrument/reflection_list/index priv user + hsetprop /instrument/reflection_list/index sicscommand runindex + hfactory /instrument/reflection_list/index/sttlim plain user float + hfactory /instrument/reflection_list/index/anglim plain user float + + hfactory /instrument/reflection_list/indexresult plain user text + hsetprop /instrument/reflection_list/indexresult visible false + hfactory /instrument/reflection_list/indexmax alias /sics/simidx/nsolutions + hsetprop /instrument/reflection_list/indexmax visible false + + hfactory /instrument/reflection_list/choose command indexub + hsetprop /instrument/reflection_list/choose type command + hsetprop /instrument/reflection_list/choose priv user + hsetprop /instrument/reflection_list/choose sicscommand indexub + hsetprop /instrument/reflection_list/choose visible false + hfactory /instrument/reflection_list/choose/sel plain user int + + hfactory /instrument/reflection_list/centerlist command centerlist + hsetprop /instrument/reflection_list/centerlist type command + hsetprop /instrument/reflection_list/centerlist priv user + hsetprop /instrument/reflection_list/centerlist sicscommand centerlist + hfactory /instrument/reflection_list/centerlist/preset plain user float + hset /instrument/reflection_list/centerlist/preset 20000 + hfactory /instrument/reflection_list/centerlist/mode plain user text + hsetprop /instrument/reflection_list/centerlist/mode values Monitor,Timer + hfactory /instrument/reflection_list/centerlist/skip plain user int + hset /instrument/reflection_list/centerlist/skip 0 + +} diff --git a/site_ansto/instrument/pelican/config/tasmad/sicscommon/fsync.jar b/site_ansto/instrument/pelican/config/tasmad/sicscommon/fsync.jar new file mode 100644 index 0000000000000000000000000000000000000000..c727e9dfc6dfbd1a44501a1cd9ba95bcc50f0d97 GIT binary patch literal 6108 zcmZ{obyO70zs5njS&$ATq-*I0K~hRsU}=_xrDLg;kYgu`Y-1q(6bMN#0V`k2onKSeK>v=wU&#|x{V&MNN-AE`G#=rFN&s-!l%P z@4q!8UPjp)a=~|o&b`*?^9@5zt?@Cj4+}Oivj{%URPf*x^TmaR#2m=$+7_EZ4u`P0 zEVQO#D6o60e#f&Y_Q`zvs3LAPtg|BRX~Kc9*gLclA!KR2t!c0|4+^H&~B3=F;h>4xh6>IUhb9jcBlb_RZKPywh5#LEk1?CcFP zrn++z{G*i1ad|Jge}rr`#G+U1^9&PfzQck<~=BMg@WzWGb%4g94%k%1PxRAd- za?kUce08lLn5QgIetKxWQPb}8bN@00&FK?pIt*aSn}dUfzj(`5ZMUMocxTU^*)f%R z2O18Cpl76m%C_a0P7W`NAL(Af=i`lUB)<$-1a<5U9|m=74*Myr{oD?FwEkn8U!m({ zSVbX-ya%;N(KF5pD|iy($2u}a-{TDsQ5mBGS`9F|kZf?cP`b329dW(&d_#OhY%T5^ z{Y_5T!yNyq4;2o|H+K1K})eo<%0Dn0PD^tFIrqwSj9_tusWOPj5?G9lzH z(UXZ%{zWaiDcc3<Q*uKZ|}G#2T+ab#bz}^f(9^k8|b)zb688D|I7n*bd4fATrhY zzpElDSXu%h;hYi<8Kzye@c1QXqhYP~2LI>NzEy5b`u!x^r_>T|OF6u9g|4})?|O~9 zJdCSENw#$8Nws<19WtgoovvuTq1Vh*aO0SC_)Ar@8~zOZM_8^gGJsU|DX-o8DJ|uu zk7!b=Zt;XlX*Me$=H0zy$*2jPf!X^xXYGZfxHq5QjD4`&_0Rn=f|%2MGbx^2WI;Kc z&^=Pmk7z=wG{I&UVM9qHUp=-|SxZ2=#Q;MlnDCzdiU$+)qfOyTeX_vEIdW$Agt+sc zlJE=D3)KOMDw&z-r1j)C< zIZHN&d~N}A+oovOpFYvrvW_dlYPwme^wQjnbBU!rUk&;g^b?D)pD6o_KOlKRi7mn% z%b%3un9;CyWT@J%-(0s~gDzCP4uT#oYu9&`DPy7L3|1YM%B7Y*S8r9p0^)jgwe43u z!BT18g!e~|I1t5@0MlvO21;TfqtDi6!U}Z-s+=}M&6)7$jGk0f<7fc9tzBEjiQOL* zfhj^eDo&rpP|kj-SvYf$TFD+D%D0v=k*-$U!XT4f#MCMOj=o%&gHE`{Jtbc(_{Tib z#|I&@#IGaF{DMM~W^pSEt~+D&O4T;_SxB$OUX07i5D;1RL{LbSgD?UoS?>7@%DVn8-uE z8Fx!XiVW-0yZ!Q)4#@mY1m;g_7d>uJm!jgADgQ0ud#bfXSmuT@auymzNRt?Fyj6(x z--)N@+V74LU#va=ox#C-U+JPyNcpQ}&n@4)OFsIVc7@IIW4NBP@#^#Y6nMf+di9t3 z!)!@PRHNj6BCGpAg)=F^63`COX0a-`Fe^j3>T0T`g5F_U(3oy(<;;=NnW2|pQ%a5+ zDBFy$cwO%wz5AWZ`a9)_D?EZ{QZ(bMejS+Ij1y;#L;Xv|<3tx-TMEOk(kPw0n1xJ& z{579?x}WyV7y++JcIRc_mLemUc;6G)1U1h+cb*(H1=9F`+aLQuS2G^YapE>IiLt!C z$@YN%A@fieV9bU0;}S3~QhO6H=3YUo`ip!XY1OwpeKS4%@YtbR6S93?KF!U&`kR=r zzl(*BA%uCt?#+ugnoaapAJUaNPuO7qi*r6gs{xDRWPJzxnS1hMM#W++>hC0l<&GG3 zD|WK!+fd~)EeMm3NRT`2mliN_nCJ(&aIz@nxI*qi3D@kkIN%Q&zaNJc$XeKGc*Avl z!(qkHSQjiIdL;@EPA=j>cR$d*=yWMdnYpz~(LsOp@{C7S>cof&9HMzw?!jCBqW|1? zHO!Q6Shcc;l=T8iwH&RwIB=1VzHiDdL^o9SE0+yJ!SQU1A=?f^7**Y<@gjGk zi2^EjYnc-TnU^g~(d*mHH-L*RU6*^UlVG+WI>23FoLHX&)g6kIpUh&}_UKcIh$U)` z)WfhSkEVxF9_tE%dPY{CZfO=GIn_U13y+g~1UHcoG|lYu3k3sLLgqn9;SK&j@ZFp$ z%B3aZo}i$f@=K!!Pd1AIz zkV$#*6xbxO4+$7^gqn%O4T^>8y=|0?Y@_^2g2Q24su!?Qq-TA=zJ9D1QdBx+ZXg-9 z@0#BS0nKA8S0)*XMeb+7gh~KouDrX81$q#|=LU=HcAF|f-6dRA;xZK_vGj+q-7=Uj z&@W$B@Z9lt<4qxF^(>h=fv^aJ2OwRQcSq<4(NE!Yy!_+^?w1kJcnY~OQ@?DnQ*5bV z3WT5equqPjtDu+;dDQ0}OL+g#{yv7pcNVu}=p{w)WF4!{chy%h40pVhNP||z9oBDx zXAka3TduD={H*qTt{>U{CPX^~$&S(HPI?aK#^`iX{F!P@L7y`D(9T!P!rT3>HBy_O8#MkN1!Nr?YtbG4YgGZ9!R ziS}Ef#j3A1A8Kh7wHMU^=CAP&10^cbCCU+ocGz}~HB?CW`Cgar5%=c61TcaC7`?YW~~Mf&y?)o`ndZ^#z<~r9l7i0K4?_y00*0&fxDY%{;aNPMN_cj~ho_lk=mgAAH%Cynz zF55a0KF%zA)XT;!yVq;LEc>ljgjx2mH&6EEU?DM6yLVvWcDHob+*uC#b6Z$-N_C9) z?sRGiZ%cKIPx0YMVFiVSpO4|53XW+9E%#gEDof&rdZaV4Pagz=HwUdTukmSFtgRRt z3BcU;Y++Rt9_0zo?5aK!DcD#N1B58xm`qBZSs@Wx$zjDEv}hg73YBGgL7uwi2!=!3 z3vWz&{L4BTLrDYQ$)tUMOnV|pHE<3u@dTwyc;)T0o~wG_(AqY=5}MT0BVC;9%-Xia zSV-%$qfQXof`cKQ=!{CZQ@=!k=7?wWJJC|BX|3}>k2B5+mvyqsjebwf0Hj;|l*{em z6#s@VrXwa9{iVpU$SF@V{bg)rClZgi1N{wmt>+i+S_(9HP#nvBlMHulNE>$z(1w7= zhF*9ygkF4tZeX!o>G|HH%}8#r1nDpFFK91mFX%6^5p56S<{Oif(Q1gY$g)5#16ee3kP2dU0Yw zhVn4;S&t)8P_a-Mg%MliXjkjFUg6Gw1LpN6sWK`NRrlar%@mVRrBIc-RdxI!SgzU< zl6L?nspzZdr!3e6uS7(aRtlTx&s+-%YCd7DYhK-*0I^HwM>n1gc*hzhqyoH*&$ha{Hd4 zun4PYlFSl%FMyUjxJU0TyN5BOZke-e=ZPFCmU;WyCa8GFo&^tz?5vmKQ7P0;`S+@m z@++FS5+LLoxq-JEB`K^>(Vtxp%+Ou(q!AS@T+Pc_0~l`mj4Pwq~j_NFiTwMUW0n#$S4 zvsiAMeLR12{_T@z(yXh?(lVKGjf2bM;FyT)NmSN(QCzZ0PTGu$1`ZhwV?0%qjPw|| zBCP!heYzZ7veFDid~qKD&i)DQ^Q#V&9q8J!L`du)RtOvM28&ppuWp*#EPuE68h-ma zlD9sBStt29>$}tx_uP3pGzX3egGR|~hi4J0Va*{=8>YaL^imdqnxex~(jrYmqEK(E zyEa$Yd%it}HJE8eYm!4@rWSIg)pF$Hr|6eand(&y_7inQuZDmhYo}a9z3U|w1k9gm z{G^%+5VpFqU|x(ZH6CZzgkGmLt0R2|O*mH7nns z+!l#)`o>3NDZQ0L5uB@?rBj`XSfoap=~!grw5}s z&h<&Z;ohE01N(w>zY zI0*=7->?)zf4UApO^)3A*W*?aPldqTDQA8>uD8q5r*FNismNL-bqIf2gL;~nv_my9 zd%tDO5m|ZF;^7qmp_H0fjlE*dEZmXcy@=nee8TZ6`MFNN88DSdiAwlUUW4|;AF68&obpqqE*U60`_a8hxuqB z97rNRN2>*W0sRVmh=7nwFep1_r>JT#9Fx5laWw1C0WZb^#=DZ35F24iEWZ?%NI#x-*mo4_}Ny;qQ=ZtFRL@iWV+X2AW$Zy-UMxVoP8N$-~+<5q6 zL5mXBczd=F6(VDF=i3^PeuQ*;2PKRfdUqt_L<^d{m*H?84wjLSrexNMkQ`Ma3J0Ym zy1h~4q2|HSUaO*5nd(BNz!*7=aWVWW7VR4O+oD48KAPFrq7GG#*;9*=EcG{qC@vzM znFslV{HUoU5&^>}oHGt<_1AY@53{htPqqBF_%uy*NhUWdF3jZxC4?d;iWeqJhXrl* zEuPiXl&()cX0i%H2SJ>S$KXyMjI)Oln~oDkPfF-#8WYy5`0WKmJ(}Mlw^dVO1W4X& z`1;_5QJJE6Q3Rh&43S`@B?(#ert(kIE^`T+2jaj0wT&RP)%+qrIV9A&3^~Rz>(p58 z$aW}z+P*P;)FR9~>JGX6tQqcBI2~9cZSD)_$ZwUuTC(Y#UNtdK+~kU;T{fXk zWBeQ$^PrQmzp=j#VjS&M+&(>uj{>igHHY%KlnY6xpr!bkT2klD7WZ~i9h$Wp%D6OW#M3=Kuw%9))gGSh zjdp&r1Y2+ls&Wv)9kuO9wm0Ps-?mREndW8b<_MCkY+kg|>Z?;?8>CzgO*WBFlBIM$ zdO*?k+x0#^8nZHJYgN=}K(J53Z__Z3wN8LJ*miWF|bY4ie^vl;=SI(MUu#kCM zXjTY|6RV0&pQIQa9%Wu(iQY{>>k=SXYS4N5m72q-J^DlK*6_qo+xsz?1TbOdTV-yE zaiV;1D#?_^QqICgZu!y7hl4gJ@#Gd#YWy1tKSHjjCFAdEcm zOdF!gsH`3U`B0(tjFW%6Uv?IbQG!yK7436{mzz65yB=n#gH&$L){k_yPfb79cum%h zJZP+>r`o8XD-rCUVCg(U|h`fs?>1LqFMamyAc;i_haLl zF5cpc>*|yZ!&>fuv#dzZte-r=HFYE%r1AdY8aL8!W}RuP*NPn7>z;N-LuX|q(canz z7Fj>#rDySoBLYS4GsRpR4d#vmYnEKk4eIYBav46vH)!9<7IMH>$QR#PM1_J@hq0yS zo3KP$e%Y+=g*fYzJ@B-b?>m04&HnDpIa&Q-{jeX2K=k@f+$R;A#&tQ3WifX>N`B!0 zh}%5CC?Q;?{*dl~H^{yV7Ki9n3#?s6C5qZ;CHA$l(s0l?X1v%@ zwMaxu4*QrZ=)Te*6--nH z@qgd&7ajjQiv2~$|A_PtX8uo*{O_}W!`i=J_BX8kqeX)MC%Wl9$HD!(4eL+!{uyy- H{;vKD&G}Qf literal 0 HcmV?d00001 diff --git a/site_ansto/instrument/pelican/config/tasmad/sicscommon/hdbutil.tcl b/site_ansto/instrument/pelican/config/tasmad/sicscommon/hdbutil.tcl new file mode 100644 index 00000000..580fedf6 --- /dev/null +++ b/site_ansto/instrument/pelican/config/tasmad/sicscommon/hdbutil.tcl @@ -0,0 +1,944 @@ +#----------------------------------------------------------------------- +# This is a collection of utility procedures to help with Hipadaba and +# Gumtree Swiss Edition. This file is supposed to be sourced by any +# instrument using Hipadaba. +# +# Copyright: see file COPYRIGHT +# +# Collected from various files: Mark Koennecke, March 2008 +# +# Requirements: +# * the internal scan command xxxscan +# * scan data to live /graphics/scan_data +# +# Many updates, till November 2008, Mark Koennecke +#---------------------------------------------------------------------- +if { [info exists hdbinit] == 0 } { + set hdbinit 1 + MakeStateMon + Publish getgumtreexml Spy + if {[string first tmp $home] < 0} { + set tmppath $home/tmp + } else { + set tmppath $home + } + Publish mgbatch Spy + Publish loadmgbatch Spy + Publish hsearchprop Spy + Publish hdbscan User + Publish hdbprepare User + Publish hdbcollect User + Publish listbatchfiles Spy + Publish makemumopos User + Publish dropmumo User + Publish hdbbatchpath User + Publish cscan User + Publish sscan User + Publish scan Spy + Publish hmake Mugger + Publish hmakescript Mugger + Publish hlink Mugger + Publish hcommand Mugger + Publish hdbstorenexus User + Publish scaninfo Spy +} +#=================================================================== +# Configuration commands provided: +# hdbReadOnly +# makesampleenv path +# makestdscan path +# makestdscangraphics path +# makestdbatch +# makeQuickPar name path +# makeslit path left right upper lower +# configures a slit. Missing motors can be indicated with NONE +# makestdadmin +# makecount path +# makerepeat path +# makekillfile path +# makesuccess path +# makestdgui +# makewait path +# makeevproxy rootpath hdbname devicename +# makemumo rootpath mumoname +# makeexe +# confnxhdb path alias pass +# makestddrive path +#===================== hfactory adapters ========================== +proc hmake {path priv type {len 1}} { + hfactory $path plain $priv $type $len +} +#-------------------------------------------------------------------- +proc hmakescript {path readscript writescript type {len 1}} { + hfactory $path script $readscript $writescript $type $len +} +#------------------------------------------------------------------- +proc hlink {path obj {treename NONE} } { + if {[string equal $treename NONE]} { + set treename $ob + } + append realpath $path / $treename + hfactory $realpath link $obj +} +#------------------------------------------------------------------- +proc hcommand {path script} { + hfactory $path command $script +} +#================ make XML tree ===================================== +proc getdataType {path} { + return [lindex [split [hinfo $path] ,] 0] +} +#--------------------------------------------------------------------- +proc makeInitValue {path type prefix} { + append result "" + if {[string compare $type none] != 0 && [string compare $type func] != 0} { + set test [catch {hgetprop $path transfer} msg] + set tst [catch {hval $path} val] + if {$test != 0 && $tst == 0} { + append result "$prefix \n" + append result "$prefix $val\n" + append result "$prefix \n" + } + } + return $result +} +#---------------------------------------------------------------------- +proc make_nodes {path result indent} { + set nodename [file tail $path]; + set type [getdataType $path] + set prefix [string repeat " " $indent] + set newIndent [expr $indent + 2] +#array set prop_list [ string trim [join [split [hlistprop $path] =]] ] + set prop_list(control) true + set we_have_control [info exists prop_list(control)] + if {$we_have_control == 0 || $we_have_control && $prop_list(control) == "true"} { + append result "$prefix\n" + foreach p [property_elements $path $newIndent] { + append result $p + } + foreach x [hlist $path] { + set result [make_nodes [string map {// /} "$path/$x"] $result $newIndent] + } +# append result [makeInitValue $path $type $prefix] + append result "$prefix\n" + } + return $result +} +#------------------------------------------------------------------- +proc property_elements_old {path indent} { + set prefix [string repeat " " $indent] + foreach {key value} [string map {= " "} [hlistprop $path]] { + if {[string compare -nocase $key "control"] == 0} {continue} + lappend proplist "$prefix\n" +# foreach v [split $value ,] { +# lappend proplist "$prefix$prefix$v\n" +# } + lappend proplist "$prefix$prefix$value\n" + lappend proplist "$prefix\n" + } + if [info exists proplist] {return $proplist} +} +#----------------------------------------------------------------------- +proc property_elements {path indent} { + set prefix [string repeat " " $indent] + set data [hlistprop $path] + set propList [split $data \n] + foreach prop $propList { + set pl [split $prop =] + set key [string trim [lindex $pl 0]] + set value [string trim [lindex $pl 1]] + if {[string length $key] < 1} { + continue + } + lappend proplist "$prefix\n" + lappend proplist "$prefix$prefix$value\n" + lappend proplist "$prefix\n" + } + if [info exists proplist] {return $proplist} +} +#-------------------------------------------------------------------------- +proc getgumtreexml {path} { + append result "\n" + append result "\n" + + if {[string compare $path "/" ] == 0} { + foreach n [hlist $path] { + set result [make_nodes /$n $result 2] + } + } else { + foreach n [hlist $path] { + set result [make_nodes $path/$n $result 2] + } + } + + append result "\n" +} +#==================== Gumtree batch ========================================= +proc searchPathForDrivable {name} { + set path [string trim [hmatchprop / sicsdev $name]] + if {[string compare $path NONE] != 0} { + return $path + } + set txt [findalias $name] + if {[string compare $txt NONE] == 0} { + return NONE + } + set l1 [split $txt =] + set l [split [lindex $l1 1] ,] + foreach alias $l { + set alias [string trim $alias] + set path [string trim [hmatchprop / sicsdev $alias]] + if {[string compare $path NONE] != 0} { + return $path + } + } + return NONE +} +#---------------------------------------------------------------- +proc searchForCommand {name} { + return [string trim [hmatchprop / sicscommand $name]] +} +#---------------------------------------------------------------- +proc treatsscan {scanpath command out} { + set l [split $command] + set len [llength $l] + set noVar [expr ($len-2)/3] + set np [lindex $l [expr $len -2]] + set preset [lindex $l [expr $len -1]] + for {set i 0} {$i < $noVar} {incr i} { + set start [expr $i * 3] + set scanVar [lindex $l [expr 1 + $start]] + set scanStart [lindex $l [expr 2 + $start]] + set scanEnd [lindex $l [expr 3 + $start]] + set scanStep [expr ($scanEnd*1. - $scanStart*1.)/$np*1.] + append hdbVar $scanVar , + append hdbStart $scanStart , + append hdbStep $scanStep , + } + set hdbVar [string trim $hdbVar ,] + set hdbStart [string trim $hdbStart ,] + set hdbStep [string trim $hdbStep ,] + puts $out "\#NODE: $scanpath" + puts $out "clientput BatchPos = 1" + puts $out "hdbscan $hdbVar $hdbStart $hdbStep $np monitor $preset" +} +#---------------------------------------------------------------- +proc treatcscan {scanpath command out} { + set l [split $command] + set scanVar [lindex $l 1] + set scanCenter [lindex $l 2] + set scanStep [lindex $l 3] + set np [lindex $l 4] + set preset [lindex $l 5] + set hdbStart [expr $scanCenter - ($np*1.0)/2. * $scanStep*1.0] + puts $out "\#NODE: $scanpath" + puts $out "clientput BatchPos = 1" + puts $out "hdbscan $scanVar $hdbStart $scanStep $np monitor $preset" +} +#---------------------------------------------------------------- +proc translateCommand {command out} { + set drivelist [list drive dr run] + set textList [list for while source if] +# clientput "Translating: $command" + set command [string trim $command] + if {[string length $command] < 2} { + return + } + set l [split $command] + set obj [string trim [lindex $l 0]] +#------- check for drive commands + set idx [lsearch $drivelist $obj] + if {$idx >= 0} { + set dev [lindex $l 1] + set path [searchPathForDrivable $dev] + if {[string compare $path NONE] != 0} { + set realTxt [hgetprop $path sicsdev] + set realL [split $realTxt =] + set realDev [lindex $realL 1] + set mapList [list $dev $realDev] + set newCom [string map $mapList $command] + puts $out "\#NODE: $path" + puts $out "clientput BatchPos = 1" + puts $out $newCom + return + } + } +#------ check for well known broken commands + set idx [lsearch $textList $obj] + if {$idx >= 0} { + puts $out "\#NODE: /batch/commandtext" + puts $out "clientput BatchPos = 1" + set buffer [string map {\n @nl@} $command] + puts $out "hset /batch/commandtext $buffer" + return + } +#--------- check for simple commands + set path [searchForCommand $command] + if {[string compare $path NONE] != 0} { + puts $out "\#NODE: $path" + puts $out "clientput BatchPos = 1" + puts $out $command + return + } + set scancom [searchForCommand hdbscan] +#---------- deal with scans + if {[string first sscan $obj] >= 0} { + if {[catch {treatsscan $scancom $command $out}] == 0} { + return + } + } + if {[string first cscan $obj] >= 0} { + if {[catch {treatsscan $scancom $command $out}] == 0} { + return + } + } +#--------- give up: output as a text node + puts $out "\#NODE: /batch/commandtext" + puts $out "clientput BatchPos = 1" + set buffer [string map {\n @nl@} $command] + puts $out "hset /batch/commandtext $buffer" +} +#---------------------------------------------------------------- +proc mgbatch {filename} { + global tmppath + set f [open $filename r] + gets $f line + close $f + if {[string first MOUNTAINBATCH $line] > 0} { +#--------- This is a mountaingum batch file which does not need +# to be massaged + return $filename + } + set f [open $filename r] + set realfilename [file tail $filename] + set out [open $tmppath/$realfilename w] + puts $out \#MOUNTAINBATCH + while {[gets $f line] >= 0} { + append buffer $line + if {[info complete $buffer] == 1} { + translateCommand $buffer $out + unset buffer + } else { + append buffer \n + } + } + close $out + return $tmppath/$realfilename +} +#---------------------------------------------------------------- +proc loadmgbatch {filename} { + set txt [exe fullpath $filename] + set l [split $txt =] + set realf [lindex $l 1] + set realf [mgbatch $realf] + return [exe print $realf] +} +#============== hdbscan ========================================= +proc hdbscan {scanvars scanstart scanincr np mode preset} { + global stdscangraph hdbscanactive + xxxscan clear + xxxscan configure script + xxxscan function prepare hdbprepare + xxxscan function collect hdbcollect + set varlist [split $scanvars ,] + set startlist [split $scanstart ,] + set incrlist [split $scanincr ,] + catch {hset $stdscangraph/scan_variable/name [lindex $varlist 0]} + set count 0 + foreach var $varlist { + if {[string first / $var] >= 0} { + set var [string trim [SplitReply [hgetprop $var sicsdev]]] + } + xxxscan add $var [lindex $startlist $count] [lindex $incrlist $count] + incr count + } + set hdbscanactive 1 + set status [catch {xxxscan run $np $mode $preset} msg] + set hdbscanactive 0 + if {$status == 0} { + return $msg + } else { + error $msg + } +} +#------------------------------------------------------------------------------ +proc hdbprepare {obj userdata } { + global stdscangraph + stdscan prepare $obj userdata + catch {hupdate $stdscangraph/dim} +} +#------------------------------------------------------------------------------ +proc hdbcollect {obj userobj np} { + global stdscangraph + stdscan collect $obj $userobj $np + catch {hupdate $stdscangraph/scan_variable} + catch {hupdate $stdscangraph/counts} +} +#----------------------------------------------------------------------------- +proc gethdbscanvardata {no} { + set np [string trim [SplitReply [xxxscan np]]] + if {$np == 0} { + return ".0 .0 .0" + } + set status [catch {SplitReply [xxxscan getvardata $no]} txt] + if {$status == 0} { + return [join $txt] + } else { + return ".0 .0 .0" + } +} +#---------------------------------------------------------------------------- +proc gethdbscancounts {} { + set np [string trim [SplitReply [xxxscan np]]] + if {$np == 0} { + return "0 0 0" + } + set status [catch {SplitReply [xxxscan getcounts]} txt] + if {$status == 0} { + return [join $txt] + } else { + return "0 0 0" + } +} +#================= helper to get the list of batch files ================= +proc listbatchfiles {} { + set ext [list *.tcl *.job *.run] + set txt [SplitReply [exe batchpath]] + set dirlist [split $txt :] + set txt [SplitReply [exe syspath]] + set dirlist [concat $dirlist [split $txt :]] +# clientput $dirlist + set result [list ""] + foreach dir $dirlist { + foreach e $ext { + set status [catch {glob [string trim $dir]/$e} filetxt] + if {$status == 0} { + set filelist [split $filetxt] + foreach f $filelist { +# clientput "Working at $f" + set nam [file tail $f] + if { [lsearch $result $nam] < 0} { +# clientput "Adding $nam" + lappend result $nam + } + } + } else { +# clientput "ERROR: $filetxt" + } + } + } + foreach bf $result { + append resulttxt $bf , + } + return [string trim $resulttxt ,] +} +#------------------------------------------------------------------------- +proc hsearchprop {root prop val} { + set children [hlist $root] + set childlist [split $children \n] + if {[llength $childlist] <= 0} { + error "No children" + } + foreach child $childlist { + if {[string length $child] < 1} { + continue + } + catch {hgetprop $root/$child $prop} msg + if { [string first ERROR $msg] < 0} { + set value [string trim [SplitReply $msg]] + if { [string equal -nocase $value $val] == 1} { + return $root/$child + } + } + set status [catch {hsearchprop $root/$child $prop $val} node] + if {$status == 0} { + return $node + } + } + error "Not found" +} +#============ various utility routines ===================================== +proc hdbReadOnly args { + error "Parameter is READ ONLY" +} +#--------------------------------------------------------------------------- +proc makesampleenv {path} { + hfactory $path plain spy none + hsetprop $path type graphdata + hsetprop $path viewer mountaingumui.TimeSeries + hfactory $path/vars plain user text + hset $path/vars tomato + hfactory $path/rank plain user int + hset $path/rank 1 + hfactory $path/dim plain user intar 1 + hset $path/dim 300 + hfactory $path/getdata plain user text + hsetprop $path/getdata type logcommand + hfactory $path/getdata/2010ttime plain spy text + hfactory $path/getdata/2010ime plain spy text +} +#-------------------------------------------------- +proc makestdscan {path} { + hfactory $path command hdbscan + hsetprop $path type command + hsetprop $path viewer mountaingumui.ScanEditor + hsetprop $path priv user + hfactory $path/scan_variables plain user text + hsetprop $path/scan_variables argtype drivable + hfactory $path/scan_start plain user text + hfactory $path/scan_increments plain user text + hfactory $path/NP plain user int + hfactory $path/mode plain user text + hsetprop $path/mode values "monitor,timer" + hfactory $path/preset plain user float +} +#--------------------------------------------------- +proc makestdscangraphics {path} { + global stdscangraph + + set stdscangraph $path + + hfactory $path plain spy none + hsetprop $path type graphdata + hsetprop $path viewer default + hattach $path title title + hfactory $path/rank plain mugger int + hset $path/rank 1 + hsetprop $path/rank priv internal + hfactory $path/dim script "xxxscan np" hdbReadOnly intar 1 + hsetprop $path/dim priv internal + hfactory $path/scan_variable script "gethdbscanvardata 0" hdbReadOnly floatvarar 1 + hsetprop $path/scan_variable type axis + hsetprop $path/scan_variable dim 0 + hsetprop $path/scan_variable transfer zip + hsetprop $path/scan_variable priv internal + hfactory $path/scan_variable/name plain user text + hfactory $path/counts script "gethdbscancounts" hdbReadOnly intvarar 1 + hsetprop $path/counts type data + hsetprop $path/counts transfer zip + hsetprop $path/counts priv internal +} +#---------------------------------------------------- +proc makeQuickPar {name path} { + hfactory /quickview/$name plain mugger text + hset /quickview/$name $path +} +#--------------------------------------------------- +proc makestdbatch {} { + hfactory /batch plain spy none + hfactory /batch/bufferlist script listbatchfiles hdbReadOnly text + sicspoll add /batch/bufferlist hdb 30 + hfactory /batch/commandtext plain spy text + hsetprop /batch/commandtext viewer mountaingumui.TextEdit + hsetprop /batch/commandtext commandtext true + hfactory /batch/currentline plain user int +} +#----------------------------------------------------- +proc makeslit {path left right upper bottom} { + hfactory $path plain spy none + hsetprop $path type part + if {![string equal $left NONE]} { + hattach $path $left left + } + if {![string equal $right NONE]} { + hattach $path $right right + } + if {![string equal $upper NONE]} { + hattach $path $upper upper + } + if {![string equal $bottom NONE]} { + hattach $path $bottom bottom + } +} +#--------------------------------------------------------- +proc makestdadmin {} { + hfactory /instrument/experiment plain spy none + hattach /instrument/experiment title title + hattach /instrument/experiment user user + set status [catch {hattach /instrument/experiment/user adress address} msg] + if {$status != 0} { + set status [catch {hattach /instrument/experiment/user address address} msg] + } + hattach /instrument/experiment/user phone phone + hattach /instrument/experiment/user email email + hfactory /instrument/experiment/datafilenumber script sicsdatanumber \ + hdbReadOnly int + hsetprop /instrument/experiment/datafilenumber priv internal + hfactory /instrument/experiment/batchpath script "exe batchpath" \ + hdbbatchpath text + hsetprop /instrument/experiment/batchpath priv user + sicspoll add /instrument/experiment/batchpath hdb 60 + sicspoll add /instrument/experiment/datafilenumber hdb 60 +} +#---------------------------------------------------------- +proc makecount {path} { + hfactory $path command count + hsetprop $path type command + hsetprop $path priv user + hfactory $path/mode plain user text + hsetprop $path/mode values "monitor,timer" + hfactory $path/preset plain user float + hset $path/preset 60000 + hset $path/mode monitor +} +#---------------------------------------------------------- +proc makerepeat {path} { + hfactory $path command repeat + hsetprop $path type command + hsetprop $path priv user + hfactory $path/num plain user int + hfactory $path/mode plain user text + hsetprop $path/mode values "monitor,timer" + hfactory $path/preset plain user float + hset $path/preset 60000 + hset $path/mode monitor +} +#---------------------------------------------------------- +proc makekillfile {path} { + hcommand $path killfile + hsetprop $path type command + hsetprop $path priv manager +} +#---------------------------------------------------------- +proc makesuccess {path} { + hcommand $path success + hsetprop $path type command + hsetprop $path priv user +} +#----------------------------------------------------------- +proc makestdgui {} { + hfactory /gui plain spy none + hfactory /gui/status plain internal text + status hdbinterest /gui/status +} +#------------------------------------------------------------ +proc makewait {path} { + hfactory $path command wait + hsetprop $path type command + hsetprop $path priv user + hfactory $path/time plain user int +} +#------------------------------------------------------------ +proc makeevproxy {rootpath hdbname devicename} { + MakeProxy p${devicename} $devicename float + p${devicename} map upperlimit upperlimit float user + p${devicename} map lowerlimit lowerlimit float user + hlink $rootpath p${devicename} $hdbname + hsetprop $rootpath/$hdbname sicsdev $devicename + hsetprop $rootpath/$hdbname type drivable + sicspoll add $rootpath/$hdbname hdb 30 +} +#================== multi motor stuff ======================= +proc getNamposList {mumo} { + set txt [$mumo list] + set l [split $txt "\n"] + set lala [llength $l] + for {set i 1} {$i < [llength $l]} {incr i} { + set pos [lindex $l $i] + if {[string length $pos] > 1} { + append result [lindex $l $i] "," + } + } + if { ![info exists result] } { +# clientput "nampos = $txt" + append result UNKNOWN + } + return [string trimright $result ","] +} +#------------------------------------------------------------ +proc getNamPos {mumo} { + set txt [$mumo find] + set l [split $txt =] + return [string trim [lindex $l 1]] +} +#----------------------------------------------------------- +proc updateNamePosValues {rootpath} { + hupdate $rootpath/namedposition/values + hupdate $rootpath/dropnamedposition/name/values +} +#------------------------------------------------------------ +proc makemumopos {mumo rootpath name} { + $mumo pos $name + updateNamePosValues $rootpath +} +#----------------------------------------------------------- +proc dropmumo {mumo rootpath name} { + $mumo drop $name + updateNamePosValues $rootpath +} +#------------------------------------------------------------ +proc getDropList {mumo} { + set txt [getNamposList $mumo] + append txt ",all" + return $txt +} +#------------------------------------------------------------- +proc makemumo {rootpath mumoname} { + hfactory $rootpath/namedposition script "getNamPos $mumoname" \ + $mumoname text + hsetprop $rootpath/namedposition priv user + hfactory $rootpath/namedposition/values script \ + "getNamposList $mumoname" hdbReadOnly text + hsetprop $rootpath/namedposition/values visible false + hupdate $rootpath/namedposition/values + hfactory $rootpath/assignname2current command \ + "makemumopos $mumoname $rootpath" + hsetprop $rootpath/assignname2current priv user + hsetprop $rootpath/assignname2current type command + hfactory $rootpath/assignname2current/name plain user text + hset $rootpath/assignname2current/name "Undefined" + hfactory $rootpath/dropnamedposition command \ + "dropmumo $mumoname $rootpath" + hsetprop $rootpath/dropnamedposition priv user + hsetprop $rootpath/dropnamedposition type command + hfactory $rootpath/dropnamedposition/name plain user text + hfactory $rootpath/dropnamedposition/name/values script \ + "getDropList $mumoname" hdbReadOnly text + hsetprop $rootpath/dropnamedposition/name/values visible false + hupdate $rootpath/dropnamedposition/name/values +} +#----------------------------------------------------------------- +proc hdbbatchpath {pathstring} { + exe batchpath $pathstring + catch {batchroot $pathstring} + catch {hupdate /instrument/commands/batch/execute/file/values} + catch {hupdate /instrument/commands/batch/batchpath} + catch {hupdate /instrument/experiment/batchpath} + catch {hupdate /batch/bufferlist} +} +#------------------------------------------------------------------ +proc makeexe {} { + set path /instrument/commands/batch + hfactory $path plain spy none + hfactory $path/batchpath script "exe batchpath" hdbbatchpath text + hsetprop $path/batchpath priv user + hfactory $path/execute command exe + hsetprop $path/execute type command + hsetprop $path/execute priv user + hfactory $path/execute/file plain user text + hfactory $path/execute/file/values script listbatchfiles hdbReadOnly text + sicspoll add $path/execute/file/values hdb 60 +} +#------------------------------------------------------------------ +proc confnxhdb {path alias pass} { + hsetprop $path nxalias $alias + hsetprop $path nxpass $pass +} +#---------------------------------------------------------------------- +proc hdbstorenexus args { + if {[llength $args] < 2} { + error "hdbstorenexus called with insufficient number of arguments" + } + set path [lindex $args 0] + set pass [lindex $args 1] + set childlist [split [hlist $path] \n] + foreach child $childlist { + if {[string length $child] < 1} { + continue + } + set status [catch {hgetpropval $path/$child nxpass} passval] + if {$status == 0} { + set status [catch {hgetpropval $path/$child nxslab} slabval] + # ------- slabbed writing + if {$status == 0 && [string first $pass $passval] >= 0} { + set slabsizes [eval $slabval [lrange $args 2 end]] + nxscript puthdbslab $path/$child [lindex $slabsizes 0] [lindex $slabsizes 1] + } + #--------- normal writing + if {[string first $pass $passval] >= 0} { + nxscript puthdb $path/$child + } + } + eval hdbstorenexus $path/$child $pass [lrange $args 2 end] + } +} +#===================== Syntactical sugar around hdbscan =================== +# center scan. A convenience scan for the one and only Daniel Clemens +# at TOPSI. Scans around a given center point. Requires the scan command +# for TOPSI to work. +# +# another convenience scan: +# sscan var1 start end var1 start end .... np preset +# scans var1, var2 from start to end with np steps and a preset of preset +# +# Mark Koennecke, August 1997 +# +# Reworked for hdbscan, Mark Koennecke, November 2008 +#----------------------------------------------------------------------------- +proc cscan { var center delta np preset } { +#------ start with some argument checking + set t [SICSType $var] + if { [string compare $t DRIV] != 0 } { + ClientPut [format "ERROR: %s is NOT drivable!" $var] + return + } + set t [SICSType $center] + if { [string compare $t NUM] != 0 } { + ClientPut [format "ERROR: %s is no number!" $center] + return + } + set t [SICSType $delta] + if { [string compare $t NUM] != 0 } { + ClientPut [format "ERROR: %s is no number!" $delta] + return + } + set t [SICSType $np] + if { [string compare $t NUM] != 0 } { + ClientPut [format "ERROR: %s is no number!" $np] + return + } + set t [SICSType $preset] + if { [string compare $t NUM] != 0 } { + ClientPut [format "ERROR: %s is no number!" $preset] + return + } + set mode [string trim [SplitReply [scan mode]]] +#-------- store command in lastscancommand + set txt [format "cscan %s %s %s %s %s" $var $center \ + $delta $np $preset] + catch {lastscancommand $txt} +#--------- calculate start and do scan + set start [expr $center - $np * $delta] + set ret [catch {hdbscan $var $start $delta [expr ($np * 2) + 1] $mode $preset} msg] + if { $ret != 0} { + error $msg + } else { + return $msg + } +} +#--------------------------------------------------------------------------- +proc sscan args { + scan clear +#------- check arguments: the last two must be preset and np! + set l [llength $args] + if { $l < 5} { + ClientPut "ERROR: Insufficient number of arguments to sscan" + return + } + set preset [lindex $args [expr $l - 1]] + set np [lindex $args [expr $l - 2]] + set t [SICSType $preset] + ClientPut $t + ClientPut [string first $t "NUM"] + if { [string compare $t NUM] != 0 } { + ClientPut [format "ERROR: expected number for preset, got %s" \ + $preset] + return + } + set t [SICSType $np] + if { [string compare $t NUM] != 0 } { + ClientPut [format "ERROR: expected number for np, got %s" \ + $np] + return + } +#--------- do variables + set nvar [expr ($l - 2) / 3] + for { set i 0 } { $i < $nvar} { incr i } { + set var [lindex $args [expr $i * 3]] + set t [SICSType $var] + if {[string compare $t DRIV] != 0} { + ClientPut [format "ERROR: %s is not drivable" $var] + return + } + set start [lindex $args [expr ($i * 3) + 1]] + set t [SICSType $start] + if { [string compare $t NUM] != 0 } { + ClientPut [format "ERROR: expected number for start, got %s" \ + $start] + return + } + set end [lindex $args [expr ($i * 3) + 2]] + set t [SICSType $end] + if { [string compare $t NUM] != 0 } { + ClientPut [format "ERROR: expected number for end, got %s" \ + $end] + return + } +#--------- do scan parameters + append scanvars $var "," + append scanstarts $start "," + set step [expr double($end - $start)/double($np-1)] + append scansteps $step "," + } +#------------- set lastcommand text + set txt [format "sscan %s" [join $args]] + catch {lastscancommand $txt} +#------------- start scan + set scanvars [string trim $scanvars ,] + set scanstarts [string trim $scanstarts ,] + set scansteps [string trim $scansteps ,] + set mode [string trim [SplitReply [scan mode]]] + set ret [catch {hdbscan $scanvars $scanstarts $scansteps $np $mode $preset} msg] + if {$ret != 0} { + error $msg + } else { + return $msg + } +} +#------------------------------------------------------------------------------ +proc splitScanVar {txt} { + set l1 [split $txt =] + set var [lindex $l1 0] + set vl [split $var .] + lappend result [lindex $vl 1] + lappend result [string trim [lindex $l1 1]] + lappend result [string trim [lindex $l1 2]] +} +#----------------------------------------------------------------------------- +proc scaninfo {} { + set novar [string trim [SplitReply [xxxscan noscanvar]]] + if {$novar == 0} { + return "0,1,NONE,0.,0.,default.dat" + } + append result "scaninfo = " + append result [string trim [SplitReply [xxxscan np]]] "," $novar + for {set i 0} {$i < $novar} {incr i} { + set vl [splitScanVar [xxxscan getvarpar $i]] + append result ", " [lindex $vl 0] + } + set vl [splitScanVar [xxxscan getvarpar 0]] + append result "," [lindex $vl 1] + append result "," [lindex $vl 2] + append result "," [SplitReply [xxxscan getfile]] + append result "," [SplitReply [sample]] + append result "," [sicstime] + append result "," [SplitReply [lastscancommand]] + return $result +} +#------------------------------------------------------------- +proc scan args { + if {[llength $args] < 1} { + error "Need keyword for scan" + } + set key [string trim [lindex $args 0]] + switch $key { + uuinterest { return [xxxscan uuinterest] } + pinterest {} + getcounts { set cts [SplitReply [xxxscan getcounts]] + return "scan.Counts = $cts" + } + mode { + if {[llength $args] > 1} { + return [counter mode [lindex $args 1]] + } else { + return [counter mode] + } + } + clear { + return [xxxscan clear] + } + default { + error "scan does not support keyword $key" + } + } +} +#------------------------------------------------------------- +proc makestddrive {path} { + hfactory $path command drive + hsetprop $path type command + hsetprop $path viewer mountaingumui.DriveEditor + hsetprop $path priv user + hfactory $path/motor plain user text + hsetprop $path/motor argtype drivable + hfactory $path/value plain user float +} diff --git a/site_ansto/instrument/pelican/config/tasmad/sicscommon/kt.sinqbck b/site_ansto/instrument/pelican/config/tasmad/sicscommon/kt.sinqbck new file mode 100644 index 0000000000000000000000000000000000000000..1ce43b1e7f112fff5d1de2e32129817732809621 GIT binary patch literal 498 zcmZQ&VqjpOiIoM3Nw2BI`*20fti8h^wq$R7iMP{00jxF zXChHOBZ=yP?s0AlIl;J7REt>mkfa{y9yIkfc*944L1M1Je$9hjyKYT6+gc^RZH0eB ksk0dG-;Xjxxew@{MQ1Jcyf6JNNtAkE_>!a^=pSVD06u1b>Hq)$ literal 0 HcmV?d00001 diff --git a/site_ansto/instrument/pelican/config/tasmad/sicscommon/motorhp.tcl b/site_ansto/instrument/pelican/config/tasmad/sicscommon/motorhp.tcl new file mode 100644 index 00000000..e2027e69 --- /dev/null +++ b/site_ansto/instrument/pelican/config/tasmad/sicscommon/motorhp.tcl @@ -0,0 +1,82 @@ +#--------------------------------------------------------------------------- +# These scripts save and load motor positions for EL734 motors connected +# directly to SICS through the terminal server. For all others, use +# David Madens el734_motor program +# +# Mark Koennecke, April 2004 +#------------------------------------------------------------------------- + +if { ![info exists motorhpscript] } { + set motorhpscript 1 + Publish motorinternsave Mugger + Publish motorsave Mugger + Publish motorload Mugger + Publish loadmotordir Mugger + Publish savemotorarray Mugger +} + +#---------------------------------------------------------------------- +# save motor parameters from controller, number to file described by +# file descriptor fd +#---------------------------------------------------------------------- +proc motorinternsave {controller number fd} { + lappend parlist mn ec ep a fd fm d e f g h j k l m q t v w z mem + puts $fd [format "%s send ec %d 0 0" $controller $number] + foreach e $parlist { + set data [$controller send $e $number] + puts $fd [format "%s send %s %d %s" $controller $e $number $data] + } +} +#---------------------------------------------------------------------- +# save a motor parameter set to a directory. The filename is automatically +# created in order to help motorload +#--------------------------------------------------------------------- +proc motorsave {controller number dirname} { + set filename [format "%s/%s%2.2d.par" $dirname $controller $number] + set f [open $filename w] + motorinternsave $controller $number $f + close $f +} +#---------------------------------------------------------------------------- +# Loading motor parameters. Because some of the commands change the position +# of the motor, the position is saved first and redefined after processing +# the data. It is assumed that the filename is in the format as made +# by motorsave. +#--------------------------------------------------------------------------- +proc motorload {filename} { + set fil [file tail $filename] + set ind [string last . $fil] + set number [string range $fil [expr $ind - 2] [expr $ind - 1]] + set controller [string range $fil 0 [expr $ind - 3]] + set pos [$controller send u $number] + fileeval $filename + $controller send uu $number $pos +} +#-------------------------------------------------------------------------- +# load a motor directory +#------------------------------------------------------------------------ +proc loadmotordir {dirname} { + set l [glob $dirname/*.par] + foreach e $l { + set ret [catch {motorload $e} msg] + if { $ret != 0} { + clientput "ERROR: failed to load $e with $msg" + } + } +} +#----------------------------------------------------------------------- +# save a whole array of motors. The array must have the following form: +# An entry: controllerlist conatins a list of all controllers +# There exists an entry with the controller name in the array which contains +# a list of motor number +#------------------------------------------------------------------------ +proc savemotorarray {motar dir} { + upvar $motar motorarray + set controllerList $motorarray(controllerlist) + foreach controller $controllerList { + set motlist $motorarray($controller) + foreach mot $motlist { + motorsave $controller $mot $dir + } + } +} diff --git a/site_ansto/instrument/pelican/config/tasmad/sicscommon/nxsupport.tcl b/site_ansto/instrument/pelican/config/tasmad/sicscommon/nxsupport.tcl new file mode 100644 index 00000000..04e6f0d9 --- /dev/null +++ b/site_ansto/instrument/pelican/config/tasmad/sicscommon/nxsupport.tcl @@ -0,0 +1,126 @@ +#=========================================================================== +# Support routines for scripting NeXus files with nxscript. +# +# Mark Koennecke, February 2003 +# Mark Koennecke, January 2004 +#========================================================================== +proc makeFileName args { + sicsdatanumber incr + set num [SplitReply [sicsdatanumber]] + set p [string trim [SplitReply [sicsdatapath]]] + set pre [string trim [SplitReply [sicsdataprefix]]] + set po [string trim [SplitReply [sicsdatapostfix]]] + return [format "%s%s%5.5d2003%s" $p $pre $num $po] +} +#========================================================================== +# new version, attending to the new 1000 grouping logic +proc newFileName args { + set ret [catch {nxscript makefilename} msg] + if {$ret != 0} { + clientput "ERROR: Misconfiguration of file writing variables" + clientput "Defaulting filename to emergency.hdf" + set fil emergency.hdf + } else { + set fil $msg + } + return $fil +} +#========================================================================== +proc writeFloatVar {alias var} { + set ret [catch {set val [SplitReply [$var]]} val] + if { $ret != 0} { + clientput [format "ERROR: failed to read %s, %s" $var $val] + return + } else { + set val [string trim $val] + set ret [catch {expr $val * 1.0} val] + if { $ret == 0} { + nxscript putfloat $alias [expr $val * 1.0 ] + } else { + clientput "ERROR: bad value $val when reading $var" + } + } +} +#========================================================================== +proc writeIntVar {alias var} { + set ret [catch {set val [SplitReply [$var]]} val] + if { $ret != 0} { + clientput [format "ERROR: failed to read %s, %s" $var $val] + return + } else { + set val [string trim $val] + set ret [catch {expr $val * 1.0} val] + if { $ret == 0} { + nxscript putint $alias [expr int($val * 1.0) ] + } else { + clientput "ERROR: bad value $val when reading $var" + } + } +} +#========================================================================= +proc writeTextVar {alias var} { + set ret [catch {$var} val] + if { $ret != 0} { + clientput [format "ERROR: failed to read %s" $var] + return + } else { + set index [string first = $val] + if {$index >= 0} { + set txt [string trim [string range $val [expr $index + 1] end]] + nxscript puttext $alias $txt + } else { + clientput [format "ERROR: failed to read %s" $var] + } + } +} +#======================================================================== +proc writeTextAttribute {attName var} { + set ret [catch {set val [SplitReply [$var]]} val] + if { $ret != 0} { + clientput [format "ERROR: failed to read %s" $var] + return + } else { + nxscript putglobal $attName [string trim $val] + } +} +#======================================================================= +proc writeStandardAttributes {fileName} { + nxscript putglobal file_name $fileName + nxscript putglobal file_time [sicstime] + writeTextAttribute instrument instrument + writeTextAttribute owner user + writeTextAttribute owner_telephone_number phone + writeTextAttribute owner_fax_number fax + writeTextAttribute owner_email email + writeTextAttribute owner_address address +} +#--------------------------------------------------------------------- +proc appendMotor {np motor alias} { + set val [SplitReply [$motor]] + __transfer putfloat 0 $val + nxscript putslab $alias [list $np] [list 1] __transfer +} +#--------------------------------------------------------------------- +proc appendFloat {np alias val} { + __transfer putfloat 0 $val + nxscript putslab $alias [list $np] [list 1] __transfer +} +#--------------------------------------------------------------------- +proc appendCount {np value alias} { + __transfer putint 0 $value + nxscript putslab $alias [list $np] [list 1] __transfer +} +#-------------------------------------------------------------------- +proc appendSampleEnv {np device alias} { +#--------- test for presence + set status [catch {SplitReply [$device]} val] + if {$status != 0} { + return + } +#--------- test for validity + set status [catch {expr $val * 1.0} msg] + if {$status != 0} { + return + } + appendFloat $np $alias $val +} diff --git a/site_ansto/instrument/pelican/config/tasmad/sicscommon/phytron.tcl b/site_ansto/instrument/pelican/config/tasmad/sicscommon/phytron.tcl new file mode 100644 index 00000000..f37bc9d2 --- /dev/null +++ b/site_ansto/instrument/pelican/config/tasmad/sicscommon/phytron.tcl @@ -0,0 +1,311 @@ +#------------------------------------------------------------------ +# This is driver for the combination Phytron MCC-2 Motor Controller +# and SICS using the scriptcontext asynchronous I/O system. The +# MCC-2 has a funny protocl as that messages are enclosed into +# data sequences. This protocol is handled by the +# C-language phytron protocol handler. Per default, the MCC-2 is +# configured to use 57600 baud. I have configured it to use 9600 +# baud and it ought to remember this. The command to change this +# 0IC1S9600, the command to read this is 0IC1R. +# +# So, if this thing does not work on a serial port then the solution is +# to set the terminal server to 57600 and try again. And set the baud rate +# or leave it. +# +# There are surely many ways to use the MCC-2. It supports two axes, X and Y. +# All examples below are given for X only. This driver uses it in +# this way: +# +# Nothing works properly without a reference run. The reference run is done +# in the following way: +# 1) Send it into the negative limit switch with 0X0- +# 2) Set the mechanical position with 0XP20Swert to the negative limit +# 3) Set the encoder position with 0XP22Swert to the negative limit +# +# Position ever afterwards with 0XAwert, read encoder with 0XP22R +# +# While driving 0X=H return ACKN, else ACKE +# +# Stopping goes via 0XSN +# +# copyright: see file COPYRIGHT +# +# Script chains: +# +# - reading position: +# readpos - posrcv +# +# - writing postion: +# setpos - setrcv +# +# - reading status: +# sendstatus - rcvstatus - statpos +# +# - reading speed: +# readspeed - rcvspeed +# +# - setting speed: +# writespeed - rcvwspeed - rcvspeed +# +# Mark Koennecke, June 2009 +# +# Added code to switch a brake on for schneider_m2 +# +# Mark Koennecke, September 2009 +# +# Added code to support the speed parameter +# +# Mark Koennecke, December 2009 +# +# Added more code to configure non encoder phytron motors which need to +# read another parameter for position +# +# Mark Koennecke, January 2011 +#------------------------------------------------------------------------- + +namespace eval phytron {} + +#----------------------------------------------------------------------- +proc phytron::check {} { + set data [sct result] + if {[string first AscErr $data] >= 0} { + error $data + } + return $data +} +#------------------------------------------------------------------------ +proc phytron::readpos {axis enc} { +# the following command must be P20R without encoder, P22R with encoder + if {$enc == 1} { + sct send "0${axis}P22R" + } else { + sct send "0${axis}P20R" + } + return posrcv +} +#------------------------------------------------------------------------ +proc phytron::posrcv {} { + set data [phytron::check] + set pos [string range $data 3 end] + sct update $pos + return idle +} +#------------------------------------------------------------------------ +proc phytron::setpos {axis name} { + set val [sct target] + sct send "0${axis}A$val" + hupdate /sics/${name}/status run + return setrcv +} +#------------------------------------------------------------------------ +proc phytron::setrcv {controller name} { + set data [phytron::check] + if {[string first NACK $data] >= 0} { + error "Invalid command" + } + $controller queue /sics/${name}/status progress read + return idle +} +#------------------------------------------------------------------------- +proc phytron::sendstatus {axis} { + sct send "0${axis}=H" + return rcvstatus +} +#------------------------------------------------------------------------- +proc phytron::rcvstatus {axis controller enc} { + set status [catch {phytron::check} data] + if {$status != 0} { + sct update error + clientput $error + } + if {[string first ACKN $data] >= 0} { + sct update run + $controller queue [sct] progress read + } + if {[string first ACKE $data] >= 0} { + phytron::readpos $axis $enc + return posrcv + } + return idle +} +#------------------------------------------------------------------------- +proc phytron::statpos {axis name} { + set data [phytron::check] + set pos [string range $data 3 end] + hupdate /sics/${name}/hardposition $pos + sct send "0${axis}=I+" + return statposlim +} +#------------------------------------------------------------------------ +proc phytron::statposlim {axis} { + set data [phytron::check] + if {[string first ACKE $data] >= 0} { + sct update error + clientput "Hit positive limit switch" + return idle + } + sct send "0${axis}=I-" + return statneglim +} +#------------------------------------------------------------------------ +proc phytron::statneglim {axis} { + set data [phytron::check] + if {[string first ACKE $data] >= 0} { + sct update error + clientput "Hit negative limit switch" + return idle + } + sct send "0${axis}=E" + return statend +} +#------------------------------------------------------------------------ +proc phytron::statend {axis} { + set data [phytron::check] + if {[string first ACKE $data] >= 0} { + sct update error + clientput "Electronics error" + return idle + } + sct update idle + return idle +} +#------------------------------------------------------------------------ +proc phytron::readspeed {axis} { + sct send "0${axis}P14R" + return rcvspeed +} +#------------------------------------------------------------------------ +proc phytron::rcvspeed {} { + set data [phytron::check] + set speed [string range $data 3 end] + sct update $speed + return idle +} +#------------------------------------------------------------------------ +proc phytron::writespeed {axis} { + set val [sct target] + sct send "0${axis}P14S$val" + return rcvwspeed +} +#------------------------------------------------------------------------ +proc phytron::rcvwspeed {axis} { + set data [phytron::check] + if {[string first NACK $data] >= 0} { + error "Invalid command" + } + return [phytron::readspeed $axis] +} +#------------------------------------------------------------------------- +proc phytron::halt {controller axis} { + $controller send "0${axis}SN" + return Done +} +#-------------------------------------------------------------------------- +proc phytron::refrun {name controller axis lowlim} { + set path /sics/${name}/status + $controller send "0${axis}0-" + hupdate $path run + set motstat run + wait 3 + while {[string compare $motstat run] == 0} { + $controller queue $path progress read + wait 1 + set motstat [string trim [hval $path]] + } + $controller transact "0${axis}P20S$lowlim" + $controller transact "0${axis}P22S$lowlim" + return Done +} +#------------------------------------------------------------------------- +proc phytron::defpos {controller axis value} { + $controller transact "0${axis}P20S$value" + $controller transact "0${axis}P22S$value" + return Done +} +#-------------------------------------------------------------------------- +proc phytron::make {name axis controller lowlim upperlim {enc 1}} { + MakeSecMotor $name + + hdel /sics/${name}/hardupperlim + hdel /sics/${name}/hardlowerlim + hfactory /sics/${name}/hardupperlim plain internal float + hfactory /sics/${name}/hardlowerlim plain internal float + $name hardlowerlim $lowlim + $name softlowerlim $lowlim + $name hardupperlim $upperlim + $name softupperlim $upperlim + + hsetprop /sics/${name}/hardposition read phytron::readpos $axis $enc + hsetprop /sics/${name}/hardposition posrcv phytron::posrcv + $controller poll /sics/${name}/hardposition 60 + + hsetprop /sics/${name}/hardposition write phytron::setpos $axis $name + hsetprop /sics/${name}/hardposition setrcv phytron::setrcv $controller $name + $controller write /sics/${name}/hardposition + + hsetprop /sics/${name}/status read phytron::sendstatus $axis + hsetprop /sics/${name}/status rcvstatus phytron::rcvstatus $axis $controller $enc + hsetprop /sics/${name}/status posrcv phytron::statpos $axis $name + hsetprop /sics/${name}/status statposlim phytron::statposlim $axis + hsetprop /sics/${name}/status statneglim phytron::statneglim $axis + hsetprop /sics/${name}/status statend phytron::statend $axis + $controller poll /sics/${name}/status 60 + + hfactory /sics/${name}/speed plain user float + hsetprop /sics/${name}/speed read "phytron::readspeed $axis" + hsetprop /sics/${name}/speed rcvspeed "phytron::rcvspeed" + hsetprop /sics/${name}/speed write "phytron::writespeed $axis" + hsetprop /sics/${name}/speed rcvwspeed "phytron::rcvwspeed $axis" + $controller poll /sics/${name}/speed 60 + $controller write /sics/${name}/speed + + $name makescriptfunc halt "phytron::halt $controller $axis" user + + $name makescriptfunc refrun "phytron::refrun $name $controller $axis $lowlim" user + + $name makescriptfunc sethardpos "phytron::defpos $controller $axis" user + hfactory /sics/${name}/sethardpos/value plain user float + + hupdate /sics/${name}/status idle + $controller queue /sics/${name}/hardposition progress read + $controller queue /sics/${name}/speed progress read +} +#=============================================================================================== +# At MORPHEUS there is a special table where one motor needs a brake. This requires a digital I/O +# to be disabled before driving and enabled after driving. The code below adds this feature to +# a phytron motor +#----------------------------------------------------------------------------------------------- +proc phytron::openset {out} { + sct send [format "0A%dS" $out] + return openans +} +#---------------------------------------------------------------------------------------------- +proc phytron::openans {axis name} { + after 100 + return [phytron::setpos $axis $name] +} +#---------------------------------------------------------------------------------------------- +proc phytron::outsend {axis out} { + set data [phytron::check] + if {[string first ACKE $data] >= 0} { + sct update error + clientput "Electronics error" + return idle + } + sct send [format "0A%dR" $out] + return outend +} +#---------------------------------------------------------------------------------------------- +proc phytron::outend {} { + sct update idle + return idle +} +#---------------------------------------------------------------------------------------------- +proc phytron::configureM2 {motor axis out} { + set path /sics/${motor} + hsetprop $path/hardposition write phytron::openset $out + hsetprop $path/hardposition openans phytron::openans $axis $motor + + hsetprop $path/status statend phytron::outsend $axis $out + hsetprop $path/status outend phytron::outend +} diff --git a/site_ansto/instrument/pelican/config/tasmad/sicscommon/pimotor.tcl b/site_ansto/instrument/pelican/config/tasmad/sicscommon/pimotor.tcl new file mode 100644 index 00000000..37bfee85 --- /dev/null +++ b/site_ansto/instrument/pelican/config/tasmad/sicscommon/pimotor.tcl @@ -0,0 +1,177 @@ +#---------------------------------------------------- +# This is a scriptcontext motor driver for the +# prehistoric Physik Instrumente DC-406, C-804 DC +# motor controller. +# +# copyright: see file COPYRIGHT +# +# Scriptchains: +# - read - readreply +# - write - writerepy +# - sendstatus - statusreply - statuspos +# - speedread - readreply +# - writespeed - speedreply +# - writenull - speedreply +# +# Mark Koennecke, November 2009, after the +# C original from 1998 +# Made to work, Mark Koennecke, January 2011 +#----------------------------------------------------- + +namespace eval pimotor {} +#---------------------------------------------------- +proc pimotor::read {num} { + sct send [format "%1.1dTP" $num] + return readreply +} +#---------------------------------------------------- +proc pimotor::readreply {} { + set result [sct result] + if {[string first ? $result] >= 0} { + error $result + } + if {[string first ERR $result] >= 0} { + error $result + } + set val [string range $result 3 end] + sct update $val + return idle +} +#---------------------------------------------------- +proc pimotor::write {num name} { + set ival [expr int([sct target])] +# After a stop, the motor is switched off. In order to fix this +# we switch the motor on for each drive command + sct send [format "%1.1dMN,%1.1dMA%10.10d{0}" $num $num $ival] + hupdate /sics/${name}/status run + return writereply +} +#---------------------------------------------------- +proc pimotor::writereply {name} { +# the DC-406 does not reply on this, so we have for sure a +# timeout here which we ignore. We do nothing else, as we +# need a little wait anyway to get the motor to start +# before starting to check status. +#---------------------------------------------------- + wait 1 + set con [sct controller] + hset /sics/${name}/status run + $con queue /sics/${name}/status progress read + return idle +} +#----------------------------------------------------- +proc pimotor::sendstatus {num} { + sct send [format "%1.1dTV" $num] + return statusreply +} +#------------------------------------------------------ +proc pimotor::statusreply {num} { + set result [sct result] + if {[string first ? $result] >= 0} { + sct update error + error $result + } + if {[string first ERR $result] >= 0} { + sct update error + error $result + } + set val [string trimleft [string range $result 3 13] "0-"] + set val [string trim $val] + if {[string length $val] > 1} { + set len [string length $val] + clientput "Value = $val, length = $len" + if {abs($val) > 0} { + sct update run + [sct controller] queue [sct] progress read + return idle + } + } + pimotor::read $num + return statuspos +} +#------------------------------------------------------ +proc pimotor::statuspos {name} { + set result [sct result] + if {[string first ? $result] >= 0} { + error $result + } + if {[string first ERR $result] >= 0} { + error $result + } + set val [string range $result 3 end] + hupdate /sics/${name}/hardposition $val + sct update idle + return idle +} +#------------------------------------------------------- +proc pimotor::readspeed {num} { + sct send [format "%1.1dTY" $num] + return readreply +} +#-------------------------------------------------------- +proc pimotor::writespeed {num} { + sct send [format "%1.1dSV%7.7d" $num [sct target]] + return speedreply +} +#---------------------------------------------------- +proc pimotor::speedreply {num} { + pimotor::readspeed $num + return readreply +} +#----------------------------------------------------- +proc pimotor::writenull {controller num} { + $controller send [format "%1.1dDH{0}" $num] + return Done +} +#------------------------------------------------------ +proc pimotor::writeon {controller num} { + $controller send [format "%1.1dMN{0}" $num] + return Done +} +#------------------------------------------------------ +proc pimotor::halt {controller num} { + $controller send [format "%1.1dAB{0}" $num] + return Done +} +#------------------------------------------------------ +proc pimotor::makepimotor {name num sct lowlim upperlim} { + MakeSecMotor $name + + hdel /sics/${name}/hardupperlim + hdel /sics/${name}/hardlowerlim + hfactory /sics/${name}/hardupperlim plain internal float + hfactory /sics/${name}/hardlowerlim plain internal float + $name hardlowerlim $lowlim + $name softlowerlim $lowlim + $name hardupperlim $upperlim + $name softupperlim $upperlim + + hsetprop /sics/${name}/hardposition read pimotor::read $num + hsetprop /sics/${name}/hardposition readreply pimotor::readreply + $sct poll /sics/${name}/hardposition 60 + + hsetprop /sics/${name}/hardposition write pimotor::write $num $name + hsetprop /sics/${name}/hardposition writereply pimotor::writereply $name + $sct write /sics/${name}/hardposition + + hsetprop /sics/${name}/status read pimotor::sendstatus $num + hsetprop /sics/${name}/status statusreply pimotor::statusreply $num + hsetprop /sics/${name}/status statuspos pimotor::statuspos $name + $sct poll /sics/${name}/status 60 + + hfactory /sics/${name}/speed plain user int + hsetprop /sics/${name}/speed read pimotor::readspeed $num + hsetprop /sics/${name}/speed readreply pimotor::readreply + $sct poll /sics/${name}/speed 120 + + hsetprop /sics/${name}/speed write pimotor::writespeed $num + hsetprop /sics/${name}/speed speedreply pimotor::speedreply $num + $sct write /sics/${name}/speed + + $name makescriptfunc halt "pimotor::halt $sct $num" user + $name makescriptfunc on "pimotor::writeon $sct $num" user + $name makescriptfunc home "pimotor::writenull $sct $num" user + + hupdate /sics/${name}/status idle + $sct queue /sics/${name}/hardposition progress read +} diff --git a/site_ansto/instrument/pelican/config/tasmad/sicscommon/secsim.tcl b/site_ansto/instrument/pelican/config/tasmad/sicscommon/secsim.tcl new file mode 100644 index 00000000..e418a23a --- /dev/null +++ b/site_ansto/instrument/pelican/config/tasmad/sicscommon/secsim.tcl @@ -0,0 +1,66 @@ +#--------------------------------------------------------------- +# This is a second generation simulation motor. +# +# copyright: see file COPYRIGHT +# +# Mark Koennecke, December 2008 +#---------------------------------------------------------------- +proc simhardset {motname newval} { + hset /sics/$motname/starttime [clock sec] +} +#-------------------------------------------------------------- +proc simhardget {motname} { + set stat [hval /sics/$motname/status] + set val [hval /sics/$motname/targetposition] + if {[string first run $stat] >= 0 \ + || [string first error $stat] >= 0 } { + return [expr $val -.777] + } else { + return $val + } +} +#------------------------------------------------------------- +proc simhardfaultget {motname} { + set val [hval /sics/$motname/targetposition] + return [expr $val - .5] +} +#-------------------------------------------------------------- +proc simstatusget {motname} { + set start [hval /sics/$motname/starttime] + if {$start < 0} { + return error + } + set delay [hval /sics/$motname/delay] + if {[clock sec] > $start + $delay} { + return idle + } else { + return run + } +} +#------------------------------------------------------------- +proc simstatusfault {motname } { + clientput "ERROR: I am feeling faulty!" + return error +} +#-------------------------------------------------------------- +proc simhalt {motname} { + hset /sics/$motname/starttime -100 +} +#--------------------------------------------------------------- +proc MakeSecSim {name lower upper delay} { + MakeSecMotor $name + hfactory /sics/$name/delay plain user text + hfactory /sics/$name/starttime plain user int + hset /sics/$name/delay $delay + hdel /sics/$name/hardposition + hfactory /sics/$name/hardposition script "simhardget $name" "simhardset $name" float +# hfactory /sics/$name/hardposition script "simhardfaultget $name" "simhardset $name" float + hdel /sics/$name/status + hfactory /sics/$name/status script "simstatusget $name" "hdbReadOnly b" text +# hfactory /sics/$name/status script "simstatusfault $name" "hdbReadOnly b" text + $name makescriptfunc halt "simhalt $name" user + hupdate /sics/$name/hardupperlim $upper + hupdate /sics/$name/softupperlim $upper + hupdate /sics/$name/hardlowerlim $lower + hupdate /sics/$name/softlowerlim $lower +} diff --git a/site_ansto/instrument/pelican/config/tasmad/sicscommon/simhm.tcl b/site_ansto/instrument/pelican/config/tasmad/sicscommon/simhm.tcl new file mode 100644 index 00000000..8785d093 --- /dev/null +++ b/site_ansto/instrument/pelican/config/tasmad/sicscommon/simhm.tcl @@ -0,0 +1,91 @@ +#----------------------------------------------------- +# This is a simulation driver for the second +# generation histogram memory. It provides +# for a fill value which is used to initialize +# data. +# +# copyright: see file COPYRIGHT +# +# Mark Koennecke, January 2010 +#----------------------------------------------------- +namespace eval simhm {} +#----------------------------------------------------- +proc simhm::getcontrol {name} { + return -9999.99 +} +#---------------------------------------------------- +proc simhm::setcontrol {name val} { + switch $val { + 1000 { + hset /sics/${name}/internalstatus run + set pp [hval /sics/${name}/preset] + hset /sics/${name}/finishtime [expr $pp + [clock seconds]] + return idle + } + 1001 { + hset /sics/${name}/internalstatus error + return idle + } + 1002 { + hset /sics/${name}/internalstatus pause + return idle + } + 1003 { + hset /sics/${name}/internalstatus run + return idle + } + 1005 { + return idle + } + default { + clientput "ERROR: bad start target $target given to control" + return idle + } + } +} +#---------------------------------------------------- +proc simhm::getstatus {name} { + set status [string trim [hval /sics/${name}/internalstatus]] + if {[string first run $status] >= 0} { + set fin [string trim [hval /sics/${name}/finishtime]] + if {[clock seconds] > $fin} { + hset /sics/${name}/internalstatus idle + set val [string trim [hval /sics/${name}/initval]] + $name set $val + set second [string trim [hval /sics/${name}/secondbank]] + if {[string compare $second NULL] != 0} { + harray /sics/${name}/${second} init $val + } + } + } + return $status +} +#----------------------------------------------------- +proc simhm::MakeSimHM {name rank {tof NULL} } { + MakeSecHM $name $rank $tof + hfactory /sics/${name}/initval plain user int + hset /sics/${name}/initval 0 + + hfactory /sics/${name}/finishtime plain user int + hfactory /sics/${name}/internalstatus plain user text + hupdate /sics/${name}/internalstatus idle + + hdel /sics/${name}/control + hfactory /sics/${name}/control script \ + "simhm::getcontrol $name" "simhm::setcontrol $name" float + hsetprop /sics/${name}/control priv user + + hdel /sics/${name}/status + hfactory /sics/${name}/status script \ + "simhm::getstatus $name" hdbReadOnly text + hsetprop /sics/${name}/control priv user + hupdate /sics/${name}/status idle + + hfactory /sics/${name}/secondbank plain user text + hupdate /sics/${name}/secondbank NULL +} +#------------------------------------------------------ +proc simhm::makeSecond {name bankname length} { + hfactory /sics/${name}/${bankname} plain user intvarar $length + hupdate /sics/${name}/secondbank $bankname +} diff --git a/site_ansto/instrument/pelican/config/tasmad/sicscommon/sinqhttp.tcl b/site_ansto/instrument/pelican/config/tasmad/sicscommon/sinqhttp.tcl new file mode 100644 index 00000000..1eff587c --- /dev/null +++ b/site_ansto/instrument/pelican/config/tasmad/sicscommon/sinqhttp.tcl @@ -0,0 +1,152 @@ +#-------------------------------------------------------- +# This is an asynchronous scriptcontext driven driver for +# the SINQ style http based histogram memory. +# +# script chains: +# -- control +# hmhttpcontrol - hmhttpreply +# -- data +# hmhttpdata - hmhttpreply +# -- status +# hmhttpstatus - hmhttpevalstatus -- hmhttpstatusdata +# +# copyright: see file COPYRIGHT +# +# Mark Koennecke, May 2009 +# +# You will need to override hmhttpevalstatus to implement +# an update of the detector data +# +# Mark Koennecke, April 2010 +#--------------------------------------------------------- +proc hmhttpsend {url} { + sct send $url + return hmhttpreply +} +#-------------------------------------------------------- +proc hmhttptest {data} { + if {[string first ASCERR $data] >= 0} { + error $data + } + if {[string first ERROR $data] >= 0} { + error $data + } + return $data +} +#-------------------------------------------------------- +proc hmhttpreply {} { + set reply [sct result] + set status [catch {hmhttptest $reply} data] + if {$status != 0} { + sct geterror $data + clientput $data + } else { + hdelprop [sct] geterror + } + return idle +} +#--------------------------------------------------------- +proc hmhttpcontrol {} { + set target [sct target] + switch $target { + 1000 { + set ret [hmhttpsend "/admin/startdaq.egi"] + set path [file dirname [sct]] + [sct controller] queue $path/status progress read + return $ret + } + 1001 {return [hmhttpsend "/admin/stopdaq.egi"] } + 1002 {return [hmhttpsend "/admin/pausedaq.egi"] } + 1003 {return [hmhttpsend "/admin/continuedaq.egi"]} + 1005 { + set path [file dirname [sct]] + set script [hval $path/initscript] + set confdata [eval $script] + return [hmhttpsend "post:/admin/configure.egi:$confdata"] + } + default { + sct print "ERROR: bad start target $target given to control" + return idle + } + } +} +#--------------------------------------------------------- +proc hmhttpdata {name} { + set len [hval /sics/${name}/datalength] + set path "/sics/${name}/data" + set com [format "node:%s:/admin/readhmdata.egi?bank=0&start=0&end=%d" $path $len] + sct send $com + return hmhttpdatareply +} +#-------------------------------------------------------- +proc hmhttpdatareply {} { + set status [catch {hmhttpreply} txt] + if {$status == 0} { + set path [file dirname [sct]] + hdelprop $path/data geterror + } + return idle +} +#-------------------------------------------------------- +proc hmhttpstatus {} { + sct send /admin/textstatus.egi + return hmhttpevalstatus +} +#------------------------------------------------------- +proc hmhttpstatusdata {} { + catch {hmhttpdatareply} + sct update idle + return idle +} +#--------------------------------------------------------- +proc hmhttpevalstatus {name} { + set reply [sct result] + set status [catch {hmhttptest $reply} data] + if {$status != 0} { + sct geterror $data + clientput $data + sct update error + return idle + } + hdelprop [sct] geterror + set lines [split $data \n] + foreach line $lines { + set ld [split $line :] + sct [string trim [lindex $ld 0]] [string trim [lindex $ld 1]] + } + set daq [sct DAQ] + set old [hval [sct]] + if {$daq == 1} { + sct update run + [sct controller] queue [sct] progress read + return idle + } else { + if {[string compare $old idle] != 0} { + hmhttpdata $name + return hmhttpstatusdata + } else { + return idle + } + } +} +#--------------------------------------------------------- +proc MakeHTTPHM {name rank host initscript {tof NULL} } { + sicsdatafactory new ${name}transfer + makesctcontroller ${name}sct sinqhttp $host ${name}transfer 600 spy 007 + MakeSecHM $name $rank $tof + hsetprop /sics/${name}/control write hmhttpcontrol + hsetprop /sics/${name}/control hmhttpreply hmhttpreply + ${name}sct write /sics/${name}/control + + hsetprop /sics/${name}/data read hmhttpdata $name + hsetprop /sics/${name}/data hmhttpdatareply hmhttpdatareply + ${name}sct poll /sics/${name}/data 120 + + hsetprop /sics/${name}/status read hmhttpstatus + hsetprop /sics/${name}/status hmhttpevalstatus hmhttpevalstatus $name + hsetprop /sics/${name}/status hmhttpstatusdata hmhttpstatusdata + ${name}sct poll /sics/${name}/status 60 + + hfactory /sics/${name}/initscript plain mugger text + hset /sics/${name}/initscript $initscript +} diff --git a/site_ansto/instrument/pelican/config/tasmad/sicscommon/stddrive.tcl b/site_ansto/instrument/pelican/config/tasmad/sicscommon/stddrive.tcl new file mode 100644 index 00000000..2df85a96 --- /dev/null +++ b/site_ansto/instrument/pelican/config/tasmad/sicscommon/stddrive.tcl @@ -0,0 +1,100 @@ +#------------------------------------------------------ +# This is some code for a standard drivable object in +# the scriptcontext system. It implements an empty +# object which throws errors when accessed. Users +# of such an object can override it to do +# something more acceptable. This object also +# provides for basic limit checking and status +# checking. It can serve as a basis for creating +# new drivable objects, for instance environment +# control devices. A possible user has as the +# first thing in a write script to set the target +# node to the desired value. +# +# copyright: see file COPYRIGHT +# +# Mark Koennecke, November 2009 +#-------------------------------------------------------- + +namespace eval stddrive {} + +proc stddrive::stdcheck {name} { + set val [sct target] + set upper [hval /sics/${name}/upperlimit] + set lower [hval /sics/${name}/lowerlimit] + if {$val < $lower || $val > $upper} { + error "$val is out of range $lower - $upper for $name" + } + return OK +} +#------------------------------------------------------- +proc stddrive::stdstatus {name} { + set test [catch {sct geterror} errortxt] + if {$test == 0} { + return fault + } + set stop [hval /sics/${name}/stop] + if {$stop == 1} { + return fault + } + set target [sct target] + set tol [hval /sics/${name}/tolerance] + set is [hval /sics/${name}] + if {abs($target - $is) < $tol} { + return idle + } else { + [sct controller] queue /sics/${name} progress read + return busy + } +} +#------------------------------------------------------- +proc stddrive::stop {name} { + hset /sics/${name}/stop 1 + return OK +} +#------------------------------------------------------- +proc stddrive::deread {} { + sct update -9999.99 + return idle +} +#-------------------------------------------------------- +proc stddrive::dewrite {name} { +# hset /sics/${name}/stop 1 + error "$name is not configured, cannot drive" +} +#-------------------------------------------------------- +proc stddrive::deconfigure {name} { + set allowed [list upperlimit lowerlimit tolerance stop] + set nodelist [split [hlist /sics/${name}] \n] + foreach node $nodelist { + if {[string length $node] < 1} { + continue + } + if {[lsearch -exact $allowed [string trim $node]] < 0} { + clientput "Deleting $node" + hdel /sics/${name}/${node} + } + } + hsetprop /sics/${name} read stddrive::deread + hsetprop /sics/${name} write stddrive::dewrite $name +} +#-------------------------------------------------------- +proc stddrive::makestddrive {name sicsclass sct} { + makesctdriveobj $name float user $sicsclass $sct + hfactory /sics/${name}/tolerance plain user float + hset /sics/${name}/tolerance 2.0 + hfactory /sics/${name}/upperlimit plain user float + hset /sics/${name}/upperlimit 300 + hfactory /sics/${name}/lowerlimit plain user float + hset /sics/${name}/lowerlimit 10 + hfactory /sics/${name}/stop plain user int + hset /sics/${name}/stop 0 + + hsetprop /sics/${name} checklimits stddrive::stdcheck $name + hsetprop /sics/${name} checkstatus stddrive::stdstatus $name + hsetprop /sics/${name} halt stddrive::stop $name + deconfigure $name + $sct write /sics/${name} + $sct poll /sics/${name} 60 + hupdate /sics/${name} -9999.99 +} diff --git a/site_ansto/instrument/pelican/config/tasmad/sicscommon/syncwrapper.pag b/site_ansto/instrument/pelican/config/tasmad/sicscommon/syncwrapper.pag new file mode 100644 index 00000000..266065d4 --- /dev/null +++ b/site_ansto/instrument/pelican/config/tasmad/sicscommon/syncwrapper.pag @@ -0,0 +1,8 @@ +#!/usr/bin/pagsh.openafs +dir=$1 +export KRB5CCNAME=`/bin/mktemp /tmp/sinqbckXXXXXX` +/usr/kerberos/bin/kinit -k -t $dir/kt.sinqbck sinqbck@PSI.CH +/usr/bin/aklog -c psi.ch -k PSI.CH +$dir/$2 +/usr/bin/unlog +/usr/kerberos/bin/kdestroy diff --git a/site_ansto/instrument/pelican/config/tasmad/sicscommon/table.tcl b/site_ansto/instrument/pelican/config/tasmad/sicscommon/table.tcl new file mode 100644 index 00000000..dba5878a --- /dev/null +++ b/site_ansto/instrument/pelican/config/tasmad/sicscommon/table.tcl @@ -0,0 +1,317 @@ +#---------------------------------------------------------------------- +# Support functions for table processing in SICS +# +# This includes a CSV processing module from someone else. See below. +# +# copyright: see file COPYRIGHT +# +# Mark Koennecke, November 2008 +#---------------------------------------------------------------------- +if { [info exists __tableheader] == 0 } { + set __tableheader NULL + Publish tableexe User + Publish loop User +} +#===================================================================== +# Csv tcl package version 2.0 +# A tcl library to deal with CSV (comma separated value) +# files, generated and readable by some DOS/Windows programs +# Contain two functions: +# csv2list string ?separator? +# and +# list2csv list ?separator? +# which converts line from CSV file to list and vice versa. +# +# Both functions have optional "separator argument" becouse some silly +# Windows +# program might use semicomon as delimiter in COMMA separated values +# file. +# +# Copyright (c) SoftWeyr, 1997-99 +# Many thanks to Robert Seeger +# for beta-testing and fixing my misprints +# This file is distributed under GNU Library Public License. Visit +# http://www.gnu.org/copyleft/gpl.html +# for details. + +# +# Convert line, read from CSV file into proper TCL list +# Commas inside quoted strings are not considered list delimiters, +# Double quotes inside quoted strings are converted to single quotes +# Double quotes are stripped out and replaced with correct Tcl quoting +# + +proc csv2list {str {separator ","}} { + #build a regexp> + set regexp [subst -nocommands \ + {^[ \t\r\n]*("(([^"]|"")*)"|[^"$separator \t\r]*)}] + set regexp1 [subst -nocommands {$regexp[ \t\r\n]*$separator\(.*)$}] + set regexp2 [subst -nocommands {$regexp[ \t\r\n]*\$}] + set list {} + while {[regexp $regexp1 $str junk1 unquoted quoted\ + junk2 str]} { + if {[string length $quoted]||$unquoted=="\"\""} { + regsub -all {""} $quoted \" unquoted + } + lappend list $unquoted + } + if {[regexp $regexp2 $str junk unquoted quoted]} { + if {[string length $quoted]||$unquoted=="\"\""} { + regsub -all {""} $quoted \" unquoted + } + lappend list $unquoted + if {[uplevel info exist csvtail]} { + uplevel set csvtail {""} + } + } else { + if {[uplevel info exist csvtail]} { + uplevel [list set csvtail $str] + } else { + return -code error -errorcode {CSV 1 "CSV parse error"}\ + "CSV parse error: unparsed tail \"$str\"" + } + } + return $list +} + +proc list2csv {list {separator ","}} { + set l {} + foreach elem $list { + if {[string match {} $elem]|| + [regexp {^[+-]?([0-9]+|([0-9]+\.?[0-9]*|\.[0-9]+)([eE][+-]?[0-9]+)?)$}\ + $elem]} { + lappend l $elem + } else { + regsub -all {"} $elem {""} selem + lappend l "\"$selem\"" + } + } + return [join $l $separator] +} + +proc csvfile {f {separator ","}} { + set csvtail "" + set list {} + set buffer {} + while {[gets $f line]>=0} { + if {[string length $csvtail]} { + set line "$csvtail\n$line" + } elseif {![string length $line]} { + lappend list {} + continue + } + set rec [csv2list $line $separator] + set buffer [concat $buffer $rec] + if {![ string length $csvtail]} { + lappend list $buffer + set buffer {} + } + } + if {[string length $csvtail]} { + return -code error -errorcode {CSV 2 "Multiline parse error"}\ + "CSV file parse error" + } + return $list +} + +proc csvstring {str {separator ","}} { + set csvtail "" + set list {} + set buffer {} + foreach line [split $str "\n"] { + if {[string length $csvtail]} { + set line "$csvtail\n$line" + } elseif {![string length $line]} { + lappend list {} + continue + } + set rec [csv2list $line $separator] + set buffer [concat $buffer $rec] + if {![ string length $csvtail]} { + lappend list $buffer + set buffer {} + } + } + if {[string length $cvstail]} { + return -code error -errorcode {CSV 2 "Multiline parse error"}\ + "CSV string parse error" + } + return $list +} + +package provide Csv 2.1 +#======================================================================== +# The plan here is such: operations which happen fast or immediatly are +# done at once. Count commands or anything given as command is appended +# to a list for later execution. The idea is that this contains the +# actual measuring payload of the row. +# Drivables are immediatly started. +# After processing the rows, there is a success to wait for motors to arrive +# Then the commands for later execution are run. This frees the user of the +# the necessity to have the count or whatever command as the last thing in the row +#-------------------------------------------------------------------------------- +proc testinterrupt {} { + set int [getint] + if {[string first continue $int] < 0} { + error "Interrupted" + } +} +#-------------------------------------------------------------------------------- +proc processtablerow {line} { + global __tableheader + set parlist [csv2list $line] + for {set i 0} {$i < [llength $__tableheader]} {incr i} { + set type [lindex $__tableheader $i] + set data [lindex $parlist $i] +#--------- first process special types + switch $type { + monitor { + lappend laterExe "count monitor $data" + continue + } + timer { + lappend laterExe "count timer $data" + continue + } + compar { + append command [join [lrange $parlist $i end]] + lappend laterExe $command + break + } + command { + lappend laterExe $data + continue + } + batch { + lappend laterExe "exe $data" + continue + } + } +#----------- now look for drivables + set test [sicstype $type] + if {[string compare $test DRIV] == 0} { + set status [catch {run $type $data} msg] + if {$status != 0} { + clientput "ERROR: $msg for $type with $data" + } + continue + } +#------------- now look for special objects + set objtype [sicsdescriptor $type] + switch $objtype { + SicsVariable - + MulMot - + Macro { + set status [catch {eval $type $data} msg] + if {$status != 0} { + clientput "ERROR: $msg for $type with $data" + } + continue + } + default { + clientput "Skipping non recognized column $type with data $data" + } + } + } + set status [catch {success} msg] + if {$status != 0} { + clientput "ERROR: $msg while waiting for motors to arrive" + } + testinterrupt + foreach command $laterExe { + eval $command + testinterrupt + } +} +#------------------------------------------------------------------------ +proc tableexe {tablefile} { + global __tableheader + if {[string first NULL $__tableheader] < 0} { + error "Tableexe already running, terminated" + } + set fullfile [SplitReply [exe fullpath $tablefile]] + set in [open $fullfile r] + gets $in header + set __tableheader [csv2list $header] + while {[gets $in line] > 0} { + set status [catch {processtablerow $line} msg] + if {$status != 0} { + set int [getint] + if {[string first continue $int] < 0} { + break + } else { + clientput "ERROR: $msg while processing row" + } + } + } + close $in + set __tableheader NULL + return "Done processing table" +} +#--------------------------------------------------------------------------- +proc loop args { + clientput $args + if {[llength $args] < 2} { + error \ +"Usage: loop \n\t number of repetions\n\t any SICS command" + } + set len [lindex $args 0] + set command [lrange $args 1 end] + for {set i 1} {$i <= $len} {incr i} { + clientput "Repetition $i of $len" + set status [catch {eval [join $command]} msg] + if {$status != 0} { + clientput "ERROR: $msg while processing loop command" + } + testinterrupt + } +} +#============================================================================== +# This is an old attempt +#============================================================================= +proc __tablescan__ args { + global __tableheader + + set idx [lsearch $__tableheader monitor] + if {$idx >= 0} { + set preset [lindex $args $idx] + set mode monitor + } + set idx [lsearch $__tableheader timer] + if {$idx >= 0} { + set preset [lindex $args $idx] + set mode timer + } + + set idx [lsearch $__tableheader scanvar] + if {$idx >= 0} { + set var [lindex $args $idx] + } else { + error "ERROR: No scan variable in table" + } + + set idx [lsearch $__tableheader scanstart] + if {$idx >= 0} { + set start [lindex $args $idx] + } else { + error "ERROR: No scan start in table" + } + + set idx [lsearch $__tableheader scanend] + if {$idx >= 0} { + set end [lindex $args $idx] + } else { + error "ERROR: No scan end in table" + } + + set idx [lsearch $__tableheader scanstep] + if {$idx >= 0} { + set step [lindex $args $idx] + } else { + error "ERROR: No scan step in table" + } + + set np [expr abs($end - $start)/$step] + xxxscan var $var $start $step + xxxscan run $np $mode $preset +} diff --git a/site_ansto/instrument/pelican/config/tasmad/sicscommon/tecs.tcl b/site_ansto/instrument/pelican/config/tasmad/sicscommon/tecs.tcl new file mode 100644 index 00000000..f022dd58 --- /dev/null +++ b/site_ansto/instrument/pelican/config/tasmad/sicscommon/tecs.tcl @@ -0,0 +1,23 @@ +#------------------------------------------------------------------------ +# tecs: a script to turn on and off temperature +# +# M. Zolliker, Jun 00 +#------------------------------------------------------------------------ + +#--------- some code to do proper initialization if necessary +set ret [catch {tecs} msg] +if {$ret != 0} { + Publish tecs User +} + +proc tecs { { arg1 "on"} { arg2 ""} { arg3 ""} } { + if {[string compare $arg1 "off"]==0 } { + evfactory del temperature + return "removed temperature" + } elseif {[string compare $arg1 "on"]==0 } { + evfactory new temperature tecs + return "installed temperature via TECS" + } else { + temperature $arg1 $arg2 $arg3 + } +} diff --git a/site_ansto/instrument/pelican/config/tasmad/taspub_sics/nxtas.tcl b/site_ansto/instrument/pelican/config/tasmad/taspub_sics/nxtas.tcl new file mode 100644 index 00000000..4aa6eb1b --- /dev/null +++ b/site_ansto/instrument/pelican/config/tasmad/taspub_sics/nxtas.tcl @@ -0,0 +1,348 @@ +#------------------------------------------------------------------------- +# Functions for writing NeXus files for a triple axis spectrometer and +# configuration of the internal scan object to support this. +# +# Mark Koennecke, May 2005 +# reworked to new NeXus standards, Mark Koennecke, February 2007 +#----------------------------------------------------------------------- +catch {sicsdatafactory new __transfer} +set __tasdata(out) "" +#---------------------------------------------------------------------- +proc appendMotor {np motor alias} { + set val [tasSplit [$motor]] + if { [string length $val] > 0} { + __transfer putfloat 0 $val + nxscript putslab $alias [list $np] [list 1] __transfer + } else { + clientput "WARNING: failed to read $motor" + } +} +#------------------------------------------------------------------ +proc appendIfPresent {np obj alias} { +# sea_get is defined in ~/sea/tcl/remob.tcl + set status [catch {sea_get val $obj} msg] + if {$status != 0} { + return + } + if {$msg} { + __transfer putfloat 0 $val + nxscript putslab $alias [list $np] [list 1] __transfer + } +} +#------------------------------------------------------------------ +proc appendFloat {np alias val} { + if {[string length $val] > 0} { + __transfer putfloat 0 $val + nxscript putslab $alias [list $np] [list 1] __transfer + } else { + clientput "WARNING: failed to read $alias" + } +} +#------------------------------------------------------------------- +proc appendCount {np value alias} { + __transfer putint 0 $value + nxscript putslab $alias [list $np] [list 1] __transfer +} +#-------------------------------------------------------------------- +proc donothing {obj userobj} { +} +#--------------------------------------------------------------------- +proc xmlprepare {obj userobj} { + global __tasdata +#------- normal prepare + tasscan prepare $obj $userobj + +#--------- parse out variable + set out [tasSplit [output]] + if {[string compare [string toupper $out] "UNKNOWN"]==0} { + set out "" + } + set out [string map { "=" " " "," " "} $out] + set outlist [split $out] + foreach var $outlist { + if { [string length $var] > 1} { + set ret [catch {tasSplit [$var]} msg] + if {$ret == 0} { + lappend __tasdata(out) $var + } + } + } +#------- build Header + append head " PNT " + set scanvars [split [tasSplit [iscan getscanvars]]] + foreach var $scanvars { + if { [string length $var] > 1} { + append head [format "%9s " [string toupper $var]] + } + } + foreach var $__tasdata(out) { + append head [format "%9s " [string toupper $var]] + } + append head [format "%8s " M1] + append head [format "%8s " M2] + append head [format "%8s " TIME] + append head [format "%8s " CNTS] + append head [format "%8s " CTOT] + clientput $head + + set __tasdata(starttime) [sicstime] + + xmltaswrite $obj $userobj +} +#-------------------------------------------------------------------- +proc xmlwritepoint {obj userobj np} { + global __tasdata scripthome + + nxscript reopen $__tasdata(file) $scripthome/tasub.dic + + append line [format " %3d" $np] + set scanvars [split [tasSplit [iscan getscanvars]]] + foreach var $scanvars { + if { [string length $var] > 1} { + set val [tasSplit [eval $var]] + append line [format "%9.4f " [tasSplit [$var]]] + appendMotor $np $var sc_$var + lappend storedvars $var + } + } + foreach var $__tasdata(out) { + append line [format "%9.4f " [tasSplit [eval $var]]] + appendMotor $np $var sc_$var + lappend storedvars $var + + } + + + append line [format "%8d " [tasSplit [counter getmonitor 1]]] + append line [format "%8d " [tasSplit [counter getmonitor 2]]] + append line [format "%8.2f " [tasSplit [counter gettime]]] + append line [format "%8d " [tasSplit [counter getcounts]]] + clientput $line + + appendCount $np [tasSplit [counter getcounts]] counts + appendCount $np [tasSplit [counter getmonitor 1]] cter_01 + appendCount $np [tasSplit [counter getcounts]] cter_02 + appendFloat $np motime [tasSplit [counter gettime]] + + set varlist [list qh qk ql qm en ei ef a1 a2 a3 a4 a5 a6 sgu sgl] + + foreach var $varlist { + if {[lsearch $storedvars $var] < 0} { + appendMotor $np $var sc_${var} + } + } + + if {$np == 0} { + makeTASLinks + } + + nxscript close +} +#====================== actual XML stuff ============================ +proc writeUserData {} { + writeTextVar usnam user + writeTextVar usaff affiliation + writeTextVar usadd address + writeTextVar usmail email + writeTextVar lonam local +} +#------------------------------------------------------------------- +proc writeMonochromator {} { + global __tasdata + nxscript puttext mono_type "Pyrolytic Graphite" + appendMotor 0 mcv sc_mcv + nxscript putfloat mono_dd [tasSplit [tasub mono dd]] +} +#------------------------------------------------------------------- +proc writeAnalyzer {} { + global __tasdata + nxscript puttext ana_type "Pyrolytic Graphite" + nxscript putfloat ana_dd [tasSplit [tasub ana dd]] + set sa [tasSplit [tasub ss]] + if {$sa == 1} { + set az 0. + } else { + set az 180. + } + nxscript putfloat ana_az $az +} +#------------------------------------------------------------------- +proc writeDetector {} { + global __tasdata + set sa [tasSplit [tasub ana ss]] + if {$sa == 1} { + set az 0. + } else { + set az 180. + } + nxscript putfloat det_az $az +} +#------------------------------------------------------------------- +proc writeMonitor {} { + nxscript putcounter cter counter +} +#----------------------------------------------------------------- +proc writeSample {} { + global __tasdata + tasscan nxdump nxscript sa + writeTextVar sanam sample + set sa [tasSplit [tasub mono ss]] + if {$sa == 1} { + set az 0. + } else { + set az 180. + } + nxscript putfloat saaz $az +} +#----------------------------------------------------------------- +proc writePowderSample {} { + global __tasdata + tasscan nxdump nxscript sa + writeTextVar sanam sample + set sa [tasSplit [tasub mono ss]] + if {$sa == 1} { + set az 0. + } else { + set az 180. + } + nxscript putfloat saaz $az +} +#------------------------------------------------------------------ +proc makeTASLinks {} { + nxscript makelink dana sc_ei + nxscript makelink dana sc_ef + nxscript makelink dana sc_qh + nxscript makelink dana sc_qk + nxscript makelink dana sc_ql + nxscript makelink dana sc_en + nxscript makelink dana counts +} +#------------------------------------------------------------------ +proc makePowderLinks {} { + nxscript makelink dana sc_ei + nxscript makelink dana sc_ef + nxscript makelink dana sc_qm + nxscript makelink dana sc_en + nxscript makelink dana counts +} +#------------------------------------------------------------------- +proc makeScanLinks {} { + set alreadyLinked [list sc_ei sc_ef sc_qh sc_qf sc_qk sc_en sc_qm] + set nscan [tasSplit [iscan noscanvar]] + set axis 0 + for {set i 0} {$i < $nscan} {incr i } { + set varpar [iscan getvarpar $i] + set l [split $varpar =] + set var [lindex $l 0] + set idx [string first . $var] + set var [string range $var [expr $idx + 1] end] + set alias [format "sc_%s" [string trim $var]] + set testalias [string trim [tasSplit [nxscript isalias $alias]]] + if {[lsearch $alreadyLinked $alias] < 0} { + if {$testalias == 1} { + nxscript makelink dana $alias + } + } + if {$axis == 0} { + set step [string trim [lindex $l 2]] + if {abs($step) > .001} { + if {$testalias == 1} { + nxscript putattribute $alias axis 1 + set axis 1 + } + } + } + } +# if axis = 0 there is no alias; so we create something in here from the +# scan data in iscan + if {$axis == 0} { + set data [tasSplit [iscan getvardata 0]] + set count 0 + foreach e $data { + set ar($count) [string trim $e] + incr count + } + nxscript putarray danascanvar ar [llength $data] + } +} +#-------------------------------------------------------------------- +proc xmltaswrite {obj userobj} { + global home __tasdata + + set fil [string trim [tasSplit [iscan getfile]]] + nxscript createxml $fil $home/tasub.dic + set __tasdata(file) $fil + + writeTextVar etitle title + nxscript puttext estart $__tasdata(starttime) + nxscript puttext eend [sicstime] + nxscript puttext edef NXmonotas + nxscript putglobal file_name $fil + nxscript putglobal file_time [sicstime] + + nxscript updatedictvar NP [tasSplit [iscan np]] + nxscript updatedictvar INSTRUMENT [tasSplit [instrument]] + + writeUserData + + writeMonochromator + + writeMonitor + + writeSample + + writeAnalyzer + + writeDetector + + + nxscript close +} +#-------------------------------------------------------------------- +proc xmlpowderwrite {obj userobj} { + global home __tasdata + + set fil [string trim [tasSplit [iscan getfile]]] + nxscript createxml $fil $home/tasub.dic + set __tasData(file) $fil + + writeTextVar etitle title + nxscript puttext estart $__tasdata(starttime) + nxscript puttext eend [sicstime] + nxscript puttext edef NXmonotas + nxscript putglobal file_name $fil + nxscript putglobal file_time [sicstime] + + nxscript updatedictvar NP [tasSplit [iscan np]] + nxscript updatedictvar INSTRUMENT [tasSplit [instrument]] + + writeUserData + + writeMonochromator + + writeMonitor + + writePowderSample + + writeAnalyzer + + writeDetector + + makePowderLinks + + nxscript close +} +#-------------------------------------------------------------------- +proc xmlfinish {obj userobj} { +} +#---------------------------------------------------------------------- +proc initxmlscan {} { + iscan configure script + iscan function writeheader donothing + iscan function prepare xmlprepare + iscan function drive tasscan drive + iscan function count tasscan count + iscan function collect tasscan collect + iscan function writepoint xmlwritepoint + iscan function finish xmlfinish +} diff --git a/site_ansto/instrument/pelican/config/tasmad/taspub_sics/tas.dic b/site_ansto/instrument/pelican/config/tasmad/taspub_sics/tas.dic new file mode 100644 index 00000000..029180fe --- /dev/null +++ b/site_ansto/instrument/pelican/config/tasmad/taspub_sics/tas.dic @@ -0,0 +1,83 @@ +##NXDICT-1.0 +#----------------------------------------------------------------------- +# NeXus dictionary file for a triple axis spectrometer following +# the instrument definition as of May 2005 +# +# Do not modify this file if you do not knwo what you are doing, +# you may corrupt your data files! +# +# Mark Koennecke, May 2005 +#---------------------------------------------------------------------- +NP=1 +INSTRUMENT=TASUB +#--------- entry level +etitle=/entry1,NXentry/SDS title -type NX_CHAR -rank 1 +estart=/entry1,NXentry/SDS start_time -type DFNT_CHAR -rank 1 +eend=/entry1,NXentry/SDS end_time -type DFNT_CHAR -rank 1 +edef=/entry1,NXentry/SDS definition -type DFNT_CHAR -rank 1 \ + -attr {URL,http://www.nexus.anl.gov/instruments/xml/NXmonotas.xml} \ + -attr {version,1.0} +#---------- looser +usnam=/entry1,NXentry/user,NXuser/SDS name -type NX_CHAR -rank 1 +usaff=/entry1,NXentry/user,NXuser/SDS affiliation -type NX_CHAR -rank 1 +usadd=/entry1,NXentry/user,NXuser/SDS address -type NX_CHAR -rank 1 +usmail=/entry1,NXentry/user,NXuser/SDS email -type NX_CHAR -rank 1 +#---------- local contact +lonam=/entry1,NXentry/local_contact,NXuser/SDS name -type NX_CHAR -rank 1 +#------------- sample +sanam=/entry1,NXentry/sample,NXsample/SDS name -type NX_CHAR -rank 1 +sa_cell=/entry1,NXentry/sample,NXsample/SDS unit_cell -rank 1 -dim {6} +sa_norm=/entry1,NXentry/sample,NXsample/SDS plane_normal -rank 1 -dim {3} +sa_vec1=/entry1,NXentry/sample,NXsample/SDS plane_vector_1 -rank 1 -dim {3} +sa_vec2=/entry1,NXentry/sample,NXsample/SDS plane_vector_2 -rank 1 -dim {3} +sa_ub=/entry1,NXentry/sample,NXsample/SDS orientation_matrix -rank 2 \ + -dim {3,3} +sapol=/entry1,NXentry/sample,NXsample/SDS polar_angle \ + -rank 1 -attr {units,degree} +saa3=/entry1,NXentry/sample,NXsample/SDS rotation_angle \ + -rank 1 -attr {units,degree} +sasgl=/entry1,NXentry/sample,NXsample/SDS sgl \ + -rank 1 -attr {units,degree} +sasgu=/entry1,NXentry/sample,NXsample/SDS sgu \ + -rank 1 -attr {units,degree} +saqh=/entry1,NXentry/sample,NXsample/SDS Qh -rank 1 +saqk=/entry1,NXentry/sample,NXsample/SDS Qk -rank 1 +saql=/entry1,NXentry/sample,NXsample/SDS Ql -rank 1 +saqm=/entry1,NXentry/sample,NXsample/SDS Qm -rank 1 +saen=/entry1,NXentry/sample,NXsample/SDS energy_transfer -rank 1 \ + -attr {units,mev} +saaz=/entry1,NXentry/sample,NXsample/SDS azimuthal_angle -attr {units,degree} +#----------- monochromator +mono_type=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS type -type NX_CHAR -rank 1 +mono_e=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS energy -rank 1 -dim {$(NP)} \ + -attr {units,mev} +mono_theta=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS rotation_angle \ + -rank 1 -dim {$(NP)} -attr {units,degree} +mono_dd=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS d_spacing -attr {units,Angstroem} +#----------- analyzer +ana_type=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS type -type NX_CHAR -rank 1 +ana_e=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS energy -rank 1 -dim {$(NP)} \ + -attr {units,mev} +ana_theta=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS rotation_angle \ + -rank 1 -dim {$(NP)} -attr {units\,degree} +ana_pol=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS polar_angle -rank 1 -dim {$(NP)} \ + -attr {units,degree} +ana_dd=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS d_spacing -attr {units,Angstroem} +ana_az=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS azimuthal_angle -attr {units,degree} +#--------- detector +det_pol=/entry1,NXentry/$(INSTRUMENT),NXinstrument/detector,NXdetector/SDS polar_angle -rank 1 -dim {$(NP)} \ + -attr {units,degree} +counts=/entry1,NXentry/$(INSTRUMENT),NXinstrument/detector,NXdetector/SDS counts -type NX_INT32 -rank 1 -dim {$(NP)} \ + -attr {units,degree} -attr {signal,1} +det_az=/entry1,NXentry/$(INSTRUMENT),NXinstrument/detector,NXdetector/SDS azimuthal_angle -attr {units,degree} +#------- monitors +cter_mode=/entry1,NXentry/control,NXmonitor/SDS mode -type NX_CHAR -rank 1 -dim {30} +cter_preset=/entry1,NXentry/control,NXmonitor/SDS preset +motime=/entry1,NXentry/control,NXmonitor/SDS time -attr {units,seconds} -rank 1 -dim {$(NP)} +mo01=/entry1,NXentry/control,NXmonitor/SDS data -type NX_INT32 -rank 1 -dim {$(NP)} +mo02=/entry1,NXentry/sample_stage,NXmonitor/SDS data -type NX_INT32 -rank 1 -dim {$(NP)} +#------- NXdata +dana=/entry1,NXentry/data,NXdata/NXVGROUP + + + diff --git a/site_ansto/instrument/pelican/config/tasmad/taspub_sics/tas.hdd b/site_ansto/instrument/pelican/config/tasmad/taspub_sics/tas.hdd new file mode 100644 index 00000000..c8686d07 --- /dev/null +++ b/site_ansto/instrument/pelican/config/tasmad/taspub_sics/tas.hdd @@ -0,0 +1,19 @@ +*************************** TOPSI Data File ******************************** +Title = !!VAR(Title)!! +User = !!VAR(User)!! +File Creation Stardate: !!DATE!! +**************************************************************************** +Monochromator Lamda = !!DRIV(lambda)!! +Monochromator A1 = !!DRIV(A1)!! +Monochromator A2 = !!DRIV(A2)!! +---------------------------------------------------------------------------- +Sample STL = !!DRIV(STL)!! +Sample STU = !!DRIV(STU)!! +Sample SGL = !!DRIV(SGL)!! +Sample SGU = !!DRIV(SGU)!! +Zero STL = !!ZERO(STL)!! +Zero STU = !!ZERO(STU)!! +Zero SGL = !!ZERO(SGL)!! +Zero SGU = !!ZERO(SGU)!! +!!SCANZERO!! +**************************** DATA ****************************************** diff --git a/site_ansto/instrument/pelican/config/tasmad/taspub_sics/tasp.tcl b/site_ansto/instrument/pelican/config/tasmad/taspub_sics/tasp.tcl new file mode 100644 index 00000000..997712df --- /dev/null +++ b/site_ansto/instrument/pelican/config/tasmad/taspub_sics/tasp.tcl @@ -0,0 +1,286 @@ +# -------------------------------------------------------------------------- +# Initialization script for Triple Axis Instruments using the +# Mark Lumsden UB matrix calculus +# +# Dr. Mark Koennecke, May 2005 +#--------------------------------------------------------------------------- +# O P T I O N S +#-------------------------------------------------------------------------- +# simMode +# - 0 real instrument +# - 1 development simulation +# - 2 simserver at instrument +#-------------------------------------------------------------------------- +set simMode 1 + +set ts psts230.psi.ch +set mupad 0 + +#---------- Enable this for more startup debugging +protocol set all + +#--------------- define home +if {$simMode == 1} { + set home $env(HOME)/src/workspace/sics/sim/taspub_sics + set scripthome $home + set loghome $env(HOME)/src/workspace/sics/sim/tmp + set datahome $loghome + ServerOption LoggerDir $env(HOME)/src/workspace/sics/test/samenv +} else { + set home /home/taspub + set scripthome $home/taspub_sics + set loghome $home/log + set datahome $home/data/2010 + ServerOption LoggerDir $home/sea/logger +} + +#ServerOption RedirectFile $loghome/stdtas + +ServerOption ReadTimeOut 10 + +ServerOption AcceptTimeOut 10 + +ServerOption ReadUserPasswdTimeout 500000 + +ServerOption LogFileBaseName $loghome/tasplog + +ServerOption ServerPort 2911 + +ServerOption InterruptPort 2917 + +ServerOption LogFileDir $loghome + +ServerOption QuieckPort 2108 + +ServerOption statusfile $datahome/taspubstat.tcl + +# Telnet Options +ServerOption TelnetPort 1301 +ServerOption TelWord sicslogin +#--------------------------------------------------------------------------- +# U S E R S + +# Here the SICS users are specified +# Syntax: SicsUser name password userRightsCode +#SicsUser Spy 007 3 +#--------------------------------------------------------------------------- +SicsUser Spy 007 1 +SicsUser Manager Manager 1 +SicsUser lnsmanager lnsSICSlns 1 +SicsUser user 10lns1 2 +SicsUser taspuser 10lns1 2 +#--------------------------------------------------------------------------- +# M O T O R S + +if {$simMode == 0} { + +MakeRS232Controller mota $ts 3002 +mota replyterminator 0xd +mota timeout 1000 +mota send "RMT 1" +mota send "ECHO 0" +mota send "RMT 1" +mota send "ECHO 0" +#mota debug 1 + +Motor A1 el734hp mota 1 # Monochromator Theta +a1 interruptmode 1 +Motor A2 el734hp mota 9 # Monochromator Two-Theta +a2 interruptmode 1 +Motor A3 el734hp mota 10 # Sample theta or omega +a3 interruptmode 1 +Motor A4 el734hp mota 11 # Sample Two-Theta +a4 interruptmode 1 +Motor MCV el734hp mota 3 # Monochromator curvature vertical +Motor SRO el734hp mota 12 # Sample table second ring +Motor MTL el734hp mota 4 # Monochromator translation lower +Motor MTU el734hp mota 5 # Monochromator Translation upper +Motor MGL el734hp mota 7 # Monochromator lower goniometer + + +MakeRS232Controller motb $ts 3003 +motb replyterminator 0xd +motb timeout 1000 +motb send "RMT 1" +motb send "ECHO 0" +motb send "RMT 1" +motb send "ECHO 0" + +Motor A5 el734hp motb 5 # Analyzer Theta +a5 interruptmode 1 +Motor A6 el734hp motb 9 # Analyzer Two-Theta +a6 interruptmode 1 +Motor ACH el734hp motb 6 # Analyzer curvature horizontal +Motor STL el734hp motb 1 # Sample lower translation +Motor STU el734hp motb 2 # Sample upper translation +Motor ATL el734hp motb 7 # Analyzer lower translation +Motor ATU el734hp motb 8 # Analyzer upper translation +#Motor SGL SIM -17 17 -1 .0 # Monochromator upper goniometer +#Motor SGU SIM -17 17 -1 .0 # Monochromator upper goniometer +Motor SGL el734hp motb 3 # Sample lower goniometer +Motor SGU el734hp motb 4 # Sample upper goniometer +Motor AGL el734hp motb 11 # Analyzer lower goniometer +#Motor AGU SIM -30. 30. -.1 2. # Analyzer upper goniometer +#Motor MSC SIM -30. 30. -.1 2. # Monochromator changer +#Motor ASC SIM -30. 30. -.1 2. # Analyzer changer +#Motor CSC SIM -30. 30. -.1 2. # Collimator changer +mcv precision .1 +} else { +Motor A1 sim -86.7 6.1 -.1 .1 # Monochromator Theta +Motor A2 sim -128.5 -21.65 -.1 .1 # Monochromator Two-Theta +Motor A3 sim -179 170 -.1 .1 # Sample theta or omega +Motor A4 sim -135 137.9 -.1 .1 # Sample Two-Theta +Motor A5 sim -103 103 -.1 .1 # Analyzer Theta +Motor A6 sim -138 118 -.1 .1 # Analyzer Two-Theta +Motor MCV sim -9 124 -.1 .1 # Monochromator curvature vertical +Motor SRO sim -180 351 -.1 .1 # Sample table second ring +Motor ACH sim -.5 11 -.1 .1 # Analyzer curvature horizontal +Motor MTL sim -17 17 -.1 .1 # Monochromator translation lower +Motor MTU sim -17 17 -.1 .1 # Monochromator Translation upper +Motor SGL sim -19 19 -1. 0 # Sample lower translation +Motor SGU SIM -30. 30. -.1 2. # Sample upper translation +Motor ATL sim -17 17 -.1 .1 # Analyzer lower translation +Motor ATU sim -17 17 -.1 .1 # Analyzer upper translation +Motor MGL sim -10 10 -.1 .1 # Monochromator lower goniometer +Motor SGL sim -16 16 -.1 .1 # Sample lower goniometer +Motor SGU sim -16 16 -.1 .1 # Sample upper goniometer +Motor AGL sim -10 10 -.1 .1 # Analyzer lower goniometer + +#-------------------------------------------------------------------------- +# C U R R E N T S +Motor I1 sim -2 2 -0.1 0.1 +Motor I2 sim -2 2 -0.1 0.1 +Motor I3 sim -2 2 -0.1 0.1 +Motor I4 sim -2 2 -0.1 0.1 +Motor I5 sim -2 2 -0.1 0.1 +Motor I6 sim -2 2 -0.1 0.1 +Motor I7 sim -2 2 -0.1 0.1 +Motor I8 sim -2 2 -0.1 0.1 + +} + +#--------- script for saving motor parameters +Publish savemotorpar Mugger +proc savemotorpar {dir} { + set mot(controllerlist) [list mota motb] + set mot(mota) [list 1 9 10 11 3 12 4 5 7] + set mot(motb) [list 5 9 6 1 2 7 8 3 4 11] + savemotorarray mot $dir + clientput "Done saving motor parameters" +} + +#-------------------------------------------------------------------------- +# C O U N T E R +#-------------------------------------------------------------------------- +if {$simMode == 0} { +MakeCounter counter el737hp $ts 3004 +} else { +MakeCounter counter sim -1. +} +#-------------------------------------------------------------------------- +VarMake instrument Text Mugger +instrument TASPUB +instrument lock + +VarMake title Text User +VarMake user Text User +VarMake affiliation Text User +VarMake address Text User +VarMake email Text User +VarMake lastscancommand Text User +VarMake output Text User +VarMake local Text User +VarMake sample Text User +#-------------------------------------------------------------------------- +# I N S T A L L M U P A D +#------------------------------------------------------------------------- +if {$mupad == 1} { +source $scripthome/mupad.tcl +# new mupad commands by M.Z. +set mudata(sim) 0 +source $scripthome/muco.tcl +source $scripthome/stddrive.tcl +source $scripthome/slsecho.tcl +if {$simMode == 0} { +makesctcontroller slssct slsecho taspmagnet:5001 +slsecho::makeslsecho i1 0 slssct +slsecho::makeslsecho i2 1 slssct +slsecho::makeslsecho i3 2 slssct +slsecho::makeslsecho i4 3 slssct +slsecho::makeslsecho i5 4 slssct +slsecho::makeslsecho i6 5 slssct +} +} + +#------------------------------------------------------------------------ +# Polarisation file +VarMake polfile Text User +#------------------------------------------------------------------------- +# Datafile generation variables +VarMake SicsDataPath Text Mugger +SicsDataPath "$datahome/" +sicsdatapath lock +VarMake SicsDataPrefix Text Mugger +SicsDataPrefix taspub +SicsDataPrefix lock +VarMake SicsDataPostFix Text Mugger +SicsDataPostFix ".xml" +#SicsDataPostFix ".scn" +SicsDataPostFix lock +MakeDataNumber SicsDataNumber "$datahome/DataNumber" +#---------------------------------------------------------------------- +# Collimation etc. parameters +#---------------------------------------------------------------------- +VarMake alf1 Float User +VarMake alf2 Float User +VarMake alf3 Float User +VarMake alf4 Float User +VarMake bet1 Float User +VarMake bet2 Float User +VarMake bet3 Float User +VarMake bet4 Float User +VarMake ETAM Float User +VarMake ETAS Float User +VarMake ETAA Float User +#----------------------------------------------------------------------- +# A helper variable for the status display +#----------------------------------------------------------------------- +VarMake scaninfo text Internal +scaninfo "0,Unknown,1.0,.1" +#------------------------------------------------------------------------ +# I N S T A L L S P E C I A L T A S C O M M A N D S +#------------------------------------------------------------------------ +MakeTasUB tasub +#--------------------------- TAS scan command +MakeScanCommand iscan counter tas.hdd recover.bin +MakePeakCenter iscan +MakeTasScan iscan tasub +#-------------------------- new exe manager +definealias do exe +alias batchroot exe batchpath +#-------------------------- normal drive command +MakeDrive +#-------------------------- for NeXus +MakeNXScript +#------------------------------------------------------------------------ +# I N S T A L L T A S U B S C R I P T E D C O M M A N D S +#------------------------------------------------------------------------ +source $scripthome/taspubcom.tcl + +#-------------------------------------------------------------------------- +# stuff for sea + +if {$simMode == 0} { +definealias tem temperature +source $home/sea/tcl/remob.tcl +connect_sea +#------------------------------------------------------------------------- +# SPS to look at guide field +#------------------------------------------------------------------------ +MakeSPS sps $ts 3006 10 + +} + +restore + +sicscron 10 backupCron $datahome/statusHistory diff --git a/site_ansto/instrument/pelican/config/tasmad/taspub_sics/taspubcom.tcl b/site_ansto/instrument/pelican/config/tasmad/taspub_sics/taspubcom.tcl new file mode 100644 index 00000000..71101b08 --- /dev/null +++ b/site_ansto/instrument/pelican/config/tasmad/taspub_sics/taspubcom.tcl @@ -0,0 +1,47 @@ +#--------------------------------------------------------------------------- +# The triple axis people love to have the command set emulate the command +# set of TASMAD as closely as possible. This is implemented through +# some scripting. This version is for the new syntax to be used with the +# new UB matrix calculaus for triple axis. +# +# Mark Koennecke, May 2005 +#-------------------------------------------------------------------------- + +proc SplitReply { text } { + set l [split $text =] + return [string trim [lindex $l 1]] +} + +source $scripthome/nxtas.tcl +source $scripthome/nxsupport.tcl +source $scripthome/tasscript.tcl + +initxmlscan + +#------------------------------------------------------------------------ +proc wwwsics {} { + append result "\n" + append result "\n" + append result "\n" + append result "\n" + append result "\n" + append result "\n" + append result "\n" + append result "\n" + append result "" + append result "" + append result "\n" + append result "" + append result "" + append result "\n" + append result "
User " [tasSplit [user]] "
Title " + append result [tasSplit [title]] "
Status " + append result [tasSplit [status]] "
Last Scan Command " + append result [tasSplit [lastcommand]] "
A1" + append result [tasSplit [a1]] "A2" + append result [tasSplit [a2]] "
A3" + append result [tasSplit [a3]] "A4" + append result [tasSplit [a4]] "
A5" + append result [tasSplit [a5]] "A6" + append result [tasSplit [a6]] "
Ki" [tasSplit [ki]] "Kf" [tasSplit [kf]] "En" [tasSplit [en]] "
Qh" [tasSplit [qh]] "Qk" [tasSplit [qk]] "Ql" [tasSplit [ql]] "
\n" +} diff --git a/site_ansto/instrument/pelican/config/tasmad/taspub_sics/tasscript.tcl b/site_ansto/instrument/pelican/config/tasmad/taspub_sics/tasscript.tcl new file mode 100644 index 00000000..7119ffb9 --- /dev/null +++ b/site_ansto/instrument/pelican/config/tasmad/taspub_sics/tasscript.tcl @@ -0,0 +1,1517 @@ +#----------------------------------------------------------------------------- +# This file contains all the scripted commands to make a SICS-TAS look +# almost like a MAD-TAS. +# +# This version is special to RITA-2!! +# +# Mark Koennecke, September 2005 +# +# The specialities for RITA have been separated and this is controlled +# by testing the instrument name. This way I can use the same version for +# TASP, RITA-2 and EIGER +# +# Mark Koennecke, November 2010 +#------------------------------------------------------------------------ +# quite often we need to split a SICS answer of the form x = y and +# extract the y. This is done here. +#----------------------------------------------------------------------- +proc tasSplit {text} { + set list [split $text =] + return [lindex $list 1] +} +#------------------------------------------------------------------------ + +set inst [string trim [tasSplit [instrument]]] +if {[string first RITA $inst] >= 0} { + set ritaspecial 1 +} else { + set ritaspecial 0 +} +#------------------------------------------------------------------------- +# The syntax emulation needs a list of motors in several cases. This +# list is in tasmot. On startup the interpreter is queried for motors, +# which then are used to initialize the list. This has to be before the +# initialization in order to be visible when initializing below. +#----------------------------------------------------------------------- +set tasmot [list a1 a2 a3 a4 a5 a6] +#---------------------------------------------------------------------- +proc initMotList {} { + global tasmot + set t [dir mot] + set list [split $t] + foreach mot $list { + set mot [string trim $mot] + set mot [string tolower $mot] + if { [string length $mot] < 2} { + continue + } + if { [lsearch -exact $tasmot $mot] < 0} { + lappend tasmot $mot + } + } +} +#--------------- debug.... +proc printmotlist {} { + global tasmot + foreach mot $tasmot { + set var [tasSplit [$mot]] + clientput "$mot = $var" + } + return OK +} + +proc enable {} { + global tasmot + foreach mot $tasmot { + catch { + set var [tasSplit [$mot enable]] + if {$var > 0} { + clientput "$mot enabled" + } else { + clientput " $mot disabled" + } + } + } + return OK +} + +proc target {} { + global tasmot + clientput "Motor HardPosition TargetPosition Position" + foreach mot $tasmot { + catch { + set var1 [tasSplit [$mot targetposition]] + set var2 [tasSplit [$mot hardposition]] + set var3 [tasSplit [$mot]] + clientput "$mot $var2 $var1 $var3" + } + } + return OK +} + +#------------------------------------------------------------------------ +proc initTasScan {} { + iscan configure script + iscan function writeheader tasscan header + iscan function prepare tasscan prepare + iscan function drive tasscan drive + iscan function count tasscan count + iscan function collect tasscan collect + iscan function writepoint tasscan writepoint +} +#--------------------------------------------------------------------------- +if { [info exists tasubinit] == 0 } { + set tasubinit 1 + Publish do User + Publish ou User + Publish out User + Publish fi User + Publish fix User + Publish cl User + Publish clear User + Publish co User + Publish fm User + Publish fz User + Publish pr Spy + Publish se User + Publish lz Spy + Publish ll Spy + Publish lm Spy + Publish ls Spy + Publish syncbackup Spy + Publish le Spy + Publish lt Spy + Publish li Spy + Publish log User + Publish sz User + Publish pa User + Publish on User + Publish off User + Publish sp User + Publish dr User + Publish sc User + Publish sf User + Publish cell User + Publish ref User + Publish makeub User + Publish makeauxub User + Publish addauxref User + Publish makeubfromcell User + Publish listub User + Publish xmlprepare User + Publish xmlwritepoint User + Publish donothing User + Publish xmlfinish User + Publish syncdrive User + initMotList +# initTasScan +# initxmlscan + Publish printmotlist User + Publish enable User + Publish target User +} +#------------------------------------------------------------------------ +# TASMAD relies on the order of variables in memory in order to interpret +# scan or drive commands. In the new syntax motor order is only preserved +# for the QE motors, not for real motors. This list configures the order. +#------------------------------------------------------------------------ +set tasOrderList [list qh qk ql en] +#------------------------------------------------------------------------- +# some MAD variables can be directly mapped to internal SICS variables. +# Some others require special functions to be called for them to be set. +# These mappings are defined here in a mapping array +#------------------------------------------------------------------------- +for {set i 0} {$i < [llength $tasmot]} { incr i } { + set mot [lindex $tasmot $i] + set tasmap(l$mot) [format "%s softlowerlim " $mot] + set tasmap(z$mot) [format "madZero %s " $mot] + set tasmap(u$mot) [format "%s softupperlim " $mot] +} +set tasmap(ss) "scatSense ss " +set tasmap(sa) "scatSense sa " +set tasmap(sm) "scatSense sm " +set tasmap(fx) "fxi " +set tasmap(dm) "tasub mono dd " +set tasmap(da) "tasub ana dd " +for {set i 0} { $i < 8} { incr i} { + set cur [format "i%1.1d" $i] + set tasmap(l$cur) [format "%s lowerlimit " $cur] + set tasmap(u$cur) [format "%s upperlimit " $cur] +} + +#---------------------------------------------------------------------- +# mapping array output for debugging +#set l [array names tasmap] +#foreach e $l { +# clientput [format " %s = %s" $e $tasmap($e)] +#} +#---------------------------------------------------------------------- +# put an angle into 360 +proc circlify {val} { + set p $val + while {$p > 360.0} { + set p [expr $p - 360.] + } + while {$p < -360.0} { + set p [expr $p + 360.] + } + return $p +} +#------------------------------------------------------------------------- +# motor zero points are handled differently in SICS and MAD: +# - MAD zero's are of opposite sign to SICS +# - Setting a MAD zero point also changes the limits. +# This function takes care of these issues. +#------------------------------------------------------------------------- +proc madZero args { + set length [llength $args] + if { $length < 1} { + error "ERROR: expected at least motor name as a parameter to madZero" + } + set mot [lindex $args 0] + if {$length == 1 } { +#inquiry case + set zero [tasSplit [$mot softzero]] + return [format "madZero = %f " [expr -$zero]] + } else { +# a new value has been given. + set val [lindex $args 1] + set val [expr -$val] + set zero [tasSplit [$mot softzero]] + set low [tasSplit [$mot softlowerlim]] + set high [tasSplit [$mot softupperlim]] + set displacement [expr $val - $zero] + $mot softzero [circlify $val] + $mot softupperlim [circlify [expr $high - $displacement]] + $mot softlowerlim [circlify [expr $low - $displacement]] + } +} +#-------------------------------------------------------------------------- +# This routine throws an error if a bad value for fx is given +#-------------------------------------------------------------------------- +proc fxi { {val UNKNOWN} } { + if {[string compare $val UNKNOWN] ==0} { + return [format " fx = %2s " [tasSplit [tasub const]] ] + } + return [tasub const $val] +} +#------------------------------------------------------------------------- +# Changing the scattering sense has various consequences: +# for SM it is rejected as this requires a major rebuild of the guide hall. +# for SS only the parameter is changed. +# for SA - the parameter is changed +# - the A5 zero point is rotated by 180 degree +# - the lower software limit is set to the new zero point +#-------------------------------------------------------------------------- +proc scatSense {par {val -1000} } { + switch $par { + ss { + set mot a3 + } + sa { + set mot a5 + } + sm { + set mot a1 + } + default { + error "ERROR: unknown scattering sense $par" + } + } +#-------- inquiry case + if { $val == -1000 } { + switch $par { + sm { + return [format "sm = %d" [tasSplit [tasub mono ss]]] + } + ss { + return [format "ss = %d" [tasSplit [tasub ss]]] + } + sa { + return [format "sa = %d" [tasSplit [tasub ana ss]]] + } + default { + error "Unknown scattering sense requested" + } + } + } + if {$val != 1 && $val != -1 && $val != 0 } { + error "ERROR: invalid scattering sense $val" + } + switch $par { + sm { + error \ + "REJECTED: Pay 100 mil. CHF for a redesign of SINQ first" + } + ss { + tasub ss $val + clientput [format " SS = %d" $val] + } + sa { + set oldzero [tasSplit [madZero $mot]] + set oldupper [tasSplit [$mot softupperlim]] + set oldlower [tasSplit [$mot softlowerlim]] + set oldsa [tasSplit [tasub ana ss]] + if { $val == 0 && $oldsa == 1} { + set newzero [expr $oldzero - 90.] + set newlower [expr $oldlower - 90.] + set newupper [expr $oldupper - 90.] + } elseif {$val == 0 && $oldsa == -1} { + set newzero [expr $oldzero + 90.] + set newlower [expr $oldlower + 90.] + set newupper [expr $oldupper + 90.] + } elseif { $val == 1 && $oldsa == 0} { + set newzero [expr $oldzero + 90.] + set newlower [expr $oldlower + 90.] + set newupper [expr $oldupper + 90.] + } elseif { $val == -1 && $oldsa == 0} { + set newzero [expr $oldzero - 90.] + set newlower [expr $oldlower - 90.] + set newupper [expr $oldupper - 90.] + } elseif { $val == 1 && $oldsa == -1} { + set newzero [expr $oldzero + 180. ] + set newlower [expr $oldlower + 180 ] + set newupper [expr $oldupper + 180. ] + set newlower [circlify $newlower] + set newupper [circlify $newupper] + } elseif {$val == -1 && $oldsa == 1} { + set newzero [expr $oldzero - 180. ] + set newlower [expr $oldlower - 180. ] + set newupper [expr $oldupper - 180. ] + } else { + error "Unknown SA setting combination" + } + tasub ana ss $val + madZero $mot $newzero + $mot softupperlim $newupper + $mot softlowerlim $newlower + } + } +} +#------------------------------------------------------------------------- +# The output command +#------------------------------------------------------------------------- +proc out args { + if {[llength $args] == 0 } { + output "" + } else { + output [join $args] + } +} +#-------------------------------------------------------------------------- +proc ou args { + if {[llength $args] == 0 } { + output "" + } else { + output [join $args] + } +} +#-------------------------------------------------------------------------- +# typeATokenizer extracts tokens from a command string. Tokens can be +# either variable names or - indicating a series of variables. +# Returns the token value or END if the end of the string text is +# reached. Uses and updates a variable pos which indicates the current +# position in the string. +#--------------------------------------------------------------------------- +proc typeATokenizer {text pos} { + upvar pos p + set l [string length $text] +#------- check for end + if {$p >= $l} { + return END + } +#-------- skip spaces + for {} {$p < $l} {incr p} { + set c [string index $text $p] + if {$c == "-" } { + incr p + return "-" + } + if { $c != " " && $c != "," } { + break + } + } + if {$p >= $l} { + return END + } +#---- extract token + set start $p +#---- proceed to next terminator + for {} {$p < $l} {incr p} { + set c [string index $text $p] + if { $c == " " || $c == "," || $c == "-" } { + break + } + } + set stop [expr $p - 1] + return [string range $text $start $stop] +} +#--------------------------------------------------------------------------- +# The cl(ear) command for unfixing motors +#--------------------------------------------------------------------------- +proc clear args { + eval cl $args +} +#------------------------------------------------------------------------ +proc cl args { + global tasmot + if {[llength $args] == 0} { +#------ clear all fixed motors + foreach m $tasmot { + set ret [catch {tasSplit [$m fixed]} x] + if {$ret != 0 } { + continue + } + if { $x > 0 } { + clientput [format "%s unfixed" $m] + $m fixed -1 + } + } + return + } +#------ trying to clear individual fixed motors + set command [join $args] + set command [string tolower $command] + set pos 0 + set token [typeATokenizer $command $pos] + while {[string compare $token END] != 0 } { + if {$token == "-" } { + set l [llength $tasmot] +#------ handle a range, first find start + for {set start 0} {$start < $l} {incr start} { + set e [lindex $tasmot $start] + if { [string compare $e $last] == 0} { + incr start + break + } + } + if { $start >= $l} { + error [format "ERROR: %s is no motor" $last] + } +#---------- next token is range stop + set stop [typeATokenizer $command $pos] +#---------- now continue to loop until stop is found, thereby unfixing + for {set i $start} { $i < $l} {incr i} { + set e [lindex $tasmot $i] + set ret [catch {$e fixed -1} msg] + if {$ret != 0} { + error [format "ERROR: %s is no motor" $e] + } else { + clientput [format "%s unfixed" $e] + } + if {[string compare $e $stop] == 0 } { + break + } + } + } else { +#------ should be a single motor here + set last $token + set ret [catch {$token fixed -1} msg] + if {$ret != 0} { + error [format "ERROR: %s is no motor" $token] + } else { + clientput [format "%s unfixed" $token] + } + } +#------- do not forget to proceed + set token [typeATokenizer $command $pos] + } +} +#------------------------------------------------------------------------ +# fi fix motor command +#------------------------------------------------------------------------ +proc fix args { + eval fi $args +} +#---------------------------------------------------------------------- +proc fi args { + global tasmot + if {[llength $args] <= 0} { +#------ list all fixed motors + foreach m $tasmot { + set ret [catch {tasSplit [$m fixed ] } x] + if {$ret != 0 } { + continue + } + if { $x > 0 } { + clientput [format "%s fixed" $m] + } + } + return + } +#------ parse motors to fix + set command [join $args] + set command [string tolower $command] + set pos 0 + set token [typeATokenizer $command $pos] + while {[string compare $token END] != 0 } { + if {$token == "-" } { + set l [llength $tasmot] +#------ handle a range, first find start + for {set start 0} {$start < $l} {incr start} { + set e [lindex $tasmot $start] + if { [string compare $e $last] == 0} { + incr start + break + } + } + if { $start >= $l} { + error [format "ERROR: %s is no motor" $last] + } +#---------- next token is range stop + set stop [typeATokenizer $command $pos] +#---------- now continue to loop until stop is found, thereby fixing + for {set i $start} { $i < $l} {incr i} { + set e [lindex $tasmot $i] + set ret [catch {$e fixed 1} msg] + if {$ret != 0} { + error [format "ERROR: %s is no motor" $e] + } else { + clientput [format "%s fixed" $e] + } + if {[string compare $e $stop] == 0 } { + break + } + } + } else { +#------ should be a single motor here + set last $token + set ret [catch {$token fixed 1} msg] + if {$ret != 0} { + error [format "ERROR: %s is no motor" $token] + } else { + clientput [format "%s fixed" $token] + } + } +#------- do not forget to proceed + set token [typeATokenizer $command $pos] + } +} +#-------------------------------------------------------------------------- +# varToken returns the next token in a variable setting string. +# handles pos as in type A syntax above. +#-------------------------------------------------------------------------- +proc varToken {text pos} { + upvar pos p + set l [string length $text] +#------- check for end + if {$p >= $l} { + return -end + } +#-------- skip spaces + for {} {$p < $l} {incr p} { + set c [string index $text $p] + if { $c != " " && $c != "," && $c != "=" } { + break + } + } + if {$p >= $l} { + return END + } +#---- extract token + set start $p +#---- proceed to next terminator + for {} {$p < $l} {incr p} { + set c [string index $text $p] + if { $c == " " || $c == "," || $c == "=" } { + break + } + } + set stop [expr $p - 1] + return [string range $text $start $stop] +} + +#--------------------------------------------------------------------------- +# varSet parses a string containing MAD variable statements and sets the +# variables. Thereby it has to take care of mappings and special variables +# which have to be set by special functions. The only format allowed here +# are name value pairs. +#-------------------------------------------------------------------------- +proc varSet { command } { + global tasmap + set pos 0 + set token [varToken $command $pos] + set value [varToken $command $pos] + while { [string compare $token -end] } { +#----- first check for special things like user, local, title etc + if { [string compare $token title] == 0 || \ + [string compare $token user] == 0 || \ + [string compare $token output] == 0 || \ + [string compare $token local] == 0 } { + eval $command + return + } + if { [string compare $token out] == 0 || \ + [string compare $token ou] == 0 } { + append txt $token " " [string range $command $pos end] + eval output $txt + return + } +#----- now check for a numeric argument +# set t [SICSType $value] +# if { [string compare $t NUM] != 0 } { +# error [format "ERROR: expected number for %s, got %s" \ +# $token $value] +# } +#------ now check for mapped variables + if { [info exists tasmap($token)] == 1} { + set ret [catch {eval $tasmap($token) $value} msg] + if { $ret != 0} { + error [format "ERROR: > %s < while setting %s" $msg $token] + } else { + clientput [format " %s = %s" $token $value] + } + } else { + set ret [catch {eval $token $value} msg] + if { $ret != 0 } { + error [format "ERROR: error %s while setting %s" $msg $token] + } else { + clientput [format " %s = %s" $token $value] + } + } + set token [varToken $command $pos] + set value [varToken $command $pos] + } + catch {tasub update} msg +} +#-------------------------------------------------------------------------- +# co for count is the funny MAD count procedure. Please note, that the +# count mode is automatically set through the last MN or TI variable. +#-------------------------------------------------------------------------- +proc coritacount {mode preset nloop} { + set rmode [ritamode] + hm countmode $mode + hm preset $preset + for { set i 0} {$i < $nloop} {incr i} { + set ret [catch {eval hm countblock} msg] + if {$ret != 0} { + error $msg + } + #----- format output + set cts [tasSplit [hm sum 0 127 0 127]] + set m1 [tasSplit [counter getmonitor 1]] + set m2 [tasSplit [counter getmonitor 2]] + set m3 [tasSplit [counter getmonitor 3]] + set time [tasSplit [counter gettime] ] + clientput [format \ + " Counts = %8d, M1 = %8d, M2 = %8d, M3 = %8d, Time = %8.2f" \ + $cts $m1 $m2 $m3 $time] + if {[string first none $rmode] >= 0} { + for {set i 1} {$i < 13} {incr i} { + set win [format "w%ds" $i] + append txt [format " %s = %d" $win [sumPSDWindow $i]] + } + clientput $txt + } + } +} +#------------------------------------------------------------------------ +proc conormalcount {mode preset nloop} { + counter setmode $mode + for { set i 0} {$i < $nloop} {incr i} { + set ret [catch {eval counter count $preset } msg] + if {$ret != 0} { + error $msg + } + #----- format output + set cts [tasSplit [counter getcounts]] + set m1 [tasSplit [counter getmonitor 1]] + set m2 [tasSplit [counter getmonitor 2]] +# set m3 [tasSplit [counter getmonitor 3]] + set m3 25 + set time [tasSplit [counter gettime] ] + clientput [format \ + " Counts = %8d, M1 = %8d, M2 = %8d, M3 = %8d, Time = %8.2f" \ + $cts $m1 $m2 $m3 $time] + } +} +#------------------------------------------------------------------------- +proc co args { + global ritaspecial + set mode [tasSplit [counter getmode]] + set preset [tasSplit [counter getpreset]] + set nloop 1 +#------ set variables if present at command line + if { [llength $args] > 0 } { + set com [join $args] + set pos 0 + set token [varToken $com $pos] + while { [string compare $token -end] != 0} { + set token [string tolower $token] + if { [string compare $token np] == 0} { + set nloop [varToken $com $pos] + if { [string is integer $nloop] != 1} { + error "ERROR: expected integer value after NP" + } + } elseif {[string compare $token mn] == 0} { + set mode monitor + set preset [varToken $com $pos] + if { [string is double $preset] != 1} { + error "ERROR: expected numeric value after MN" + } + } elseif {[string compare $token ti] == 0} { + set mode timer + set preset [varToken $com $pos] + if { [string is double $preset] != 1} { + error "ERROR: expected numeric value after TI" + } + } + set token [varToken $com $pos] + } + } +#---- done this, now count + if {$ritaspecial} { + return [coritacount $mode $preset $nloop] + } else { + return [conormalcount $mode $preset $nloop] + } +} +#---------------------------------------------------------------------------- +# fm or FindMaximum: does a scan, then proceeds to find the maximum +# of the peak and drives the first scan variable to the maximum. +#---------------------------------------------------------------------------- +proc fm args { +#------ do the scan first + append com "sc " [ join $args] + set ret [catch {eval $com} msg] + if { $ret != 0 } { + error $msg + } +# iscan simscan 15 .3 1000 +#----- calculate the center + set ret [catch {eval peak value} msg] + if { $ret != 0 } { + error $msg + } + if { [string first "WARN" $msg ] >= 0 } { + error [format "ERROR: failed to find peak: %s" $msg] + } + set val $msg +#------ find variable and drive to center + set temp [iscan getvardata 0] + set start [string first "." $temp] + incr start + set stop [string first "=" $temp] + incr stop -1 + set var [string range $temp $start $stop] + set ret [catch {eval dr $var $val} msg] + if { $ret != 0 } { + error $msg + } +} +#------------------------------------------------------------------------ +# fz does almost the same as fm, but also sets the current position to be +# the zeropoint after driving +#------------------------------------------------------------------------ +proc fz args { +#------ do the scan first + append com "sc " [ join $args] + set ret [catch {eval $com} msg] + if { $ret != 0 } { + error $msg + } + iscan simscan 15 .3 1000 +#----- calculate the center + set ret [catch {eval peak value} msg] + if { $ret != 0 } { + error $msg + } + if { [string first "WARN" $msg ] >= 0 } { + error [format "ERROR: failed to find peak: %s" $msg] + } + set val $msg +#------ find variable and drive to center + set temp [iscan getvardata 0] + set start [string first "." $temp] + incr start + set stop [string first "=" $temp] + incr stop -1 + set var [string range $temp $start $stop] + set ret [catch {eval dr $var $val} msg] + if { $ret != 0 } { + error $msg + } +#------- now do zero point + set temp [eval $var hardposition] + set newZero [tasSplit $temp] + madZero [string trim $var] [expr -$newZero] +} + +#-------------------------------------------------------------------------- +# pr(int) values of variables +#------------------------------------------------------------------------- +proc pr args { + global tasmap + set line [join $args] + set line [string tolower $line] + set pos 0 + set token [varToken $line $pos] + while { [string compare $token -end] } { +#-------- check for mapped values first + if { [info exists tasmap($token)] == 1 } { + set val [tasSplit [eval $tasmap($token)]] + clientput [format " %s = %s" $token $val] + } else { +#------ simple variables go here + set val [tasSplit [$token] ] + clientput [format " %s = %s" $token $val] + } + set token [varToken $line $pos] + } +} +#------------------------------------------------------------------------- +# se(t) variables +#------------------------------------------------------------------------ +proc se args { +#------- is it the only command line case? + if {[llength $args] > 0 } { + set line [join $args] + return [varSet $line] + } else { +#------- we are prompting + while { 1== 1} { +#-------- check for error + set line [sicsprompt "SET> "] + if { [string first ERROR $line] >= 0} { + error $line + } +#-------- check for end + if { [string length $line] < 4 } { + return + } +#------- OK, evaluate the line + set ret [catch {varSet $line} msg] + if {$ret != 0} { + clientput $msg + } + } + } +} +#--------------------------------------------------------------------------- +# lz list limits and zeros, ll is the same +#--------------------------------------------------------------------------- +proc ll args { + return [eval lz $args] +} +#-------------------------------------------------------------------------- +proc lz args { + global tasmap + global tasmot +#--------- do header + append outPut [format " Limits & Zeros\n"] + append outPut [format " ===============\n"] + append outPut [format " Lo(hard) Lo(soft) Posn%s" \ + " Hi(soft) Hi(hard) Zero\n"] +#--------- do motors + set count 0 + foreach mot $tasmot { + set zero [tasSplit [madZero $mot]] + set loh [tasSplit [eval $mot hardlowerlim]] + set loh [expr $loh + $zero] + set los [tasSplit [eval $mot softlowerlim]] + set pos [tasSplit [eval $mot]] + set his [tasSplit [eval $mot softupperlim]] + set hih [tasSplit [eval $mot hardupperlim]] + set hih [expr $hih + $zero] + append outPut [format "%-10s %8.2f %8.2f %8.2f %8.2f %8.2f %8.2f\n" \ + $mot $loh $los $pos $his $hih $zero] + incr count + if { $count == 6 } { + append outPut " \n" + } + } + return $outPut +} +#-------------------------------------------------------------------------- +# lm list machine parameters +#-------------------------------------------------------------------------- +proc lm args { + append output " Machine Parameters\n" + append output " ==================\n" +#----------- first line + append output [format " DM DA SM SS%s\n" \ + " SA ALF1 ALF2 ALF3 ALF4"] + set v1 [tasSplit [eval tasub mono dd]] + set v2 [tasSplit [eval tasub ana dd]] + set v3 [tasSplit [eval tasub mono ss]] + set v4 [tasSplit [eval tasub ss]] + set v5 [tasSplit [eval tasub ana ss]] + set v6 [tasSplit [eval ALF1]] + set v7 [tasSplit [eval ALF2]] + set v8 [tasSplit [eval ALF3]] + set v9 [tasSplit [eval ALF4]] + append output [format \ + " %8.4f %8.4f %9d %9d %9d %8.3f %8.3f %8.3f %8.3f\n"\ + $v1 $v2 $v3 $v4 $v5 $v6 $v7 $v8 $v9] +#--------- second line + append output [format " BET1 BET2 BET3 BET4%s\n" \ + " ETAM ETAA FX NP TI"] + set v1 [tasSplit [eval BET1]] + set v2 [tasSplit [eval BET2]] + set v3 [tasSplit [eval BET3]] + set v4 [tasSplit [eval BET4]] + set v5 [tasSplit [eval ETAM]] + set v6 [tasSplit [eval ETAA]] + set v7 [tasSplit [tasub const]] + append output [format \ + " %8.3f %8.3f %8.3f %8.3f %8.3f %8.3f %2s\n"\ + $v1 $v2 $v3 $v4 $v5 $v6 $v7] + return $output +} +#--------------------------------------------------------------------------- +# ls list sample parameters +#-------------------------------------------------------------------------- +proc ls args { + append output " Sample Parameters\n" + append output " =================\n" +#----------- first line + append output [format " AS BS CS AA%s\n" \ + " BB CC ETAS"] + set lat [tasSplit [tasub cell]] + set l [split [string trim $lat]] + set v1 [lindex $l 0] + set v2 [lindex $l 1] + set v3 [lindex $l 2] + set v4 [lindex $l 3] + set v5 [lindex $l 4] + set v6 [lindex $l 5] + set v7 [tasSplit [eval ETAS]] + append output [format \ + " %8.4f %8.4f %8.4f %8.3f %8.3f %8.3f %8.3f\n"\ + $v1 $v2 $v3 $v4 $v5 $v6 $v7] +#--------- second line + append output [tasub listub] + append output "Current Content of Reflection List\n" + append output [tasub listref] + return $output +} +#--------------------------------------------------------------------------- +# le --> list energy +#--------------------------------------------------------------------------- +proc le args { + append output " ================\n" + append output [format " EI KI EF%s\n" \ + " KF QH QK QL"] + set v1 [tasSplit [ei]] + set v2 [tasSplit [ki]] + set v3 [tasSplit [ef]] + set v4 [tasSplit [kf]] + set v5 [tasSplit [qh]] + set v6 [tasSplit [qk]] + set v7 [tasSplit [ql]] + set val [format " %9.4f %9.4f %9.4f %9.4f %9.4f %9.4f %9.4f \n" \ + $v1 $v2 $v3 $v4 $v5 $v6 $v7] + set v1 [tasSplit [ei target]] + set v2 [tasSplit [ki target]] + set v3 [tasSplit [ef target]] + set v4 [tasSplit [kf target]] + set v5 [tasSplit [qh target]] + set v6 [tasSplit [qk target]] + set v7 [tasSplit [ql target]] + set val2 [format " %9.4f %9.4f %9.4f %9.4f %9.4f %9.4f %9.4f \n" \ + $v1 $v2 $v3 $v4 $v5 $v6 $v7] + append output [format "POSN: %s" $val] + append output [format "TARG: %s" $val2] + append output [format " EN QM\n"] + set v1 [tasSplit [en]] + set v2 [tasSplit [qm]] + set val [format " %9.4f %9.4f\n" $v1 $v2] + set v1 [tasSplit [en target]] + set v2 [tasSplit [qm target]] + set val2 [format " %9.4f %9.4f\n" $v1 $v2] + append output [format "POSN: %s" $val] + append output [format "TARG: %s" $val2] + + return $output +} +#----------------------------------------------------------------------- +# fmtMot formats a motors parameters in order to fit the format for +# the list targets commands +#----------------------------------------------------------------------- +proc fmtMot mot { + set zero [tasSplit [madZero $mot]] + set pos [tasSplit [$mot]] + set target [expr [tasSplit [eval $mot target]] + $zero] + if { [tasSplit [eval $mot fixed]] < 0} { + set fix " " + } else { + set fix "f" + } + set txt [format "%-7s%1s %7.2f %7.2f %7.2f" $mot $fix $pos $target \ + $zero] + return $txt +} +#------------------------------------------------------------------------- +# lt --> list targets +#------------------------------------------------------------------------- +proc lt args { + append output " Positions and Targets \n" + append output " ===================== \n" + append output [format " Posn Targ Zero %s" \ + " Posn Targ Zero\n"] + append output [format "%s | %s\n" \ + [fmtMot A1] " "] + append output [format "%s | %s\n" \ + [fmtMot A2] [fmtMot ATL]] + append output [format "%s | %s\n" \ + [fmtMot A3] [fmtMot ATU] ] + append output [format "%s | %s\n" \ + [fmtMot A4] " " ] + append output [format "%s | %s\n" \ + [fmtMot A5] [fmtMot MGL] ] + append output [format "%s | %s\n" \ + [fmtMot A6] [fmtMot SGL] ] + append output [format "%s | %s\n" \ + [fmtMot MCV] [fmtMot SGU] ] + append output [format "%s | %s\n" \ + [fmtMot SRO] " " ] + append output [format "%s | %s\n" \ + [fmtMot ACH] [fmtMot AGL] ] + append output [format "%s | %s\n" \ + [fmtMot MTL] " " ] + append output [format "%s | %s\n" \ + [fmtMot MTU] " " ] + return $output +} +#-------------------------------------------------------------------- +# li --> list everything +#--------------------------------------------------------------------- +proc li args { + clientput [lm] + clientput [ls] + clientput [lz] + clientput [lt] + clientput [le] +} +#----------------------------------------------------------------------- +# make a new log file name for log +proc makeLog args { + set tim [sicstime] + set l [split $tim] + set l2 [split [lindex $l 1] ":"] + set nam [format "madsics-%s@%s-%s-%s.log" [lindex $l 0] \ + [lindex $l2 0] [lindex $l2 1] [lindex $l2 2]] + return $nam +} +#--------------------------------------------------------------------- +# log the logging control command +#--------------------------------------------------------------------- +set madlog disabled + +proc log args { + global madlog +#------ no args, just print status + if { [ llength $args] == 0 } { + if { [string compare $madlog disabled] == 0 } { + return "Logging is disabled" + } else { + return [format "Logging to %s" $madlog] + } + } +#------args, action according to keyword + set key [string tolower [lindex $args 0]] + switch $key { + new { + set madlog [makeLog] + commandlog new $madlog + } + start { + set madlog [makeLog] + commandlog new $madlog + } + close { + commandlog close + set madlog disabled + } + default { + append output "Log understands: \n" + append output "\tLog new : new logfile\n" + append output "\tLog start : start logging\n" + append output "\tLog close : stop logging\n" + return $output + } + } +} + +#-------------------------------------------------------------------------- +# sz -->setzero +#-------------------------------------------------------------------------- +proc sz args { + global tasmot + set usage "\n Usage: \n\t sz motor newval \n" + set line [string tolower [join $args]] + set pos 0 + set mot [varToken $line $pos] + set val [varToken $line $pos] + if { [lsearch $tasmot $mot] < 0 } { + error [format "ERROR: %s is no motor\n %s" $mot $usage] + } + if { [string compare [SICStype $val] NUM ] != 0 } { + error [format "ERROR: expected number, got %s \n%s" $val $usage] + } +#-------- output, output, output......... + append output [format "Values : Lo(hard) Lo(soft) Posn%s" \ + " Target Hi(soft) Hi(hard) Zero\n"] + set zero [tasSplit [madZero $mot]] + set loh [tasSplit [eval $mot hardlowerlim]] + set loh [expr $loh + $zero] + set los [tasSplit [eval $mot softlowerlim]] + set pos [tasSplit [eval $mot]] + set his [tasSplit [eval $mot softupperlim]] + set hih [tasSplit [eval $mot hardupperlim]] + set hih [expr $hih + $zero] + set targ [expr [tasSplit [eval $mot target]] + $zero] + append output [format \ + "%-8sOld: %8.2f %8.2f %8.2f %8.2f %8.2f %8.2f %8.2f\n" \ + $mot $loh $los $pos $targ $his $hih $zero] +#-------action + madZero $mot $val + catch {tasub update} msg +#-------- more output + set zero [tasSplit [madZero $mot]] + set loh [tasSplit [eval $mot hardlowerlim]] + set loh [expr $loh + $zero] + set los [tasSplit [eval $mot softlowerlim]] + set pos [tasSplit [eval $mot]] + set his [tasSplit [eval $mot softupperlim]] + set hih [tasSplit [eval $mot hardupperlim]] + set hih [expr $hih + $zero] + set targ [expr [tasSplit [eval $mot target]] + $zero] + append output [format \ + " New: %8.2f %8.2f %8.2f %8.2f %8.2f %8.2f %8.2f\n" \ + $loh $los $pos $targ $his $hih $zero] + return $output +} +#--------------------------------------------------------------------------- +# pa : set polarization analysis file +#-------------------------------------------------------------------------- +proc pa args { + if {[llength $args] < 1} { + error "Usage: pa polarisation analysis file" + } + set fil [lindex $args 0] + if {[string first "." $fil] < 0} { + set fil $fil.pal + } + polfile $fil +} +#-------------------------------------------------------------------------- +# on and off for switching spin flippers +#------------------------------------------------------------------------- +proc checkarg args { + if {[llength $args] < 1} { + error "No flipper to set given" + } + set flipper [string trim [string tolower [lindex $args 0]]] + if { [string compare $flipper f1] == 0 || \ + [string compare $flipper f2] == 0} { + return $flipper + } else { + error [format "%s not a recognized flipper" $flipper] + } +} +#------------------------------------------------------------------------ +proc on args { + set flip [checkarg $args] + if { [string compare $flip f1] == 0 } { + f1 1 + set i1val [expr [tasSplit [tki]] * [tasSplit [if1h]]] + set i2val [tasSplit [if1v]] + return [dr i1 $i1val i2 $i2val] + } else { + f2 1 + set i3val [expr [tasSplit [tkf]] * [tasSplit [if2h]]] + set i4val [tasSplit [if2v]] + return [dr i3 $i3val i4 $i4val] + } +} +#------------------------------------------------------------------------- +proc off args { + set flip [checkarg $args] + if { [string compare $flip f1] == 0 } { + f1 0 + return [dr i1 .0 i2 .0] + } else { + f2 0 + return [dr i3 .0 i4 .0] + } +} +#------------------------------------------------------------------------ +proc do {filename} { + return [exe [string trim $filename]] +} +#----------------------------------------------------------------------- +proc syncbackup {file} { + backup motorSave + backup $file + backup motorSave +} +#------------------------------------------------------------------------- +proc syncdrive {mot pos} { + set test [catch {tasSplit [$mot fixed]} fix] + if {$test == 0} { + $mot fixed -1 + } + drive $mot $pos + if {$test == 0} { + eval $mot fixed $fix + } +} +#-------------------------------------------------------------------------- +# "set posttion" sp to reset the zero-position. +# syntax: "SP " to set the softzero value of +# in a way that the targetposition is set to . +# J. Stahn, 10. 2001 +#------------------------------------------------------------------------- +proc sp { axes wert } { + set tt [$axes hardposition] + set t [split $tt "="] + set posh [lindex $t 1] +# extended to included motors with negative signs (M. Laver 7/6/10) + set tt [$axes sign] + set t [split $tt "="] + set poss [lindex $t 1] + $axes softzero [expr $poss*$posh - $wert] +} +#-------------- --------------------------------------------------------- +# locate scan variable. This is not so easy at TASP as sometimes the first +# ones really do not vary. We choose the first one which does vary. +# This returns the name, the start and the step. +#------------------------------------------------------------------------- +proc findscanvar {} { + set result "NONE,.0,.0" + set nvar [tasSplit [iscan noscanvar]] + for { set i 0} { $i < $nvar} { incr i } { + set ret [catch {iscan getvardata $i} msg] + if {$ret != 0} { + break + } + set l [split $msg =] + set xlist [lindex $l 1] + set start [lindex $xlist 0] + set 2pos [lindex $xlist 1] + if { abs($2pos - $start) > .0} { + set step [expr $2pos - $start] + set l2 [split [lindex $l 0] .] + set scanvar [lindex $l2 1] + set result "$scanvar,[string trim $start],$step" + break + } + } + return $result +} +#-------------- simulate scan info ---------------------------------------- +proc scan {name} { + switch $name { + uuinterest { + return [iscan uuinterest] + } + pinterest { + return [iscan interest] + } + getcounts { + return [iscan getcounts] + } + info { + set scanvar [findscanvar] + append result [tasSplit [iscan np]] ",1," $scanvar + append result , + append result [string trim [tasSplit [iscan getfile]]] + return $result + } + default { + error "ERROR: $name not supported" + } + } +} +#------------------------------------------------------------------------ +# The TAS dr(ive) command. Takes care of variable order. +#------------------------------------------------------------------------ +proc dr args { + global tasOrderList ritaspecial + set command [join $args] + set pos 0 + set lastVar neutronenPhaser + set token [varToken $command $pos] + while { [string compare $token -end] != 0} { + if { [string is double $token] == 1} { + lappend targets $token + if { [info exists motors] == 0} { + error "ERROR: Need motor first before handling target" + } + if { [llength $targets] > [llength $motors] } { + set idx [lsearch $tasOrderList $lastVar] + if { $idx >= 0} { + incr idx + set lastVar [lindex $tasOrderList $idx] + lappend motors $lastVar + } + } + if { [llength $motors] != [llength $targets]} { + error "ERROR: do not know what to drive to $token" + } + } else { + set lastVar $token + lappend motors $lastVar + } + set token [varToken $command $pos] + } + if { [info exists motors] == 0} { + error "ERROR: Nothing to drive!" + } + if { [llength $motors] > [llength $targets] } { + error "ERROR: Not enough targets for motors" + } + append drivecommand "drive " + for {set i 0} {$i < [llength $motors]} {incr i} { + append drivecommand [lindex $motors $i] + append drivecommand " " + append drivecommand [lindex $targets $i] + append drivecommand " " + } + tasub silent 0 + set status [catch {eval $drivecommand} msg] + foreach mot $motors { + clientput [format "New %s position: %.5g" $mot [tasSplit [$mot]]] + } + tasub update + if { [lsearch $args ef] >= 0 && $ritaspecial} { + adjustritaanalyzer bla blu 1 + } + if { $status != 0} { + error $msg + } else { + return $msg + } +} +#---------------------------------------------------------------------- +# The TAS sc(an) command. Translates the TAS sc syntax into the SICS +# syntax +#----------------------------------------------------------------------- +proc sc args { + global tasOrderList + global __tasdata + set command [join $args] + lastscancommand sc $command + tasscan pol -1 + set np 0 + set mode [tasSplit [counter getmode]] + set preset [tasSplit [counter getpreset]] + set lastVar quarkPhaser + set pos 0 + set state 0 +# states: +# 0 = expectToken, 1 = expectPosition, 2 = continuePosition +# 3 = expectIncrement, 4 = continueIncrement + + set token [varToken $command $pos] + while { [string compare $token -end] != 0} { + if { [string is double $token] == 1 } { +#--------- numbers + switch $state { + 0 { error "ERROR: expected name at $pos in $command" } + 1 { + set scanpos($lastVar) $token + set state 2 + } + 2 { + set idx [lsearch $tasOrderList $lastVar] + if { $idx < 0} { + error "ERROR: variable order handling only for qh,qk,ql,en" + } + incr idx + set lastVar [lindex $tasOrderList $idx] + lappend scanvars $lastVar + set scanpos($lastVar) $token + } + 3 { + set inc($lastVar) $token + set state 4 + } + 4 { + set idx [lsearch $tasOrderList $lastVar] + if { $idx < 0} { + error "ERROR: variable order handling only for qh,qk,ql,en" + } + incr idx + set lastVar [lindex $tasOrderList $idx] + set inc($lastVar) $token + } + default { + error "ERROR: programming error: bad code in num handling in sc" + } + } + } else { +#--------- text tokens + set token [string tolower $token] + set c [string index $token 0] + set type [sicstype $token] + if { [string compare $token np] == 0} { + set np [varToken $command $pos] + if { [string is integer $np] != 1} { + error "ERROR: expected integer after NP" + } + set state 0 + } elseif { [string compare $token mn] == 0} { + set preset [varToken $command $pos] + if { [string is double $preset] != 1} { + error "ERROR: expected numeric token after MN" + } + set mode monitor + set state 0 + } elseif { [string compare $token ti] == 0} { + set preset [varToken $command $pos] + if { [string is double $preset] != 1} { + error "ERROR: expected numeric token after TI" + } + set mode timer + set state 0 + } elseif { [string compare $c d] == 0 \ + && [string compare DRIV $type] != 0} { + set state 3 + set lastVar [string range $token 1 end] + } else { + lappend scanvars $token + set state 1 + set lastVar $token + } + } + set token [varToken $command $pos] + } +#=========== we are done parsing! Check if there is enough to go on + if { [info exists scanvars] == 0} { + error "ERROR: nothing to scan" + } + set __tasdata(qe) 0 + set qeVars [list qh qk ql ei ef en qm ki kf] + foreach var $scanvars { + if {[lsearch -exact $qeVars [string tolower $var]] >= 0} { + set __tasdata(qe) 1 + } + if { [info exists scanpos($var)] == 0} { + error "ERROR: position for $var missing" + } + if { [info exists inc($var)] == 0} { + error "ERROR: increment for $var missing" + } + } + set tasmode [string trim [tasSplit [tasub const]]] + if {[string compare $tasmode kf] == 0 && $__tasdata(qe) == 1} { + set __tasdata(qe) 2 + } +#========= prepare scan and run + iscan clear + foreach var $scanvars { + set start [expr $scanpos($var) - $inc($var) * ($np - 1)/2.] + iscan add $var $start $inc($var) + } + return [iscan run $np $mode $preset] +} +#--------------------------------------------------------------------- +proc cell args { + return [tasSplit [eval tasub cell $args]] +} +#-------------------------------------------------------------------- +proc ref args { + if { [llength $args] == 0} { + return [tasub listref] + } + set key [string trim [lindex $args 0]] + if { [string compare $key clear] == 0} { + if { [llength $args] > 1 } { + if {[string first all [lindex $args 1]] >= 0} { + return [tasub clear] + } else { + return [tasub del [lindex $args 1]] + } + } else { + error "Need argument to ref clear" + } + } elseif {[string compare $key aux] == 0} { + set qpos [lrange $args 1 end] + append cmd "tasub addauxref " [join $qpos] + return [eval $cmd] + } else { + return [eval tasub addref $args] + } +} +#-------------------------------------------------------------------- +proc makeub args { + if { [llength $args] >= 2} { + tasub makeub [lindex $args 0] [lindex $args 1] + return OK + } else { + return [tasub listub] + } +} +#-------------------------------------------------------------------- +proc makeauxub {qh qk ql} { + tasub makeauxub $qh $qk $ql +} +#------------------------------------------------------------------- +proc addauxref {qh qk ql} { + tasub addauxref $qh $qk $ql +} +#-------------------------------------------------------------------- +proc makeubfromcell args { + return [tasub makeubfromcell] +} +#--------------------------------------------------------------------- +proc listub args { + append output [tasSplit [tasub cell]] + append output "\n" + append output [tasub listub] + append output [tasub listref] + return $output +} +#---------------------------------------------------------------------- +proc sf args { + tasscan fast 1 + set ret [catch {eval sc $args} msg] + tasscan fast 0 + if { $ret != 0} { + error $msg + } else { + return $msg + } +} diff --git a/site_ansto/instrument/pelican/config/tasmad/taspub_sics/tasub.dic b/site_ansto/instrument/pelican/config/tasmad/taspub_sics/tasub.dic new file mode 100644 index 00000000..5ae7de42 --- /dev/null +++ b/site_ansto/instrument/pelican/config/tasmad/taspub_sics/tasub.dic @@ -0,0 +1,138 @@ +##NXDICT-1.0 +#----------------------------------------------------------------------- +# NeXus dictionary file for a triple axis spectrometer following +# the instrument definition as of May 2005 +# +# Do not modify this file if you do not knwo what you are doing, +# you may corrupt your data files! +# +# Mark Koennecke, May 2005 +# Mark Koennecke, August 2006 +# Change to new NeXus standards, Mark Koennecke, February 2007 +#---------------------------------------------------------------------- +NP=1 +INSTRUMENT=TASPUB +#--------- entry level +etitle=/entry1,NXentry/SDS title -type NX_CHAR -rank 1 +instrument=/entry1,NXentry/SDS instrument -type NX_CHAR -rank 1 +escancommand=/entry1,NXentry/SDS scancommand -type NX_CHAR -rank 1 +escanvars=/entry1,NXentry/SDS scanvars -type NX_CHAR -rank 1 +estart=/entry1,NXentry/SDS start_time -type DFNT_CHAR -rank 1 +eend=/entry1,NXentry/SDS end_time -type DFNT_CHAR -rank 1 +edef=/entry1,NXentry/SDS definition -type DFNT_CHAR -rank 1 \ + -attr {URL,http://www.nexus.anl.gov/instruments/xml/NXmonotas.xml} \ + -attr {version,1.0} +#---------- looser +usnam=/entry1,NXentry/user,NXuser/SDS name -type NX_CHAR -rank 1 +usaff=/entry1,NXentry/user,NXuser/SDS affiliation -type NX_CHAR -rank 1 +usadd=/entry1,NXentry/user,NXuser/SDS address -type NX_CHAR -rank 1 +usmail=/entry1,NXentry/user,NXuser/SDS email -type NX_CHAR -rank 1 +#---------- local contact +lonam=/entry1,NXentry/local_contact,NXuser/SDS name -type NX_CHAR -rank 1 +#------------- sample +sa_temperature=/entry1,NXentry/sample,NXsample/SDS temperature \ + -attr {units,K} -rank 1 -dim {-1} +sc_tt=/entry1,NXentry/sample,NXsample/SDS temperature \ + -attr {units,K} -rank 1 -dim {-1} +sa_field=/entry1,NXentry/sample,NXsample/SDS magnetic_field \ + -attr {units,Tesla} -rank 1 -dim {-1} +sc_temperature=/entry1,NXentry/sample,NXsample/SDS temperature \ + -attr {units,K} -rank 1 -dim {-1} +sc_te=/entry1,NXentry/sample,NXsample/SDS temperature \ + -attr {units,K} -rank 1 -dim {-1} +sc_field=/entry1,NXentry/sample,NXsample/SDS magnetic_field \ + -attr {units,Tesla} -rank 1 -dim {-1} +sc_mf=/entry1,NXentry/sample,NXsample/SDS magnetic_field \ + -attr {units,Tesla} -rank 1 -dim {-1} +sanam=/entry1,NXentry/sample,NXsample/SDS name -type NX_CHAR -rank 1 +sa_cell=/entry1,NXentry/sample,NXsample/SDS unit_cell -rank 1 -dim {6} +sa_norm=/entry1,NXentry/sample,NXsample/SDS plane_normal -rank 1 -dim {3} +sa_vec1=/entry1,NXentry/sample,NXsample/SDS plane_vector_1 -rank 1 -dim {9} +sa_vec2=/entry1,NXentry/sample,NXsample/SDS plane_vector_2 -rank 1 -dim {9} +sa_ub=/entry1,NXentry/sample,NXsample/SDS orientation_matrix -rank 2 \ + -dim {3,3} +sc_a2=/entry1,NXentry/sample,NXsample/SDS polar_angle \ + -rank 1 -attr {units,degree} -dim {-1} +sc_a3=/entry1,NXentry/sample,NXsample/SDS rotation_angle \ + -rank 1 -attr {units,degree} -dim {-1} +sc_sgl=/entry1,NXentry/sample,NXsample/SDS sgl \ + -rank 1 -attr {units,degree} -dim {-1} +sc_sgu=/entry1,NXentry/sample,NXsample/SDS sgu \ + -rank 1 -attr {units,degree} -dim {-1} +2tm_zero=/entry1,NXentry/sample,NXsample/SDS polar_angle_zero \ + -rank 1 -attr {units,degree} +om_zero=/entry1,NXentry/sample,NXsample/SDS rotation_angle_zero \ + -rank 1 -attr {units,degree} +sgl_zero=/entry1,NXentry/sample,NXsample/SDS sgl_zero \ + -rank 1 -attr {units,degree} +sgu_zero=/entry1,NXentry/sample,NXsample/SDS sgu_zero \ + -rank 1 -attr {units,degree} +sc_qh=/entry1,NXentry/sample,NXsample/SDS Qh -rank 1 -dim {-1} +sc_qk=/entry1,NXentry/sample,NXsample/SDS Qk -rank 1 -dim {-1} +sc_ql=/entry1,NXentry/sample,NXsample/SDS Ql -rank 1 -dim {-1} +sc_qm=/entry1,NXentry/sample,NXsample/SDS Qm -rank 1 -dim {-1} +sc_en=/entry1,NXentry/sample,NXsample/SDS energy_transfer -rank 1 \ + -attr {units,mev} -dim {-1} +saaz=/entry1,NXentry/sample,NXsample/SDS azimuthal_angle -attr {units,degree} +sc_tu=/entry1,NXentry/sample,NXsample/SDS x \ + -rank 1 -attr {units,degree} -dim {-1} +sc_tl=/entry1,NXentry/sample,NXsample/SDS y \ + -rank 1 -attr {units,degree} -dim {-1} +#----------- monochromator +mono_type=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS type -type NX_CHAR -rank 1 +sc_ei=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS energy -rank 1 -dim {-1} \ + -attr {units,mev} -dim {-1} +sc_a1=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS rotation_angle \ + -rank 1 -dim {-1} -attr {units,degree} -dim {-1} +omm_zero=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS rotation_angle_zero \ + -rank 1 -dim {-1} -attr {units,degree} +mono_dd=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS d_spacing -attr {units,Angstroem} +sc_mcv=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS curvature \ + -rank 1 -dim {-1} -attr {units,degree} +sc_cum=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS curvature \ + -rank 1 -dim {-1} -attr {units,degree} -dim {-1} +#----------- analyzer +ana_type=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS type -type NX_CHAR -rank 1 +sc_ef=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS energy -rank 1 -dim {-1} \ + -attr {units,mev} +sc_a5=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS rotation_angle \ + -rank 1 -dim {-1} -attr {units,degree} +a5_zero=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS rotation_angle_zero \ + -attr {units,degree} +sc_a4=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS polar_angle -rank 1 -dim {-1} \ + -attr {units,degree} +2t_zero=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS polar_angle_zero -attr {units,degree} +ana_dd=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS d_spacing -attr {units,Angstroem} +ana_az=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS azimuthal_angle -attr {units,degree} +sdistance=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS distance -attr {units,mm} +#--------- detector +set winno 1 +sc_a6=/entry1,NXentry/$(INSTRUMENT),NXinstrument/detector,NXdetector/SDS polar_angle -rank 1 -dim {-1} \ + -attr {units,degree} +2ta_zero=/entry1,NXentry/$(INSTRUMENT),NXinstrument/detector,NXdetector/SDS polar_angle_zero -attr {units,degree} +counts=/entry1,NXentry/$(INSTRUMENT),NXinstrument/detector,NXdetector/SDS data -type NX_INT32 \ + -rank 1 -dim {-1} -attr {signal,1} +det_az=/entry1,NXentry/$(INSTRUMENT),NXinstrument/detector,NXdetector/SDS azimuthal_angle -attr {units,degree} +adistance=/entry1,NXentry/$(INSTRUMENT),NXinstrument/adetector,NXcrystal/SDS distance -attr {units,mm} +#------- monitors +cter_mode=/entry1,NXentry/control,NXmonitor/SDS mode -type NX_CHAR -rank 1 -dim {30} +cter_preset=/entry1,NXentry/control,NXmonitor/SDS preset +motime=/entry1,NXentry/control,NXmonitor/SDS time -attr {units,seconds} -rank 1 -dim {-1} +cter_01=/entry1,NXentry/control,NXmonitor/SDS data -type NX_INT32 -rank 1 -dim {-1} +cter_02=/entry1,NXentry/aux_detector,NXmonitor/SDS data -type NX_INT32 -rank 1 -dim {-1} +#------- NXdata +dana=/entry1,NXentry/data,NXdata/NXVGROUP +emotor_a1=/entry1,NXentry/data,NXdata/SDS a1 \ + -rank 1 -dim {-1} -attr {units,degree} +emotor_a2=/entry1,NXentry/data,NXdata/SDS a2 \ + -rank 1 -dim {-1} -attr {units,degree} +emotor_a3=/entry1,NXentry/data,NXdata/SDS a3 \ + -rank 1 -dim {-1} -attr {units,degree} +emotor_a4=/entry1,NXentry/data,NXdata/SDS a4 -rank 1 -dim {-1} \ + -attr {units,degree} +emotor_a5=/entry1,NXentry/data,NXdata/SDS a5 -rank 1 -dim {-1} \ + -attr {units,degree} +emotor_a6=/entry1,NXentry/data,NXdata/SDS a6 -rank 1 -dim {-1} \ + -attr {units,degree} +danascanvar=/entry1,NXentry/data,NXdata/SDS scanvar \ + -type NX_FLOAT32 -attr {axis,1} -rank 1 -dim {-1} diff --git a/site_ansto/instrument/pelican/script_validator/MANIFEST.TXT b/site_ansto/instrument/pelican/script_validator/MANIFEST.TXT new file mode 100644 index 00000000..b541f143 --- /dev/null +++ b/site_ansto/instrument/pelican/script_validator/MANIFEST.TXT @@ -0,0 +1,2 @@ +sics_ports.tcl +config diff --git a/site_ansto/instrument/pelican/script_validator/config/counter/counter.tcl b/site_ansto/instrument/pelican/script_validator/config/counter/counter.tcl new file mode 100644 index 00000000..6cf16ba7 --- /dev/null +++ b/site_ansto/instrument/pelican/script_validator/config/counter/counter.tcl @@ -0,0 +1,4 @@ +# Make and configure an ANSTO beam monitor counter. +# This must be sourced before the hmm_configuration.tcl until we separate the scan setup from the hmm setup +MakeCounter bm SIM 0.0 +bm SetExponent 0 diff --git a/site_ansto/instrument/pelican/script_validator/config/hmm/hmm_configuration.tcl b/site_ansto/instrument/pelican/script_validator/config/hmm/hmm_configuration.tcl new file mode 100644 index 00000000..ec035a55 --- /dev/null +++ b/site_ansto/instrument/pelican/script_validator/config/hmm/hmm_configuration.tcl @@ -0,0 +1,27 @@ +MakeHM hmm SIM +hmm configure HistMode Normal +hmm configure OverFlowMode Ceil +hmm configure dim0 512 +hmm configure dim1 128 +hmm configure rank 2 +hmm configure BinWidth 4 +#hmm configure BinWidth 1 +hmm preset 100. +hmm CountMode Timer +hmm configure Counter counter +hmm configure init 0 +hmm init + +#MakeScanCommand hmscan bm scan.hdd recover.bin + +namespace eval histogram_memory { +proc hs_prepare {scanobjectname userobjectname} {} +proc hs_finish {scanobjectname userobjectname} {} +proc hs_count_bm_controlled {scanobjectname userobjectname point mode preset} {} +proc hmm_initialize {} {} +proc hmm_setup {mode bankNum rankNum nyc nxc ntc} {} +} + +publish ::histogram_memory::hs_prepare user +publish ::histogram_memory::hs_finish user +publish ::histogram_memory::hs_count_bm_controlled user diff --git a/site_ansto/instrument/pelican/script_validator/sics_ports.tcl b/site_ansto/instrument/pelican/script_validator/sics_ports.tcl new file mode 100644 index 00000000..f71acd54 --- /dev/null +++ b/site_ansto/instrument/pelican/script_validator/sics_ports.tcl @@ -0,0 +1,4 @@ +set quieckport sics-quieck-val-taipan +set serverport sics-server-val-taipan +set interruptport sics-interrupt-val-taipan +set telnetport sics-telnet-val-taipan diff --git a/site_ansto/instrument/pelican/script_validator_ports.tcl b/site_ansto/instrument/pelican/script_validator_ports.tcl new file mode 100644 index 00000000..f71acd54 --- /dev/null +++ b/site_ansto/instrument/pelican/script_validator_ports.tcl @@ -0,0 +1,4 @@ +set quieckport sics-quieck-val-taipan +set serverport sics-server-val-taipan +set interruptport sics-interrupt-val-taipan +set telnetport sics-telnet-val-taipan diff --git a/site_ansto/instrument/pelican/sics_ports.tcl b/site_ansto/instrument/pelican/sics_ports.tcl new file mode 100644 index 00000000..69c79dcd --- /dev/null +++ b/site_ansto/instrument/pelican/sics_ports.tcl @@ -0,0 +1,4 @@ +set quieckport sics-quieck-taipan +set serverport sics-server-taipan +set interruptport sics-interrupt-taipan +set telnetport sics-telnet-taipan diff --git a/site_ansto/instrument/pelican/taipan_configuration.tcl b/site_ansto/instrument/pelican/taipan_configuration.tcl new file mode 100644 index 00000000..5dd814cc --- /dev/null +++ b/site_ansto/instrument/pelican/taipan_configuration.tcl @@ -0,0 +1,53 @@ +# Author: Jing Chen (jgn@ansto.gov.au) + +# Required by server_config.tcl +VarMake Instrument Text Internal +Instrument taipan +Instrument lock + +#START SERVER CONFIGURATION SECTION +source util/dmc2280/dmc2280_util.tcl +source sics_ports.tcl +source server_config.tcl +#END SERVER CONFIGURATION SECTION + +######################################## +# INSTRUMENT SPECIFIC CONFIGURATION + + +fileeval $cfPath(source)/source.tcl +source $cfPath(hipadaba)/hipadaba_configuration.tcl +fileeval $cfPath(motors)/motor_configuration.tcl +fileeval $cfPath(motors)/spin_galil.tcl +fileeval $cfPath(motors)/positmotor_configuration.tcl +fileeval $cfPath(plc)/plc.tcl +fileeval $cfPath(optics)/optics.tcl +fileeval $cfPath(counter)/counter.tcl +#fileeval $cfPath(environment)/temperature/sct_lakeshore_340.tcl +#fileeval $cfPath(environment)/temperature/sct_lakeshore_336.tcl +fileeval $cfPath(hmm)/hmm_configuration.tcl +fileeval $cfPath(nexus)/nxscripts.tcl +fileeval $cfPath(scan)/scan.tcl +fileeval $cfPath(commands)/commands.tcl +fileeval $cfPath(anticollider)/anticollider.tcl +#fileeval $cfPath(environment)/temperature/sct_julabo_lh45.tcl +#fileeval $cfPath(environment)/temperature/sct_qlink.tcl +#fileeval $cfPath(environment)/magneticField/sct_oxford_ips.tcl +#fileeval $cfPath(environment)/environment.tcl +#fileeval $cfPath(environment)/sct_mcr500_rheometer.tcl +#fileeval $cfPath(environment)/sct_protek_common.tcl +fileeval $cfPath(tasmad)/taspub_sics/tasscript.tcl +#fileeval $cfPath(tasmad)/taspub_sics/tasp.tcl +source gumxml.tcl + +::utility::mkVar ::anticollider::protect_detector text manager protect_detector false detector true false +::anticollider::protect_detector "true" + +# init for the tasUB +MakeTasUB tasub m1 m2 mvfocus mhfocus s1 s2 sgu sgl a1 a2 avfocus ahfocus + +server_init +########################################### +# WARNING: Do not add any code below server_init, if you do SICS may fail to initialise properly. + +# You can add extra-configuration code in ../extraconfig.tcl diff --git a/site_ansto/instrument/pelican/util/dmc2280/troubleshoot_setup.tcl b/site_ansto/instrument/pelican/util/dmc2280/troubleshoot_setup.tcl new file mode 100644 index 00000000..2ff79d6d --- /dev/null +++ b/site_ansto/instrument/pelican/util/dmc2280/troubleshoot_setup.tcl @@ -0,0 +1,19 @@ +# Platypus troubleshooter setup + +# Author: Ferdi Franceschini (ffr@ansto.gov.au) + +set configFileName "motor_configuration.tcl" + +# These subroutines should be installed on the controllers +set contSubs(dmc2280_controller1) "#AUTO #LIMSWI #SOLCTRL #TCPERR" +set contSubs(dmc2280_controller2) "#AUTO #LIMSWI #SOLCTRL #TCPERR" +set contSubs(dmc2280_controller3) "#AUTO #HOME #LOOPER #RES #TCPERR" +set contSubs(dmc2280_controller4) "#AUTO #HOME #LIMSWI #LOOPER #TCPERR" + + +# These threads should be running on the controllers. +set contThreads(dmc2280_controller1) "0" +set contThreads(dmc2280_controller2) "0" +set contThreads(dmc2280_controller3) "0" +set contThreads(dmc2280_controller4) "0" +