X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?a=blobdiff_plain;f=yarrg%2Fwhere-vessels;h=47cd6ed1119fb63aedea28561d8a8a00abdae5c3;hb=54f130dd25e32cfeb3e52b11b50fffc2f93d18ad;hp=a99917eecd451dd06f71e3fd2b5cc51b6d6a48c9;hpb=b7c56bf4481a41c5c762b0081f32b05858f0d52a;p=ypp-sc-tools.web-live.git diff --git a/yarrg/where-vessels b/yarrg/where-vessels index a99917e..47cd6ed 100755 --- a/yarrg/where-vessels +++ b/yarrg/where-vessels @@ -267,14 +267,7 @@ proc vesselclasses-init {} { load-icon $abbrev } - load-icon unlocked - load-icon locked - load-icon battle load-icon atsea - load-icon borrow - load-icon query - load-icon ours - load-icon dot foreach a {battle borrow dot} { foreach b {ours dot query} { load-icon-combine $a $b @@ -394,7 +387,7 @@ proc show-report-decode {code} { switch -exact $notown { 0 { report-set own "Yours" } 1 { report-set own "Other pirate's" } - 2 { report-set own "Owner not specified in notes" } + 2 { report-set own "Owner unknown" } default { report-set own "?? $notown" } } @@ -734,7 +727,7 @@ proc redraw-needed {} { } proc draw {} { - global chart found isleloc canvas redraw_after + global chart found isleloc canvas redraw_after islandnames catch { after cancel $redraw_after } catch { unset redraw_after } @@ -747,6 +740,7 @@ proc draw {} { eval chart-got/$proc [lrange $l 1 end] } + set islandnames {} set lastislandname {} foreach key [lsort [array names found]] { set c [llength $found($key)] @@ -760,6 +754,7 @@ proc draw {} { set x [coord $x] set y [coord $y] set lastislandname $islandname + lappend islandnames $islandname # debug "START Y $y" } @@ -770,6 +765,8 @@ proc draw {} { } panner::updatecanvas-bbox .cp.ctrl.pan + + islandnames-update } @@ -777,7 +774,7 @@ proc draw {} { proc parser-control-create {w base invokebuttontext etl_title} { frame $w - button $w.do -text $invokebuttontext -command invoke_$base + button $w.do -text $invokebuttontext -command invoke_$base -pady 3 frame $w.resframe -width 120 -height 32 button $w.resframe.res -text {} -anchor nw \ @@ -912,6 +909,28 @@ proc reparse {base varname old fulldesc okshow noneshow parse ok} { } } +#---------- island names selection etc. ---------- + +proc islandnames-update {} { + global islandnames + .islands.count configure -text [format "ships at %d island(s)" \ + [llength $islandnames]] +} + +proc islandnames-select {} { + .islands.clip configure -relief sunken -state disabled + selection own -command islandnames-deselect .islands.clip +} +proc islandnames-deselect {} { + .islands.clip configure -relief raised -state normal +} + +proc islandnames-handler {offset maxchars} { + global islandnames + return [string range [join $islandnames ", "] \ + $offset [expr {$offset+$maxchars-1}]] +} + #---------- main user interface ---------- proc widgets-setup {} { @@ -931,8 +950,9 @@ proc widgets-setup {} { #----- control panels and filter ----- frame .cp - frame .filter -relief groove -bd 2 - pack .cp .filter -side top + frame .filter -relief groove -bd 2 -padx 1 + frame .islands -pady 2 + pack .cp .filter .islands -side top label .filter.title -text Filter grid configure .filter.title -row 0 -column 0 -columnspan 2 @@ -947,12 +967,12 @@ proc widgets-setup {} { panner::canvas-scroll-bbox .f.c panner::create .cp.ctrl.pan .f.c 120 120 $debug - pack .cp.ctrl.pan -side top -pady 10 -padx 5 + pack .cp.ctrl.pan -side top -pady 0 -padx 5 frame .cp.ctrl.zoom pack .cp.ctrl.zoom -side top - button .cp.ctrl.zoom.out -text - -font {Courier 16} -command {zoom /2} - button .cp.ctrl.zoom.in -text + -font {Courier 16} -command {zoom *2} + button .cp.ctrl.zoom.out -text - -font {Courier 16} -command {zoom /2} -pady 0 + button .cp.ctrl.zoom.in -text + -font {Courier 16} -command {zoom *2} -pady 0 pack .cp.ctrl.zoom.out .cp.ctrl.zoom.in -side left parser-control-create .cp.ctrl.acquire \ @@ -967,6 +987,14 @@ proc widgets-setup {} { pack .cp.ctrl.notes -side top -pady 2 + #----- island name count and copy ----- + + label .islands.count + button .islands.clip -text "copy island names" -pady 2 -padx 2 \ + -command islandnames-select + selection handle .islands.clip islandnames-handler + pack .islands.count .islands.clip -side left + #----- decoding etc. report ----- frame .cp.report @@ -987,7 +1015,8 @@ proc widgets-setup {} { listbox .cp.report.list -height 5 pack .cp.report.island .cp.report.abbrev .cp.report.details \ - .cp.report.list .cp.report.code -side top + .cp.report.list -side top + #pack .cp.report.code -side top pack configure .cp.report.details -fill x foreach sw {inport class subclass lock own xabbrev} {