A Paginated Canvas Widget

NEM 2009-03-30: Inspired by a question on comp.lang.tcl about producing paginated output from a canvas widget, here is an attempt at providing a paginated canvas widget that supports multiple pages and can create decent-ish paginated PostScript output. This is very much a work-in-progress, but I thought I'd put it here for others to use and fix. The widget uses the standard postscript capabilities of the underlying canvas to output each page as encapsulated postscript and then stitches them together into a full postscript file. It seems to work ok on my Mac, but I'm not a postscript expert, so YMMV.

The widget also automatically sets the scrollregion and adds MouseWheel bindings, so that scrolling should work fairly automatically.

NEM 2009-04-08: V0.2 Fixed some PostScript output bugs, and added some options for specifying the title, creator, etc in the resulting .ps file.

Screenshots

Sample PS output

Code

# page.tcl --
#
#       A paginated canvas widget.
#

package require Tk      8.5
package require snit    2.0

package provide paged   0.2

namespace eval ::paged {
    namespace export canvas
    namespace ensemble create
}

snit::widgetadaptor paged::canvas {
    option -pagesize    A4
    option -pagefill    white
    option -pageoutline #666666
    option -pagepadding {20 20}

    delegate option * to hull
    delegate method * to hull

    # List of active pages
    variable pages [list]

    constructor args {
        installhull using ::canvas -background #cccccc
        $self configurelist $args
    }

    destructor {
        foreach page $pages { $page destroy }
    }

    typevariable pagesize [dict create]
    typemethod pagesizes {} { dict names $pagesize }
    typemethod pagesize {name args} {
        if {[llength $args] == 2} {
            dict set pagesize $name $args
        } elseif {[llength $args] == 0} {
            dict get $pagesize $name
        } else {
            usage "$type pagesize name ?width height?"
        }
    }
    method pixels {width} { winfo pixels $win $width }
    method pagepixelsize {name} {
        lassign [$type pagesize $name] width height
        set width   [$self pixels $width]
        set height  [$self pixels $height]
        return [list $width $height]
    }
    proc usage msg {
        return -level 2 -code error -errorcode [list USAGE $msg] $msg
    }
    typeconstructor {
        # Create a variety of standard sizes
        # Source: http://en.wikipedia.org/wiki/Paper_size
        #
        # ISO paper sizes
        # Calculate approximate sizes. Should be within tolerances specified in
        # standard, and most sizes should be exact. Only a couple of values in
        # the C series differ slightly from the standard values listed on
        # Wikipedia.
        foreach {series width height} {
            A   841     1189
            B   1000    1414
            C   917     1297
        } {
            for {set i 0} {$i <= 10} {incr i} {
                $type pagesize $series$i ${width}m ${height}m
                lassign [list $width [expr {$height/2}]] height width
                #puts "$series$i = [$type pagesize $series$i]"
            }
        }
        # Extra German DIN 476 sizes
        $type pagesize 4A0  1682m 2378m
        $type pagesize 2A0  1189m 1682m

        # Standard US paper sizes
        $type pagesize letter       8.5i 11i
        $type pagesize legal        8.5i 14i
        $type pagesize juniorlegal  8i   5i
        $type pagesize ledger       17i  11i
        $type pagesize tabloid      11i  17i

        # Some UK writing paper sizes
        $type pagesize quarto       11i 9i
        $type pagesize imperial     9i  7i
        $type pagesize kings        8i  6.5i
        $type pagesize dukes        7i  5.5i

        # Adjust canvas bindings to support scrollwheel
        bind Canvas <MouseWheel> [list %W mousescroll %D]
    }

    method mousescroll {delta} {
        if {[tk windowingsystem] eq "aqua"} {
            $self yview scroll [expr {-$delta}] units
        } else {
            $self yview scroll [expr {-$delta/120}] units
        }
    }

    variable pages [list]

    method {page names} {} { return $pages }
    method {page create} {args} {
        set prev [lindex $pages end]
        if {$prev eq ""} { 
            lassign {0 0 0 0} x1 y1 x2 y2 
        } else {
            lassign [$prev coords] x1 y1 x2 y2
        }
        lassign [$self cget -pagepadding] left top
        set x $left
        set y [expr {$y2 + $top}]
        # Create the page item on the canvas
        set page [page create %AUTO% $self -xorigin $x -yorigin $y \
                -outline [$self cget -pageoutline] \
                -fill    [$self cget -pagefill] \
                -pagesize [$self cget -pagesize] {*}$args]
        #set offset [$page height]
        # Move all other pages down to accomodate for the change
        #foreach id [lrange $pages $index end] {
        #    $id move 0 $offset
        #}
        lappend pages $page
        return $page
    }

    method {export postscript} args {
        set title   [from args -title ""]
        set creator [from args -creator "Tk paged canvas"]
        set date    [from args -creationdate [clock format [clock seconds]]]
        set size    [from args -pagesize [$self cget -pagesize]]
        # Any remaining args will get passed to the individual page exporters.
        
        lassign [$self pagepixelsize [$self cget -pagesize]] w h

        set output    "%!PS-Adobe-2.0\n"
        append output "%%Creator: $creator\n"
        append output "%%CreationDate: $date\n"
        append output "%%Title: $title\n"
        append output "%%Pages: [llength $pages]\n"
        append output "%%PageOrder: Ascend\n"
        #append output "%%DocumentMedia: Default $w $h 0 () ()\n"
        append output "%%EndComments\n"
        #append output "%%BeginFeature: *PageSize Default\n"
        #append output "<< /PageSize \[ $w $h \] /ImagingBBox null >> setpagedevice\n"
        #append output "%%EndFeature\n"
        append output "%%BeginSetup\n"
        append output "%%PaperSize: $size\n"
        append output "%%EndSetup\n"
        foreach page $pages i [range 1 [llength $pages]] {
            set eps [$page export postscript {*}$args]
            set label [$page cget -label]
            if {$label eq ""} { set label $i }
            append output "%%Page: $label $i\n"
            append output "%%BeginDocument: page$i.eps\n"
            append output $eps\n
            append output "%%EndDocument\n"
        }
        append output "%%Trailer\n"
        append output "%%EOF\n"
        return $output
    }

    proc range {start end} {
        set xs [list]
        for {set i $start} {$i <= $end} {incr i} { lappend xs $i }
        return $xs
    }

    method update {} {
        lassign [$self bbox all] _ _ w h
        lassign [$self cget -pagepadding] left top
        $self configure -scrollregion [list 0 0 $w [expr {$h+$top}]]
    }
}

