#-----------------------------------------------------------------------
# Scripts for the SANS-II Risoe instrument as installed at PSI.
#
# Initial version: Mark Koennecke, Febrary 2003
#----------------------------------------------------------------------
#source $root/log.tcl
#source $root/batch.tcl
source $root/nxsupport.tcl

if { [info exists sansinit] == 0 } {
  set sansinit 1
  Publish beamstop Spy
  Publish stopmot User
#  Publish collRead Spy #-----for debugging
#  Publish collSet  Spy #-----for debugging
  Publish collimator Spy
  Publish coll Spy
#  Publis att   Spy
  Publish batchrun  User
  Publish LogBook User
  Publish count User
  Publish Repeat User
  Publish storedata User
  Publish disto     Spy
  Publish statusinfo Spy
  Publish displaycontrol User
  Publish displayunits User
  Publish setdispar User
}  
#======================== general useful stuff ======================
proc SplitReply { text } {
     set l [split $text =]
     return [lindex $l 1]
}
#======================== Collimator stuff ===========================
proc collRead args {
    set res [ecb1 func 164 0 0 0 0]
    set l [split $res]
    return [expr ([lindex $l 1] << 8) + [lindex $l 0]] 
} 
#--------------------------------------------------------------------
proc collSet {val} {
    switch $val {
	1 { set d 0}
	2 { set d 01}
	3 { set d 03}
	4 { set d 07}
	5 { set d 017}
	6 { set d 037}
	default {
	    error "Invalid collimation length requested"
	}
    }
    ecb1 func 148 $d 0 0 0 
    return OK
}
#--------------------------------------------------------------------
proc collimator args {
    if { [llength $args ] < 1} {
#------------- read case
	set res [collRead]
	set res [expr $res & 255]
	set length -1
	switch $res {
	    0 { set length 1}
	    1 { set length 2}
	    3 { set length 3}
	    7 { set length 4}
	    15 { set length 5}
	    31 { set length 6}
	    default {
		error "Unknown reply $res from colRead"
	    }
        }
	return [format "collimator = %f" $length]
    } else {
#------------- set case
	set rights [SplitReply [config myrights]]
	if {$rights > 2} {
	    error "Insufficient rights to drive collimator"
	}
	return [collSet [lindex $args 0]] 
    }
}
#----------------------------------------------------------------------
proc coll args {
    return collimator $args
}
#======================== Beamstop stuff ==============================
proc beamstop args {
#----- without arguments: request
    if { [llength $args] < 1} {
	set res [collRead 0]
	if { ($res & 256) > 0 } {
	    return "0 in"
	} else {
	    return "1 out"
	}
    }
#---- with arguments: change, but only with at least user privilege
    set rights [SplitReply [config myrights]]
    if {$rights > 2} {
	error "Insufficient rights to drive beamstop"
    }
    switch [lindex $args 0]  {
	0 { set d 1}
	in {set d 1}
	1  {set d 0}
	out {set d 0}
	default{
	    error "Invalid beamstop requested"
	} 
    }
    ecb1 func 160 $d 0 0 0
    return OK
}
#================================ stopmot ================================
proc stopmot args {
    ecb1 func 132 0 0 0 0
}
#=============================== counting ===============================
proc count { {mode  NULL } { preset NULL } } {
#----- deal with mode
     set mode2 [string toupper $mode]
     set mode3 [string trim $mode2]
     set mc    [string index $mode2 0]
     if { [string compare $mc T] == 0 } {
       banana CountMode Timer
     } elseif { [string compare $mc M] == 0 } {
       banana CountMode Monitor
     }
#------ deal with preset
     if { [string compare $preset NULL] != 0 } {
       banana preset $preset
     }
#------ prepare a count message
     set ret [catch {Success} msg]
     set a [banana preset]
     set aa [SplitReply $a]
     set b [banana CountMode]
     set bb [SplitReply $b]
     set tt [sicstime]
     set sn [SplitReply [sample]]
     starttime [sicstime]
     ClientPut [format " Starting counting in %s mode with a preset of %s" \
               $bb $aa ]
     ClientPut [format "Count started at %s" $tt] 
     ClientPut [format " sample name: %s" $sn]
#------- count
     banana count
     set ret [catch {Success} msg]
#------- StoreData
     storedata
     set ttt [sicstime]
     if { $ret != 0 } {
       ClientPut [format "Counting ended at %s" $ttt]
       error [format "Counting ended with error: %s" $msg]
     }
     ClientPut [format "Counting ended at %s" $ttt]
     ClientPut "Total Counts: [SplitReply [banana sum 0 128 0 128]]"
}
#---------------- Repeat -----------------------------------------------
proc repeat { num {mode  NULL} {preset NULL} }  {
     for { set i 0 } { $i < $num } { incr i } {
        count $mode $preset
     }
}
#=================== Data File Writing =================================
proc writeBeforeSample args {
    writeTextVar etitle title
    writeTextVar etime  starttime
    nxscript puttext endtime [sicstime]
    writeTextVar iname instrument
    nxscript puttext sname SINQ, Paul Scherrer Institut
    nxscript puttext stype Continuous flux spallation source
    nxscript puttext vname Dornier velocity selector
    set res [nvs list]
    set l [split $res "\n"]
    nxscript putfloat vrot [SplitReply [lindex $l 0]]
    writeFloatVar  vtilt tilt
    writeFloatvar vlambda lambda
    writeFloatVar colli collimator 
#    writeFloatVar atti attenuator
}
#--------------------------------------------------------------------
proc writeSample args {
    writeTextVar san sample
    writeTextVar stable sampletable
#------------- sample chamber
    nxscript putmot charo sr
    nxscript putmot chax  stx
    nxscript putmot chaz  stz
    nxscript putmot chac  sc
#------------- goniometer    
    nxscript putmot goniox tu
    nxscript putmot gonioy tl
    nxscript putmot goniochi gu
    nxscript putmot goniophi gl
#------------- xyz-table
    nxscript putmot tablex sx
    nxscript putmot tabley sy
    nxscript putmot tablez sz
    nxscript putmot tableom om
#------------ sans1table
    nxscript putmot sans1chi chi
    nxscript putmot sans1om  ome
#---------- environment
    if { [catch {set tmp [SplitReply [temperature]]} tmp] == 0} {
	nxscript putfloat satemp $tmp
    }
    if { [catch {set tmp [SplitReply [magnet]]} tmp] == 0} {
	nxscript putfloat samag $tmp
    }
    writeTextVar saenv environment
}
#----------------------------------------------------------------------
proc writeAfterSample args {
#-------- beamstop
    nxscript putmot vsx dh
    nxscript putmot vsy dv
    set tst [beamstop]
    if { [string first in $tst] >= 0} {
	nxscript putfloat bspos 0
    } else {
	nxscript putfloat bspos 1.
    }
#------- counter
    nxscript putcounter cter counter
#------- detector
    nxscript putmot ddx dz
    nxscript puthm ddcounts banana
    for { set i 0} { $i < 128} {incr i} {
	set detar($i) [expr -64. + $i]
    }
    nxscript putarray ddcx detar 128
    nxscript putarray ddcy detar 128
}
#----------------------------------------------------------------------
proc makeLinks args {
    nxscript makelink dan ddcounts
    nxscript makelink dan ddcx
    nxscript makelink dan ddcy
}
#-----------------------------------------------------------------------
proc storedata args {
    global root
    set filnam [makeFileName]
    clientput [format "Writing %s" $filnam]
    nxscript create5 $filnam $root/sans2.dic
    writeStandardAttributes $filnam

    writeBeforeSample
    
    writeSample

    writeAfterSample

    makeLinks

    nxscript close
}
#========================= laser distance reading ========================
proc disto args {
    global distoCON
    gpib sendwithterm $distoCON a 13
    gpib readtillterm $distoCON 10
    gpib sendwithterm $distoCON g 13
    set result [gpib readtillterm $distoCON 10]
    set l [split $result " +" ]
    return [string trim [lindex $l 1] 0]
}
#========================= helper function for status display ============
proc statusinfo {} {
    append result "SICS  = " [SplitReply [status]] " \n"
    append result [title] " \n"
    append result [sample] " \n"
    append result [user]  " \n"
    set tst [nvs list]
    set l [split $tst "\n"]
    append result "Velocity selector rotation = " \
	    [SplitReply [lindex $l 0]] " \n" 
    append result "lambda = " [SplitReply [lambda]]  " \n"
    append result "Collimation length = " [SplitReply [collimator]] " \n"
    append result "filenumber = " [SplitReply [sicsdatanumber]] " \n"
    return $result
}
#============= scripts for controlling the ECB display unit ============
proc disloadpar {unit offset val} {
    ecb1 func 166 0 [expr $unit -1] $offset $val 
}
#-----------------------------------------------------------------------
proc startdisplay {} {
    ecb1 func  128 0 0 0 1
}
#----------------------------------------------------------------------
proc stopdisplay {} {
    ecb1 func 129 0 0 0 0
}
#-----------------------------------------------------------------------
proc setdispar {unit name key parnum} {
    switch $key {
	timer {set type 1}
	scaler {set type 2}
	ratemeter {set type 4}
	motor {set type 3}
	encoder {set type 5}
	default {
	    error "Unknown parameter key"
	}
    }
    stopdisplay
    disloadpar $unit 0 [ecb1 toint [string index $name 0]] 
    disloadpar $unit 1 [ecb1 toint [string index $name 1]] 
    disloadpar $unit 2 [ecb1 toint [string index $name 2]] 
    disloadpar $unit 3  $parnum
    disloadpar $unit 4 $type 
    startdisplay
}
#--------------------------------------------------------------------------
proc cleardisplay {} {
    ecb1 func 131 0 0 0 0
}
#-------------------------------------------------------------------------
proc defdisplay { num} {
    ecb1 func 166 1 $num 0 0
}
#------------------------------------------------------------------------
proc displayunits { u1 u2 u3 u4} {
    ecb1 func 130 $u1 $u2 $u3 $u4
}
#-----------------------------------------------------------------------
proc displaycontrol {command} {
    ecb1 func 170 0 0 $command 0
}