# teapots.tcl
#
# An example of the OpenGL red book modified to work with Tcl3D.
# The original C sources are Copyright (c) 1993-2003, Silicon Graphics, Inc.
# The Tcl3D sources are Copyright (c) 2005-2022, Paul Obermeier.
# See file LICENSE for complete license information.
#
# This program demonstrates lots of material properties.
# A single light source illuminates the objects.
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
}
}
proc CreateCallback { toglwin } {
global teapotList
set ambient {0.0 0.0 0.0 1.0}
set diffuse {1.0 1.0 1.0 1.0}
set specular {1.0 1.0 1.0 1.0}
set position {0.0 3.0 3.0 0.0}
set lmodel_ambient {0.2 0.2 0.2 1.0}
set local_view {0.0}
glLightfv GL_LIGHT0 GL_AMBIENT $ambient
glLightfv GL_LIGHT0 GL_DIFFUSE $diffuse
glLightfv GL_LIGHT0 GL_POSITION $position
glLightModelfv GL_LIGHT_MODEL_AMBIENT $lmodel_ambient
glLightModelfv GL_LIGHT_MODEL_LOCAL_VIEWER $local_view
glFrontFace GL_CW
glEnable GL_LIGHTING
glEnable GL_LIGHT0
glEnable GL_AUTO_NORMAL
glEnable GL_NORMALIZE
glEnable GL_DEPTH_TEST
set teapotList [glGenLists 1]
glNewList $teapotList GL_COMPILE
glutSolidTeapot 1.0
glEndList
}
# Move object into position. Use 3rd through 12th
# parameters to specify the material property. Draw a teapot.
#
proc renderTeapot { x y ambr ambg ambb difr difg difb \
specr specg specb shine } {
global teapotList
glPushMatrix
glTranslatef $x $y 0.0
set mat [list $ambr $ambg $ambb 1.0]
glMaterialfv GL_FRONT GL_AMBIENT $mat
set mat [list $difr $difg $difb 1.0]
glMaterialfv GL_FRONT GL_DIFFUSE $mat
set mat [list $specr $specg $specb 1.0]
glMaterialfv GL_FRONT GL_SPECULAR $mat
glMaterialf GL_FRONT GL_SHININESS [expr $shine * 128.0]
glCallList $teapotList
glPopMatrix
}
# First column: emerald, jade, obsidian, pearl, ruby, turquoise
# 2nd column: brass, bronze, chrome, copper, gold, silver
# 3rd column: black, cyan, green, red, white, yellow plastic
# 4th column: black, cyan, green, red, white, yellow rubber
#
proc DisplayCallback { toglwin } {
glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]
# Viewport command is not really needed, but has been inserted for
# Mac OSX. Presentation framework (Tk) does not send a reshape event,
# when switching from one demo to another.
glViewport 0 0 [$toglwin width] [$toglwin height]
renderTeapot 2.0 17.0 0.0215 0.1745 0.0215 \
0.07568 0.61424 0.07568 0.633 0.727811 0.633 0.6
renderTeapot 2.0 14.0 0.135 0.2225 0.1575 \
0.54 0.89 0.63 0.316228 0.316228 0.316228 0.1
renderTeapot 2.0 11.0 0.05375 0.05 0.06625 \
0.18275 0.17 0.22525 0.332741 0.328634 0.346435 0.3
renderTeapot 2.0 8.0 0.25 0.20725 0.20725 \
1 0.829 0.829 0.296648 0.296648 0.296648 0.088
renderTeapot 2.0 5.0 0.1745 0.01175 0.01175 \
0.61424 0.04136 0.04136 0.727811 0.626959 0.626959 0.6
renderTeapot 2.0 2.0 0.1 0.18725 0.1745 \
0.396 0.74151 0.69102 0.297254 0.30829 0.306678 0.1
renderTeapot 6.0 17.0 0.329412 0.223529 0.027451 \
0.780392 0.568627 0.113725 0.992157 0.941176 0.807843 \
0.21794872
renderTeapot 6.0 14.0 0.2125 0.1275 0.054 \
0.714 0.4284 0.18144 0.393548 0.271906 0.166721 0.2
renderTeapot 6.0 11.0 0.25 0.25 0.25 \
0.4 0.4 0.4 0.774597 0.774597 0.774597 0.6
renderTeapot 6.0 8.0 0.19125 0.0735 0.0225 \
0.7038 0.27048 0.0828 0.256777 0.137622 0.086014 0.1
renderTeapot 6.0 5.0 0.24725 0.1995 0.0745 \
0.75164 0.60648 0.22648 0.628281 0.555802 0.366065 0.4
renderTeapot 6.0 2.0 0.19225 0.19225 0.19225 \
0.50754 0.50754 0.50754 0.508273 0.508273 0.508273 0.4
renderTeapot 10.0 17.0 0.0 0.0 0.0 0.01 0.01 0.01 \
0.50 0.50 0.50 .25
renderTeapot 10.0 14.0 0.0 0.1 0.06 0.0 0.50980392 0.50980392 \
0.50196078 0.50196078 0.50196078 .25
renderTeapot 10.0 11.0 0.0 0.0 0.0 \
0.1 0.35 0.1 0.45 0.55 0.45 .25
renderTeapot 10.0 8.0 0.0 0.0 0.0 0.5 0.0 0.0 \
0.7 0.6 0.6 .25
renderTeapot 10.0 5.0 0.0 0.0 0.0 0.55 0.55 0.55 \
0.70 0.70 0.70 .25
renderTeapot 10.0 2.0 0.0 0.0 0.0 0.5 0.5 0.0 \
0.60 0.60 0.50 .25
renderTeapot 14.0 17.0 0.02 0.02 0.02 0.01 0.01 0.01 \
0.4 0.4 0.4 .078125
renderTeapot 14.0 14.0 0.0 0.05 0.05 0.4 0.5 0.5 \
0.04 0.7 0.7 .078125
renderTeapot 14.0 11.0 0.0 0.05 0.0 0.4 0.5 0.4 \
0.04 0.7 0.04 .078125
renderTeapot 14.0 8.0 0.05 0.0 0.0 0.5 0.4 0.4 \
0.7 0.04 0.04 .078125
renderTeapot 14.0 5.0 0.05 0.05 0.05 0.5 0.5 0.5 \
0.7 0.7 0.7 .078125
renderTeapot 14.0 2.0 0.05 0.05 0.0 0.5 0.5 0.4 \
0.7 0.7 0.04 .078125
glFlush
$toglwin swapbuffers
}
proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
set w [$toglwin width]
set h [$toglwin height]
glViewport 0 0 $w $h
glMatrixMode GL_PROJECTION
glLoadIdentity
if { $w <= $h } {
glOrtho 0.0 16.0 0.0 [expr 16.0*double($h)/double($w)] -10.0 10.0
} else {
glOrtho 0.0 [expr 16.0*double($w)/double($h)] 0.0 16.0 -10.0 10.0
}
glMatrixMode GL_MODELVIEW
}
frame .fr
pack .fr -expand 1 -fill both
togl .fr.toglwin -width 500 -height 600 -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: OpenGL Red Book example teapots"
bind . <Key-Escape> "exit"
.fr.usage insert end "Key-Escape Exit"
.fr.usage configure -state disabled
PrintInfo [tcl3dOglGetInfoString]
|