snit::type paged::page {
    component canvas
    component item

    # General page configuration options
    option -pagesize    -default A4         -configuremethod ChangePageSize
    option -margin      -default {1i 1i 1i 1i} -configuremethod ChangeMargins
    option -xorigin     -default 0          -configuremethod ChangeOffset
    option -yorigin     -default 0          -configuremethod ChangeOffset
    option -marginoutline -default #efefef  -configuremethod ChangeMarginView
    option -marginfill  -default {}         -configuremethod ChangeMarginView
    # Options delegated to the canvas item
    option -fill        -default white      -configuremethod ChangeOption
    option -outline     -default #999999    -configuremethod ChangeOption
    option -state       -default normal     -configuremethod ChangeOption
    option -tags        -default [list]     -configuremethod ChangeOption
    option -label       ""

    # Methods delegated to the canvas element
    method bbox {} { $canvas bbox $item }
    method bind args { $canvas bind $item {*}$args }
    method coords args { $canvas coords $item {*}$args }

    method move {xoffset yoffset} {
        # First move all items on this canvas
        foreach elem [$canvas find overlapping {*}[$self coords]] {
            $canvas move $elem $xoffset $yoffset
        }
        # Now move the page
        $canvas move $item $xoffset $yoffset
    }

    method create {itemtype args} {
        # Adjust each coordinate to be relative to the page + any margin offset
        set coords [list]
        lassign [$self margins] left top
        set xoff [expr {[$self cget -xorigin] + $left}]
        set yoff [expr {[$self cget -yorigin] + $top}]
        foreach {x y} [GetCoords args] {
            if {$x eq "center"} { set x [expr {[$self width] / 2}] }
            if {$y eq "center"} { set y [expr {[$self height] / 2}] }
            lappend coords [expr {round($x + $xoff)}] [expr {round($y + $yoff)}]
        }
        $canvas create $itemtype $coords {*}$args
    }

    method margins {} {
        lassign [$self cget -margin] left top right bottom
        list [$canvas pixels $left] [$canvas pixels $top] \
             [$canvas pixels $right] [$canvas pixels $bottom]
    }

    proc GetCoords {argv} {
        upvar 1 $argv args
        set coord [lindex $args 0]
        if {[llength $coord] > 1} { return [pop args] }
        set coords [list]
        while {$coord eq "center" || [string is integer -strict $coord]} {
            lappend coords [pop args]
            set coord [lindex $args 0]
        }
        return $coords
    }

    proc pop {listVar} {
        upvar 1 $listVar list
        set list [lassign $list elem][set list ""]
        return $elem
    }

    # Constructor. Should only be called by paged canvas.
    constructor {_canvas args} {
        set canvas $_canvas
        install item using $canvas create rectangle 0 0 0 0 \
            -tags page
        $self configurelist $args
    }

    method height {} {
        lassign [$self coords] _ y1 _ y2
        lassign [$self margins] l t r b
        set h [expr {$t+$b}]
        expr {$y2-$y1-$h}
    }

    method width {} {
        lassign [$self coords] x1 _ x2 _
        lassign [$self margins] l t r b
        set w [expr {$l+$r}]
        expr {$x2-$x1-$w}
    }

    # Export this page in a given format.
    method {export postscript} args {
        $canvas postscript {*}[$self pagebox] {*}$args
    }

    method pagebox {} {
        lassign [$self coords] x y x1 y1
        # The "magic numbers" here were calculated using trial and error,
        # based on what it took for the postscript output to not include the
        # page border outline.
        list -x [expr {$x+2}] -y [expr {$y+2}] \
            -width [expr {$x1-$x-4}] -height [expr {$y1-$y-4}] \
            -pagex 0 -pagey 0 -pageanchor sw
    }

    method ChangePageSize {option value} {
        lassign [$canvas pagepixelsize $value] width height
        set x0 [$self cget -xorigin]
        set y0 [$self cget -yorigin]
        $self coords $x0 $y0 [expr {$x0+$width}] [expr {$y0+$height}]
        after idle [list $canvas update]
        set options($option) $value
    }

    method ChangeMargins {option value} {
        if {[llength $value] == 1} { set value [lrepeat 4 $value] }
        if {[llength $value] == 2} { set value [lrepeat 2 {*}$value] }
        set options($option) $value
    }

    method ChangeOffset {option value} {
        set options($option) $value
        set w [$self width]
        set h [$self height]
        set x0 [$self cget -xorigin]
        set y0 [$self cget -yorigin]
        set x1 [expr {$x0+$w}]
        set y1 [expr {$y0+$h}]
        $self coords $x0 $y0 $x1 $y1
    }

    method ChangeOption {option value} {
        $canvas itemconfigure $item $option $value
        set options($option) $value
    }

    method ChangeMarginView {option value} {
        set options($option) $value
    }
}

