# copyright (C) 1997-2006 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu

# $Id: print.tcl,v 2.45 2006/01/28 19:16:59 jfontain Exp $


namespace eval print {

    variable dotsPerMillimeter [expr {72 / 25.4}]                                        ;# 72 dots/inch is the default for printers
    variable previewerWindow .grabber.printPreviewer


    proc printOrSaveCanvas {} {
        variable printToFile $global::printToFile
        variable printCommand $global::printCommand
        variable fileToPrintTo $global::fileToPrintTo
        variable orientations
        variable orientation
        variable palettes
        variable palette
        variable sizes
        variable size
        variable printPaperSize $global::printPaperSize
        variable printer

        if {![info exists orientations]} {
            foreach orientation $global::printOrientations {lappend orientations [mc $orientation]}
            foreach palette $global::printPalettes {lappend palettes [mc $palette]}
            foreach size $global::printPaperSizes {lappend sizes [mc $size]}
        }
        set index [lsearch -exact $global::printOrientations $global::printOrientation]; if {$index < 0} {set index 0}
        set orientation [lindex $orientations $index]
        set index [lsearch -exact $global::printPalettes $global::printPalette]; if {$index < 0} {set index 0}
        set palette [lindex $palettes $index]
        set index [lsearch -exact $global::printPaperSizes $global::printPaperSize]; if {$index < 0} {set index 0}
        set size [lindex $sizes $index]
        set objects {}                                                                  ;# to delete upon destruction of this folder
        set dialog [new dialogBox .grabber\
            -buttons hoc -default o -title [mc {moodss: Print}] -die 0 -x [winfo pointerx .] -y [winfo pointery .]\
            -helpcommand {generalHelpWindow #menus.file.print} -deletecommand {grab release .grabber}\
        ]
        grab .grabber                                                      ;# grab siblings such as help window so that it is usable
        lappend objects [linkedHelpWidgetTip $composite::($dialog,help,path)]
        set toplevel $widget::($dialog,path)
        set frame [frame $toplevel.frame]
        set row 0
        message $frame.help -width [winfo screenwidth .] -font $font::(mediumNormal) -justify left\
            -text [mc {Print the window to a printer device or to a file, in Postscript}]
        grid $frame.help -pady 5 -row $row -column 0 -columnspan 3
        incr row
        radiobutton $frame.toCommand -variable print::printToFile -value 0
        grid $frame.toCommand -row $row -column 0 -sticky w
        if {[string first %P $printCommand] < 0} {                                     ;# command does not include printer parameter
            $frame.toCommand configure -text [mc {with Command:}]
            entry $frame.command -textvariable print::printCommand
            grid $frame.command -row $row -column 1 -sticky ew
        } else {                                                                   ;# let user choose printer from printers database
            $frame.toCommand configure -text [mc {to Printer:}]
            printerCapability::parseDatabase aliases default
            catch {unset printer}                                                            ;# make sure printer is reset each time
            catch {set printer [printerFormattedEntry $default $aliases($default)]}                       ;# default might not exist
            set entries {}
            foreach name [lsort -dictionary [array names aliases]] {                                       ;# sort for easier access
                lappend entries [printerFormattedEntry $name $aliases($name)]
            }
            set entry [new comboEntry $frame -font $widget::option(entry,font) -list $entries]
            lappend objects $entry
            composite::configure $entry entry -textvariable print::printer
            if {[llength $entries] <= 3} {
                composite::configure $entry button -listheight [llength $entries]
            }
            composite::configure $entry button scroll -selectmode single
            grid $widget::($entry,path) -row $row -column 1 -sticky ew
        }
        set button\
            [button $frame.preview -text [mc Preview]... -command "wm withdraw $toplevel; print::preview; wm deiconify $toplevel"]
        if {[catch {exec gs --version} version]} {
            $button configure -state disabled
            lappend objects [new widgetTip -path $button -text [mc {could not get gs version}]]
        } elseif {[package vcompare $version 5.20] < 0} {                                   ;# -dWindowID switch did not work before
            $button configure -state disabled
            lappend objects [new widgetTip -path $button -text [mc {requires gs version above 5.20}]]
        }
        grid $button -row $row -column 2 -sticky ew
        incr row
        radiobutton $frame.toFile -variable print::printToFile -value 1 -text [mc {or to File:}]
        grid $frame.toFile -row $row -column 0 -sticky w
        entry $frame.file -textvariable print::fileToPrintTo
        grid $frame.file -row $row -column 1 -sticky ew
        button $frame.browse -text [mc Browse]... -command "print::inquireFileToPrintTo $frame"
        grid $frame.browse -row $row -column 2 -sticky ew
        if {$printToFile} {
            $frame.toFile invoke
        } else {
            $frame.toCommand invoke
        }
        incr row
        grid [label $frame.orientation -text [mc Orientation:]] -row $row -column 0 -sticky w
        set entry [new comboEntry $frame -font $widget::option(entry,font) -list $orientations -editable 0]
        lappend objects $entry
        composite::configure $entry entry -textvariable print::orientation
        composite::configure $entry button -listheight [llength $orientations]
        composite::configure $entry button scroll -selectmode single
        grid $widget::($entry,path) -row $row -column 1 -columnspan 2 -sticky ew
        incr row
        grid [label $frame.palette -text [mc Palette:]] -row $row -column 0 -sticky w
        set entry [new comboEntry $frame -font $widget::option(entry,font) -list $palettes -editable 0]
        lappend objects $entry
        composite::configure $entry entry -textvariable print::palette
        composite::configure $entry button -listheight [llength $palettes]
        composite::configure $entry button scroll -selectmode single
        grid $widget::($entry,path) -row $row -column 1 -columnspan 2 -sticky ew
        incr row
        grid [label $frame.size -text [mc {Paper size:}]] -row $row -column 0 -sticky w
        set entry [new comboEntry $frame -font $widget::option(entry,font) -list $sizes -editable 0]
        lappend objects $entry
        composite::configure $entry entry -textvariable print::size
        composite::configure $entry button -listheight [llength $sizes]
        composite::configure $entry button scroll -selectmode single
        grid $widget::($entry,path) -row $row -column 1 -columnspan 2 -sticky ew
        grid columnconfigure $frame 1 -weight 1
        dialogBox::display $dialog $frame
        # make sure dialog box does not appear in printout
        widget::configure $dialog -command "delete $dialog; print::updateGlobals; update; print::print"
        bind $frame <Destroy> "print::cleanup $objects"                              ;# delete objects not managed by the dialog box
    }

    proc printerFormattedEntry {name aliases} {
        set string $name
        set first 1
        foreach alias $aliases {
            if {$first} {
                append string { (}
                set first 0
            } else {
                append string {, }
            }
            append string $alias
        }
        if {!$first} {
            append string )
        }
        return $string
    }

    proc cleanup {args} {                                                                          ;# arguments are objets to delete
        variable previewerWindow

        catch {destroy $previewerWindow}
        eval delete $args
    }

    proc inquireFileToPrintTo {parentPath} {
        set file [tk_getSaveFile\
            -title [mc {moodss: Print to file}] -parent $parentPath -initialdir [file dirname $print::fileToPrintTo]\
            -defaultextension .ps -filetypes [list {Postscript .ps} [list [mc {All files}] *]] -initialfile $print::fileToPrintTo\
        ]
        if {[string length $file] > 0} {                                                                             ;# not canceled
            set print::fileToPrintTo $file
        }
    }

    proc updateGlobals {} {
        variable printToFile
        variable printCommand
        variable fileToPrintTo
        variable orientations
        variable orientation
        variable palettes
        variable palette
        variable sizes
        variable size

        set global::printToFile $printToFile
        set global::printCommand $printCommand
        set global::fileToPrintTo $fileToPrintTo
        set index [lsearch -exact $orientations $orientation]; if {$index < 0} {set index 0}
        set global::printOrientation [lindex $global::printOrientations $index]
        set index [lsearch -exact $palettes $palette]; if {$index < 0} {set index 0}
        set global::printPalette [lindex $global::printPalettes $index]
        set index [lsearch -exact $sizes $size]; if {$index < 0} {set index 0}
        set global::printPaperSize [lindex $global::printPaperSizes $index]
    }

    proc canvasPrintArea {} {                                                                  ;# calculate visible area coordinates
        set canvas $global::canvas
        # first calculate visible area coordinates
        foreach {left top right bottom} [$canvas cget -scrollregion] {}
        set width [expr {$right - $left}]
        set height [expr {$bottom - $top}]
        foreach {minimum maximum} [$canvas xview] {}
        set left [expr {$left + ($minimum * $width)}]
        foreach {minimum maximum} [$canvas yview] {}
        set top [expr {$top + ($minimum * $height)}]
        scan [winfo geometry $canvas] %ux%u width height                                                ;# now get visible area size
        set right [expr {$left + $width}]
        set bottom [expr {$top + $height}]
        set items {}
        foreach item [$canvas find all] {
            set print 1
            foreach tag [$canvas gettags $item] {
                # do not take icons into account (they are only printed if visible among the printable items):
                if {[string match icon(*) $tag]} {
                    set print 0
                    break
                }
            }
            if {$print} {
                lappend items $item
            }
        }
        if {[llength $items] > 0} {                                  ;# there may be no items in the canvas if no modules are loaded
            foreach {boundsLeft boundsTop boundsRight boundsBottom} [eval $canvas bbox $items] {}
            if {$boundsLeft > $left} {set left $boundsLeft}
            if {$boundsRight < $right} {set right $boundsRight}
            if {$boundsTop > $top} {set top $boundsTop}
            if {$boundsBottom < $bottom} {set bottom $boundsBottom}
        }
        return [list $left $top [expr {$right - $left}] [expr {$bottom - $top}]]
    }

    proc postscriptOptions {{gsOutput 0} {pageWidthName {}} {pageHeightName {}}} {
        variable orientations
        variable orientation
        variable sizes
        variable size
        variable palettes
        variable palette
        variable dotsPerMillimeter

        if {[string length $pageWidthName] > 0} {
            upvar 1 $pageWidthName pageWidth
        }
        if {[string length $pageHeightName] > 0} {
            upvar 1 $pageHeightName pageHeight
        }
        update                                          ;# make sure everything is redrawn properly in case dialog box hid something
        foreach {left top width height} [canvasPrintArea] {}
        set inch 25.4                                                                                                 ;# millimeters
        set margin [expr {$inch / 2}]                                                               ;# all dimensions in millimeters
        set index [lsearch -exact $sizes $size]; if {$index < 0} {set index 0}
        switch -glob [lindex $global::printPaperSizes $index] {
            A3* {
                set pageWidth 297
                set pageHeight 420
            }
            A4* {
                set pageWidth 210
                set pageHeight 297
            }
            executive* {
                set pageWidth [expr {7.5 * $inch}]
                set pageHeight [expr {10 * $inch}]
            }
            legal* {
                set pageWidth [expr {8.5 * $inch}]
                set pageHeight [expr {14 * $inch}]
            }
            default {
                set pageWidth [expr {8.5 * $inch}]                                                                         ;# letter
                set pageHeight [expr {11 * $inch}]
            }
        }
        set pageX ${margin}m
        set index [lsearch -exact $orientations $orientation]; if {$index < 0} {set index 0}
        set rotate [string equal [lindex $global::printOrientations $index] landscape]
        if {$rotate} {
            set pageY ${margin}m
        } else {
            set pageY [expr {$pageHeight - $margin}]m
        }
        # now make sure everything fits in page
        if {$rotate} {                                                                                 ;# swap page width and height
            set value $pageWidth
            set pageWidth $pageHeight
            set pageHeight $value
            unset value
            if {$gsOutput} {                                   ;# for gs, the printout is not rotated, only the page size is changed
                set pageY [expr {$pageHeight - $margin}]m
            }
        }
        set printWidth [expr {($pageWidth - (2 * $margin)) * $dotsPerMillimeter}]                                       ;# in pixels
        set printHeight [expr {($pageHeight - (2 * $margin)) * $dotsPerMillimeter}]
        set ratio 1                                                                  ;# use identical horizontal and vertical ratios
        if {$printWidth < $width} {
            set ratio [expr {$printWidth / $width}]
        }
        if {($printHeight < $height) && (($printHeight / $height) < $ratio)} {
            set ratio [expr {$printHeight / $height}]
        }
        if {$gsOutput} {                                       ;# for gs, the printout is not rotated, only the page size is changed
            set rotate 0
        }
        set index [lsearch -exact $palettes $palette]; if {$index < 0} {set index 0}
        set options [list\
            -colormode [lindex $global::printPalettes $index] -rotate $rotate -x $left -y $top -width $width -height $height\
            -pageanchor nw -pagex $pageX -pagey $pageY\
        ]
        if {$ratio < 1} {                                                                                   ;# size reduction needed
            lappend options -pagewidth [expr {$ratio * $width}] -pageheight [expr {$ratio * $height}]
        }
        return $options
    }

    proc print {} {
        variable printToFile
        variable fileToPrintTo
        variable printCommand
        variable printer

        busy 1
        set options [postscriptOptions]                       ;# do first as internal updating is done for proper geometry assertion
        if {$printToFile} {
            lifoLabel::push $global::messenger [format [mc {printing to file %s...}] $fileToPrintTo]
        } else {
            lifoLabel::push $global::messenger [mc printing...]
        }
        update idletasks                                                                             ;# make sure message is visible
        if {$printToFile} {
            lappend options -file $fileToPrintTo
            eval $global::canvas postscript $options
        } else {                             ;# gather data first in case window gets obscured by printing utility (which may be gs)
            set data [eval $global::canvas postscript $options]
            if {[string first %P $printCommand] < 0} {                                 ;# command does not include printer parameter
                set command $printCommand                                                                               ;# use as is
            } else {                                                                                         ;# use selected printer
                regsub -all %P $printCommand [scan $printer %s] command       ;# only use first word (format is "name (alias, ...)")
            }
            if {\
                [catch {set channel [open |$command w]} message] ||\
                [catch {puts -nonewline $channel $data} message] || [catch {close $channel} message]\
            } {
                tk_messageBox -title [mc {moodss: Error when printing}] -type ok -icon error -message "$command: $message"
            }
        }
        lifoLabel::pop $global::messenger
        busy 0
    }

    proc preview {} {
        variable previewerWindow
        variable viewer
        variable zoomRatio

        if {![winfo exists $previewerWindow]} {                                          ;# make window visible if it already exists
            toplevel $previewerWindow
            wm resizable $previewerWindow 0 0
            wm group $previewerWindow .                              ;# for proper window manager (windowmaker for example) behavior
            wm title $previewerWindow [mc {moodss: Print preview...}]
            set viewer [new printViewer $previewerWindow -deletefile 1]

            set menu [menu $previewerWindow.menu -tearoff 0]
            $previewerWindow configure -menu $menu
            menu $menu.zoom -tearoff 0
            foreach {string underline} [underlineAmpersand [mc &Zoom]] {}
            $menu add cascade -label $string -menu $menu.zoom -underline $underline
            set zoomRatio 100%
            foreach {label value} {10 0.1 25 0.25 50 0.5 75 0.75 100 1 200 2 500 5} {
                $menu.zoom add radiobutton -label $label% -variable ::print::zoomRatio\
                    -command "composite::configure $viewer -zoom $value; printViewer::refresh $viewer"
            }
            foreach {string underline} [underlineAmpersand [mc &Close]] {}
            $menu.zoom add command -label $string -underline $underline -command "destroy $previewerWindow"

            frame $previewerWindow.bound      ;# create a frame for bindings that otherwise would propagate to all toplevel children
            bind $previewerWindow.bound <Destroy> "delete $viewer"
            pack $widget::($viewer,path)
        }
        lower $previewerWindow                                                                             ;# do not obstruct canvas
        busy 1
        lifoLabel::push $global::messenger [mc {previewing with gs...}]
        update idletasks                                                                             ;# make sure message is visible
        set options [postscriptOptions 1 width height]        ;# do first as internal updating is done for proper geometry assertion
        lappend options -file [set file [temporaryFileName]]
        eval $global::canvas postscript $options
        wm deiconify $previewerWindow
        raise $previewerWindow
        composite::configure $viewer -file $file -pagewidth $width -pageheight $height
        printViewer::refresh $viewer
        lifoLabel::pop $global::messenger
        busy 0
    }

    proc createTemporaryCanvasShot {} {
        update idletasks                                                            ;# try to make sure everything is drawn properly
        foreach {left top width height} [canvasPrintArea] {}
        set file [temporaryFileName png]
        set channel [open\
            "|gs -q -dBATCH -dNOPROMPT -sDEVICE=png256 -g${width}x${height} -r$printViewer::(pixelsPerInch) -sOutputFile=$file -"\
            w\
        ]
        $global::canvas postscript -colormode color -x 0 -y 0 -width $width -height $height -pageanchor sw -pagex 0 -pagey 0\
            -channel $channel
        close $channel
        return $file
    }

}
