#----------------------------------------------------------------------------
# VDMC instrument special scripted commands
#
# Mark Koennecke, June 2005
#---------------------------------------------------------------------------
source $home/mcsupport.tcl

if { [info exists vdmcinit] == 0 } {
  set vdmcinit 1
  Publish LogBook Spy
  Publish count   User
  Publish Repeat  User
  Publish storedmcdata User
  Publish rundmcsim User
  Publish copydmcdata User
  Publish sample User
  Publish wwwsics Spy
  Publish wwwfilefornumber Spy
  mcinstall
  Publish gethm Spy
  Publish hdbscan User
  Publish hdbprepare User
  Publish hdbcollect User
  Publish mgbatch Spy
  Publish loadmgbatch Spy
  Publish listbatchfiles Spy
}
source $home/log.tcl
source $home/nxsupport.tcl
source $home/nxdmc.tcl
source $home/gumxml.tcl
source $home/gumibatch.tcl
#------------------------------------------------------------------------
proc SplitReply { text } {
     set l [split $text =]
     return [lindex $l 1]
}
#---------------------------------------------------------------------
# load a lazy pulverix file
#---------------------------------------------------------------------
proc washlazy {name} {
    global home
    set newNam [file rootname [file tail $name]]
    set in [open $name r]
    set out [open $home/$newNam.q w]
#------- proceed to first header line 
    while { [gets $in line] >= 0} {
		if { [string first "H  K  L  THETA  2THETA D VALUE" $line] > 0} {
		    break
		}
#-------- A second version to treat the messed up lazy pulverix files
# uploaded through the WWW-interface
		if { [string first "H K L THETA" $line] >= 0} {
		    break
		}
    }
#------- process data lines
    puts $out "// mult Q(hkl) F2 DW w"
    clientput "HKL found at: $line"
    while { [gets $in line] >= 0} {
		set num [scan $line "%d %d %d %f %f %f %f %f %d %d %d %f %f %f %f %f %d"\
			     h k l th th2 d di sin h2 k2 l2 I F A B ang mul]
	        clientput "Line = $num, $line"
		if { $num == 17} {
	    	set q [expr (2.*3.14159265358979323846)/$d]
	    	set f2 [expr $F * $F]
	    	puts $out [format "%d %f %f 1 0" $mul $q $f2]
		}
    }
    close $in
    close $out
}
#----------------------------------------------------------------------
# script for setting the sample. We only allow samples for which
# there is a corresponing q data file
#------------------------------------------------------------------------
proc sample args {
	global home
	if { [llength $args] < 1} {
		set sa [SplitReply [sampleintern]]
		return "sample = $sa"
	}
	set txt [lindex $args 0]
#-------- list
	if { [string compare $txt list] == 0} {
		set l [glob $home/*.q]
		foreach f $l {
			append out [file rootname [file tail $f]] "\n"
        }
		return $out
	}
#--------- load
	if { [string compare $txt load] == 0} {
		if { [llength $args] < 2} {
			error "Need path to lazy pulverix output file to load"
		}
		set nam [lindex $args 1]
		washlazy  $nam
		set nam2 [file rootname [file tail $nam]]
		eval sampleintern $nam2
		return OK
	}
	if { ![file exists $home/$txt.q] } {
		error "No Q data for sample $txt"
	} else {
		eval sampleintern $txt
		return OK
	}
} 
#-----------------------------------------------------------------------
# Scripts required for controlling McStas simulations
#-----------------------------------------------------------------------
proc rundmcsim {mode preset} {
	global home
	append command $home/dmc_sics05 " -f $home/dmc.xml --format=\"XML\""
	append command " -n 1e10 "
	append command " lambda=[string trim [SplitReply [lambda]]]"
	append command " Det_start=[string trim [SplitReply [TwoThetaD]]]"
	append command " samplefile=$home/[string trim [SplitReply [sampleintern]]].q"
	append command " monfile=$home/monfile "
	append command " >& $home/dmc.log &"
	clientput "Starting McStas.. "
#	clientput $command
	set ret [catch {eval exec $command} msg]
	if {$ret != 0} {
		error $msg
	} else {
		return $msg
	} 
}
#------------------------------------------------------------------------
# Run the DMC simulation in an optimized mode with neutrons 
# precalculated for various wave length until the sample slit
#------------------------------------------------------------------------
set dmcdata(2.56) dmc256.dat
set dmcdata(4.2)  dmc420.dat
set dmcdata(2.45) dmc245.dat
set dmcdata(3.8)  dmc380.dat
#-------------------------------------------------------------------------
proc rundmcoptsim {mode preset } {
	global home dmcdata
#--------- locate closest precalculated neutron data file
	set lambda [SplitReply [lambda]]
	set myLambda $lambda
	set wv [array names dmcdata]
	set diff 999999.99
	set lambdafile $dmcdata(2.56)
	foreach w $wv {
		set tmp [expr abs($w - $lambda)]
		if { $tmp < $diff} {
			set diff $tmp
			set lambdafile $dmcdata($w)
			set myLambda $w
		}
	}
#-------- build McStas command line
	append command $home/dmcafter " -f $home/dmc.xml --format=\"XML\""
	append command " -n 1e10 "
	append command " lambdafile=$home/$lambdafile"
	append command " Det_start=[string trim [SplitReply [TwoThetaD]]]"
	append command " samplefile=$home/[string trim [SplitReply [sampleintern]]].q"
	append command " monfile=$home/monfile "
	append command " repeat=1000000000 "
	append command " >& $home/dmc.log &"
#--------- start McStas
	clientput "Starting McStas.. "
	clientput "Coercing $lambda to precalculated $myLambda"
#	clientput $command
	set ret [catch {eval exec $command} msg]
	if {$ret != 0} {
		error "ERROR: $msg"
	} else {
		return $msg
	} 
        wait 5
} 
#------------------------------------------------------------------------
proc copydmcdataold { } {
	global home
	set mcversion "McStas 1.8 - Mar. 05, 2004"
	washsimfile $home/dmc.xml
	mcreader open $home/dmc.xml
	mcreader insertmon \
	"/$mcversion/DMC_diff/dmc.xml/PSD_sample/values" \
	counter 1 [expr 1./350]
	mcreader insertmon \
	"/$mcversion/DMC_diff/dmc.xml/Det9/det9.dat/values" \
	counter 5
	set hmScale [SplitReply [counter getmonitor 5]]
	if { $hmScale <= 0} {
		set hmScale 1e9
	} else {
		set hmScale [expr $hmScale * 5e4]
	}
	clientput "HM scale = $hmScale"
	mcreader inserthm \
	"/$mcversion/DMC_diff/dmc.xml/Det9/det9.dat/data"  banana $hmScale
	mcreader close
}
#------------------------------------------------------------------------
proc copydmcdata { } {
	global home
	set mcversion "McStas 1.8 - Mar. 05, 2004"
#---- loop till the file can be opened 
        for {set i 0} {$i < 20} {incr i} {
	  washsimfile $home/dmc.xml
	    set stat [catch {mcreader open $home/dmc.xml} msg]
	    if {$stat == 0} {
              break
	    } else {
	       file copy -force $home/dmc.xml $home/brokenfile.xml
	      wait 1
	    }
        }
	mcreader insertmon \
	"/$mcversion/DMC_diff/dmc.xml/PSD_sample/values" \
	counter 1 [expr 1./350]
#	mcreader insertmon \
#	"/$mcversion/DMC_diff/dmc.xml/Det9/det9.dat/values" \
#	counter 4
	set val [mcreader getfield\
		"/$mcversion/DMC_diff/dmc.xml/Det9/det9.dat/values"]
	set l [split $val]
	set a [lindex $l 0]
	set b [lindex $val 2]
	if {$b > .0} {
		set hmScale [expr $b / $a]
		set hmScale [expr $hmScale / 6.]
	} else {
		set hmScale 1e9
	}
	clientput "HM scale = $hmScale"
	mcreader inserthm \
	"/$mcversion/DMC_diff/dmc.xml/Det9/det9.dat/data"  banana $hmScale
	mcreader close
}
#-------------------------------------------------------------------------
proc dmcdump {pid} {
#--do nothing: progress is doing it for us
}
#--------------------------------------------------------------------------
mccontrol configure mcstart rundmcoptsim
mccontrol configure mccopydata copydmcdata
mccontrol configure update 30
mccontrol configure mcmonfile $home/monfile
mccontrol configure monitorscale [expr 1. /350]
mccontrol configure mcdump mcstasdump
#--------------------------------------------------------------------------
# A count command for VDMC
# All arguments are optional. The current values will be used if not
# specified
# Dr. Mark Koennecke, Juli 1997
#--------------------------------------------------------------------------
proc count { {mode  NULL } { preset NULL } } {
     starttime [sicstime]
     catch {temperature log clear} msg
#----- 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 a [banana preset]
     set aa [SplitReply $a]
     set b [banana CountMode]
     set bb [SplitReply $b]
     ClientPut [format " Starting counting in %s mode with a preset of %s" \
               $bb $aa] 
#------- count
     banana InitVal 0
     wait 1
     hupdate /graphics/powder_diagram/counts
     banana count
     set ret [catch {Success} msg]
#------- StoreData
     storedata
     if { $ret != 0 } {
       error [format "Counting ended with error"]
     }
}
#---------------- Repeat -----------------------------------------------
proc repeat { num {mode  NULL} {preset NULL} }  {
     for { set i 0 } { $i < $num } { incr i } {
        set ret [catch {count $mode $preset} msg]
        if {$ret != 0} {
            error "Counting ended with error"
        }
     }
}
#--------------------------------------------------------------------------
proc GetNum { text } {
	set list [split $text =]
        return [lindex $list 1]
}
#------------------------------------------------------------------------
# This implements the wwwsics command which generates a listing of
# important experiment parameters in html format for the SICS WWW Status
# application. This version is for the powder diffractometers DMC and
# HRPT. 
#
# Mark Koennecke, March 2000
#------------------------------------------------------------------------
proc wwwsics {} {
#----- get all the data we need
 set user  [GetNum [user]]
 set sample [GetNum [sample]]
 set tit    [GetNum [title]]
 set ret [catch {lambda} msg]
 if {$ret != 0 } {
    set lam Undetermined
 } else {
    set lam [GetNum $msg]
 }
 set ret [catch {temperature} msg]
 if {$ret != 0 } {
    set tem Undetermined
 } else {
    set tem [GetNum $msg]
 }
 set run [GetNum [sicsdatanumber]]
 catch {incr run} msg
 set stat [GetNum [status]]
#------- html format the reply
 append result "<table BORDER=2>"
 append result <tr> <th>Run Number</th> <td> $run </td> </tr>
 append result <tr> <th>Title</th> <td> $tit </td> </tr>
 append result <tr> <th>User</th> <td> $user </td> </tr>
 append result <tr> <th>Sample </th> <td> $sample </td> </tr>
 append result <tr> <th>wavelength</th> <td> $lam</td> </tr>
 append result <tr> <th>Sample Temperature</th> <td> $tem</td> </tr>
 append result <tr> <th>Status</th> <td> $stat</td> </tr>
 append result </table>
 return $result
} 
#----------------------------------------------------------------------------
# wwpar formats a parameter for display in the WWW-control. 
#
# Mark Koennecke, June 2000
#---------------------------------------------------------------------------
set ret [catch {wwwpar motor a4} msg]
if {$ret != 0} {
  Publish wwwpar Spy 
  Publish wwwuser Spy
} 
#--------------------------------------------------------------------------
proc WWWNum { text } {
	set list [split $text =]
        return [lindex $list 1]
}
#---------------------------------------------------------------------------
proc wwwpar {type mot} {
  append txt $mot ,
#----- get lowerlimit, either from motor or temperature controller
  if { [string compare $type motor] == 0} { 
     set ret [catch {$mot softlowerlim} msg]
  } else {
      set ret [catch {$mot lowerlimit} msg]
  }
  if {$ret != 0 } {
    append txt UNKNOWN ,
  } else {
    append txt [WWWNum $msg] ,
  }
#------- get value
  set ret [catch {$mot} msg]
  if {$ret == 0} {
     append txt [WWWNum $msg] ,
  } else  {
     append txt UNKNOWN ,
  } 
#----- get upperlimit, either from motor or temperature controller 
  if {[string compare $type motor] == 0} { 
      set ret [catch {$mot softupperlim} msg]
  } else {
      set ret [catch {$mot upperlimit} msg]
  }
  if {$ret != 0 } {
    append txt UNKNOWN 
  } else {
    append txt [WWWNum $msg] 
  }
  return $txt 
}
#------------- wwwuser formats user information into a html table
proc wwwuser {} {
  lappend list title  user email phone adress
  append txt "<table>"
  foreach e $list {
    set ret [catch {$e} msg]
    if {$ret == 0} {
      set l [split $msg =]
      append txt "<tr><th>" [lindex $l 0] "</th><td> \n"
      append txt "<INPUT type=text name=[lindex $l 0] value=\"[lindex $l 1]\" "
      append txt "\n LENGTH=40 MAXLENGTH=80></td></tr>\n "
    }
  }  
  return $txt
}
#------------- wwwfilefornumber returns the path to a data file for a
#              number
proc wwwfilefornumber {num} {
    return [makeSimForNum $num]
}
#-------------------------------------------------------------------
proc gethm {} {
    banana uuget 0
}
#--------------------------------------------------------------------
proc hdbscan {scanvars scanstart scanincr np mode preset} {
    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 ,]
    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 status [catch {xxxscan run $np $mode $preset} msg]
    if {$status == 0} {
	return $msg
    } else {
	error $msg
    }
}
#------------------------------------------------------------------------------
proc hdbprepare {obj userdata } {
    stdscan prepare $obj userdata
    hupdate /graphics/scan_data/dim
}
#------------------------------------------------------------------------------
proc hdbcollect {obj userobj np} {
    stdscan collect $obj $userobj $np
    hupdate /graphics/scan_data/scan_variable
    hupdate /graphics/scan_data/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]
    set txt [SplitReply [exe batchpath]]
    set dirlist [split $txt :]
    set txt [SplitReply [exe syspath]]
    set dirlist [concat $dirlist [split $txt :]]
    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 {
		    set nam [file tail  $f]
		    if { [lsearch $result $nam] < 0} {
			lappend result $nam
                    }
		}
            }
        }
    }
    foreach bf $result {
	append resulttxt $bf ,
    }
    return [string trim $resulttxt ,]
}
#-----------------------------------------------------------------------