- Updated GumTree support for most recent versions
This commit is contained in:
koennecke
159
mcstas/dmc/gumibatch.tcl
Normal file
159
mcstas/dmc/gumibatch.tcl
Normal file
@@ -0,0 +1,159 @@
|
||||
#-------------------------------------------------------------
|
||||
# This is a set of Tcl procedures which try to convert an old
|
||||
# batch file into a batch file suitable for Mountaingum.
|
||||
#
|
||||
# copyright: GPL
|
||||
#
|
||||
# Mark Koennecke, February 2008
|
||||
#-------------------------------------------------------------
|
||||
if {[string first tmp $home] < 0} {
|
||||
set tmppath $home/tmp
|
||||
} else {
|
||||
set tmppath $home
|
||||
}
|
||||
#-------------------------------------------------------------
|
||||
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]
|
||||
# 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} {
|
||||
puts $out "\#NODE: $path"
|
||||
puts $out "clientput BatchPos = 1"
|
||||
puts $out $command
|
||||
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]
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user