global vsc_game2code
set vsc_game2code(null) {}
set vsc_code2report() Ordinary
- set vsc_code2report(!) "Special/L.E."
+ set vsc_code2report(!) "(Special/L.E.)"
foreach {game code full} $subclassinfos {
if {![regexp {^[A-Z]$} $code code]} { error "bad code" }
set vsc_game2code($game) $code
}
load-icon atsea
+ set owners {ours dot query}
+ foreach b $owners { load-icon $b }
foreach a {battle borrow dot} {
- foreach b {ours dot query} {
- load-icon-combine $a $b
- }
+ load-icon $a
+ foreach b $owners { load-icon-combine $a $b }
}
}
proc code-lockown2icon {lockown} {
manyset [split $lockown ""] lock notown
- return icon/[
- lindex {battle borrow dot} $lock
- ]+[
- lindex {ours dot query} $notown
- ]
+ set l "
+ [lindex {battle borrow dot} $lock]
+ [lindex {ours dot query {} {} dot} $notown]
+ "
+ if {[llength $l]} { return icon/[join $l +] } { return {} }
}
proc canvas-horiz-stack {xvar xoff y bind type args} {
upvar 1 canvas canvas
set id [eval $canvas create $type [expr {$x+$xoff}] $y $args]
set bbox [$canvas bbox $id]
+# debug "CANVAS-HORIZ-STACK $type $x $xoff $id $bbox [list $args]"
set x [lindex $bbox 2]
$canvas bind $id <ButtonPress> $bind
return $id
}
incr stackx
- canvas-horiz-stack stackx 0 $imy $bind \
- image -anchor nw -image [code-lockown2icon $lockown]
- incr stackx
+ set lockownicon [code-lockown2icon $lockown]
+ if {[string length $lockownicon]} {
+ canvas-horiz-stack stackx 0 $imy $bind \
+ image -anchor nw -image $lockownicon
+ incr stackx
+ }
if {[string length $xabbrev]} {
canvas-horiz-stack stackx 0 $y $bind \
report-set inport [lindex {{At Sea} {In port}} $inport]
report-set class $vc_code2full($classcode)
- upvar #0 vsc_code2report($subclass) subclass_report
- if {[info exists subclass_report]} {
+ global smash_subclass
+ if {$smash_subclass >= 2} {
+ report-set subclass "(Any subclass)"
+ } elseif {[
+ upvar #0 vsc_code2report($subclass) subclass_report
+ info exists subclass_report
+ ]} {
report-set subclass $subclass_report
} else {
report-set subclass "Subclass \"$subclass\""
report-set lock [lindex {
{Battle ready} {Unlocked} {Locked}
+ {(All lock states)} {(Not battle ready)}
} $lock]
switch -exact $notown {
0 { report-set own "Yours" }
1 { report-set own "Other pirate's" }
2 { report-set own "Owner unknown" }
+ 3 { report-set own "(All ownerships)" }
+ 4 - 5 { report-set own "(Yours/unknown)" }
default { report-set own "?? $notown" }
}
}
}
+#---------- common to smashing and filtering ----------
+
+proc make-control {parent ctrl label ekind} {
+ debug "MAKE-CONTROL [list $parent $ctrl $label $ekind]"
+ label $parent.lab_$ctrl -text $label -justify left
+ $ekind $parent.$ctrl
+ manyset [grid size $parent] dummy row
+ incr row
+ grid configure $parent.lab_$ctrl -row $row -column 0 -sticky nw -pady 4
+ grid configure $parent.$ctrl -row $row -column 1 -sticky w -pady 3
+ return $parent.$ctrl
+}
+
+proc begin-control-grid {cw count rows inrow} {
+ if {!$inrow} { set inrow [expr {($count + $rows) / $rows}] }
+ upvar #0 control_grid_properties($cw) props
+ set props [list $rows $inrow]
+ return $cw
+}
+
+proc make-control-grid-entry {cw kind ix ekind args} {
+ upvar #0 control_grid_properties($cw) props
+ manyset $props rows inrow
+
+ set ew $cw.$ix
+
+ debug "MAKE-CONTROL-GRID-ENTRY $cw $kind $ix $ekind $rows $inrow $ew"
+
+ eval [list $ekind $ew] $args
+
+ switch -exact $kind {
+ ix {
+ grid configure $ew -sticky sw \
+ -row [expr {$ix / $inrow}] \
+ -column [expr {$ix % $inrow}]
+ }
+ final {
+ grid configure $ew -sticky se \
+ -row [expr {$rows-1}] \
+ -column [expr {$inrow-1}]
+ }
+ default {
+ error "$kind ?"
+ }
+ }
+ return $ew
+}
+
+proc control-tickbox-flip {varsvn values} {
+ upvar #0 $varsvn vars
+ foreach val $values {
+ set vars($val) [expr {!$vars($val)}]
+ }
+ redraw-needed c.-tickbox-flip $varsvn $values
+}
+
+proc populate-control-grid-tickboxes {cw rows inrow varsvn values flipvalues
+ label_kind valvn default_get label_get} {
+ debug "POPULATE-CONTROL-GRID-TICKBOXES $cw $rows $inrow $varsvn\
+ [list $values] $label_kind $valvn"
+
+ upvar #0 $varsvn vars
+ upvar 1 $valvn val
+ set count [llength $values]
+
+ begin-control-grid $cw $count $rows $inrow
+
+ for {set ix 0} {$ix < $count} {incr ix} {
+ set val [lindex $values $ix]
+ set vars($val) [uplevel 1 $default_get]
+ set ew [make-control-grid-entry $cw ix $ix checkbutton \
+ -variable ${varsvn}($val) \
+ -font fixed \
+ -command [list redraw-needed c.-g.-tickbox $cw $val]]
+ $ew configure -$label_kind [uplevel 1 $label_get]
+ switch -exact $label_kind {
+ image { $ew configure -height 16 }
+ }
+ }
+ [make-control-grid-entry $cw final invert button] \
+ configure \
+ -text flip -command [list control-tickbox-flip $varsvn $flipvalues] \
+ -padx 0 -pady 0
+}
+
#---------- smashing ----------
set smash_subclass 0
+set smash_owner 0
proc smash-code {code} {
manyset [split $code _] inport class subclass lockown xabbrev
+ upvar #0 smash_sizemap($class) smclass
+
global smash_subclass
if {$smash_subclass > 1} {
set subclass {}
set subclass !
}
- return [join [list $inport $class $subclass $lockown $xabbrev] _]
+ global smash_owner
+ switch $smash_owner {
+ 0 { }
+ 1 { regsub {[12]$} $lockown 5 lockown }
+ 2 {
+ if {[regexp {^0.} $lockown]} {
+ # battle ready / all lock states
+ set lockown 03
+ } elseif {[regexp {^.0} $lockown]} {
+ # not battle ready / yours
+ set lockown 40
+ } else {
+ # state (not battle ready) / not known to be yours
+ regsub {.$} $lockown 4 lockown
+ }
+ }
+ 3 { regsub {.$} $lockown {3} lockown }
+ 4 { set lockown 33 }
+ }
+
+ return [join [list $inport $smclass $subclass $lockown $xabbrev] _]
+}
+
+proc smash-prepare {} {
+ global vc_codes smash_sizemap smash_size
+ set mapto {}
+ foreach size $vc_codes {
+ if {!$smash_size($size)} { set mapto $size }
+ set smash_sizemap($size) $mapto
+ }
}
proc make-smasher {sma label ekind} {
- return [make-gridded-control .smash $sma $label $ekind]
+ return [make-control .smash $sma $label $ekind]
}
-proc make-radio-smasher {sma label variable descs} {
+proc make-radio-smasher {sma label variable descs rows inrow} {
set w [make-smasher $sma $label frame]
+ begin-control-grid $w [llength $descs] $rows $inrow
for {set i 0} {$i < [llength $descs]} {incr i} {
- radiobutton $w.v$i \
+ make-control-grid-entry $w ix $i \
+ radiobutton \
-variable $variable -value $i -command redraw-needed \
-text [lindex $descs $i]
- pack $w.v$i -side left
}
}
+proc make-smashers {} {
+ global vc_codes vc_code2abbrev
+ set cw [make-smasher size "Size\n round\n down" frame]
+ populate-control-grid-tickboxes $cw 2 0 smash_size \
+ $vc_codes [lrange $vc_codes 1 end] \
+ image val { expr 0 } { expr {"icon/$vc_code2abbrev($val)"} }
+ $cw.0 configure -state disabled
+
+ make-radio-smasher subclass Subclass smash_subclass \
+ {Show Normal/LE Hide} 1 0
+
+ make-radio-smasher owner Owner smash_owner \
+ {Show Yours? {For you} Lock Hide} 2 3
+}
+
#---------- filtering ----------
set filters {}
proc filter-says-yes/lockown {codel} {
set lockown [lindex $codel 3]
upvar #0 filter_lockown($lockown) yes
+ debug "FILTER-SAYS-YES/LOCKOWN $codel $lockown $yes"
return $yes
}
return [regexp -- $filter_xabbre $xabbrev]
}
-proc filter-tickbox-flip {fil} {
- upvar #0 filter_$fil vars
+proc make-tickbox-filter {fil label rows inrow} {
set values [filter-values/$fil]
- foreach val $values {
- set vars($val) [expr {!$vars($val)}]
+
+ if {![catch { info args filter-icon/$fil }]} {
+ set label_get { filter-icon/$fil $val }
+ set label_kind image
+ } else {
+ set label_get { filter-map/$fil $val }
+ set label_kind text
}
- redraw-needed
-}
-proc make-tickbox-filter {fil label rows inrow} {
- upvar #0 filter_$fil vars
set fw [make-filter $fil $label frame]
- set values [filter-values/$fil]
- set nvalues [llength $values]
- if {!$inrow} {
- set inrow [expr {($nvalues + $rows) / $rows}]
- }
- set noicons [catch { info args filter-icon/$fil }]
- for {set ix 0} {$ix < $nvalues} {incr ix} {
- set val [lindex $values $ix]
- set vars($val) [filter-default/$fil $val]
- checkbutton $fw.$ix -variable filter_${fil}($val) \
- -font fixed -command redraw-needed
- if {!$noicons} {
- $fw.$ix configure -image [filter-icon/$fil $val] -height 16
- } else {
- $fw.$ix configure -text [filter-map/$fil $val]
- }
- grid configure $fw.$ix -sticky sw \
- -row [expr {$ix / $inrow}] \
- -column [expr {$ix % $inrow}]
- }
- button $fw.invert -text flip -command [list filter-tickbox-flip $fil] \
- -padx 0 -pady 0
- grid configure $fw.invert -sticky se \
- -row [expr {$rows-1}] \
- -column [expr {$inrow-1}]
+
+ populate-control-grid-tickboxes $fw $rows $inrow filter_$fil \
+ $values $values \
+ $label_kind val { filter-default/$fil $val } $label_get
}
proc entry-filter-changed {fw fil n1 n2 op} {
pack $fw.entry $fw.error -side top -anchor w
}
-proc make-gridded-control {parent name label ekind} {
- debug "MAKE-GRIDDED-CONTROL [list $parent $name $label $ekind]"
- label $parent.lab_$name -text $label -justify left
- $ekind $parent.$name
- manyset [grid size $parent] dummy row
- incr row
- grid configure $parent.lab_$name -row $row -column 0 -sticky nw -pady 4
- grid configure $parent.$name -row $row -column 1 -sticky w -pady 3
- return $parent.$name
-}
-
proc make-filter {fil label ekind} {
global filters
lappend filters $fil
- return [make-gridded-control .filter $fil $label $ekind]
+ return [make-control .filter $fil $label $ekind]
}
proc make-filters {} {
proc filters-say-yes {code} {
global filters filterstyle
- debug "filters-say-yes $code"
set codel [split $code _]
set lockown [lindex $codel 3]
switch -exact $filterstyle {
}
foreach fil $filters {
- if {![filter-says-yes/$fil $codel]} { return 0 }
+ if {![filter-says-yes/$fil $codel]} {
+ debug "FILTERS-SAY-YES $code NO $fil"
+ return 0
+ }
}
+ debug "FILTERS-SAY-YES $code YES $filters"
return 1
}
}
}
-proc redraw-needed {} {
+proc debug-filter-array {array} {
+ upvar #0 $array a
+ set m " FILTER $array"
+ foreach k [lsort [array names a]] {
+ append m " $k=$a($k)"
+ }
+ debug $m
+}
+
+proc redraw-needed {args} {
global redraw_after
- debug "REDRAW NEEDED"
+ debug "REDRAW NEEDED $args"
if {[info exists redraw_after]} return
+
+ global filterstyle
+ debug " FILTER style $filterstyle"
+ debug-filter-array filter_size
+ debug-filter-array filter_lockown
+ global filter_xabbre
+ debug " FILTER xabbre $filter_xabbre"
+
set redraw_after [after 250 draw]
}
eval chart-got/$proc [lrange $l 1 end]
}
+ smash-prepare
+
catch { unset smfound }
foreach key [lsort [array names found]] {
regexp {^(.*) (\S+)$} $key dummy islandname code
+
+ if {![filters-say-yes $code]} continue
+
set smcode [smash-code $code]
debug "smashed $code => $smcode"
set smkey "$islandname $smcode"
set lastislandname {}
foreach smkey [lsort [array names smfound]] {
set c [llength $smfound($smkey)]
-# debug "SHOWING $smkey $c"
regexp {^(.*) (\S+)$} $smkey dummy islandname code
-
- if {![filters-say-yes $code]} continue
+ debug "SHOWING [list $smkey $c $islandname $code l=$lastislandname]"
if {[string compare $lastislandname $islandname]} {
manyset $isleloc($islandname) x y
proc widgets-setup {} {
global canvas debug pirate ocean filterstyle
- wm geometry . 1024x600
+ wm geometry . 1200x800
wm title . "where-vessels - $pirate on the $ocean ocean"
#----- map -----
frame .islands -pady 2
pack .cp .filter .islands .smash -side top
- label .smash.title -text Smash
+ label .smash.title -text {Display/combine details}
grid .smash.title -row 0 -column 0 -columnspan 2
- make-radio-smasher subclass Subclass smash_subclass \
- {Show Normal/LE Hide}
-
set filterstyle 1
trace add variable filterstyle write filterstyle-changed
load-chart
widgets-setup
make-filters
+make-smashers
set notes_data {}
if {[catch { parse-clipboard } emsg]} {
draw
+if {$debug} {
+ package require Tclx
+ commandloop -async \
+ -prompt1 { return "where-vessels% " } \
+ -prompt2 { return "> " }
+}
+
# rsync -r --exclude=\*~ yarrg/icons/. ijackson@chiark.greenend.org.uk:/home/ftp/users/ijackson/yarrg/vessel-info/.
~yarrgweb / ypp-sc-tools.db-test.git / blobdiff