As an example of its use, this little program will create a small 2-page A4 document and then produce postscript output to the file "test.ps" in the current working directory:

paged canvas .c -background #efefef -yscrollcommand [list .vsb set] \
                -xscrollcommand [list .hsb set] -pagesize A4
scrollbar .vsb -orient vertical     -command [list .c yview]
scrollbar .hsb -orient horizontal   -command [list .c xview]

grid .c .vsb -sticky nsew
grid .hsb -sticky ew
grid rowconfigure . 0 -weight 1
grid columnconfigure . 0 -weight 1

# Add some pages and text
set p [.c page create]
$p create text center 0 -text "Test Document" -tag title
$p create text 0 40 -text "Introduction" -tag heading
$p create text 0 70 -text {This is a sample piece of text to see how well it
looks inside this wonderful canvas widget that I have created. It would be
truly wonderful if we could get this widget to support justified text and all
those other wonderful features...} -tags para

set p2 [.c page create]
$p2 create text 0 0 -text "Next Section" -tag heading
$p2 create text 0 30 -text "Another little page..." -tag para

.c itemconfigure title -font {{Lucida Grande} 34} -anchor n
.c itemconfigure heading -font {{Lucida Grande} 24} -anchor nw
.c itemconfigure para -anchor nw -font {Palatino 12}

