2D Scrollable Canvas using Tclogl

Philip Quaife 17 Oct 05,

For those that find change difficult, I demonstrate here how you could make a 2D canvas that functions like the existing tk canvas, but using the 3D openGL Togl widget.

I dispense here with any explaination of tclogl and refer you to that page to get a background.

What we will demonstrate here is:

  1. 2D Projection
  2. Overlapping canvas items.
  3. Scrollbar attaced to Togl widget.
  4. Tk canvas like shapes (ovals, rectangles, lines)

While my Qanim - tclogl Animation Demo code shows how you can make a canvas that stores items in display lists, we keep it very simple here and just use a tcl list variable that holds the items we want to display.

Example

To make a red rectangle 100 units square we :

        lappend Objects [list rectangle red 0 0 100 100]

When we need to redraw the canvas we loop through the Objects variable executing the statements in it. Not very efficient but demonstrates how you could add and remove objects from the canvas.


 #
 # Demonstrate 2D canvas concept with tclogl
 # Copyright Philip Quaife 2005
 # This code is placed in the public domain
 #


 # Let us dispense with a database to store items on the canvas
 # we will just use a list to hold the objects we want to display
 #
 set Objects [list]

 lappend Objects [list rectangle red 0 0 100 100]
 lappend Objects [list rectangle blue 100 100 200 300]
 lappend Objects [list rectangle green 50 400 150 500]
 lappend Objects [list oval grey 20 20 60 60]
 lappend Objects [list oval black 10 1000 200 1100]
 lappend Objects [list polygon green 10 150 100 200 200 250 150 100 10 200]
 lappend Objects [list line yellow 10 10 100 100 200 10 500 1000 10 500 100 20]

 # YRange will hold the range we want the canvas to scroll over
 # YOffset is the yscroll setting (0-1)  for the togl widget
 variable YRange 2000
 variable YOffset 0

 # Update the togl widget view matrix when yview is changed.
 proc canvasSet {w} {
        variable YOffset
        variable YRange

        $w makecurrent
        glMatrixMode GL_MODELVIEW
        glLoadIdentity
        glTranslatef 5 [expr {-$YOffset * $YRange}]  0
        $w postredisplay
 }

 # We need to create our own scroll function as the togl widget does not have one
 proc 2dscroll {w togl args} {
        variable YRange
        variable YOffset

        foreach {cmd amt unit} $args {break}

        switch -- $cmd {
                scroll {
                        set YOffset [expr {$YOffset + 0.1 * $amt}]
                }
                moveto {
                        set YOffset $amt

                }
        }
        if {$YOffset < 0 } {set YOffset 0}
        if {$YOffset > 1} {set YOffset 1}                        
        set size [lindex [$togl configure -height] 3]
        set ratio [expr {$size / double($YRange)}]

        $w set [expr {$YOffset}] [expr {$YOffset + $ratio}]

        canvasSet $togl
 }

 #
 # Let us define our Canvas procedures and shapes
 #

 # Allow named colours
 #
 proc colour {name} {
         glColor3usv [winfo rgb . $name]
 }

 # Make a compatible canvas rectangle rectangle
 proc  rectangle {colour x1 y1 x2 y2} {
        set p1 [list $x1 $y1]
        set p3 [list $x2 $y2]

        set p2 $p1
        set p4 $p3
        lset p2 0 [lindex $p3 0]
        lset p4 0 [lindex $p1 0]

        colour $colour
        glBegin GL_QUADS
                glVertex2fv $p1
                glVertex2fv $p2
                glVertex2fv $p3
                glVertex2fv $p4
        glEnd
 }

 # make a compatible canvas oval item
 proc  oval {colour x1 y1 x2 y2} {

        set xc [expr {($x2+$x1) / 2.0}]
        set yc [expr {($y2+$y1) / 2.0}]

        set xr [expr {($x2-$x1)}]
        set yr [expr {($y2-$y1)}]

        colour $colour
        glPushMatrix
        glTranslatef $xc $yc 0
        set quad [gluNewQuadric]
        glScalef [expr {$xr /2.0}] [expr {$yr/2.0}] 1
        gluDisk $quad 0 1 128 128
        gluDeleteQuadric $quad
        glPopMatrix
 }

 # make a compatible canvas polygon item
 proc  polygon {colour args} {

        colour $colour
        glBegin GL_POLYGON
                foreach {x y} $args {
                        glVertex2f $x $y
                }
        glEnd
 }
 # make a compatible canvas line item
 proc  line {colour args} {

        colour $colour
        glBegin GL_LINE_LOOP
                foreach {x y} $args {
                        glVertex2f $x $y
                }
        glEnd
 }


 ###
 #
 # Here is the standard tclogl widget initialisation
 ###

 proc tclReshapeFunc { toglwin width height } {

    glViewport 0 0 $width $height
    glMatrixMode GL_PROJECTION
    glLoadIdentity
    if { $width > $height } {
        set w [expr double ($width) / double ($height)]
    } else {
        set h [expr double ($height) / double ($width)]
    }

    # This is where we set our scale for the window
    # We also set our zero at the top left corner
    # and make y run down the screen.
    glOrtho 0 $width $height 0 -10000 10000
    canvasSet $toglwin
    after idle $toglwin postredisplay
 }

 proc tclCreateFunc { toglwin } {

   glClearColor 1 1 1 1
   glLineWidth 2

 }

 # This is were we loop through our display list and draw the objects.
 proc tclDisplayFunc { toglwin } {
        variable Objects

    glMatrixMode GL_MODELVIEW
    glClearColor 1 1 1 0
    glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]
    glPushMatrix

    set i 0
    foreach obj $Objects {
        eval $obj
        glTranslatef 0 0 [incr i 1]
    }
    glPopMatrix
    $toglwin swapbuffers
 }


 # Make a demo window
 proc setup {} {
        variable YOffset 0

        package require Tk
        package require Togl
        package require tclogl


        eval destroy [winfo children .]

    wm title . "2D Canvas Test (tclogl)"

    togl .togl -width 256 -height 256  -rgba true  -double true \
              -depth true -privatecmap false  \
              -createproc  tclCreateFunc \
              -displayproc tclDisplayFunc \
              -reshapeproc tclReshapeFunc

        pack .togl -side right -anc nw -fill both -expand 1
        pack [scrollbar .vsc -command "2dscroll .vsc .togl" -orient v] -side left -fill y

        .vsc set 0 0.1
        bind . <Escape> [list after idle exit]

 }

 wm geometry . {}

 setup