X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?a=blobdiff_plain;f=yarrg%2Fwhere-vessels;h=045f5ad76bb06f591777eeb753c69dc4244c88d2;hb=0249114accb7871b75a33868f85c279aebb7d365;hp=9005a7f9032c9dadd15e5d1da71d39e6ad140634;hpb=792a2a676fb8c320255990e3b7bbc22ea74c6ae6;p=ypp-sc-tools.db-test.git diff --git a/yarrg/where-vessels b/yarrg/where-vessels index 9005a7f..045f5ad 100755 --- a/yarrg/where-vessels +++ b/yarrg/where-vessels @@ -124,7 +124,7 @@ proc parseargs {} { --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] @@ -135,6 +135,10 @@ proc have-notes {} { 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 @@ -143,14 +147,19 @@ proc argdefaults {} { 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 @@ -471,7 +480,7 @@ proc show-report-decode {code} { 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" } } } @@ -621,7 +630,7 @@ proc smash-code {code} { 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 @@ -654,6 +663,7 @@ proc make-radio-smasher {sma label variable descs rows inrow} { -command [list redraw-needed radio-smasher $sma] \ -text [lindex $descs $i] } + return $w } proc make-smashers {} { @@ -669,9 +679,13 @@ proc make-smashers {} { 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 "Lock/\nowner" 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} { @@ -1141,6 +1155,18 @@ proc draw {} { } +#---------- 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} { @@ -1157,17 +1183,11 @@ 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 @@ -1308,6 +1328,29 @@ proc islandnames-handler {offset maxchars} { $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 {} { @@ -1334,23 +1377,26 @@ 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 @@ -1388,8 +1434,20 @@ proc widgets-setup {} { 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 @@ -1401,7 +1459,7 @@ proc widgets-setup {} { #----- 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 { } @@ -1423,8 +1481,8 @@ proc widgets-setup {} { .cp.report.list .cp.report.abbrev1 -side top bind .cp.report.list <> 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 { }