# Export as postscript. -file etc options not implemented yet.
set ps [.c export postscript]
set out [open test.ps w]
puts $out $ps
close $out

Discussion

Martyn Smith: 09 April 2009 Is there something missing from this example, when I try it (tcl 8.5.2 or 8.6) I get an error message)

invalid command name "page"
   while executing
page create %AUTO% $self -xorigin ....

I copied the whole page into a tcl file added an apropriate auto_path and ran it using tclkit.

NEM: It works for me, on various platforms with various versions of Tcl/Tk. What version of snit are you using?

Martyn Smith: as the code says 'package require snit 2.0', I only have one tcl file with all the code above plus, just in case a package require paged but always the same error.

greg 2018-09-24:

I have a problem with font size in Postscript. I solved it with the two lines

row 7

  set faktor [expr round([tk scaling] * 100) / 100.0]

row 24

  append output "/scalefont \{$faktor mul scalefont\} bind def\n"

method {export postscript} args {
        set title   [from args -title ""]
        set creator [from args -creator "Tk paged canvas"]
        set date    [from args -creationdate [clock format [clock seconds]]]
        set size    [from args -pagesize [$self cget -pagesize]]
        # Any remaining args will get passed to the individual page exporters.
        set faktor [expr round([tk scaling] * 100) / 100.0]       
        lassign [$self pagepixelsize [$self cget -pagesize]] w h

        set output    "%!PS-Adobe-2.0\n"
        append output "%%Creator: $creator\n"
        append output "%%CreationDate: $date\n"
        append output "%%Title: $title\n"
        append output "%%Pages: [llength $pages]\n"
        append output "%%PageOrder: Ascend\n"
        #append output "%%DocumentMedia: Default $w $h 0 () ()\n"
        append output "%%EndComments\n"
        #append output "%%BeginFeature: *PageSize Default\n"
        #append output "<< /PageSize \[ $w $h \] /ImagingBBox null >> setpagedevice\n"
        #append output "%%EndFeature\n"
        append output "%%BeginSetup\n"
        append output "%%PaperSize: $size\n"
        append output "%%EndSetup\n"
        append output "/scalefont \{$faktor mul scalefont\} bind def\n"        
        foreach page $pages i [range 1 [llength $pages]] {
            set eps [$page export postscript {*}$args]
            set label [$page cget -label]
            if {$label eq ""} { set label $i }
            append output "%%Page: $label $i\n"
            append output "%%BeginDocument: page$i.eps\n"
            append output $eps\n
            append output "%%EndDocument\n"
        }
        append output "%%Trailer\n"
        append output "%%EOF\n"
        return $output
    }

greg 2018-09-24:

export in pdf with pdf4tcl

package require pdf4tcl

new method in

snit::widgetadaptor paged::canvas { ... }

method {export pdf} args {
    lassign [$self pagemmsize [$self cget -pagesize]] w h
    set pagepdf [pdf4tcl::new ::paged::mypdf -paper [list $w $h]]
    foreach page $pages i [range 1 [llength $pages]] {
        $page export pdf {*}$args
    }
    return $pagepdf 
}

3 new method in

snit::type paged::page { ... }

method pagemmsize {name} {
        lassign [$type pagesize $name] width height
        return [list $width $height]
    }

method {export pdf} args {
    mypdf startPage
    mypdf canvas $canvas  {*}[$self pdfbox]  
    mypdf endPage
}

method pdfbox {} {
    lassign [$self coords] x y x1 y1
    list  -bbox [list [expr {$x +2}]  [expr {$y +2 }]  [expr {$x1 -4}] [expr {$y1-4}]]
}

in example

# Export as pdf
set mypdf [.c export pdf]
$mypdf write -file test.pdf
$mypdf destroy

Category GUI

Category Widget

Category Printing