Demo 10 of 17 in category tcl3dOgl
 |
# Copyright: 2005-2024 Paul Obermeier (obermeier@tcl3d.org)
#
# See the file "Tcl3D_License.txt" for information on
# usage and redistribution of this file, and for a
# DISCLAIMER OF ALL WARRANTIES.
#
# Module: Tcl3D -> tcl3dOgl
# Filename: multiview.tcl
#
# Author: Paul Obermeier
#
# Description: Tcl3D demo showing the famous teapot in 4 different
# viewports on a single togl widget.
package require Tk
package require tcl3d
# Font to be used in the Tk listbox.
set listFont {-family {Courier} -size 10}
# Show errors occuring in the Togl callbacks.
proc bgerror { msg } {
tk_messageBox -icon error -type ok -message "Error: $msg\n\n$::errorInfo"
exit
}
# Print info message into widget a the bottom of the window.
proc PrintInfo { msg } {
if { [winfo exists .fr.info] } {
.fr.info configure -text $msg
}
}
# Print string "str" to raster position (x,y).
proc PrintString { str x y } {
set len [string length $str]
if { $len > 0 } {
glRasterPos2f $x $y
glListBase $::fontBase
set sa [tcl3dVectorFromString GLubyte $str]
glCallLists $len GL_UNSIGNED_BYTE $sa
$sa delete
}
}
proc CreateCallback { toglwin } {
glClearColor 0.0 0.0 0.6 1.0
glClearDepth 1
glMatrixMode GL_PROJECTION
glLoadIdentity
glOrtho -2 2 -2 2 -2 2
glMatrixMode GL_MODELVIEW
glLoadIdentity
set ::fontBase [$toglwin loadbitmapfont]
}
proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
set w [$toglwin width]
set h [$toglwin height]
set ::width $w
set ::height $h
}
proc DrawScene {} {
glColor3f 0.6 0.3 0.3
glPushMatrix
glTranslatef 0 -1 0
glBegin GL_QUADS
glVertex3f 2 0 2
glVertex3f 2 0 -2
glVertex3f -2 0 -2
glVertex3f -2 0 2
glEnd
glPopMatrix
glColor3f 0.8 0.8 0.8
glPushMatrix
glutWireTeapot 1
glPopMatrix
}
proc DisplayCallback { toglwin } {
glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]
set w2 [expr $::width/2]
set h2 [expr $::height/2]
# Bottom left
glViewport 0 0 $w2 $h2
glMatrixMode GL_PROJECTION
glPushMatrix
glLoadIdentity
gluPerspective 45 1 1 10000
glMatrixMode GL_MODELVIEW
glPushMatrix
gluLookAt 5 5 5 0 0 0 0 1 0
DrawScene
glPopMatrix
glMatrixMode GL_PROJECTION
glPopMatrix
PrintString "Perspective view" 0.0 -1.9
# Bottom right
glViewport $w2 0 $w2 $h2
glPushMatrix
gluLookAt 0 0 1 0 0 0 0 1 0
DrawScene
glPopMatrix
PrintString "Ortho view along Z" 0.0 -1.9
# Top left
glViewport 0 $h2 $w2 $h2
glPushMatrix
gluLookAt 0 1 0 0 0 0 0 0 1
DrawScene
glPopMatrix
PrintString "Ortho view along Y" 0.0 -1.9
# Top right
glViewport $w2 $h2 $w2 $h2
glPushMatrix
gluLookAt 1 0 0 0 0 0 0 1 0
DrawScene
glPopMatrix
PrintString "Ortho view along X" 0.0 -1.9
glFlush
$toglwin swapbuffers
}
set ::width 500
set ::height 500
frame .fr
pack .fr -expand 1 -fill both
togl .fr.toglwin -width $width -height $height \
-double true -depth true \
-createcommand CreateCallback \
-reshapecommand ReshapeCallback \
-displaycommand DisplayCallback
listbox .fr.usage -font $::listFont -height 1
label .fr.info
grid .fr.toglwin -row 0 -column 0 -sticky news
grid .fr.usage -row 1 -column 0 -sticky news
grid .fr.info -row 2 -column 0 -sticky news
grid rowconfigure .fr 0 -weight 1
grid columnconfigure .fr 0 -weight 1
wm title . "Tcl3D demo: Multiple viewports"
bind . <Key-Escape> "exit"
.fr.usage insert end "Key-Escape Exit"
.fr.usage configure -state disabled
PrintInfo [tcl3dOglGetInfoString]
|
