proc draw {} {
global chart count isleloc canvas
+ $canvas delete all
+
foreach l [split $chart "\n"] {
# debug "CHART-GOT $l"
set proc [lindex $l 0]
#---------- user interface ----------
proc widgets-setup {} {
- global canvas debug
+ global canvas debug acqdeffont
frame .f -border 1 -relief groove
set canvas .f.c
button .ctrl.zoom.in -text + -font {Courier 16} -command {zoom *2}
pack .ctrl.zoom.out .ctrl.zoom.in -side left
+ frame .ctrl.acquire
+ button .ctrl.acquire.do -text Acquire -command acquire
+
+ frame .ctrl.acquire.resframe -width 120 -height 32
+ button .ctrl.acquire.resframe.res -text {} -anchor nw \
+ -padx 1 -pady 1 -borderwidth 0 -justify left
+ glset acqdeffont [.ctrl.acquire.resframe.res cget -font]
+ place .ctrl.acquire.resframe.res -relx 0.5 -y 0 -anchor n
+ # -relheight 1.0 -relwidth 1.0
+
+ pack .ctrl.acquire.do -side top
+ pack .ctrl.acquire.resframe -side top -expand y -fill both
+ pack .ctrl.acquire -side top
+
wm geometry . 1024x480
}
debug "ZOOM $scale $nscale"
if {$nscale < 1 || $nscale > 200} return
set scale $nscale
- $canvas delete all
+ draw
+}
+
+proc acquire_showerror {} {
+ global acqerr
+ tk_messageBox -type ok \
+ -title "where-vessels: clipboard parsing error" \
+ -message $acqerr
+}
+
+proc acquire {} {
+ global clipboard acqdeffont acqerr
+ set old $clipboard
+ if {[catch {
+ set clipboard [clipboard get]
+ parse-clipboard
+ .ctrl.acquire.resframe.res configure \
+ -background blue -disabledforeground black -font $acqdeffont \
+ -state disabled -command {} \
+ -text " acquired ok "
+ } emsg]} {
+ set acqerr "clipboard parsing failed: $emsg"
+ puts stderr $acqerr
+ regsub -all {.{18}} "error: [string trim $emsg]" "&\n" ewrap
+ .ctrl.acquire.resframe.res configure \
+ -background red -foreground white -font fixed \
+ -state normal -command acquire_showerror \
+ -text $ewrap
+ set clipboard $old
+ parse-clipboard
+ }
draw
}