#-----------------------------------------------------------------------
# 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
#----------------------------------------------------------------------
if { [info exists hdbinit] == 0 } {
  set hdbinit 1
  InstallHdb
  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 hmake Mugger
#  Publish hmakescript Mugger
#  Publish hlink    Mugger
#  Publish hcommand Mugger
}
#===================================================================
# 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 
#===================== 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 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<component id=\"$nodename\" dataType=\"$type\">\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  "$prefix</component>\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<property id=\"$key\">\n"
#    foreach v [split $value ,] {
#      lappend proplist "$prefix$prefix<value>$v</value>\n"
#    }
    lappend proplist "$prefix$prefix<value>$value</value>\n"  
    lappend proplist "$prefix</property>\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<property id=\"$key\">\n"
    lappend proplist "$prefix$prefix<value>$value</value>\n"  
    lappend proplist "$prefix</property>\n"
  }
  if [info exists proplist] {return $proplist}
}
#--------------------------------------------------------------------------
proc getgumtreexml {path} {
  append result "<?xml version = \"1.0\" encoding = \"UTF-8\"?>\n"
  append result "<hipadaba:SICS xmlns:hipadaba=\"http://www.psi.ch/sics/hipadaba\" >\n"

  if {[string compare $path "/" ] == 0} {
    foreach n [hlist $path] {
      set result [make_nodes $n $result 2]
    }
  } else {
#    set result [make_nodes $path $result 2]
    foreach n [hlist $path] {
      set result [make_nodes $path/$n $result 2]
    }
  }

  append result "</hipadaba:SICS>\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 ,]
    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
    hupdate $stdscangraph/dim
}
#------------------------------------------------------------------------------
proc hdbcollect {obj userobj np} {
    global stdscangraph
    stdscan collect $obj $userobj $np
    hupdate $stdscangraph/scan_variable
    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 {} {
	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/starttime plain spy text
    hfactory  $path/getdata/endtime 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
    hattach /instrument/experiment/user adress address
    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" \
	"exe batchpath" text
    hsetprop /instrument/experiment/batchpath priv user
}
#----------------------------------------------------------
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
    hupdate /instrument/commands/batch/execute/file/values 
}
#------------------------------------------------------------------
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
}