update for Lyrebird deployment
r3105 | jgn | 2011-04-20 08:48:12 +1000 (Wed, 20 Apr 2011) | 1 line
This commit is contained in:
Jing Chen
committed by
Douglas Clowes
Douglas Clowes
parent
9acffeb772
commit
8b1d0103f4
@@ -0,0 +1,317 @@
|
||||
#----------------------------------------------------------------------
|
||||
# Support functions for table processing in SICS
|
||||
#
|
||||
# This includes a CSV processing module from someone else. See below.
|
||||
#
|
||||
# copyright: see file COPYRIGHT
|
||||
#
|
||||
# Mark Koennecke, November 2008
|
||||
#----------------------------------------------------------------------
|
||||
if { [info exists __tableheader] == 0 } {
|
||||
set __tableheader NULL
|
||||
Publish tableexe User
|
||||
Publish loop User
|
||||
}
|
||||
#=====================================================================
|
||||
# Csv tcl package version 2.0
|
||||
# A tcl library to deal with CSV (comma separated value)
|
||||
# files, generated and readable by some DOS/Windows programs
|
||||
# Contain two functions:
|
||||
# csv2list string ?separator?
|
||||
# and
|
||||
# list2csv list ?separator?
|
||||
# which converts line from CSV file to list and vice versa.
|
||||
#
|
||||
# Both functions have optional "separator argument" becouse some silly
|
||||
# Windows
|
||||
# program might use semicomon as delimiter in COMMA separated values
|
||||
# file.
|
||||
#
|
||||
# Copyright (c) SoftWeyr, 1997-99
|
||||
# Many thanks to Robert Seeger <rseeger1@nycap.rr.com>
|
||||
# for beta-testing and fixing my misprints
|
||||
# This file is distributed under GNU Library Public License. Visit
|
||||
# http://www.gnu.org/copyleft/gpl.html
|
||||
# for details.
|
||||
|
||||
#
|
||||
# Convert line, read from CSV file into proper TCL list
|
||||
# Commas inside quoted strings are not considered list delimiters,
|
||||
# Double quotes inside quoted strings are converted to single quotes
|
||||
# Double quotes are stripped out and replaced with correct Tcl quoting
|
||||
#
|
||||
|
||||
proc csv2list {str {separator ","}} {
|
||||
#build a regexp>
|
||||
set regexp [subst -nocommands \
|
||||
{^[ \t\r\n]*("(([^"]|"")*)"|[^"$separator \t\r]*)}]
|
||||
set regexp1 [subst -nocommands {$regexp[ \t\r\n]*$separator\(.*)$}]
|
||||
set regexp2 [subst -nocommands {$regexp[ \t\r\n]*\$}]
|
||||
set list {}
|
||||
while {[regexp $regexp1 $str junk1 unquoted quoted\
|
||||
junk2 str]} {
|
||||
if {[string length $quoted]||$unquoted=="\"\""} {
|
||||
regsub -all {""} $quoted \" unquoted
|
||||
}
|
||||
lappend list $unquoted
|
||||
}
|
||||
if {[regexp $regexp2 $str junk unquoted quoted]} {
|
||||
if {[string length $quoted]||$unquoted=="\"\""} {
|
||||
regsub -all {""} $quoted \" unquoted
|
||||
}
|
||||
lappend list $unquoted
|
||||
if {[uplevel info exist csvtail]} {
|
||||
uplevel set csvtail {""}
|
||||
}
|
||||
} else {
|
||||
if {[uplevel info exist csvtail]} {
|
||||
uplevel [list set csvtail $str]
|
||||
} else {
|
||||
return -code error -errorcode {CSV 1 "CSV parse error"}\
|
||||
"CSV parse error: unparsed tail \"$str\""
|
||||
}
|
||||
}
|
||||
return $list
|
||||
}
|
||||
|
||||
proc list2csv {list {separator ","}} {
|
||||
set l {}
|
||||
foreach elem $list {
|
||||
if {[string match {} $elem]||
|
||||
[regexp {^[+-]?([0-9]+|([0-9]+\.?[0-9]*|\.[0-9]+)([eE][+-]?[0-9]+)?)$}\
|
||||
$elem]} {
|
||||
lappend l $elem
|
||||
} else {
|
||||
regsub -all {"} $elem {""} selem
|
||||
lappend l "\"$selem\""
|
||||
}
|
||||
}
|
||||
return [join $l $separator]
|
||||
}
|
||||
|
||||
proc csvfile {f {separator ","}} {
|
||||
set csvtail ""
|
||||
set list {}
|
||||
set buffer {}
|
||||
while {[gets $f line]>=0} {
|
||||
if {[string length $csvtail]} {
|
||||
set line "$csvtail\n$line"
|
||||
} elseif {![string length $line]} {
|
||||
lappend list {}
|
||||
continue
|
||||
}
|
||||
set rec [csv2list $line $separator]
|
||||
set buffer [concat $buffer $rec]
|
||||
if {![ string length $csvtail]} {
|
||||
lappend list $buffer
|
||||
set buffer {}
|
||||
}
|
||||
}
|
||||
if {[string length $csvtail]} {
|
||||
return -code error -errorcode {CSV 2 "Multiline parse error"}\
|
||||
"CSV file parse error"
|
||||
}
|
||||
return $list
|
||||
}
|
||||
|
||||
proc csvstring {str {separator ","}} {
|
||||
set csvtail ""
|
||||
set list {}
|
||||
set buffer {}
|
||||
foreach line [split $str "\n"] {
|
||||
if {[string length $csvtail]} {
|
||||
set line "$csvtail\n$line"
|
||||
} elseif {![string length $line]} {
|
||||
lappend list {}
|
||||
continue
|
||||
}
|
||||
set rec [csv2list $line $separator]
|
||||
set buffer [concat $buffer $rec]
|
||||
if {![ string length $csvtail]} {
|
||||
lappend list $buffer
|
||||
set buffer {}
|
||||
}
|
||||
}
|
||||
if {[string length $cvstail]} {
|
||||
return -code error -errorcode {CSV 2 "Multiline parse error"}\
|
||||
"CSV string parse error"
|
||||
}
|
||||
return $list
|
||||
}
|
||||
|
||||
package provide Csv 2.1
|
||||
#========================================================================
|
||||
# The plan here is such: operations which happen fast or immediatly are
|
||||
# done at once. Count commands or anything given as command is appended
|
||||
# to a list for later execution. The idea is that this contains the
|
||||
# actual measuring payload of the row.
|
||||
# Drivables are immediatly started.
|
||||
# After processing the rows, there is a success to wait for motors to arrive
|
||||
# Then the commands for later execution are run. This frees the user of the
|
||||
# the necessity to have the count or whatever command as the last thing in the row
|
||||
#--------------------------------------------------------------------------------
|
||||
proc testinterrupt {} {
|
||||
set int [getint]
|
||||
if {[string first continue $int] < 0} {
|
||||
error "Interrupted"
|
||||
}
|
||||
}
|
||||
#--------------------------------------------------------------------------------
|
||||
proc processtablerow {line} {
|
||||
global __tableheader
|
||||
set parlist [csv2list $line]
|
||||
for {set i 0} {$i < [llength $__tableheader]} {incr i} {
|
||||
set type [lindex $__tableheader $i]
|
||||
set data [lindex $parlist $i]
|
||||
#--------- first process special types
|
||||
switch $type {
|
||||
monitor {
|
||||
lappend laterExe "count monitor $data"
|
||||
continue
|
||||
}
|
||||
timer {
|
||||
lappend laterExe "count timer $data"
|
||||
continue
|
||||
}
|
||||
compar {
|
||||
append command [join [lrange $parlist $i end]]
|
||||
lappend laterExe $command
|
||||
break
|
||||
}
|
||||
command {
|
||||
lappend laterExe $data
|
||||
continue
|
||||
}
|
||||
batch {
|
||||
lappend laterExe "exe $data"
|
||||
continue
|
||||
}
|
||||
}
|
||||
#----------- now look for drivables
|
||||
set test [sicstype $type]
|
||||
if {[string compare $test DRIV] == 0} {
|
||||
set status [catch {run $type $data} msg]
|
||||
if {$status != 0} {
|
||||
clientput "ERROR: $msg for $type with $data"
|
||||
}
|
||||
continue
|
||||
}
|
||||
#------------- now look for special objects
|
||||
set objtype [sicsdescriptor $type]
|
||||
switch $objtype {
|
||||
SicsVariable -
|
||||
MulMot -
|
||||
Macro {
|
||||
set status [catch {eval $type $data} msg]
|
||||
if {$status != 0} {
|
||||
clientput "ERROR: $msg for $type with $data"
|
||||
}
|
||||
continue
|
||||
}
|
||||
default {
|
||||
clientput "Skipping non recognized column $type with data $data"
|
||||
}
|
||||
}
|
||||
}
|
||||
set status [catch {success} msg]
|
||||
if {$status != 0} {
|
||||
clientput "ERROR: $msg while waiting for motors to arrive"
|
||||
}
|
||||
testinterrupt
|
||||
foreach command $laterExe {
|
||||
eval $command
|
||||
testinterrupt
|
||||
}
|
||||
}
|
||||
#------------------------------------------------------------------------
|
||||
proc tableexe {tablefile} {
|
||||
global __tableheader
|
||||
if {[string first NULL $__tableheader] < 0} {
|
||||
error "Tableexe already running, terminated"
|
||||
}
|
||||
set fullfile [SplitReply [exe fullpath $tablefile]]
|
||||
set in [open $fullfile r]
|
||||
gets $in header
|
||||
set __tableheader [csv2list $header]
|
||||
while {[gets $in line] > 0} {
|
||||
set status [catch {processtablerow $line} msg]
|
||||
if {$status != 0} {
|
||||
set int [getint]
|
||||
if {[string first continue $int] < 0} {
|
||||
break
|
||||
} else {
|
||||
clientput "ERROR: $msg while processing row"
|
||||
}
|
||||
}
|
||||
}
|
||||
close $in
|
||||
set __tableheader NULL
|
||||
return "Done processing table"
|
||||
}
|
||||
#---------------------------------------------------------------------------
|
||||
proc loop args {
|
||||
clientput $args
|
||||
if {[llength $args] < 2} {
|
||||
error \
|
||||
"Usage: loop <no> <sicscommand>\n\t<no> number of repetions\n\t<sicscommand> any SICS command"
|
||||
}
|
||||
set len [lindex $args 0]
|
||||
set command [lrange $args 1 end]
|
||||
for {set i 1} {$i <= $len} {incr i} {
|
||||
clientput "Repetition $i of $len"
|
||||
set status [catch {eval [join $command]} msg]
|
||||
if {$status != 0} {
|
||||
clientput "ERROR: $msg while processing loop command"
|
||||
}
|
||||
testinterrupt
|
||||
}
|
||||
}
|
||||
#==============================================================================
|
||||
# This is an old attempt
|
||||
#=============================================================================
|
||||
proc __tablescan__ args {
|
||||
global __tableheader
|
||||
|
||||
set idx [lsearch $__tableheader monitor]
|
||||
if {$idx >= 0} {
|
||||
set preset [lindex $args $idx]
|
||||
set mode monitor
|
||||
}
|
||||
set idx [lsearch $__tableheader timer]
|
||||
if {$idx >= 0} {
|
||||
set preset [lindex $args $idx]
|
||||
set mode timer
|
||||
}
|
||||
|
||||
set idx [lsearch $__tableheader scanvar]
|
||||
if {$idx >= 0} {
|
||||
set var [lindex $args $idx]
|
||||
} else {
|
||||
error "ERROR: No scan variable in table"
|
||||
}
|
||||
|
||||
set idx [lsearch $__tableheader scanstart]
|
||||
if {$idx >= 0} {
|
||||
set start [lindex $args $idx]
|
||||
} else {
|
||||
error "ERROR: No scan start in table"
|
||||
}
|
||||
|
||||
set idx [lsearch $__tableheader scanend]
|
||||
if {$idx >= 0} {
|
||||
set end [lindex $args $idx]
|
||||
} else {
|
||||
error "ERROR: No scan end in table"
|
||||
}
|
||||
|
||||
set idx [lsearch $__tableheader scanstep]
|
||||
if {$idx >= 0} {
|
||||
set step [lindex $args $idx]
|
||||
} else {
|
||||
error "ERROR: No scan step in table"
|
||||
}
|
||||
|
||||
set np [expr abs($end - $start)/$step]
|
||||
xxxscan var $var $start $step
|
||||
xxxscan run $np $mode $preset
|
||||
}
|
||||
Reference in New Issue
Block a user