Canvas woes

Using canvas sizes with ... exceptional widths can bring some surpises. The following pieces of code show how from a working test sample that was used to check whether some things are possible in Tcl or not.

First, two helper scripts that get loaded in all three examples:

 # ScrolledCanvas.tcl is a scrollable canvas using standard techniques
 # as described for example in Brent B. Welch's book "Practical 
 # Programming in Tcl  and Tk"

 proc ScrolledCanvas {c args} {
   frame $c
   eval {canvas $c.canvas \
          -xscrollcommand [list $c.xscroll set] \
          -yscrollcommand [list $c.yscroll set] \
          -highlightthickness 0 \
          -borderwidth 0} $args
   scrollbar $c.xscroll -orient horizontal \
     -command [list $c.canvas xview]
   scrollbar $c.yscroll -orient vertical \
     -command [list $c.canvas yview]
   grid $c.canvas $c.yscroll -sticky news
   grid $c.xscroll -sticky ew
   grid rowconfigure $c 0 -weight 1
   grid columnconfigure $c 0 -weight 1
   return $c.canvas
 }

and

 # Drawer.tcl will drop a few objects (arrows etc.) onto a canvas

 proc DrawLeftMark {canvas color {width ""} {height ""}} {

   if {$height == ""} {
     set h [$canvas cget -height]
   } else {
     set h $height
   }

   set x1 0
   set x2 [expr {$h - 1}]
   set x3 [expr {($h * 4) - 1}]

   set y1 0
   set y5 [expr {$h - 1}]    
   set y3 [expr {($y1 + $y5) / 2}]    
   set y2 [expr {$y3 - ($h / 4)}]
   set y4 [expr {$y3 + ($h / 4)}]

   $canvas create polygon \
     $x1 $y3 $x2 $y1 $x2 $y2 $x3 $y2 $x3 $y4 $x2 $y4 $x2 $y5 $x1 $y3 \
     -fill $color \
     -outline black
 }

 proc DrawRightMark {canvas color {width ""} {height ""}} {

   if {$width == ""} {
     set w [$canvas cget -width]
   } else {
     set w $width
   }

   if {$height == ""} {
     set h [$canvas cget -height]
   } else {
     set h $height
   }

   set x1 [expr {$w - 1}]
   set x2 [expr {$w - $h - 1}]
   set x3 [expr {$w - ($h * 4) - 1}]

   set y1 0
   set y5 [expr {$h - 1}]    
   set y3 [expr {($y1 + $y5) / 2}]    
   set y2 [expr {$y3 - ($h / 4)}]
   set y4 [expr {$y3 + ($h / 4)}]

   $canvas create polygon \
     $x1 $y3 $x2 $y1 $x2 $y2 $x3 $y2 $x3 $y4 $x2 $y4 $x2 $y5 \
     -fill $color \
     -outline black
 }

 proc DrawTicks {canvas {width ""}} {

   if {$width == ""} {
     set w [$canvas cget -width]
   } else {
     set w $width
   }

   set lm 0
   set rm $w

   set tickSpace [expr {$w / 1000}]
   if {$tickSpace < 200} {set tickSpace 200}

   for {set x $lm} {$x <= $rm} {incr x $tickSpace} {
     $canvas create text $x 0 -text $x -anchor nw
   }

 }

