#!/usr/bin/wish
-set us Aristarchus
+source yarrglib.tcl
+source panner.tcl
-proc manyset {list args} {
- foreach val $list var $args {
- upvar 1 $var my
- set my $val
+set pirate { }
+
+proc badusage {m} {
+ puts stderr "where-vessels: bad usage: $m"
+ exit 1
+}
+
+set ai 0
+proc nextarg {} {
+ global ai argv
+ if {$ai >= [llength $argv]} {
+ badusage "option [lindex $argv [expr {$ai-1}]] needs a value"
}
+ set v [lindex $argv $ai]
+ incr ai
+ return $v
}
+while {[regexp {^\-} [set arg [lindex $argv $ai]]]} {
+ incr ai
+ switch -exact -- $arg {
+ -- { break }
+ --pirate { set pirate [string totitle [nextarg]] }
+ --ocean { set ocean [string totitle [nextarg]] }
+ --clipboard-file { set clipboard_file [nextarg] }
+ --notes { set notes_loc [nextarg] }
+ default { badusage "unknown option $arg" }
+ }
+}
+set argv [lrange $argv $ai end]
+if {[llength $argv]} { badusage "non-option args not allowed" }
+
set itemre { (\w+) = ([^=]*) }
set manyitemre "^\\\[ $itemre ( (?: ,\\ $itemre)* ) \\]\$"
puts $manyitemre
close $vn
proc vessel {vin} {
- global us
+ global pirate
upvar #0 $vin vi
switch -exact $vi(vesselClass) {
smsloop { set sz 00sl }
upvar #0 notes($nk) note
if {[info exists note]} {
manyset $note owner xabbrev
- if {![string compare $owner $us]} {
+ if {![string compare $owner $pirate]} {
append abbrev =
} else {
append abbrev -
}
close $cl
-set chart [open |[list perl -we {
+set chart [exec perl -we {
use strict;
use CommodsScrape;
use IO::File;
sub { printf STDERR "warning: %s: incomprehensible: %s", @_; }
);
STDOUT->error and die $!;
-}] r]
+}]
frame .f -border 1 -relief groove
set canvas .f.c
canvas $canvas
#$canvas configure -width 1000 -height 800
pack $canvas -expand 1 -fill both
-pack .f -expand 1 -fill both
+pack .f -expand 1 -fill both -side left
-set scale 15
+set scale 16
proc coord {c} {
global scale
}
}
-while {[gets $chart l] >= 0} {
+proc draw {} {
+ global chart count isleloc canvas
+
+ foreach l [split $chart "\n"] {
# puts "CHART-GOT $l"
set proc [lindex $l 0]
eval chart-got/$proc [lrange $l 1 end]
-}
-
-puts WILLSHOW
+ }
-set lastislandname {}
-foreach key [lsort [array names count]] {
+ set lastislandname {}
+ foreach key [lsort [array names count]] {
set c $count($key)
# puts "SHOWING $key $c"
regexp {^(.*) (\S+)$} $key dummy islandname abbrev
$canvas lower $bid $id
manyset $bbox dummy dummy dummy y
# puts "NEW Y $y"
+ }
}
+draw
+
foreach nk [lsort [array names $note]] {
puts "IGNORED NOTE $nk"
}
+frame .ctrl
+pack .ctrl -side right
+
+panner::canvas-scroll-bbox .f.c
+panner::create .ctrl.pan .f.c 120 120
+
+pack .ctrl.pan -side top -pady 10 -padx 5
+frame .ctrl.zoom
+pack .ctrl.zoom -side top
+
+proc zoom {extail} {
+ global scale canvas
+ set nscale [expr "\$scale $extail"]
+ puts "ZOOM $scale $nscale"
+ if {$nscale < 1 || $nscale > 200} return
+ set scale $nscale
+ $canvas delete all
+ draw
+ panner::updatecanvas-bbox .ctrl.pan
+}
+
+button .ctrl.zoom.out -text - -font {Courier 16} -command {zoom /2}
+button .ctrl.zoom.in -text + -font {Courier 16} -command {zoom *2}
+pack .ctrl.zoom.out .ctrl.zoom.in -side left
+
+#. configure -width 640 -height 480
+wm geometry . 1024x480
+
#puts "[$canvas bbox all]"