5 proc manyset {list args} {
6 foreach val $list var $args {
12 set itemre { (\w+) = ([^=]*) }
13 set manyitemre "^\\\[ $itemre ( (?: ,\\ $itemre)* ) \\]\$"
16 set vn [open vessel-notes]
17 while {[gets $vn l] >= 0} {
18 regsub -all {\t+} $l "\t" l
19 manyset [split $l "\t"] vname vid owner note
22 set notes($nk) [list $owner $note]
29 switch -exact $vi(vesselClass) {
30 smsloop { set sz 00sl }
31 lgsloop { set sz 01ct }
33 longship { set sz 03ls }
34 baghlah { set sz 04bg }
35 merchbrig { set sz 05mb }
36 warbrig { set sz 06wb }
38 warfrig { set sz 08wf }
39 merchgal { set sz 09mg }
40 grandfrig { set sz 10gf }
41 default { error "$vi(vesselClass) ?" }
44 switch -exact $vi(vesselSubclass) {
46 icy { append abbrev F }
47 default { error "$vi(vesselSubclass) ?" }
49 switch -exact $vi(isLocked)/$vi(isBattleReady) {
50 true/false { append abbrev 2- }
51 false/false { append abbrev 1+ }
52 false/true { append abbrev 0* }
53 default { error "$vi(isLocked)/$vi(isBattleReady) ?" }
55 switch -exact $vi(inPort) {
57 false { append abbrev ? }
58 default { error "$vi(inPort) ?" }
60 set nk $vi(vesselId).$vi(vesselName)
61 upvar #0 notes($nk) note
62 if {[info exists note]} {
63 manyset $note owner xabbrev
64 if {![string compare $owner $us]} {
69 append abbrev $xabbrev
74 set kk "$vi(islandName) $abbrev"
76 if {![info exists k]} { set k 0 }
80 set cl [open clipboard]
81 while {[gets $cl l] >= 0} {
85 if {![regexp -expanded $manyitemre $l dummy \
86 thiskey thisval rhs]} { error "$l ?" }
87 # puts "KEY $thiskey VAL $thisval"
88 set vi($thiskey) $thisval
89 if {![string length $rhs]} break
90 regsub {^, } $rhs {} rhs
97 set chart [open |[list perl -we {
102 yppedia_chart_parse(\*STDIN, (new IO::File ">/dev/null"),
103 sub { sprintf "%d %d", @_; },
104 sub { printf "archlabel %d %d %s\n", @_; },
105 sub { printf "island %s %s\n", @_; },
106 sub { printf "league %s %s %s.\n", @_; },
107 sub { printf STDERR "warning: %s: incomprehensible: %s", @_; }
109 STDOUT->error and die $!;
112 frame .f -border 1 -relief groove
115 #$canvas configure -width 1000 -height 800
116 pack $canvas -expand 1 -fill both
117 pack .f -expand 1 -fill both
123 return [expr {$c * $scale}]
126 proc chart-got/archlabel {args} { }
127 proc chart-got/island {x y args} {
128 # puts "ISLE $x $y $args"
129 global canvas isleloc
130 set isleloc($args) [list $x $y]
132 # $canvas create oval \
133 # [expr {[coord $x] - $sz}] [expr {[coord $y] - $sz}] \
134 # [expr {[coord $x] + $sz}] [expr {[coord $y] + $sz}] \
136 $canvas create text [coord $x] [coord $y] \
137 -text $args -anchor s
139 proc chart-got/league {x1 y1 x2 y2 kind} {
140 # puts "LEAGUE $x1 $y1 $x2 $y2 $kind"
142 set l [$canvas create line \
143 [coord $x1] [coord $y1] \
144 [coord $x2] [coord $y2]]
145 if {![string compare $kind .]} {
146 $canvas itemconfigure $l -dash .
150 while {[gets $chart l] >= 0} {
151 # puts "CHART-GOT $l"
152 set proc [lindex $l 0]
153 eval chart-got/$proc [lrange $l 1 end]
158 set lastislandname {}
159 foreach key [lsort [array names count]] {
161 # puts "SHOWING $key $c"
162 regexp {^(.*) (\S+)$} $key dummy islandname abbrev
163 if {[string compare $lastislandname $islandname]} {
164 manyset $isleloc($islandname) x y
167 set lastislandname $islandname
171 regsub -all {[0-9]} $text {} text
173 set text [format "%2d%s" $c $text]
175 set text [format " %s" $text]
177 set id [$canvas create text $x $y \
178 -anchor nw -font fixed \
180 set bbox [$canvas bbox $id]
181 set bid [eval $canvas create rectangle $bbox -fill white]
182 $canvas lower $bid $id
183 manyset $bbox dummy dummy dummy y
187 foreach nk [lsort [array names $note]] {
188 puts "IGNORED NOTE $nk"
191 #puts "[$canvas bbox all]"