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:
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