X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?a=blobdiff_plain;f=yarrg%2Fwhere-vessels;h=045f5ad76bb06f591777eeb753c69dc4244c88d2;hb=0249114accb7871b75a33868f85c279aebb7d365;hp=6b46b89cce62924a89150bcd2aa746e7e71c8dab;hpb=199a0223ed500288af2224b56d2535be0bfa4592;p=ypp-sc-tools.db-live.git diff --git a/yarrg/where-vessels b/yarrg/where-vessels index 6b46b89..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] @@ -136,6 +136,7 @@ proc have-notes {} { return [string length $notes_loc] } proc have-ownership {} { + global pirate return [expr {[have-notes] && [string length $pirate]}] } @@ -146,7 +147,13 @@ 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 ?" } @@ -473,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" } } } @@ -623,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 @@ -675,6 +682,7 @@ proc make-smashers {} { 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 } } @@ -1147,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} { @@ -1163,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 @@ -1314,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 {} { @@ -1340,7 +1377,7 @@ 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 @@ -1397,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 @@ -1410,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 { } @@ -1432,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 { }