Now for the first example: draw a simple canvas with 800 million pixels and drop a few objects on that. This example will work flawlessly:

 source ScrolledCanvas.tcl
 source Drawer.tcl

 # The following code for a simple canvas works fine for "small"
 # scroll regions and for "large" scroll regions

 #set scrollWidth 20000
 set scrollWidth 800000000
 set scrollHeight 400
 set rowHeight 20

 # Create a ScrolledCanvas and setup its scroll region
 set sc [ScrolledCanvas .c -width 400 -height 200]
 $sc configure -scrollregion "0 0 $scrollWidth $scrollHeight"

 # Make the ScrollableWindow visible
 pack .c -fill both -expand true

 DrawLeftMark $sc yellow $scrollWidth $rowHeight
 DrawRightMark $sc yellow $scrollWidth $rowHeight
 DrawTicks $sc $scrollWidth

 # Show the canvas coordinates of the mouse pointer for
 # validation
 set location [label .location -textvariable cur_x_y]
 pack .location
 bind Canvas <Motion> {ShowLocation %W %x %y} 
 bind Canvas <Leave> {set cur_x_y ""} 

 proc ShowLocation {w x y} {
   global cur_x_y
   set cx [expr int([$w canvasx $x])]
   set cy [expr int([$w canvasy $y])]
   set cur_x_y "x = $cx , y = $cy"
 }

So, if that works, packing some canvases together in one frame to scroll them should work too, right? Nope, sorry, it wont:

 # Demo program for the creation of a scrollable multi row canvas
 # using native Tcl/Tk methods

 source ScrolledCanvas.tcl
 source Drawer.tcl

 # The following code works fine for "small" scroll regions,
 # but runs into problems with "large" scroll regions. Try,
 # for example, a scroll width of 40,000 pixel (let alone 
 # 800,000,000 pixel).
 # Windows will exit abnormally, running under Linux (albeit
 #  with a display on Solaris) gives different effects for
 #  different lengths ... objects not shown, canvas too small etc.)

 set scrollWidth 40000
 #set scrollWidth 800000000
 set scrollHeight 400
 set rowHeight 20

 # Create a ScrolledCanvas and setup its scroll region
 set sc [ScrolledCanvas .c -width 400 -height 200]
 $sc configure -scrollregion "0 0 $scrollWidth $scrollHeight"

 # Create a frame widget within the ScrolledCanvas, which
 # will serve as a container for the individual rows
 set sf [frame $sc.f]
 $sc create window 0 0 -anchor nw -window $sf

 # Make the ScrolledCanvas visible.
 pack .c -fill both -expand true

 # Create some rows (canvas widgets) for displaying data...
 set row1 [canvas $sf.c1 \
               -width $scrollWidth \
               -height $rowHeight \
               -highlightthickness 0 \
               -bg lightyellow]
 DrawLeftMark $row1 yellow $scrollWidth $rowHeight
 DrawRightMark $row1 yellow $scrollWidth $rowHeight
 DrawTicks $row1 $scrollWidth

 set row2 [canvas $sf.c2 \
               -width $scrollWidth \
               -height $rowHeight \
               -highlightthickness 0 \
               -bg orange]
 DrawLeftMark $row2 brown
 DrawRightMark $row2 brown
 DrawTicks $row2

 set row3 [canvas $sf.c3 \
               -width $scrollWidth \
               -height $rowHeight \
               -highlightthickness 0 \
               -bg lightgreen]
 DrawLeftMark $row3 green
 DrawRightMark $row3 green
 DrawTicks $row3

 set row4 [canvas $sf.c4 \
               -width $scrollWidth \
               -height $rowHeight \
               -highlightthickness 0 \
               -bg pink]
 DrawLeftMark $row4 red
 DrawRightMark $row4 red
 DrawTicks $row4

 # ... and put them into the ScrolledCanvas.
 grid $row1 -row 0
 grid $row2 -row 1
 grid $row3 -row 2
 grid $row4 -row 3

 # swap row2 and row3:
 #grid $row2 -row 2
 #grid $row3 -row 1

 # hide row2:
 #grid forget $row2

 # Show the canvas coordinates of the mouse pointer for
 # validation
 set location [label .location -textvariable cur_x_y]
 pack .location
 bind Canvas <Motion> {ShowLocation %W %x %y} 
 bind Canvas <Leave> {set cur_x_y ""} 

 proc ShowLocation {w x y} {
     global cur_x_y
     set cx [expr int([$w canvasx $x])]
     set cy [expr int([$w canvasy $y])]
     set cur_x_y "x = $cx , y = $cy"
 }

The question is now: why?


Category Widget