home *** CD-ROM | disk | FTP | other *** search
Text File | 2003-09-01 | 31.5 KB | 1,112 lines |
- #
- # CanvasPrintBox v1.5
- # ----------------------------------------------------------------------
- # Implements a print box for printing the contents of a canvas widget
- # to a printer or a file. It is possible to specify page orientation, the
- # number of pages to print the image on and if the output should be
- # stretched to fit the page.
- #
- # CanvasPrintBox is a "super-widget" that can be used as an
- # element in ones own GUIs. It is used to print the contents
- # of a canvas (called the source hereafter) to a printer or a
- # file. Possible settings include: portrait and landscape orientation
- # of the output, stretching the output to fit the page while maintaining
- # a proper aspect-ratio and posterizing to enlarge the output to fit on
- # multiple pages. A stamp-sized copy of the source will be shown (called
- # the stamp hereafter) at all times to reflect the effect of changing
- # the settings will have on the output.
- #
- # ----------------------------------------------------------------------
- # AUTHOR: Tako Schotanus EMAIL: Tako.Schotanus@bouw.tno.nl
- # ----------------------------------------------------------------------
- # Copyright (c) 1995 Tako Schotanus
- # ======================================================================
- # Permission is hereby granted, without written agreement and without
- # license or royalty fees, to use, copy, modify, and distribute this
- # software and its documentation for any purpose, provided that the
- # above copyright notice and the following two paragraphs appear in
- # all copies of this software.
- #
- # IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE TO ANY PARTY FOR
- # DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
- # ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN
- # IF THE COPYRIGHT HOLDER HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
- # DAMAGE.
- #
- # THE COPYRIGHT HOLDER SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING,
- # BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
- # FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS
- # ON AN "AS IS" BASIS, AND THE COPYRIGHT HOLDER HAS NO OBLIGATION TO
- # PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
- # ======================================================================
-
- #
- # Default resources.
- #
- option add *Canvasprintbox.filename "canvas.ps" widgetDefault
- option add *Canvasprintbox.hPageCnt 1 widgetDefault
- option add *Canvasprintbox.orient landscape widgetDefault
- option add *Canvasprintbox.output printer widgetDefault
- option add *Canvasprintbox.pageSize A4 widgetDefault
- option add *Canvasprintbox.posterize 0 widgetDefault
- option add *Canvasprintbox.printCmd lpr widgetDefault
- option add *Canvasprintbox.printRegion "" widgetDefault
- option add *Canvasprintbox.vPageCnt 1 widgetDefault
-
- #
- # Usual options.
- #
- itk::usual Canvasprintbox {
- keep -background -cursor -textbackground -foreground
- }
-
- #<
- #
- # CanvasPrintBox is a "super-widget" that can be used as an
- # element in ones own GUIs. It is used to print the contents
- # of a canvas (called the source hereafter) to a printer or a
- # file. Possible settings include: portrait and landscape orientation
- # of the output, stretching the output to fit the page while maintaining
- # a proper aspect-ratio and posterizing to enlarge the output to fit on
- # multiple pages. A stamp-sized copy of the source will be shown (called
- # the stamp hereafter) at all times to reflect the effect of changing
- # the settings will have on the output.
- #
- #>
- itcl::class iwidgets::Canvasprintbox {
- inherit itk::Widget
-
- #
- # Holds the current state for all check- and radiobuttons.
- #
- itk_option define -filename filename FileName "canvas.ps"
- itk_option define -hpagecnt hPageCnt PageCnt 1
- itk_option define -orient orient Orient "landscape"
- itk_option define -output output Output "printer"
- itk_option define -pagesize pageSize PageSize "A4"
- itk_option define -posterize posterize Posterize 0
- itk_option define -printcmd printCmd PrintCmd ""
- itk_option define -printregion printRegion PrintRegion ""
- itk_option define -stretch stretch Stretch 0
- itk_option define -vpagecnt vPageCnt PageCnt 1
-
- constructor {args} {}
- destructor {}
-
- # ---------------------------------------------------------------
- # PUBLIC
- #----------------------------------------------------------------
- public {
- method getoutput {}
- method print {}
- method refresh {}
- method setcanvas {canv}
- method stop {}
- }
-
- # ---------------------------------------------------------------
- # PROTECTED
- #----------------------------------------------------------------
- protected {
- #
- # Just holds the names of some widgets/objects. "win" is used to
- # determine if the object is fully constructed and initialized.
- #
- variable win ""
- variable canvw ""
-
- #
- # The canvas we want to print.
- #
- variable canvas ""
-
- #
- # Boolean indicating if the attribute "orient" is set
- # to landscape or not.
- #
- variable rotate 1
-
- #
- # Holds the configure options that were used to create this object.
- #
- variable init_opts ""
-
- #
- # The following attributes hold a list of lines that are
- # currently drawn on the "stamp" to show how the page(s) is/are
- # oriented. The first holds the vertical dividing lines and the
- # second the horizontal ones.
- #
- variable hlines ""
- variable vlines ""
-
- #
- # Updating is set when the thumbnail is being drawn. Settings
- # this to 0 while drawing is still busy will terminate the
- # proces.
- # Restart_update can be set to 1 when the thumbnail is being
- # drawn to force a redraw.
- #
- variable _reposition ""
- variable _update_attr_id ""
-
- method _calc_poster_size {}
- method _calc_print_region {}
- method _calc_print_scale {}
- method _mapEventHandler {}
- method _update_attr {{when later}}
- method _update_canvas {{when later}}
-
- common _globVar
-
- proc ezPaperInfo {size {attr ""} \
- {orient "portrait"} {window ""}} {}
- }
- }
-
- #
- # Provide a lowercased access method for the Canvasprintbox class.
- #
- proc ::iwidgets::canvasprintbox {args} {
- uplevel ::iwidgets::Canvasprintbox $args
- }
-
- # ------------------------------------------------------------------
- # OPTIONS
- # ------------------------------------------------------------------
-
- #<
- # A list of four coordinates specifying which part of the canvas to print.
- # An empty list means that the canvas' entire scrollregion should be
- # printed. Any change to this attribute will automatically update the "stamp".
- # Defaults to an empty list.
- #>
- itcl::configbody iwidgets::Canvasprintbox::printregion {
- if {$itk_option(-printregion) != ""
- && [llength $itk_option(-printregion)] != 4} {
- error {bad option "printregion": should contain 4 coordinates}
- }
- _update_canvas
- }
-
- #<
- # Specifies where the postscript output should go: to the printer
- # or to a file. Can take on the values "printer" or "file".
- # The corresponding entry-widget will reflect the contents of
- # either the printcmd attribute or the filename attribute.
- #>
- itcl::configbody iwidgets::Canvasprintbox::output {
- switch $itk_option(-output) {
- file - printer {
- set _globVar($this,output) $itk_option(-output)
- }
- default {
- error {bad output option \"$itk_option(-output)\":\
- should be file or printer}
- }
- }
- _update_attr
- }
-
- #<
- # The command to execute when printing the postscript output.
- # The command will get the postscript directed to its standard
- # input. (Only when output is set to "printer")
- #>
- itcl::configbody iwidgets::Canvasprintbox::printcmd {
- set _globVar($this,printeref) $itk_option(-printcmd)
- _update_attr
- }
-
- #<
- # The file to write the postscript output to (Only when output
- # is set to "file"). If posterizing is turned on and hpagecnt
- # and/or vpagecnt is more than 1, x.y is appended to the filename
- # where x is the horizontal page number and y the vertical page number.
- #>
- itcl::configbody iwidgets::Canvasprintbox::filename {
- set _globVar($this,fileef) $itk_option(-filename)
- _update_attr
- }
-
- #<
- # The pagesize the printer supports. Changes to this attribute
- # will be reflected immediately in the "stamp".
- #>
- itcl::configbody iwidgets::Canvasprintbox::pagesize {
- set opt [string tolower $itk_option(-pagesize)]
- set lst [string tolower [ezPaperInfo types]]
- if {[lsearch $lst $opt] == -1} {
- error "bad option \"pagesize\": should be one of: [ezPaperInfo types]"
- }
- $itk_component(paperom) select "*[string range $opt 1 end]"
- _update_canvas
- }
-
- #<
- # Determines the orientation of the output to the printer (or file).
- # It can take the value "portrait" or "landscape" (default). Changes
- # to this attribute will be reflected immediately in the "stamp".
- #>
- itcl::configbody iwidgets::Canvasprintbox::orient {
- switch $itk_option(-orient) {
- "portrait" - "landscape" {
- $itk_component(orientom) select $itk_option(-orient)
- _update_canvas
-
- }
- default {
- error "bad orient option \"$itk_option(-orient)\":\
- should be portrait or landscape"
- }
- }
- }
-
- #<
- # Determines if the output should be stretched to fill the
- # page (as defined by the attribute pagesize) as large as
- # possible. The aspect-ratio of the output will be retained
- # and the output will never fall outside of the boundaries
- # of the page.
- #>
- itcl::configbody iwidgets::Canvasprintbox::stretch {
- if {$itk_option(-stretch) != 0 && $itk_option(-stretch) != 1} {
- error {bad option "stretch": should be a boolean}
- }
- set _globVar($this,stretchcb) $itk_option(-stretch)
- _update_attr
- }
-
- #<
- # Indicates if posterizing is turned on or not. Posterizing
- # the output means that it is possible to distribute the
- # output over more than one page. This way it is possible to
- # print a canvas/region which is larger than the specified
- # pagesize without stretching. If used in combination with
- # stretching it can be used to "blow up" the contents of a
- # canvas to as large as size as you want (See attributes:
- # hpagecnt end vpagecnt). Any change to this attribute will
- # automatically update the "stamp".
- #>
- itcl::configbody iwidgets::Canvasprintbox::posterize {
- if {$itk_option(-posterize) != "0" && $itk_option(-posterize) != "1"} {
- error "expected boolean but got \"$itk_option(-posterize)\""
- }
- set _globVar($this,postercb) $itk_option(-posterize)
- _update_canvas
- }
-
- #<
- # Is used in combination with "posterize" to determine over
- # how many pages the output should be distributed. This
- # attribute specifies how many pages should be used horizontaly.
- # Any change to this attribute will automatically update the "stamp".
- #>
- itcl::configbody iwidgets::Canvasprintbox::hpagecnt {
- set _globVar($this,hpc) $itk_option(-hpagecnt)
- _update_canvas
- }
-
- #<
- # Is used in combination with "posterize" to determine over
- # how many pages the output should be distributed. This
- # attribute specifies how many pages should be used verticaly.
- # Any change to this attribute will automatically update the "stamp".
- #>
- itcl::configbody iwidgets::Canvasprintbox::vpagecnt {
- set _globVar($this,vpc) $itk_option(-vpagecnt)
- _update_canvas
- }
-
- # ------------------------------------------------------------------
- # CONSTRUCTOR
- # ------------------------------------------------------------------
- itcl::body iwidgets::Canvasprintbox::constructor {args} {
- set _globVar($this,output) printer
- set _globVar($this,printeref) ""
- set _globVar($this,fileef) "canvas.ps"
- set _globVar($this,hpc) 1
- set _globVar($this,vpc) 1
- set _globVar($this,postercb) 0
- set _globVar($this,stretchcb) 0
-
- itk_component add canvasframe {
- frame $itk_interior.f18 -bd 2
- }
-
- itk_component add canvas {
- canvas $itk_component(canvasframe).c1 \
- -bd 2 -relief sunken \
- -scrollregion {0c 0c 10c 10c} \
- -width 250
- }
- pack $itk_component(canvas) -expand 1 -fill both
-
- itk_component add outputom {
- iwidgets::Labeledframe $itk_interior.outputom \
- -labelpos nw \
- -labeltext "Output to"
- }
- set cs [$itk_component(outputom) childsite]
-
- itk_component add printerrb {
- radiobutton $cs.printerrb \
- -text Printer \
- -variable [itcl::scope _globVar($this,output)] \
- -anchor w \
- -justify left \
- -value printer \
- -command [itcl::code $this _update_attr]
- } {
- usual
- rename -font -labelfont labelFont Font
- }
- itk_component add printeref {
- iwidgets::entryfield $cs.printeref \
- -labeltext "command:" \
- -state normal \
- -labelpos w \
- -textvariable [itcl::scope _globVar($this,printeref)]
- }
-
- itk_component add filerb {
- radiobutton $cs.filerb \
- -text File \
- -justify left \
- -anchor w \
- -variable [itcl::scope _globVar($this,output)] \
- -value file \
- -command [itcl::code $this _update_attr]
- } {
- usual
- rename -font -labelfont labelFont Font
- }
- itk_component add fileef {
- iwidgets::entryfield $cs.fileef \
- -labeltext "filename:" \
- -state disabled \
- -labelpos w \
- -textvariable [itcl::scope _globVar($this,fileef)]
- }
-
- itk_component add propsframe {
- iwidgets::Labeledframe $itk_interior.propsframe \
- -labelpos nw \
- -labeltext "Properties"
- }
- set cs [$itk_component(propsframe) childsite]
-
- itk_component add paperom {
- iwidgets::optionmenu $cs.paperom \
- -labelpos w -cyclicon 1 \
- -labeltext "Paper size:" \
- -command [itcl::code $this refresh]
- } {
- usual
- rename -font -labelfont labelFont Font
- }
- eval $itk_component(paperom) insert end [ezPaperInfo types]
- $itk_component(paperom) select A4
-
- itk_component add orientom {
- iwidgets::radiobox $itk_interior.orientom \
- -labeltext "Orientation" -command [itcl::code $this refresh]
- }
- $itk_component(orientom) add landscape -text Landscape
- $itk_component(orientom) add portrait -text Portrait
- $itk_component(orientom) select 0
-
- itk_component add stretchcb {
- checkbutton $cs.stretchcb \
- -relief flat \
- -text {Stretch to fit} \
- -justify left \
- -anchor w \
- -variable [itcl::scope _globVar($this,stretchcb)] \
- -command [itcl::code $this refresh]
- } {
- usual
- rename -font -labelfont labelFont Font
- }
-
- itk_component add postercb {
- checkbutton $cs.postercb \
- -relief flat \
- -text Posterize \
- -justify left \
- -anchor w \
- -variable [itcl::scope _globVar($this,postercb)] \
- -command [itcl::code $this refresh]
- } {
- usual
- rename -font -labelfont labelFont Font
- }
-
- itk_component add hpcnt {
- iwidgets::entryfield $cs.hpcnt \
- -labeltext on \
- -textvariable [itcl::scope _globVar($this,hpc)] \
- -validate integer -width 3 \
- -command [itcl::code $this refresh]
- }
-
- itk_component add vpcnt {
- iwidgets::entryfield $cs.vpcnt \
- -labeltext by \
- -textvariable [itcl::scope _globVar($this,vpc)] \
- -validate integer -width 3 \
- -command [itcl::code $this refresh]
- }
-
- itk_component add pages {
- label $cs.pages -text pages.
- } {
- usual
- rename -font -labelfont labelFont Font
- }
-
- set init_opts $args
-
- grid $itk_component(canvasframe) -row 0 -column 0 -rowspan 4 -sticky nsew
- grid $itk_component(propsframe) -row 0 -column 1 -sticky nsew
- grid $itk_component(outputom) -row 1 -column 1 -sticky nsew
- grid $itk_component(orientom) -row 2 -column 1 -sticky nsew
- grid columnconfigure $itk_interior 0 -weight 1
- grid rowconfigure $itk_interior 3 -weight 1
-
- grid $itk_component(printerrb) -row 0 -column 0 -sticky nsw
- grid $itk_component(printeref) -row 0 -column 1 -sticky nsw
- grid $itk_component(filerb) -row 1 -column 0 -sticky nsw
- grid $itk_component(fileef) -row 1 -column 1 -sticky nsw
- iwidgets::Labeledwidget::alignlabels $itk_component(printeref) $itk_component(fileef)
- grid columnconfigure $itk_component(outputom) 1 -weight 1
-
- grid $itk_component(paperom) -row 0 -column 0 -columnspan 2 -sticky nsw
- grid $itk_component(stretchcb) -row 1 -column 0 -sticky nsw
- grid $itk_component(postercb) -row 2 -column 0 -sticky nsw
- grid $itk_component(hpcnt) -row 2 -column 1 -sticky nsw
- grid $itk_component(vpcnt) -row 2 -column 2 -sticky nsw
- grid $itk_component(pages) -row 2 -column 3 -sticky nsw
- grid columnconfigure $itk_component(propsframe) 3 -weight 1
-
- eval itk_initialize $args
-
- bind $itk_component(pages) <Map> +[itcl::code $this _mapEventHandler]
- bind $itk_component(canvas) <Configure> +[itcl::code $this refresh]
- }
-
-
- # ---------------------------------------------------------------
- # PUBLIC METHODS
- #----------------------------------------------------------------
-
- #<
- # This is used to set the canvas that has to be printed.
- # A stamp-sized copy will automatically be drawn to show how the
- # output would look with the current settings.
- #
- # In: canv - The canvas to be printed
- # Out: canvas (attrib) - Holds the canvas to be printed
- #>
- itcl::body iwidgets::Canvasprintbox::setcanvas {canv} {
- set canvas $canv
- _update_canvas
- }
-
- #<
- # Returns the value of the -printercmd or -filename option
- # depending on the current setting of -output.
- #
- # In: itk_option (attrib)
- # Out: The value of -printercmd or -filename
- #>
- itcl::body iwidgets::Canvasprintbox::getoutput {} {
- switch $_globVar($this,output) {
- "file" {
- return $_globVar($this,fileef)
- }
- "printer" {
- return $_globVar($this,printeref)
- }
- }
- return ""
- }
-
- #<
- # Perfrom the actual printing of the canvas using the current settings of
- # all the attributes.
- #
- # In: itk_option, rotate (attrib)
- # Out: A boolean indicating wether printing was successful
- #>
- itcl::body iwidgets::Canvasprintbox::print {} {
-
- global env tcl_platform
-
- stop
-
- if {$itk_option(-output) == "file"} {
- set nm $_globVar($this,fileef)
- if {[string range $nm 0 1] == "~/"} {
- set nm "$env(HOME)/[string range $nm 2 end]"
- }
- } else {
- set nm "/tmp/xge[winfo id $canvas]"
- }
-
- set pr [_calc_print_region]
- set x1 [lindex $pr 0]
- set y1 [lindex $pr 1]
- set x2 [lindex $pr 2]
- set y2 [lindex $pr 3]
- set cx [expr {int(($x2 + $x1) / 2)}]
- set cy [expr {int(($y2 + $y1) / 2)}]
- if {!$itk_option(-stretch)} {
- set ps [_calc_poster_size]
- set pshw [expr {int([lindex $ps 0] / 2)}]
- set pshh [expr {int([lindex $ps 1] / 2)}]
- set x [expr {$cx - $pshw}]
- set y [expr {$cy - $pshh}]
- set w [ezPaperInfo $itk_option(-pagesize) pwidth $itk_option(-orient) $win]
- set h [ezPaperInfo $itk_option(-pagesize) pheight $itk_option(-orient) $win]
- } else {
- set x $x1
- set y $y1
- set w [expr {($x2-$x1) / $_globVar($this,hpc)}]
- set h [expr {($y2-$y1) / $_globVar($this,vpc)}]
- }
-
- set i 0
- set px $x
- while {$i < $_globVar($this,hpc)} {
- set j 0
- set py $y
- while {$j < $_globVar($this,vpc)} {
- set nm2 [expr {$_globVar($this,hpc) > 1 || $_globVar($this,vpc) > 1 ? "$nm$i.$j" : $nm}]
-
- if {$itk_option(-stretch)} {
- $canvas postscript \
- -file $nm2 \
- -rotate $rotate \
- -x $px -y $py \
- -width $w \
- -height $h \
- -pagex [ezPaperInfo $itk_option(-pagesize) centerx] \
- -pagey [ezPaperInfo $itk_option(-pagesize) centery] \
- -pagewidth [ezPaperInfo $itk_option(-pagesize) pwidth $itk_option(-orient)] \
- -pageheight [ezPaperInfo $itk_option(-pagesize) pheight $itk_option(-orient)]
- } else {
- $canvas postscript \
- -file $nm2 \
- -rotate $rotate \
- -x $px -y $py \
- -width $w \
- -height $h \
- -pagex [ezPaperInfo $itk_option(-pagesize) centerx] \
- -pagey [ezPaperInfo $itk_option(-pagesize) centery]
- }
-
- if {$itk_option(-output) == "printer"} {
- set cmd "$itk_option(-printcmd) < $nm2"
- if {[catch {eval exec $cmd &}]} {
- return 0
- }
- }
-
- set py [expr {$py + $h}]
- incr j
- }
- set px [expr {$px + $w}]
- incr i
- }
-
- return 1
- }
-
- #<
- # Retrieves the current value for all edit fields and updates
- # the stamp accordingly. Is useful for Apply-buttons.
- #>
- itcl::body iwidgets::Canvasprintbox::refresh {} {
- stop
- _update_canvas
- return
- }
-
- #<
- # Stops the drawing of the "stamp". I'm currently unable to detect
- # when a Canvasprintbox gets withdrawn. It's therefore advised
- # that you perform a stop before you do something like that.
- #>
- itcl::body iwidgets::Canvasprintbox::stop {} {
-
- if {$_reposition != ""} {
- after cancel $_reposition
- set _reposition ""
- }
-
- if {$_update_attr_id != ""} {
- after cancel $_update_attr_id
- set _update_attr_id ""
- }
-
- return
- }
-
- # ---------------------------------------------------------------
- # PROTECTED METHODS
- #----------------------------------------------------------------
-
- #
- # Calculate the total size the output would be with the current
- # settings for "pagesize" and "posterize" (and "hpagecnt" and
- # "vpagecnt"). This size will be the size of the printable area,
- # some space has been substracted to take into account that a
- # page should have borders because most printers can't print on
- # the very edge of the paper.
- #
- # In: posterize, hpagecnt, vpagecnt, pagesize, orient (attrib)
- # Out: A list of two numbers indicating the width and the height
- # of the total paper area which will be used for printing
- # in pixels.
- #
- itcl::body iwidgets::Canvasprintbox::_calc_poster_size {} {
- set tpw [expr {[ezPaperInfo $itk_option(-pagesize) \
- pwidth $itk_option(-orient) $win]*$_globVar($this,hpc)}]
- set tph [expr {[ezPaperInfo $itk_option(-pagesize) \
- pheight $itk_option(-orient) $win]*$_globVar($this,vpc)}]
-
- return "$tpw $tph"
- }
-
- #
- # Determine which area of the "source" canvas will be printed.
- # If "printregion" was set by the "user" this will be used and
- # converted to pixel-coordinates. If the user didn't set it
- # the bounding box that contains all canvas-items will be used
- # instead.
- #
- # In: printregion, canvas (attrib)
- # Out: Four floats specifying the region to be printed in
- # pixel-coordinates (topleft & bottomright).
- #
- itcl::body iwidgets::Canvasprintbox::_calc_print_region {} {
- set printreg [expr {$itk_option(-printregion) != ""
- ? $itk_option(-printregion) : [$canvas bbox all]}]
-
- if {$printreg != ""} {
- set prx1 [winfo fpixels $canvas [lindex $printreg 0]]
- set pry1 [winfo fpixels $canvas [lindex $printreg 1]]
- set prx2 [winfo fpixels $canvas [lindex $printreg 2]]
- set pry2 [winfo fpixels $canvas [lindex $printreg 3]]
-
- set res "$prx1 $pry1 $prx2 $pry2"
- } else {
- set res "0 0 0 0"
- }
-
- return $res
- }
-
- #
- # Calculate the scaling factor needed if the output was
- # to be stretched to fit exactly on the page (or pages).
- # If stretching is turned off this will always return 1.0.
- #
- # In: stretch (attrib)
- # Out: A float specifying the scaling factor.
- #
- itcl::body iwidgets::Canvasprintbox::_calc_print_scale {} {
- if {$itk_option(-stretch)} {
- set pr [_calc_print_region]
- set prw [expr {[lindex $pr 2] - [lindex $pr 0]}]
- set prh [expr {[lindex $pr 3] - [lindex $pr 1]}]
- set ps [_calc_poster_size]
- set psw [lindex $ps 0]
- set psh [lindex $ps 1]
- set sfx [expr {$psw / $prw}]
- set sfy [expr {$psh / $prh}]
- set sf [expr {$sfx < $sfy ? $sfx : $sfy}]
- return $sf
- } else {
- return 1.0
- }
- }
-
- #
- # Schedule the thread that makes a copy of the "source"
- # canvas to the "stamp".
- #
- # In: win, canvas (attrib)
- # Out: -
- #
- itcl::body iwidgets::Canvasprintbox::_update_canvas {{when later}} {
- if {$win == "" || $canvas == "" || [$canvas find all] == ""} {
- return
- }
- if {$when == "later"} {
- if {$_reposition == ""} {
- set _reposition [after idle [itcl::code $this _update_canvas now]]
- }
- return
- }
-
- _update_attr now
-
- #
- # Make a copy of the "source" canvas to the "stamp".
- #
- if {$_globVar($this,hpc) == [llength $vlines] &&
- $_globVar($this,vpc) == [llength $hlines]} {
- stop
- return
- }
-
- $canvw delete all
-
- set width [winfo width $canvw]
- set height [winfo height $canvw]
- set ps [_calc_poster_size]
-
- #
- # Calculate the scaling factor that would be needed to fit the
- # whole "source" into the "stamp". This takes into account the
- # total amount of "paper" that would be needed to print the
- # contents of the "source".
- #
- set xsf [expr {$width/[lindex $ps 0]}]
- set ysf [expr {$height/[lindex $ps 1]}]
- set sf [expr {$xsf < $ysf ? $xsf : $ysf}]
- set w [expr {[lindex $ps 0]*$sf}]
- set h [expr {[lindex $ps 1]*$sf}]
- set x1 [expr {($width-$w)/2}]
- set y1 [expr {($height-$h)/2}]
- set x2 [expr {$x1+$w}]
- set y2 [expr {$y1+$h}]
- set cx [expr {($x2+$x1)/ 2}]
- set cy [expr {($y2+$y1)/ 2}]
-
- set printreg [_calc_print_region]
- set prx1 [lindex $printreg 0]
- set pry1 [lindex $printreg 1]
- set prx2 [lindex $printreg 2]
- set pry2 [lindex $printreg 3]
- set prcx [expr {($prx2+$prx1)/2}]
- set prcy [expr {($pry2+$pry1)/2}]
-
- set psf [_calc_print_scale]
-
- #
- # Copy all items from the "real" canvas to the canvas
- # showing what we'll send to the printer. Bitmaps and
- # texts are not copied because they can't be scaled,
- # a rectangle will be created instead.
- #
- set tsf [expr {$sf * $psf}]
- set dx [expr {$cx-($prcx*$tsf)}]
- set dy [expr {$cy-($prcy*$tsf)}]
- $canvw create rectangle \
- [expr {$x1+0}] \
- [expr {$y1+0}] \
- [expr {$x2-0}] \
- [expr {$y2-0}] -fill white
- set items [eval "$canvas find overlapping $printreg"]
-
- set itemCount [llength $items]
- for {set cnt 0} {$cnt < $itemCount} {incr cnt} {
- #
- # Determine the item's type and coordinates
- #
- set i [lindex $items $cnt]
- set t [$canvas type $i]
- set crds [$canvas coords $i]
-
- #
- # Ask for the item's configuration settings and strip
- # it to leave only a list of option names and values.
- #
- set cfg [$canvas itemconfigure $i]
- set cfg2 ""
- foreach c $cfg {
- if {[llength $c] == 5} {
- lappend cfg2 [lindex $c 0] [lindex $c 4]
- }
- }
-
- #
- # Handle texts and bitmaps differently: they will
- # be represented as rectangles.
- #
- if {$t == "text" || $t == "bitmap" || $t == "window"} {
- set t "rectangle"
- set crds [$canvas bbox $i]
- set cfg2 "-outline {} -fill gray"
- }
-
- #
- # Remove the arrows from a line item when the scale
- # factor drops below 1/3rd of the original size.
- # This to prevent the arrowheads from dominating the
- # display.
- #
- if {$t == "line" && $tsf < 0.33} {
- lappend cfg2 -arrow none
- }
-
- #
- # Create a copy of the item on the "printing" canvas.
- #
- set i2 [eval "$canvw create $t $crds $cfg2"]
- $canvw scale $i2 0 0 $tsf $tsf
- $canvw move $i2 $dx $dy
-
- if {($cnt%25) == 0} {
- update
- }
- if {$_reposition == ""} {
- return
- }
- }
-
- set p $x1
- set i 1
- set vlines {}
- while {$i < $_globVar($this,hpc)} {
- set p [expr {$p + ($w/$_globVar($this,hpc))}]
- set l [$canvw create line $p $y1 $p $y2]
- lappend vlines $l
- incr i
- }
-
- set p $y1
- set i 1
- set vlines {}
- while {$i < $_globVar($this,vpc)} {
- set p [expr {$p + ($h/$_globVar($this,vpc))}]
- set l [$canvw create line $x1 $p $x2 $p]
- lappend vlines $l
- incr i
- }
-
- set _reposition ""
- }
-
- #
- # Update the attributes to reflect changes made in the user-
- # interface.
- #
- # In: itk_option (attrib) - the attributes to update
- # itk_component (attrib) - the widgets
- # _globVar (common) - the global var holding the state
- # of all radiobuttons and checkboxes.
- # Out: -
- #
- itcl::body iwidgets::Canvasprintbox::_update_attr {{when "later"}} {
- if {$when != "now"} {
- if {$_update_attr_id == ""} {
- set _update_attr_id [after idle [itcl::code $this _update_attr now]]
- }
- return
- }
-
- set itk_option(-printcmd) $_globVar($this,printeref)
- set itk_option(-filename) $_globVar($this,fileef)
- set itk_option(-output) $_globVar($this,output)
- set itk_option(-pagesize) [string tolower [$itk_component(paperom) get]]
- set itk_option(-stretch) $_globVar($this,stretchcb)
- set itk_option(-posterize) $_globVar($this,postercb)
- set itk_option(-vpagecnt) $_globVar($this,vpc)
- set itk_option(-hpagecnt) $_globVar($this,hpc)
- set itk_option(-orient) [$itk_component(orientom) get]
- set rotate [expr {$itk_option(-orient) == "landscape"}]
-
- if {$_globVar($this,output) == "file"} {
- $itk_component(fileef) configure \
- -state normal -foreground $itk_option(-foreground)
- $itk_component(printeref) configure \
- -state disabled -foreground $itk_option(-disabledforeground)
- } else {
- $itk_component(fileef) configure \
- -state disabled -foreground $itk_option(-disabledforeground)
- $itk_component(printeref) configure \
- -state normal -foreground $itk_option(-foreground)
- }
-
- set fg [expr {$_globVar($this,postercb) \
- ? $itk_option(-foreground) : $itk_option(-disabledforeground)}]
-
- $itk_component(vpcnt) configure -foreground $fg
- $itk_component(hpcnt) configure -foreground $fg
- $itk_component(pages) configure -foreground $fg
-
- #
- # Update dependencies among widgets. (For example: disabling
- # an entry-widget when its associated checkbox-button is used
- # to turn of the option (the entry's value is not needed
- # anymore and this should be reflected in the fact that it
- # isn't possible to change it anymore).
- #
- # former method:_update_widgets/_update_UI
- #
- set state [expr {$itk_option(-posterize) ? "normal" : "disabled"}]
- $itk_component(vpcnt) configure -state $state
- $itk_component(hpcnt) configure -state $state
- $itk_component(paperom) select "*[string range $itk_option(-pagesize) 1 end]"
-
- set _update_attr_id ""
- }
-
- #
- # Gets called when the CanvasPrintBox-widget gets mapped.
- #
- itcl::body iwidgets::Canvasprintbox::_mapEventHandler {} {
- set win $itk_interior
- set canvw $itk_component(canvas)
- if {$canvas != ""} {
- setcanvas $canvas
- }
- _update_attr
- }
-
- #
- # Destroy this object and its associated widgets.
- #
- itcl::body iwidgets::Canvasprintbox::destructor {} {
- stop
- }
-
- #
- # Hold the information about common paper sizes. A bit of a hack, but it
- # should be possible to add your own if you take a look at it.
- #
- itcl::body iwidgets::Canvasprintbox::ezPaperInfo {size {attr ""} \
- {orient "portrait"} {window ""}} {
-
- set size [string tolower $size]
- set attr [string tolower $attr]
- set orient [string tolower $orient]
-
- case $size in {
- types {
- return "A5 A4 A3 A2 A1 Legal Letter"
- }
- a5 {
- set paper(x1) "1.0c"
- set paper(y1) "1.0c"
- set paper(x2) "13.85c"
- set paper(y2) "20.0c"
- set paper(pheight) "19.0c"
- set paper(pwidth) "12.85c"
- set paper(height) "21.0c"
- set paper(width) "14.85c"
- set paper(centerx) "7.425c"
- set paper(centery) "10.5c"
- }
- a4 {
- set paper(x1) "1.0c"
- set paper(y1) "1.0c"
- set paper(x2) "20.0c"
- set paper(y2) "28.7c"
- set paper(pheight) "27.7c"
- set paper(pwidth) "19.0c"
- set paper(height) "29.7c"
- set paper(width) "21.0c"
- set paper(centerx) "10.5c"
- set paper(centery) "14.85c"
- }
- a3 {
- set paper(x1) "1.0c"
- set paper(y1) "1.0c"
- set paper(x2) "28.7c"
- set paper(y2) "41.0c"
- set paper(pheight) "40.0c"
- set paper(pwidth) "27.7c"
- set paper(height) "42.0c"
- set paper(width) "29.7c"
- set paper(centerx) "14.85c"
- set paper(centery) "21.0c"
- }
- a2 {
- set paper(x1) "1.0c"
- set paper(y1) "1.0c"
- set paper(x2) "41.0c"
- set paper(y2) "58.4c"
- set paper(pheight) "57.4c"
- set paper(pwidth) "40.0c"
- set paper(height) "59.4c"
- set paper(width) "42.0c"
- set paper(centerx) "21.0c"
- set paper(centery) "29.7c"
- }
- a1 {
- set paper(x1) "1.0c"
- set paper(y1) "1.0c"
- set paper(x2) "58.4c"
- set paper(y2) "83.0c"
- set paper(pheight) "82.0c"
- set paper(pwidth) "57.4c"
- set paper(height) "84.0c"
- set paper(width) "59.4c"
- set paper(centerx) "29.7c"
- set paper(centery) "42.0c"
- }
- legal {
- set paper(x1) "0.2i"
- set paper(y1) "0.2i"
- set paper(x2) "8.3i"
- set paper(y2) "13.8i"
- set paper(pheight) "13.6i"
- set paper(pwidth) "8.1i"
- set paper(height) "14.0i"
- set paper(width) "8.5i"
- set paper(centerx) "4.25i"
- set paper(centery) "7.0i"
- }
- letter {
- set paper(x1) "0.2i"
- set paper(y1) "0.2i"
- set paper(x2) "8.3i"
- set paper(y2) "10.8i"
- set paper(pheight) "10.6i"
- set paper(pwidth) "8.1i"
- set paper(height) "11.0i"
- set paper(width) "8.5i"
- set paper(centerx) "4.25i"
- set paper(centery) "5.5i"
- }
- default {
- error "ezPaperInfo: Unknown paper type ($type)"
- }
- }
-
- set inv(x1) "y1"
- set inv(x2) "y2"
- set inv(y1) "x1"
- set inv(y2) "x2"
- set inv(pwidth) "pheight"
- set inv(pheight) "pwidth"
- set inv(width) "height"
- set inv(height) "width"
- set inv(centerx) "centery"
- set inv(centery) "centerx"
-
- case $orient in {
- landscape {
- set res $paper($inv($attr))
- }
- portrait {
- set res $paper($attr)
- }
- default {
- error "ezPaperInfo: orientation should be\
- portrait or landscape (not $orient)"
- }
- }
-
- if {$window != ""} {
- set res [winfo fpixels $window $res]
- }
-
- return $res
- }
-