where-vessels: printing

[ypp-sc-tools.db-test.git] / yarrg / where-vessels

diff --git a/yarrg/where-vessels b/yarrg/where-vessels
index 78a29543244ea91848c406051e12bd2d658196fc..045f5ad76bb06f591777eeb753c69dc4244c88d2 100755 (executable)
--- a/yarrg/where-vessels
+++ b/yarrg/where-vessels
@@ -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
@@ -1148,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} {
@@ -1164,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
@@ -1315,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 {} {
@@ -1341,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
@@ -1398,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
@@ -1411,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 { }
 
@@ -1433,8 +1481,8 @@ proc widgets-setup {} {
        .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 { }