OUTPUT BUFFER:
# Copyright: 2006-2010 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: glutShapes.tcl # # Author: Paul Obermeier # Date: 2006-12-01 # # Description: Tcl3D demo showing all supported GLUT shapes. package require Tk package require tcl3d 0.5.0 # Font to be used in the Tk listbox. set listFont {-family {Courier} -size 10} set xrot 0.0 ; # X Rotation set yrot 0.0 ; # Y Rotation set xspeed 0.5 ; # X Rotation Speed set yspeed 0.5 ; # Y Rotation Speed # 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 ResetRotation {} { set ::xspeed 0.0 set ::yspeed 0.0 set ::xrot 0.0 set ::yrot 0.0 .fr.toglwin postredisplay } proc SetXSpeed { val } { set ::xspeed [expr $::xspeed + $val] } proc SetYSpeed { val } { set ::yspeed [expr $::yspeed + $val] } 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 {5.0 3.0 3.0 0.0} set lmodel_ambient {0.5 0.5 0.5 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 glEnable GL_LIGHT0 glEnable GL_AUTO_NORMAL glEnable GL_NORMALIZE glEnable GL_DEPTH_TEST set ::gShapeCmdsList [lsort [info commands glut*]] set ::gShapeSolidList [lsort [info commands glutSolid*]] set ::gShapeWireList [lsort [info commands glutWire*]] set ::gOffsetY 4 set ::gOffsetX 3 foreach shape $::gShapeCmdsList { set ::gShapeDisplayList($shape) [glGenLists 1] glNewList $::gShapeDisplayList($shape) GL_COMPILE switch $shape { glutSolidCone { glEnable GL_LIGHTING glutSolidCone 1 1 10 5 } glutWireCone { glDisable GL_LIGHTING glutWireCone 1 1 10 5 } glutSolidCube { glEnable GL_LIGHTING glutSolidCube 2 } glutWireCube { glDisable GL_LIGHTING glutWireCube 2 } glutSolidDodecahedron { glEnable GL_LIGHTING glPushMatrix glScalef 0.5 0.5 0.5 glutSolidDodecahedron glPopMatrix } glutWireDodecahedron { glDisable GL_LIGHTING glPushMatrix glScalef 0.5 0.5 0.5 glutWireDodecahedron glPopMatrix } glutSolidIcosahedron { glEnable GL_LIGHTING glutSolidIcosahedron } glutWireIcosahedron { glDisable GL_LIGHTING glutWireIcosahedron } glutSolidOctahedron { glEnable GL_LIGHTING glutSolidOctahedron } glutWireOctahedron { glDisable GL_LIGHTING glutWireOctahedron } glutSolidSphere { glEnable GL_LIGHTING glutSolidSphere 1 10 10 } glutWireSphere { glDisable GL_LIGHTING glutWireSphere 1 10 10 } glutSolidTeapot { glEnable GL_LIGHTING glutSolidTeapot 1 } glutWireTeapot { glDisable GL_LIGHTING glutWireTeapot 1 } glutSolidTetrahedron { glEnable GL_LIGHTING glPushMatrix glScalef 1.7 1.7 1.7 glutSolidTetrahedron glPopMatrix } glutWireTetrahedron { glDisable GL_LIGHTING glPushMatrix glScalef 1.7 1.7 1.7 glutWireTetrahedron glPopMatrix } glutSolidTorus { glEnable GL_LIGHTING glutSolidTorus 0.5 1 10 10 } glutWireTorus { glDisable GL_LIGHTING glutWireTorus 0.5 1 10 10 } default { error "Unknown GLUT shape <$shape>" } } glEndList } } # Move object into position. Use 3rd through 12th # parameters to specify the material property. Draw a teapot. # proc renderShape { shape x y ambr ambg ambb difr difg difb \ specr specg specb shine } { glPushMatrix glTranslatef $x $y 0.0 glRotatef $::xrot 1.0 0.0 0.0 glRotatef $::yrot 0.0 1.0 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 $::gShapeDisplayList($shape) glPopMatrix } 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] set x 2 set y 2 foreach shape $::gShapeSolidList { renderShape $shape $x $y 0.1 0.2 0.1 0.1 0.4 0.1 0.6 0.7 0.6 0.6 incr x $::gOffsetX } set x 2 set y [expr {$y + $::gOffsetY}] foreach shape $::gShapeWireList { renderShape $shape $x $y 0.1 0.2 0.1 0.1 0.4 0.1 0.6 0.7 0.6 0.6 incr x $::gOffsetX } if { [info exists ::animateId] } { set ::xrot [expr {$::xrot + $::xspeed}] set ::yrot [expr {$::yrot + $::yspeed}] } $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 set sizeX [expr 2 + 9 * $::gOffsetX] set sizeY [expr 2 + 2 * $::gOffsetY] if { $w <= $h } { glOrtho 0.0 $sizeX 0.0 [expr $sizeY*double($h)/double($w)] -10.0 10.0 } else { glOrtho 0.0 $sizeX 0.0 [expr $sizeY*double($w)/double($h)] -10.0 10.0 } glMatrixMode GL_MODELVIEW } proc Animate {} { .fr.toglwin postredisplay set ::animateId [tcl3dAfterIdle Animate] } proc StartAnimation {} { if { ! [info exists ::animateId] } { Animate } } proc StopAnimation {} { if { [info exists ::animateId] } { after cancel $::animateId unset ::animateId } } # Put all exit related code here. proc ExitProg {} { exit } proc CreateWindow {} { frame .fr pack .fr -expand 1 -fill both togl .fr.toglwin -width 600 -height 400 \ -double true -depth true \ -createproc CreateCallback \ -reshapeproc ReshapeCallback \ -displayproc DisplayCallback listbox .fr.usage -font $::listFont -height 4 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 GLUT shapes" wm protocol . WM_DELETE_WINDOW "ExitProg" bind .