#
# Sorting for cartesian plots with pseudo-listbox
#
# (c) Peter Kämpf 2003 - 2005
# mailto:Peter.Kaempf@fbmev.de
#
# This routine reads a text file with data for a X-Y-Plot and
# opens a dialog to query the user for the parameters of the
# X- and Y-axes. Left and right Y-axes are supported, and both
# can take an unlimited number of parameters.
#
# Structure of the plot data:
# All values are read into the array MP. This array also contains
# a couple of settings for the plot, as follows:
#
# MP(Namen) List of all parameter names. Read from the first line
# of the input file (must be separated by commas)
# MP_1(n,m) Value in line n, column m. Must be separated by spaces.
# MP(YLZeilen) Number of lines in the file m inus the first line
#
# MP(LKurven) Number of parameters on the left Y-axis
# MP(RKurven) Number of parameters on the right Y-axis
# MP(XLIndex) Position of the X-axis parameter in the list MP(Namen)
# MP(YLIndex,i) Position of the i-th left Y-axis parameter in the list MP(Namen)
# MP(YRIndex,i) Position of the i-th right Y-axis parameter in the list MP(Namen)
#
# MP(auto) Switch for automatic scaling of the plot axes
# MP(XLinksMin) Minimum value for the X axis
# MP(YLinksMin) Minimum value for the left Y axis
# MP(YRechtsMin) Minimum value for the right Y axis
# MP(XLinksMax) Maximum value for the X axis
# MP(YLinksMax) Maximum value for the left Y axis
# MP(YRechtsMax) Maximum value for the right Y axis
# MP(XLMajor) Number of major steps on the X axis
# MP(YLMajor) Number of major steps on the left Y axis
# MP(YRMajor) Number of major steps on the right Y axis
# MP(XSubgrid) Switch for fine gridding of the X axis
# MP(YLSubgrid) Switch for fine gridding of the left Y axis
# MP(YRSubgrid) Switch for fine gridding of the right Y axis
# MP(XLog) Switch for logarithmic scaling of the X axis
# MP(YLLog) Switch for logarithmic scaling of the left Y axis
# MP(YRLog) Switch for logarithmic scaling of the right Y axis
#
# GLOBAL VARIABLES
#
global MP
set MP(Namen) [list ]
set MP(auto) 1
set MP(XSubgrid) 0
set MP(YLSubgrid) 0
set MP(YRSubgrid) 0
set MP(XLog) 0
set MP(YLLog) 0
set MP(YRLog) 0
global Listfile ; set Listfile [file join [file dirname [info script]] Liste]
global still ; set still 1
#
# A good GUI has only one mouse button!
#
event add <<Loslassen>> <ButtonRelease-1>
event add <<Loslassen>> <ButtonRelease-2>
event add <<Loslassen>> <ButtonRelease-3>
event add <<Ziehen>> <B1-Motion>
event add <<Ziehen>> <B2-Motion>
event add <<Ziehen>> <B3-Motion>
event add <<Klick>> <1>
event add <<Klick>> <2>
event add <<Klick>> <3>
# USER DEFINED PROCEDURES
#
# Open a modal dialog to compose the X- and Y-axis parameters.
#
namespace eval Sortbox {
variable Breite ; set Breite 630
variable Hoehe ; set Hoehe 420
}
proc Sortbox::plotBereich { {was 0} } {
global MP
global Eintrag
global errorInfo
#
variable oben
variable unten
variable Breite
variable Hoehe
variable Canvashoehe
variable Listenbreite
variable Scrollposition
#
set base .plotBereich
if [winfo exists $base] {destroy $base}
# CREATING WIDGETS
toplevel $base -class Toplevel -cursor left_ptr
wm focusmodel $base passive
wm geometry $base [join [list $Breite x $Hoehe +100+60] {}]
wm maxsize $base 1280 960
wm minsize $base 1 1
wm overrideredirect $base 0
wm resizable $base 1 1
wm deiconify $base
wm title $base "Define Plot"
#
# Initialize common variables
#
set Canvashoehe 0
set Listenbreite 0
set Scrollposition 0
#
# Read the parameter lists
#
Sortbox::Lesen
#
# To avoid unnecessary work: Is anything to do?
#
if {[llength $MP(Namen)] < 3} {
MessageDlg .error \
-title "Error" -icon warning -type ok \
-message "No data for plot"
return
}
#
# Set a default choice
#
set MP(RKurven) 0
set MP(XLIndex) 0
set MP(LKurven) 0
frame .plotBereich.f
pack .plotBereich.f -expand yes -fill both
#
# Two frames take all controls
#
set oben [frame .plotBereich.f.box1]
set unten [frame .plotBereich.f.box2]
pack $oben -side top -expand yes -fill both -padx 3 -pady 3
pack $unten -side bottom -expand yes -fill both -padx 3 -pady 3
#
# To facilitate dragging and dropping, the upper frame is filled with
# a canvas, and all widgets only pretend to be a listbox and stuff
#
set Canv [canvas $oben.cv -borderwidth 0 -highlightthickness 0]
#
# Create the upper frame
#
label $oben.l0 -anchor center -text "Available Parameters"
label $oben.l1 -anchor center -text "Left Y-Axis"
label $oben.l2 -anchor center -text "Right Y-Axis"
#
grid columnconfigure $oben {0 1 2} -weight 1
grid rowconfigure $oben 0 -weight 0 -minsize 30
grid rowconfigure $oben 1 -weight 1
#
# Put the canvas in place
#
Sortbox::PlotObenZeigen
grid $Canv -column 0 -row 1 -columnspan 3 -sticky nsew
#
# Fill the lower frame with widgets, three rows, one per axis
#
label $unten.min -anchor w -text "Minima"
label $unten.max -anchor w -text "Maxima"
label $unten.int -anchor w -text "Intervals"
label $unten.sub -anchor w -text "fine grid"
label $unten.log -anchor w -text "logarithmic"
#
label $unten.xlabel -anchor w -text "X-Axis"
entry $unten.xmin -width 12 -textvariable MP(XLinksMin) \
-validate focusout -validatecommand {KommaP %W %P} \
-invalidcommand {KommaPunkt %W %P %v}
entry $unten.xmax -width 12 -textvariable MP(XLinksMax) \
-validate focusout -validatecommand {KommaP %W %P} \
-invalidcommand {KommaPunkt %W %P %v}
entry $unten.xint -width 12 -textvariable MP(XLMajor) \
-validate focusout -validatecommand {IntP %W %P}
checkbutton $unten.xsub \
-offvalue 0 -onvalue 1 -variable MP(XSubgrid)
checkbutton $unten.xlog \
-offvalue 0 -onvalue 1 -variable MP(XLog) \
-command "set MP(XLinksMin) 0.0; set MP(XLinksMax) 0.0; set MP(XLMajor) 0"
#
label $unten.ylinks -anchor w -text "Left Y-Axis"
entry $unten.ylinksmin -width 12 -textvariable MP(YLinksMin) \
-validate focusout -validatecommand {KommaP %W %P} \
-invalidcommand {KommaPunkt %W %P %v}
entry $unten.ylinksmax -width 12 -textvariable MP(YLinksMax) \
-validate focusout -validatecommand {KommaP %W %P} \
-invalidcommand {KommaPunkt %W %P %v}
entry $unten.ylinksint -width 12 -textvariable MP(YLMajor) \
-validate focusout -validatecommand {IntP %W %P}
checkbutton $unten.ylinkssub \
-offvalue 0 -onvalue 1 -variable MP(YLSubgrid)
checkbutton $unten.ylinkslog \
-offvalue 0 -onvalue 1 -variable MP(YLLog) \
-command "set MP(YLinksMin) 0.0; set MP(YLinksMax) 0.0; set MP(YLMajor) 0"
#
label $unten.yrechts -anchor w -text "Right Y-Axis"
entry $unten.yrechtsmin -width 12 -textvariable MP(YRechtsMin) \
-validate focusout -validatecommand {KommaP %W %P} \
-invalidcommand {KommaPunkt %W %P %v}
entry $unten.yrechtsmax -width 12 -textvariable MP(YRechtsMax) \
-validate focusout -validatecommand {KommaP %W %P} \
-invalidcommand {KommaPunkt %W %P %v}
entry $unten.yrechtsint -width 12 -textvariable MP(YRMajor) \
-validate focusout -validatecommand {IntP %W %P}
checkbutton $unten.yrechtssub \
-offvalue 0 -onvalue 1 -variable MP(YRSubgrid)
checkbutton $unten.yrechtslog \
-offvalue 0 -onvalue 1 -variable MP(YRLog) \
-command "set MP(YRechtsMin) 0.0; set MP(YRechtsMax) 0.0; set MP(YRMajor) 0"
#
# Place the usual buttons at the bottom
#
checkbutton $unten.resetBut -command "Sortbox::PlotUntenZeigen" \
-text "automatic" -variable MP(auto)
button $unten.cancelBut \
-text "Cancel" -width 12 -command "destroy .plotBereich"
button $unten.okBut \
-text "OK" -width 12 -default active \
-command "destroy .plotBereich; exit"
bind $oben <Return> "destroy .plotBereich; exit"
bind $base <<Loslassen>> "Sortbox::PlotNeuZeigen"
#
foreach x {x ylinks yrechts} {
foreach y {min int max} {
bind $unten.$x$y <KeyRelease> \
"$unten.$x$y configure -background white -foreground black"
}
}
# SETTING GEOMETRY
grid rowconfigure $unten 0 -weight 0 -minsize 6
grid rowconfigure $unten {1 2 3} -weight 0 -minsize 24
grid rowconfigure $unten 4 -weight 0 -minsize 48
grid columnconfigure $unten {0 1 2 3 4 5} -weight 1
#
grid $unten.min -row 0 -column 1 -padx 6 -sticky ew
grid $unten.max -row 0 -column 2 -padx 6 -sticky ew
grid $unten.int -row 0 -column 3 -padx 6 -sticky ew
grid $unten.sub -row 0 -column 4 -padx 6 -sticky ew
grid $unten.log -row 0 -column 5 -padx 6 -sticky ew
#
grid $unten.xlabel -row 1 -column 0 -padx 12 -sticky e
grid $unten.xmin -row 1 -column 1 -padx 6 -sticky ew
grid $unten.xmax -row 1 -column 2 -padx 6 -sticky ew
grid $unten.xint -row 1 -column 3 -padx 6 -sticky ew
grid $unten.xsub -row 1 -column 4 -padx 40 -sticky w
grid $unten.xlog -row 1 -column 5 -padx 40 -sticky w
#
grid $unten.ylinks -row 2 -column 0 -padx 12 -sticky e
grid $unten.ylinksmin -row 2 -column 1 -padx 6 -sticky ew
grid $unten.ylinksmax -row 2 -column 2 -padx 6 -sticky ew
grid $unten.ylinksint -row 2 -column 3 -padx 6 -sticky ew
grid $unten.ylinkssub -row 2 -column 4 -padx 40 -sticky w
grid $unten.ylinkslog -row 2 -column 5 -padx 40 -sticky w
#
Sortbox::PlotUntenZeigen
#
grid $unten.resetBut -row 4 -column 0 -columnspan 2 -sticky n
grid $unten.cancelBut -row 4 -column 2 -columnspan 2 -pady 6
grid $unten.okBut -row 4 -column 4 -columnspan 2 -pady 6
#
# This "grab" is only needed when this dialog is embedded into
# an application, and the user is supposed to finish the dialog
# before switching to other windows.
#
grab $base
}
#
# Place all elements in the upper half of the dialog
#
proc Sortbox::PlotObenZeigen {} {
global MP
global Eintrag
global errorInfo
#
variable oben
variable Breite
variable Hoehe
variable Liste
variable Canvashoehe
variable Listenbreite
variable Scrollposition
variable Scrollbereich
#
# Dimension the canvas
#
set Canv $oben.cv
set hoch [expr int( 0.5 * $Hoehe - 12)]
set breit [expr int(($Breite - 96) / 3)]
set Canvashoehe $hoch
set Listenbreite $breit
$Canv configure -height $hoch
$Canv delete Box
destroy $oben.scroll
#
# Create a list of all entries
#
set Liste(0) [list ]
for {set i 0} {$i < [llength $MP(Namen)]} {incr i} {
set Eintrag($i) "[lindex $MP(Namen) $i]"
$Canv delete ent$i
lappend Liste(0) $i
}
set Scrollbereich [expr 20 * ([llength $MP(Namen)] - $MP(LKurven) - $MP(RKurven))]
#
# Sort the entries in their respective lists
#
if {$MP(XLIndex) >= 0} {
lset Liste(0) $MP(XLIndex) X
}
set Liste(1) [list ]
set Liste(2) [list ]
for {set i 0} {$i < $MP(LKurven)} {incr i} {
if {$MP(YLIndex,$i) < 0} {
set Liste(1) [lreplace $Liste(1) $i $i]
incr MP(LKurven) -1
for {set j $i} {$j < $MP(LKurven)} {incr j} {
set MP(YLIndex,$j) $MP(YLIndex,[expr $j + 1])
}
} else {
lappend Liste(1) $MP(YLIndex,$i)
lset Liste(0) $MP(YLIndex,$i) X
}
}
for {set i 0} {$i < $MP(RKurven)} {incr i} {
if {$MP(YRIndex,$i) < 0} {
set Liste(2) [lreplace $Liste(2) $i $i]
incr MP(RKurven) -1
for {set j $i} {$j < $MP(RKurven)} {incr j} {
set MP(YRIndex,$j) $MP(YRIndex,[expr $j + 1])
}
} else {
lappend Liste(2) $MP(YRIndex,$i)
lset Liste(0) $MP(YRIndex,$i) X
}
}
#
# The list of parameters is the longest, so it gets a longer
# box and a scrollbar:
#
$Canv create rectangle 20 3 [expr 4 + $breit] $hoch \
-outline black -width 1 -fill white -tags Box
$Canv create rectangle 19 2 [expr 5 + $breit] \
[expr $hoch + 1] -outline grey50 -width 1 -tags {Box Boxrand}
scrollbar $oben.scroll -command "Sortbox::ScrollBereich" \
-borderwidth 0 -orient vert -width 16 -cursor left_ptr
$oben.scroll set 0.0 [expr double($hoch) / $Scrollbereich]
set Scrollposition 0
place $oben.scroll -x [expr 5 + $breit] -y 33 -anchor nw \
-width 16 -height $hoch
Sortbox::ScrollBereich
grid $oben.l0 -column 0 -row 0 -padx 10 -pady 5
#
# To cutt off the entries at the ends of the box (Clipping only works
# at the edges of the Canvas), a rectangle is painted on top.
# Quite a kludge - but it works. So what!
#
$Canv create rectangle 20 0 [expr 20 + $breit] 1 \
-width 0 -tags {Box Boxrand} -fill white
$Canv create rectangle [expr 21 + $breit] 0 \
[expr 38 + $breit] [expr $hoch + 9] \
-width 0 -tags {Box Boxrand} -fill white
$Canv create rectangle 20 [expr $hoch + 1] \
[expr 20 + $breit] [expr $hoch + 9] \
-width 0 -tags {Box Boxrand} -fill white
#
# create the other two boxes
#
for {set n 1} {$n < 3} {incr n} {
$Canv create rectangle [expr 20 + $n * ($breit + 20)] 3 \
[expr ($n + 1) * ($breit + 20)] [expr $hoch - 80] \
-outline black -width 1 -fill white -tags Box
$Canv create rectangle [expr 19 + $n * ($breit + 20)] 2 \
[expr ($n + 1) * ($breit + 20) + 1] [expr $hoch - 79] \
-outline grey50 -width 1 -tags {Box Boxrand}
set xPos [expr 24 + $n * ($breit + 20)]
set yPos 12
foreach x $Liste($n) {
if {$x == "X"} continue
if {$x < 0} break
$Canv create text $xPos $yPos -text "$Eintrag($x)" \
-anchor w -fill black -font System -tags ent$x
incr yPos 20
#
# These bindings support the dragging and evoke the right function
# when an entry has been dropped.
#
$Canv bind ent$x <<Klick>> "plotDown $Canv %x %y"
$Canv bind ent$x <<Ziehen>> "plotMove $Canv %x %y"
$Canv bind ent$x <<Loslassen>> "plotCopy $Canv %x %y $n $x"
if {$yPos > $hoch} break
}
grid $oben.l$n -column $n -row 0 -padx 10 -pady 5
}
#
# The box for the X-axis only holds a single entry
#
$Canv create text [expr $breit + 40] [expr $hoch - 55] \
-anchor w -text "X-Axis" -font System -tags Box
$Canv create rectangle [expr $breit + 120] [expr $hoch - 65] \
[expr 3 * $breit - 20] [expr $hoch - 45] \
-outline black -width 1 -fill white -tags Box
$Canv create rectangle [expr $breit + 119] [expr $hoch - 66] \
[expr 3 * $breit - 19] [expr $hoch - 44] \
-outline grey50 -width 1 -tags {Box Boxrand}
#
$Canv create text [expr 2 * $breit + 40] [expr $hoch - 12] -font System \
-anchor center -justify center -width [expr 2 * $breit + 40] -tags Box \
-text "To drop a parameter into a different list, click on it\
\nand drag it's name into the desired list\nwhile keeping\
the mouse button pressed."
#
# More bindings
#
set xWert $MP(XLIndex)
if {$xWert >= 0} {
$Canv create text [expr $breit + 140] [expr $hoch - 55] \
-anchor w -text "$Eintrag($xWert)" -font System -tags ent$xWert
$Canv bind ent$xWert <<Klick>> "plotDown $Canv %x %y"
$Canv bind ent$xWert <<Ziehen>> "plotMove $Canv %x %y"
$Canv bind ent$xWert <<Loslassen>> "plotCopy $Canv %x %y 3 $xWert"
}
}
#
# Create the lower half with the preferences table
#
proc Sortbox::PlotUntenZeigen {} {
global MP
#
variable unten
#
# Adjust the rows depending on the content of the rightmost box
#
if {$MP(RKurven) > 0} {
grid $unten.yrechts -row 3 -column 0 -padx 12 -sticky e
grid $unten.yrechtsmin -row 3 -column 1 -padx 6 -sticky ew
grid $unten.yrechtsmax -row 3 -column 2 -padx 6 -sticky ew
grid $unten.yrechtsint -row 3 -column 3 -padx 6 -sticky ew
grid $unten.yrechtssub -row 3 -column 4 -padx 40 -sticky w
grid $unten.yrechtslog -row 3 -column 5 -padx 40 -sticky w
} else {
grid remove $unten.yrechts
grid remove $unten.yrechtsmin
grid remove $unten.yrechtsmax
grid remove $unten.yrechtsint
grid remove $unten.yrechtssub
grid remove $unten.yrechtslog
}
#
# Activate the entries only when "automatic" has been deselected
#
if {$MP(auto) > 0} {
$unten.xmin configure -state disabled -foreground grey50
$unten.xmax configure -state disabled -foreground grey50
$unten.xint configure -state disabled -foreground grey50
$unten.ylinksmin configure -state disabled -foreground grey50
$unten.ylinksmax configure -state disabled -foreground grey50
$unten.ylinksint configure -state disabled -foreground grey50
$unten.yrechtsmin configure -state disabled -foreground grey50
$unten.yrechtsmax configure -state disabled -foreground grey50
$unten.yrechtsint configure -state disabled -foreground grey50
} else {
$unten.xmin configure -state normal -foreground black
$unten.xmax configure -state normal -foreground black
$unten.xint configure -state normal -foreground black
$unten.ylinksmin configure -state normal -foreground black
$unten.ylinksmax configure -state normal -foreground black
$unten.ylinksint configure -state normal -foreground black
$unten.yrechtsmin configure -state normal -foreground black
$unten.yrechtsmax configure -state normal -foreground black
$unten.yrechtsint configure -state normal -foreground black
}
}
#
# Read the table of parameters and their values
#
# The format is quite simple: The first line holds the names of the parameters,
# delimited by commas (so parameter names containing spaces can ben used),
# and all other lines the sequence of values, all delimited by spaces.
#
proc Sortbox::Lesen { } {
global MP
global MP_1
global Listfile
#
puts stdout "Dateiname ist voreingestellt auf $Listfile"
if [file exists $Listfile] {
#
# The path has been set to the location of the script
#
if [catch {open "$Listfile" r} fileID] {
MessageDlg .error \
-title "Error in function Sortbox::Lesen" -message \
[format "List file %s can not be opened" $Listfile] \
-icon error -type ok
} else {
set MP(Namen) [split [gets $fileID] ,]
foreach Wort $MP(Namen) {
set Namen [string trim $Wort]
}
set Datei [split [read $fileID] \n]
set n 0
foreach Zeile $Datei {
if {[llength $Zeile] < 8} {
continue
}
set m 0
foreach Zahl $Zeile {
set MP_1($n,$m) $Zahl
incr m
}
incr n
}
set MP(LZeilen) [expr $n - 2]
puts stdout "Verlauf::Lesen: Finished reading after $MP(LZeilen) lines"
close $fileID
}
#
# Complain if the file cannot be found
#
} else {
MessageDlg .error \
-title "Error" -type ok -icon info \
-message "No data to read"
}
}
#
# When the window has changed, it is redrawn
#
proc Sortbox::PlotNeuZeigen {} {
variable oben
variable Breite
variable Hoehe
variable Canvashoehe
variable Listenbreite
#
# If the size has changed, the canvas is rebuilt
#
set hoch [expr int( 0.5 * $Hoehe - 12)]
set breit [expr int(($Breite - 96) / 3)]
if {$Canvashoehe != $hoch || $Listenbreite != $breit} {
Sortbox::PlotObenZeigen
}
}
#
# React to clicks in the scrollbar. This is a complete low-level
# programming for a scrollbar, since we cannot use a regular listbox.
#
proc Sortbox::ScrollBereich { {was moveto} {Zahl 0.0} {Einheit units} } {
global MP
global Eintrag
#
variable oben
variable Liste
variable Canvashoehe
variable Scrollposition
variable Scrollbereich
#
if {$was == "scroll"} {
if {$Einheit == "pages"} {
incr Scrollposition [expr $Zahl * $Canvashoehe - 20]
} else {
incr Scrollposition [expr 20 * $Zahl]
}
} else {
set Scrollposition [expr int($Zahl * $Scrollbereich)]
}
#
# Don't exceed the target
#
if {$Scrollposition > [expr $Scrollbereich - $Canvashoehe]} {
set Scrollposition [expr $Scrollbereich - $Canvashoehe]
}
if {$Scrollposition < 0} {set Scrollposition 0}
#
# Erase the list and rebuild it from scratch. This is simpler than
# shifting it around, because it avoids trouble at the edges.
#
set yPos [expr 12 - $Scrollposition]
set Canv $oben.cv
foreach x $Liste(0) {
if {$x == "X"} continue
$Canv delete ent$x
if {$yPos < 0} {
incr yPos 20
continue
}
#
if {$yPos < [expr $Canvashoehe + 4]} {
$Canv create text 24 $yPos -text $Eintrag($x) -anchor w \
-fill black -font System -tags ent$x
incr yPos 20
#
# Recreate the bindings.
#
$Canv bind ent$x <<Klick>> "plotDown $Canv %x %y"
$Canv bind ent$x <<Ziehen>> "plotMove $Canv %x %y"
$Canv bind ent$x <<Loslassen>> "plotCopy $Canv %x %y 0 $x"
}
}
$Canv raise Boxrand
#
$oben.scroll set [expr double($Scrollposition) / $Scrollbereich] \
[expr double($Canvashoehe + $Scrollposition) / $Scrollbereich]
}
#
# Parser for Entry-Inputs. Complains when non-numeric data is entered.
#
proc IntP { e Zahl } {
global still
#
# Scan the string letter by letter. A minus sign is not OK, since
# in this version only positive numbers are allowed.
#
$e configure -background white -foreground black
foreach Ziffer [split $Zahl {}] {
if {[string match {[+0-9]} $Ziffer] == 0} {
if {$still != 0} bell
$e configure -background red -foreground white
}
}
return 1
}
#
# Parser for Entry-Inputs. Tests for Commas in entries.
#
proc KommaP { e Zahl } {
global still
#
# To be precise: The last point is interpreted as the decimal point,
# all commas and points before are ignored.
#
set Punkt 1
$e configure -background white -foreground black
foreach Ziffer [split $Zahl {}] {
if {$Ziffer == ","} {
return 0
} elseif {$Ziffer == "."} {
if {$Punkt == 0} {
return 0
} else {
set Punkt 0
}
} else {
if {[string match {[+-\ e0-9]} $Ziffer] == 0} {
if {$still != 0} bell
$e configure -background red -foreground white
}
}
}
return 1
}
#
# Parser for Entry-Inputs. Changes Commas to points.
#
proc KommaPunkt { e Zahl v } {
#
# If the user inputs a decimal comma, it is changed into a point.
#
set Variable [lindex [$e configure -textvariable] end]
set Liste [split $Zahl {}]
set Ende [expr {[llength $Liste] - 1}]
set Ergebnis [list ]
set Punkt 0
#
for {set i $Ende} {$i >= 0} {incr i -1} {
set Ziffer [lindex $Liste $i]
if {$Ziffer == ","} {
if {$Punkt == 0} {
set Ergebnis [linsert $Ergebnis 0 .]
set Punkt 1
}
} elseif {$Ziffer == "."} {
if {$Punkt == 0} {
set Ergebnis [linsert $Ergebnis 0 .]
set Punkt 1
}
} else {
set Ergebnis [linsert $Ergebnis 0 $Ziffer]
}
}
set $Variable [join $Ergebnis {}]
after idle "$e config -validate $v -validatecommand {KommaP %W %P} \
-invalidcommand {KommaPunkt %W %P %v}"
}
#
# plotDown --
# This procedure is invoked when the mouse is pressed over one of the
# data points. It sets up state to allow the point to be dragged.
#
# Arguments:
# w - The canvas window.
# x, y - The coordinates of the mouse press.
#
proc plotDown {w x y} {
global plot
#
$w dtag selected
$w addtag selected withtag current
$w raise current
set plot(lastX) $x
set plot(lastY) $y
}
# plotMove --
# This procedure is invoked during mouse motion events. It drags the
# current item.
#
# Arguments:
# w - The canvas window.
# x, y - The coordinates of the mouse.
#
proc plotMove { w x y } {
global plot
#
$w move selected [expr {$x-$plot(lastX)}] [expr {$y-$plot(lastY)}]
set plot(lastX) $x
set plot(lastY) $y
set plot(Lage) -1
}
#
# When the mouse button is released, this routine determines the new
# position and re-orders the list.
#
proc plotCopy { Cv x y woher i } {
global plot
global MP
#
set Breite [expr {20 + int(([winfo width $Cv] - 80) / 3)}]
set Hoehe [expr {[winfo height $Cv] - 100}]
set Versatz 0
#
# First remove it from the old list
#
if {$woher == 0} {
} elseif {$woher == 1} {
incr MP(LKurven) -1
for {set n 0} {$n < $MP(LKurven)} {incr n} {
if {$i == $MP(YLIndex,$n)} {set Versatz 1}
if {$Versatz} {set MP(YLIndex,$n) $MP(YLIndex,[expr {$n + 1}])}
}
} elseif {$woher == 2} {
incr MP(RKurven) -1
for {set n 0} {$n < $MP(RKurven)} {incr n} {
if {$i == $MP(YRIndex,$n)} {set Versatz 1}
if {$Versatz} {set MP(YRIndex,$n) $MP(YRIndex,[expr {$n + 1}])}
}
} elseif {$woher == 3} {
set MP(XLIndex) -1
} else {
MessageDlg .error \
-title "Fehler in Funktion plotCopy" \
-message "Die Aktion wurde nicht verstanden: (woher = $woher)" \
-icon info -type ok
return
}
#
# Now find the target and add the parameter.
# If the parameter is already there, nothing changes.
#
if {$x > $Breite} {
if {$y > $Hoehe} {
set MP(XLIndex) $i
} else {
if {$x < [expr {2 * $Breite}]} {
for {set n 0} {$n < $MP(LKurven)} {incr n} {
if {$i == $MP(YLIndex,$n)} {
Sortbox::PlotObenZeigen
return
}
}
set MP(YLIndex,$MP(LKurven)) $i
incr MP(LKurven)
} else {
for {set n 0} {$n < $MP(RKurven)} {incr n} {
if {$i == $MP(YRIndex,$n)} {
Sortbox::PlotObenZeigen
return
}
}
set MP(YRIndex,$MP(RKurven)) $i
incr MP(RKurven)
}
}
}
Sortbox::PlotObenZeigen
Sortbox::PlotUntenZeigen
}
#
#console hide
Sortbox::plotBereichTo play with this, you need a text file called "Liste" in the same directory as the script (in case you ask: No, the file does not have an extension. Just because others do stupid things doesn't mean I have to repeat them). Here is a short sample for this file:Time [h],Distance N-S [nm],Distance E-W [nm],TAS [kts],EAS [kts],used Fuel [lbs],Thrust [lbs],Altitude [ft],Heading [∞],Mass [lbs],Mach,Alfa [∞],Elevator Deflection [∞],Flap Deflection [∞],Climb Speed [ft/min],Load Factor [g],L/D,Cm,Prop. Pitch [∞],Prop. Efficiency [%],RPM,Throttle Setting [%],Fuel Flow [lbs/min]
0.00000 0.0000 0.0000 2.508 2.484 0.000 174.895 656.168 0.000 2218.156 0.004 0.000 0.000 0.000 0.000 1.00000 10.39654 -0.11972 0.000 45.815 460.097 10.000 0.469
0.16667 0.0000 0.0000 0.000 0.000 4.693 174.895 656.168 0.000 2213.463 0.000 0.000 0.000 0.000 0.000 1.00000 10.39654 -0.11972 0.000 45.815 460.097 10.000 0.469
0.16694 0.0001 0.0006 4.070 4.031 4.739 472.581 656.168 80.000 2213.417 0.006 0.000 0.000 10.000 0.000 1.00000 16.91763 -0.13621 0.000 44.466 2629.527 100.000 2.761
0.16722 0.0004 0.0022 7.607 7.534 4.785 466.472 656.168 80.000 2213.371 0.012 0.000 0.000 10.000 0.000 1.00000 12.79023 -0.13856 0.000 46.660 2633.984 100.000 2.761
0.16750 0.0008 0.0047 11.115 11.008 4.831 463.592 656.168 80.000 2213.325 0.017 0.000 0.000 10.000 0.000 1.00000 14.01656 -0.13854 0.000 48.568 2637.859 100.000 2.761
0.16778 0.0015 0.0082 14.589 14.449 4.877 460.665 656.168 80.000 2213.279 0.022 0.000 0.000 10.000 0.000 1.00000 14.74881 -0.13850 0.000 50.460 2641.700 100.000 2.761
0.16806 0.0022 0.0127 18.026 17.854 4.923 457.568 656.168 80.000 2213.233 0.027 0.000 0.000 10.000 0.000 1.00000 15.26024 -0.13846 0.000 52.334 2645.506 100.000 2.761
0.16833 0.0032 0.0181 21.423 21.218 4.969 454.260 656.168 80.000 2213.187 0.032 0.000 0.000 10.000 0.000 1.00000 15.64373 -0.13840 0.000 54.187 2649.270 100.000 2.761
0.16861 0.0043 0.0244 24.774 24.537 5.015 450.744 656.168 80.000 2213.141 0.038 0.000 0.000 10.000 0.000 1.00000 15.94240 -0.13833 0.000 56.019 2652.990 100.000 2.761MG Assuming your script runs cross-platform, you might find it's stupid not to do "the stupid thing". On Windows, with certain options set (which are, of course, the default), it's difficult to make a file with no extension at all. It wouldn't be difficult in the above to make it look for "Liste.txt" (etc) if "Liste" isn't present. Just changing the line
global Listfile ; set Listfile [file join [file dirname [info script]] Liste]to
global Listfile ; set Listfile [file join [file dirname [info script]] Liste]
if { ![file exists $Listfile] } {
set Listfile [file join [file dirname [info script]] Liste.txt]
}would make the necessary change, and still default to "Liste" with no extension.
