[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
   1. Overlapping canvas items.
   1. Scrollbar attaced to Togl widget.
   1. 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
 #


 # Lets 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
 }

 #
 # Lets 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

----
[Category 3D Graphics] | [Category Tutorial]