Demo 47 of 68 in category RedBook
 |
# polys.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 polygon stippling.
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 DisplayCallback { toglwin } {
set fly {
0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00
0x03 0x80 0x01 0xC0 0x06 0xC0 0x03 0x60
0x04 0x60 0x06 0x20 0x04 0x30 0x0C 0x20
0x04 0x18 0x18 0x20 0x04 0x0C 0x30 0x20
0x04 0x06 0x60 0x20 0x44 0x03 0xC0 0x22
0x44 0x01 0x80 0x22 0x44 0x01 0x80 0x22
0x44 0x01 0x80 0x22 0x44 0x01 0x80 0x22
0x44 0x01 0x80 0x22 0x44 0x01 0x80 0x22
0x66 0x01 0x80 0x66 0x33 0x01 0x80 0xCC
0x19 0x81 0x81 0x98 0x0C 0xC1 0x83 0x30
0x07 0xe1 0x87 0xe0 0x03 0x3f 0xfc 0xc0
0x03 0x31 0x8c 0xc0 0x03 0x33 0xcc 0xc0
0x06 0x64 0x26 0x60 0x0c 0xcc 0x33 0x30
0x18 0xcc 0x33 0x18 0x10 0xc4 0x23 0x08
0x10 0x63 0xC6 0x08 0x10 0x30 0x0c 0x08
0x10 0x18 0x18 0x08 0x10 0x00 0x00 0x08}
set halftone {
0xAA 0xAA 0xAA 0xAA 0x55 0x55 0x55 0x55
0xAA 0xAA 0xAA 0xAA 0x55 0x55 0x55 0x55
0xAA 0xAA 0xAA 0xAA 0x55 0x55 0x55 0x55
0xAA 0xAA 0xAA 0xAA 0x55 0x55 0x55 0x55
0xAA 0xAA 0xAA 0xAA 0x55 0x55 0x55 0x55
0xAA 0xAA 0xAA 0xAA 0x55 0x55 0x55 0x55
0xAA 0xAA 0xAA 0xAA 0x55 0x55 0x55 0x55
0xAA 0xAA 0xAA 0xAA 0x55 0x55 0x55 0x55
0xAA 0xAA 0xAA 0xAA 0x55 0x55 0x55 0x55
0xAA 0xAA 0xAA 0xAA 0x55 0x55 0x55 0x55
0xAA 0xAA 0xAA 0xAA 0x55 0x55 0x55 0x55
0xAA 0xAA 0xAA 0xAA 0x55 0x55 0x55 0x55
0xAA 0xAA 0xAA 0xAA 0x55 0x55 0x55 0x55
0xAA 0xAA 0xAA 0xAA 0x55 0x55 0x55 0x55
0xAA 0xAA 0xAA 0xAA 0x55 0x55 0x55 0x55
0xAA 0xAA 0xAA 0xAA 0x55 0x55 0x55 0x55}
glClear GL_COLOR_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]
glColor3f 1.0 1.0 1.0
# draw one solid, unstippled rectangle
# then two stippled rectangles
glRectf 25.0 25.0 125.0 125.0
glEnable GL_POLYGON_STIPPLE
glPolygonStipple $fly
glRectf 125.0 25.0 225.0 125.0
glPolygonStipple $halftone
glRectf 225.0 25.0 325.0 125.0
glDisable GL_POLYGON_STIPPLE
glFlush
$toglwin swapbuffers
}
proc CreateCallback { toglwin } {
glClearColor 0.0 0.0 0.0 0.0
glShadeModel GL_FLAT
}
proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
set w [$toglwin width]
set h [$toglwin height]
glViewport 0 0 $w $h
glMatrixMode GL_PROJECTION
glLoadIdentity
gluOrtho2D 0.0 $w 0.0 $h
}
frame .fr
pack .fr -expand 1 -fill both
togl .fr.toglwin -width 350 -height 150 -double 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 polys"
bind . <Key-Escape> "exit"
.fr.usage insert end "Key-Escape Exit"
.fr.usage configure -state disabled
PrintInfo [tcl3dOglGetInfoString]
|
