#----------------------------------------------------------------------------
# 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
  mcinstall
}
source $home/log.tcl
source $home/nxsupport.tcl
source $home/nxdmc.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
		}
    }
#------- process data lines
    puts $out "// mult Q(hkl) F2 DW w"
    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]
		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
	} 
} 
#------------------------------------------------------------------------
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"
	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 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
     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 sample 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
}