X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?a=blobdiff_plain;f=yarrg%2Fwhere-vessels;h=045f5ad76bb06f591777eeb753c69dc4244c88d2;hb=0249114accb7871b75a33868f85c279aebb7d365;hp=bebdf79f370f2869af534b220046dbb260217c64;hpb=f276e170ffec2e6ee6e61b212fe8e1bd90279386;p=ypp-sc-tools.db-live.git diff --git a/yarrg/where-vessels b/yarrg/where-vessels index bebdf79..045f5ad 100755 --- a/yarrg/where-vessels +++ b/yarrg/where-vessels @@ -147,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 ?" } @@ -624,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 @@ -1149,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} { @@ -1165,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 @@ -1316,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 {} { @@ -1399,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