--- /dev/null
+#!/usr/bin/wish
+
+set us Aristarchus
+
+proc manyset {list args} {
+ foreach val $list var $args {
+ upvar 1 $var my
+ set my $val
+ }
+}
+
+set itemre { (\w+) = ([^=]*) }
+set manyitemre "^\\\[ $itemre ( (?: ,\\ $itemre)* ) \\]\$"
+puts $manyitemre
+
+set vn [open vessel-notes]
+while {[gets $vn l] >= 0} {
+ regsub -all {\t+} $l "\t" l
+ manyset [split $l "\t"] vname vid owner note
+ set nk $vid.$vname
+ puts "SET NOTE $nk"
+ set notes($nk) [list $owner $note]
+}
+close $vn
+
+proc vessel {vin} {
+ global us
+ upvar #0 $vin vi
+ switch -exact $vi(vesselClass) {
+ smsloop { set sz 00sl }
+ lgsloop { set sz 01ct }
+ dhow { set sz 02dh }
+ longship { set sz 03ls }
+ baghlah { set sz 04bg }
+ merchbrig { set sz 05mb }
+ warbrig { set sz 06wb }
+ xebec { set sz 07xe }
+ warfrig { set sz 08wf }
+ merchgal { set sz 09mg }
+ grandfrig { set sz 10gf }
+ default { error "$vi(vesselClass) ?" }
+ }
+ set abbrev $sz
+ switch -exact $vi(vesselSubclass) {
+ null { }
+ icy { append abbrev F }
+ default { error "$vi(vesselSubclass) ?" }
+ }
+ switch -exact $vi(isLocked)/$vi(isBattleReady) {
+ true/false { append abbrev 2- }
+ false/false { append abbrev 1+ }
+ false/true { append abbrev 0* }
+ default { error "$vi(isLocked)/$vi(isBattleReady) ?" }
+ }
+ switch -exact $vi(inPort) {
+ true { }
+ false { append abbrev ? }
+ default { error "$vi(inPort) ?" }
+ }
+ set nk $vi(vesselId).$vi(vesselName)
+ upvar #0 notes($nk) note
+ if {[info exists note]} {
+ manyset $note owner xabbrev
+ if {![string compare $owner $us]} {
+ append abbrev =
+ } else {
+ append abbrev -
+ }
+ append abbrev $xabbrev
+ unset note
+ } else {
+# puts "UNKNOWN $nk"
+ }
+ set kk "$vi(islandName) $abbrev"
+ upvar #0 count($kk) k
+ if {![info exists k]} { set k 0 }
+ incr k
+}
+
+set cl [open clipboard]
+while {[gets $cl l] >= 0} {
+# puts "========"
+ catch { unset vi }
+ while 1 {
+ if {![regexp -expanded $manyitemre $l dummy \
+ thiskey thisval rhs]} { error "$l ?" }
+# puts "KEY $thiskey VAL $thisval"
+ set vi($thiskey) $thisval
+ if {![string length $rhs]} break
+ regsub {^, } $rhs {} rhs
+ set l "\[$rhs\]"
+ }
+ vessel vi
+}
+close $cl
+
+set chart [open |[list perl -we {
+ use strict;
+ use CommodsScrape;
+ use IO::File;
+ use IO::Handle;
+ yppedia_chart_parse(\*STDIN, (new IO::File ">/dev/null"),
+ sub { sprintf "%d %d", @_; },
+ sub { printf "archlabel %d %d %s\n", @_; },
+ sub { printf "island %s %s\n", @_; },
+ sub { printf "league %s %s %s.\n", @_; },
+ 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
+
+set scale 15
+
+proc coord {c} {
+ global scale
+ return [expr {$c * $scale}]
+}
+
+proc chart-got/archlabel {args} { }
+proc chart-got/island {x y args} {
+# puts "ISLE $x $y $args"
+ global canvas isleloc
+ set isleloc($args) [list $x $y]
+ set sz 5
+# $canvas create oval \
+# [expr {[coord $x] - $sz}] [expr {[coord $y] - $sz}] \
+# [expr {[coord $x] + $sz}] [expr {[coord $y] + $sz}] \
+# -fill blue
+ $canvas create text [coord $x] [coord $y] \
+ -text $args -anchor s
+}
+proc chart-got/league {x1 y1 x2 y2 kind} {
+# puts "LEAGUE $x1 $y1 $x2 $y2 $kind"
+ global canvas
+ set l [$canvas create line \
+ [coord $x1] [coord $y1] \
+ [coord $x2] [coord $y2]]
+ if {![string compare $kind .]} {
+ $canvas itemconfigure $l -dash .
+ }
+}
+
+while {[gets $chart l] >= 0} {
+# 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 c $count($key)
+# puts "SHOWING $key $c"
+ regexp {^(.*) (\S+)$} $key dummy islandname abbrev
+ if {[string compare $lastislandname $islandname]} {
+ manyset $isleloc($islandname) x y
+ set x [coord $x]
+ set y [coord $y]
+ set lastislandname $islandname
+# puts "START Y $y"
+ }
+ set text $abbrev
+ regsub -all {[0-9]} $text {} text
+ if {$c > 1} {
+ set text [format "%2d%s" $c $text]
+ } else {
+ set text [format " %s" $text]
+ }
+ set id [$canvas create text $x $y \
+ -anchor nw -font fixed \
+ -text $text]
+ set bbox [$canvas bbox $id]
+ set bid [eval $canvas create rectangle $bbox -fill white]
+ $canvas lower $bid $id
+ manyset $bbox dummy dummy dummy y
+# puts "NEW Y $y"
+}
+
+foreach nk [lsort [array names $note]] {
+ puts "IGNORED NOTE $nk"
+}
+
+#puts "[$canvas bbox all]"