#----------------------------------------------------------
# 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

}