--vessel-info-source { glset info_source [nextarg] }
--filter-separate-lock-owner { glset filter_lockown_separate 1 }
--debug { incr debug }
- default { badusage "unknown option $arg" }
+ default { badusage "bad option $arg; see README.where-vessels" }
}
}
set argv [lrange $argv $ai end]
global notes_loc
return [string length $notes_loc]
}
+proc have-ownership {} {
+ global pirate
+ return [expr {[have-notes] && [string length $pirate]}]
+}
proc argdefaults {} {
global ocean notes_loc pirate scraper
set cmd {./yarrg --find-window-only --quiet}
if {[info exists ocean]} { lappend cmd --ocean $ocean }
if {[info exists pirate]} { lappend cmd --pirate $pirate }
- manyset [split [eval exec $cmd] " "] ocean pirate
+ if {[catch {
+ manyset [split [eval exec $cmd] " "] ocean pirate
+ } emsg]} {
+ puts stderr "yarrg: [string trim $emsg]"
+ puts stderr "Alternatively pass, --ocean and perhaps --pirate options to where-vessels"
+ exit 1
+ }
if {![llength $ocean] || ![llength $pirate]} {
error "$ocean $pirate ?"
}
}
if {![info exists pirate]} {
set pirate {}
- glset filter_lockown_separate 1
}
if {![have-notes]} {
glset filter_lockown_separate 1
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)" }
+ 4 - 5 { report-set own "(Not yours / unknown)" }
default { report-set own "?? $notown" }
}
}
return $ew
}
-proc control-tickbox-flip {varsvn values} {
+proc control-tickbox-flip {varsvn values onflip} {
upvar #0 $varsvn vars
foreach val $values {
set vars($val) [expr {!$vars($val)}]
}
- redraw-needed c.-tickbox-flip $varsvn $values
+ $onflip c.-tickbox-flip $varsvn $values
}
proc populate-control-grid-tickboxes {cw rows inrow varsvn values flipvalues
- label_kind valvn default_get label_get} {
+ label_kind valvn default_get label_get onflip} {
debug "POPULATE-CONTROL-GRID-TICKBOXES $cw $rows $inrow $varsvn\
[list $values] $label_kind $valvn"
set ew [make-control-grid-elem $cw ix $ix checkbutton \
-variable ${varsvn}($val) \
-font fixed \
- -command [list redraw-needed c.-g.-tickbox $cw $val]]
+ -command [list $onflip 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-elem $cw final invert button] \
configure \
- -text flip -command [list control-tickbox-flip $varsvn $flipvalues] \
- -padx 0 -pady 0
+ -text flip -padx 0 -pady 0 \
+ -command [list control-tickbox-flip $varsvn $flipvalues $onflip]
}
#---------- smashing ----------
proc smash-prepare {} {
global vc_codes smash_sizemap smash_size smash_sizeinexact
set mapto {}
- catch { unset smash_sizeplus }
+ catch { unset smash_sizeinexact }
foreach size $vc_codes {
if {!$smash_size($size)} {
set mapto $size
for {set i 0} {$i < [llength $descs]} {incr i} {
make-control-grid-elem $w ix $i \
radiobutton \
- -variable $variable -value $i -command redraw-needed \
+ -variable $variable -value $i \
+ -command [list redraw-needed radio-smasher $sma] \
-text [lindex $descs $i]
}
+ return $w
}
proc make-smashers {} {
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)"} }
+ image val { expr 0 } { expr {"icon/$vc_code2abbrev($val)"} } \
+ redraw-needed
$cw.0 configure -state disabled
glset smash_subclass 0
make-radio-smasher subclass Class smash_subclass \
{Show Normal/LE Hide} 1 0
- glset smash_owner [expr {[have-notes] ? 0 : 3}]
- make-radio-smasher owner Owner smash_owner \
- {Show Yours? {For you} Lock Hide} 2 3
+ glset smash_owner [expr {[have-ownership] ? 0 : 3}]
+ set cw [make-radio-smasher owner "Lock/\nowner" smash_owner \
+ {Show Yours? {For you} Lock Hide} 2 3]
+ if {![have-notes]} { $cw.0 configure -state disabled }
+ if {![have-ownership]} {
+ foreach ix {1 2} { $cw.$ix configure -state disabled }
+ }
set cw [make-smasher xabbrev "Flags" frame]
foreach ix {1 3} ab {a b} width {14 12} {
populate-control-grid-tickboxes $fw $rows $inrow filter_$fil \
$values $values \
- $label_kind val { filter-default/$fil $val } $label_get
+ $label_kind val { filter-default/$fil $val } $label_get \
+ specific-filter-adjusted
}
proc entry-filter-changed {fw fil n1 n2 op} {
} else {
$fw.error configure -text { } -background $def_background
set realvar $entryvar
- redraw-needed
+ specific-filter-adjusted entry-filter-changed $fw
}
} emsg]} {
puts stderr "FILTER CHECK ERROR $emsg $errorInfo"
make-entry-filter xabbre "Flags\n regexp" {}
}
+proc specific-filter-adjusted {args} {
+ glset filterstyle 3
+ eval redraw-needed $args
+}
+
proc filterstyle-changed {n1 n2 op} {
global filterstyle
- debug "filterstyle-changed $filterstyle"
- redraw-needed
+ debug "FILTERSTYLE-CHANGED $filterstyle"
+ redraw-needed filterstyle-changed
}
proc filters-say-yes {code} {
}
+#---------- info toplevel ----------
+
+proc info-toplevel-create {info title} {
+ toplevel $info
+ wm withdraw $info
+ wm title $info "where-vessels - $title"
+ wm protocol $info WM_DELETE_WINDOW [list wm withdraw $info]
+
+ button $info.close -text Close -command [list wm withdraw $info]
+ pack $info.close -side bottom
+}
+
#---------- parser error reporting ----------
proc parser-control-create {w base invokebuttontext etl_title} {
pack $w.resframe -side top -expand y -fill both
set eb .err_$base
- toplevel $eb
- wm withdraw $eb
- wm title $eb "where-vessels - $etl_title"
- wm protocol $eb WM_DELETE_WINDOW [list wm withdraw $eb]
+ info-toplevel-create $eb $etl_title
label $eb.title -text $etl_title
pack $eb.title -side top
- button $eb.close -text Close -command [list wm withdraw $eb]
- pack $eb.close -side bottom
-
frame $eb.emsg -bd 2 -relief groove
label $eb.emsg.lab -anchor nw -text "Error:"
text $eb.emsg.text -height 1
$offset [expr {$offset+$maxchars-1}]]
}
+#---------- print to postscript ----------
+
+proc print-to-postscript {} {
+ global canvas ocean
+ set postscript_fontmap(fixed) {Courier 12}
+ manyset [$canvas bbox all] xmin ymin xmax ymax
+ set file where-vessels.$ocean.ps
+ $canvas postscript -file $file -rotate 1 \
+ -width [expr {$xmax-$xmin}] \
+ -height [expr {$ymax-$ymin}] \
+ -fontmap postscript_fontmap
+ .printed.info configure -text "Printed to $file
+
+Usually, the next thing would be something like"
+ set text "epsffit 0 0 595.276 841.89 <$file >t.ps"
+ .printed.rune configure -state normal
+ .printed.rune delete 1.0 end
+ .printed.rune insert end $text
+ .printed.rune configure -width [string length $text] -state disabled
+ update idletasks
+ wm deiconify .printed
+}
+
#---------- main user interface ----------
proc widgets-setup {} {
frame .smash -relief groove -bd 2 -padx 1
frame .filter -relief groove -bd 2 -padx 1
frame .islands -pady 2
- pack .cp .filter .islands .smash -side top
+ pack .cp .filter .islands .smash -side top -fill x
label .smash.title -text {Display/combine details}
grid .smash.title -row 0 -column 0 -columnspan 2
- set filterstyle 1
+ set filterstyle [expr {[have-ownership] ? 1 : 3}]
trace add variable filterstyle write filterstyle-changed
frame .filter.title
label .filter.title.title -text Show
pack .filter.title.title -side left
- for {set fing 0} {$fing < 4} {incr fing} {
+ foreach fing {0 1 2 3} {
radiobutton .filter.title.f$fing \
-variable filterstyle -value $fing \
-text [lindex {All Useable Mine These:} $fing]
pack .filter.title.f$fing -side left
}
+ if {![have-ownership]} {
+ foreach fing {1 2} { .filter.title.f$fing configure -state disabled }
+ }
grid configure .filter.title -row 0 -column 0 -columnspan 2
if {![have-notes]} {
.cp.ctrl.notes.do configure -state disabled
- }
+ }
+
+ button .cp.ctrl.print -text {Print to file} -command print-to-postscript
+ pack .cp.ctrl.print -side top
+ #----- message saying we've printed -----
+
+ info-toplevel-create .printed "printed"
+
+ label .printed.info
+ text .printed.rune -state disabled -height 1 -borderwidth 0
+ pack .printed.info -side top
+ pack .printed.rune -side top
+
#----- island name count and copy -----
label .islands.count
#----- decoding etc. report -----
frame .cp.report
- pack .cp.report -side left -anchor n
+ pack .cp.report -side left -anchor n -fill both -expand y
label .cp.report.island -text { }
.cp.report.list .cp.report.abbrev1 -side top
bind .cp.report.list <<ListboxSelect>> show-report-abbrev1
- #pack .cp.report.code -side top
pack configure .cp.report.details -fill x
+ pack configure .cp.report.list -fill x
foreach sw {inport size subclass lock own xabbrev} {
label .cp.report.details.$sw -text { }