OUTPUT BUFFER:
# platonic.c - An OpenGL demonstration that draws the six platonic solids: # The tetrahedron, the cube, the dodecahedron, the octahedron, # the icosahedron and the teapotahedron. :-) # The ray-traced image by Arvo and Kirk on the front cover of # "An Introduction to Ray Tracing" (A. S. Glassner (ed.), # Academic Press) inspired me to write this demo. # A menu with a number of options is tied to the left mouse # button. # # Author: Gustav Taxen, nv91-gta@nada.kth.se # # Notes: The code is not very pretty, nor is it optimized wrt OpenGL. # Should add shadows as well, but I'll save that for the next # version... # # Copyright (C) 1998 Gustav Taxen. # This is free software with ABSOLUTELY NO WARRANTY. # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, write to the Free Software # Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. # # Original C code taken from: # http://www.student.nada.kth.se/~nv91-gta/OpenGL/projects/platonic/ # # Modified for Tcl3D by Paul Obermeier 2008/12/21 # See www.tcl3d.org for the Tcl3D extension. # # See http://design.osu.edu/carlson/history/lesson20.html about the history of # the famous Utah teapot. This page also contains an image of the original # ray-traced scene by Arvo and Kirk. # The image is also on the front page of Glassner's book "An Introduction to # Ray Tracing". # For a mathematical description of the five platonic solids see # http://en.wikipedia.org/wiki/Platonic_solid package require tcl3d 0.5.0 # Font to be used in the Tk listbox. set gDemo(listFont) {-family {Courier} -size 10} # Determine the directory of this script. set gDemo(scriptDir) [file dirname [info script]] # Column dimensions set COLUMN_FOOT_X 1.00 set COLUMN_FOOT_Y 0.25 set COLUMN_FOOT_Z 1.00 set COLUMN_BASE_X 0.50 set COLUMN_BASE_Y 1.00 set COLUMN_BASE_Z 0.50 # Platonic dimensions set PLATONIC_X 0.50 set PLATONIC_Y 0.50 set PLATONIC_Z 0.50 # Mirroring status set NO_MIRROR 0 set MIRROR 1 # Window dimensions set gDemo(winWidth) 640 set gDemo(winHeight) 480 # Flags for toggles set gDemo(mirrorImage) 1 set gDemo(drawTeapot) 1 set gDemo(drawTexture) 1 set gDemo(lightSource0) 1 set gDemo(lightSource1) 1 # Animation parameters set gDemo(platonicAngle) 0.0 set gDemo(cameraPhaseX) 0.0 set gDemo(cameraPhaseZ) 0.0 set gDemo(cameraX) 0.0 set gDemo(cameraZ) 0.0 set gDemo(lookAtPhaseX) 0.0 set gDemo(lookAtX) 0.0 set gDemo(speed) 0.2 # Texture name set gDemo(texture) [tcl3dVector GLuint 1] # Show errors occuring in the Togl callbacks. proc bgerror { msg } { tk_messageBox -icon error -type ok -message "Error: $msg\n\n$::errorInfo" ExitProg } # 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 SetLightSources {} { global gDemo set lightAmb { 0.5 0.5 0.5 1.0 } set lightDif { 1.0 1.0 1.0 1.0 } set lightSpc { 1.0 1.0 1.0 1.0 } set lightPos0 { 0.0 0.05 1.0 0.0 } set lightPos1 { 0.0 0.05 -1.0 0.0 } glLightfv GL_LIGHT0 GL_AMBIENT $lightAmb glLightfv GL_LIGHT0 GL_DIFFUSE $lightDif glLightfv GL_LIGHT0 GL_SPECULAR $lightSpc glLightfv GL_LIGHT0 GL_POSITION $lightPos0 glLightfv GL_LIGHT1 GL_AMBIENT $lightAmb glLightfv GL_LIGHT1 GL_DIFFUSE $lightDif glLightfv GL_LIGHT1 GL_SPECULAR $lightSpc glLightfv GL_LIGHT1 GL_POSITION $lightPos1 if { $gDemo(lightSource0) } { glEnable GL_LIGHT0 } else { glDisable GL_LIGHT0 } if { $gDemo(lightSource1) } { glEnable GL_LIGHT1 } else { glDisable GL_LIGHT1 } } proc SetColumnMaterial {} { set columnAmb { 0.1 0.1 0.1 1.0 } set columnDif { 0.4 0.4 0.4 1.0 } set columnSpc { 0.0 0.0 0.0 1.0 } set columnShn 0.0 glMaterialfv GL_FRONT_AND_BACK GL_AMBIENT $columnAmb glMaterialfv GL_FRONT_AND_BACK GL_DIFFUSE $columnDif glMaterialfv GL_FRONT_AND_BACK GL_SPECULAR $columnSpc glMaterialf GL_FRONT_AND_BACK GL_SHININESS $columnShn } proc DrawColumn {} { glPushMatrix glPushMatrix glTranslatef 0.0 [expr $::COLUMN_FOOT_Y / 2.0] 0.0 glScalef $::COLUMN_FOOT_X $::COLUMN_FOOT_Y $::COLUMN_FOOT_Z glutSolidCube 1.0 glPopMatrix glPushMatrix glTranslatef 0.0 [expr $::COLUMN_FOOT_Y + ($::COLUMN_BASE_Y / 2.0)] 0.0 glScalef $::COLUMN_BASE_X $::COLUMN_BASE_Y $::COLUMN_BASE_Z glutSolidCube 1.0 glPopMatrix glPushMatrix glTranslatef 0.0 [expr (1.5 * $::COLUMN_FOOT_Y) + $::COLUMN_BASE_Y] 0.0 glScalef $::COLUMN_FOOT_X $::COLUMN_FOOT_Y $::COLUMN_FOOT_Z glutSolidCube 1.0 glPopMatrix glPopMatrix } proc DrawColumnRow {} { glPushMatrix DrawColumn glPushMatrix glTranslatef [expr 2.0 * $::COLUMN_FOOT_X] 0.0 0.0 DrawColumn glPopMatrix glPushMatrix glTranslatef [expr -2.0 * $::COLUMN_FOOT_X] 0.0 0.0 DrawColumn glPopMatrix glPopMatrix } proc DrawColumns {} { glPushMatrix glTranslatef 0.0 0.0 $::COLUMN_FOOT_Z DrawColumnRow glPopMatrix glPushMatrix glTranslatef 0.0 0.0 [expr -1.0*$::COLUMN_FOOT_Z] DrawColumnRow glPopMatrix } proc SetFloorMaterial {} { set floorAmb { 0.4 0.4 0.4 0.7 } set floorDif { 0.6 0.6 0.6 0.7 } set floorSpc { 0.7 0.7 0.7 0.7 } set floorShn 60.0 glMaterialfv GL_FRONT_AND_BACK GL_AMBIENT $floorAmb glMaterialfv GL_FRONT_AND_BACK GL_DIFFUSE $floorDif glMaterialfv GL_FRONT_AND_BACK GL_SPECULAR $floorSpc glMaterialf GL_FRONT_AND_BACK GL_SHININESS $floorShn glColor4f 0.0 0.1 0.5 0.5 } proc DrawFloor {} { glPushMatrix glNormal3f 0.0 1.0 0.0 glBegin GL_QUADS glTexCoord2f 0.0 0.0 glVertex3f [expr -4.0 * $::COLUMN_FOOT_X] 0.0 [expr 3.0 * $::COLUMN_FOOT_Z] glTexCoord2f 3.0 0.0 glVertex3f [expr 4.0 * $::COLUMN_FOOT_X] 0.0 [expr 3.0 * $::COLUMN_FOOT_Z] glTexCoord2f 3.0 3.0 glVertex3f [expr 4.0 * $::COLUMN_FOOT_X] 0.0 [expr -3.0 * $::COLUMN_FOOT_Z] glTexCoord2f 0.0 3.0 glVertex3f [expr -4.0 * $::COLUMN_FOOT_X] 0.0 [expr -3.0 * $::COLUMN_FOOT_Z] glEnd glPopMatrix } proc DrawStencil {} { glDisable GL_DEPTH_TEST ; # Turn off writes to depth buffer glColorMask GL_FALSE GL_FALSE GL_FALSE GL_FALSE ; # Turn off writes to color buffer glDisable GL_LIGHTING ; # No need for lighting now SetFloorMaterial glFrontFace GL_CCW DrawFloor glEnable GL_LIGHTING glEnable GL_DEPTH_TEST ; # Turn on writes to depth buffer glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE ; # Turn on writes to color buffer } proc SetPlatonicMaterial {} { set platonicAmb { 0.16 0.12 0.03 1.0 } set platonicDif { 0.42 0.37 0.11 1.0 } set platonicSpc { 0.99 0.91 0.81 1.0 } set platonicShn 27.8 glMaterialfv GL_FRONT_AND_BACK GL_AMBIENT $platonicAmb glMaterialfv GL_FRONT_AND_BACK GL_DIFFUSE $platonicDif glMaterialfv GL_FRONT_AND_BACK GL_SPECULAR $platonicSpc glMaterialf GL_FRONT_AND_BACK GL_SHININESS $platonicShn } proc DrawPlatonicSolids { mirror } { global gDemo # Icosahedron glPushMatrix glTranslatef [expr 2.0 * $::COLUMN_FOOT_X] 0.0 $::COLUMN_FOOT_Z glRotatef $gDemo(platonicAngle) 0.0 1.0 0.0 glScalef $::PLATONIC_X $::PLATONIC_Y $::PLATONIC_Z glutSolidIcosahedron glPopMatrix # Tetrahedron glPushMatrix glTranslatef 0.0 0.0 [expr -$::COLUMN_FOOT_Z] glRotatef $gDemo(platonicAngle) 0.0 1.0 0.0 glScalef $::PLATONIC_X $::PLATONIC_Y $::PLATONIC_Z glutSolidTetrahedron glPopMatrix # Dodecahedron glPushMatrix glTranslatef [expr -2.0 * $::COLUMN_FOOT_X] 0.0 $::COLUMN_FOOT_Z glRotatef $gDemo(platonicAngle) 0.0 1.0 0.0 glScalef [expr $::PLATONIC_X / 2.0] [expr $::PLATONIC_Y / 2.0] [expr $::PLATONIC_Z / 2.0] glutSolidDodecahedron glPopMatrix # Teapotahedron if { $gDemo(drawTeapot) } { glPushMatrix glTranslatef 0.0 0.0 $::COLUMN_FOOT_Z glRotatef $gDemo(platonicAngle) 0.0 1.0 0.0 glScalef $::PLATONIC_X $::PLATONIC_Y $::PLATONIC_Z if { $mirror } { glFrontFace GL_CCW } else { glFrontFace GL_CW } glutSolidTeapot 1.0 if { $mirror } { glFrontFace GL_CW } else { glFrontFace GL_CCW } glPopMatrix } # Octahedron glPushMatrix glTranslatef [expr -2.0 * $::COLUMN_FOOT_X] 0.0 [expr -$::COLUMN_FOOT_Z] glRotatef $gDemo(platonicAngle) 0.0 1.0 0.0 glScalef $::PLATONIC_X $::PLATONIC_Y $::PLATONIC_Z glutSolidOctahedron glPopMatrix # Cube glPushMatrix glTranslatef [expr 2.0 * $::COLUMN_FOOT_X] 0.0 [expr -$::COLUMN_FOOT_Z] glRotatef $gDemo(platonicAngle) 0.0 1.0 0.0 glScalef $::PLATONIC_X $::PLATONIC_Y $::PLATONIC_Z glutSolidCube 1.0 glPopMatrix } proc DrawPlatonics { mirror } { glPushMatrix glTranslatef 0.0 \ [expr (2.0*$::COLUMN_FOOT_Y) + $::COLUMN_BASE_Y + $::PLATONIC_Y] \ 0.0 DrawPlatonicSolids $mirror glPopMatrix } proc ToggleMirror {} { global gDemo set gDemo(mirrorImage) [expr 1 - $gDemo(mirrorImage)] .fr.toglwin postredisplay } proc ToggleTeapot {} { global gDemo set gDemo(drawTeapot) [expr 1 - $gDemo(drawTeapot)] .fr.toglwin postredisplay } proc ToggleTextures {} { global gDemo set gDemo(drawTexture) [expr 1 - $gDemo(drawTexture)] .fr.toglwin postredisplay } proc ToggleLight0 {} { global gDemo set gDemo(lightSource0) [expr 1 - $gDemo(lightSource0)] .fr.toglwin postredisplay } proc ToggleLight1 {} { global gDemo set gDemo(lightSource1) [expr 1 - $gDemo(lightSource1)] .fr.toglwin postredisplay } proc IncrSpeed { delta } { global gDemo set gDemo(speed) [expr $gDemo(speed) + $delta] .fr.toglwin postredisplay } proc UpdateCamera {} { global gDemo # Rotate platonic solids set gDemo(platonicAngle) [expr $gDemo(platonicAngle) - 2.5] # Move camera set gDemo(cameraPhaseX) [expr $gDemo(cameraPhaseX) + $gDemo(speed) * 3.2] set gDemo(cameraX) [expr 6.0 * $::COLUMN_FOOT_X * sin (0.017453 * $gDemo(cameraPhaseX))] set gDemo(cameraPhaseZ) [expr $gDemo(cameraPhaseZ) + $gDemo(speed) * 2.1] set gDemo(cameraZ) [expr 4.0 * $::COLUMN_FOOT_Z * sin (0.017453 * $gDemo(cameraPhaseZ))] set gDemo(lookAtPhaseX) [expr $gDemo(lookAtPhaseX) + $gDemo(speed) * 1.8] set gDemo(lookAtX) [expr 2.0 * $::COLUMN_FOOT_X * sin (0.017453 * $gDemo(lookAtPhaseX))] } proc CreateTexture {} { global gDemo # Load texture image. set texName [file join $gDemo(scriptDir) "wood.ppm"] set retVal [catch {set phImg [image create photo -file $texName]} err1] if { $retVal != 0 } { error "Error reading image $texName ($err1)" } else { set w [image width $phImg] set h [image height $phImg] set n [tcl3dPhotoChans $phImg] set textureImg [tcl3dVectorFromPhoto $phImg] image delete $phImg } glGenTextures 1 $::gDemo(texture) glBindTexture GL_TEXTURE_2D [$::gDemo(texture) get 0] glTexImage2D GL_TEXTURE_2D 0 $::GL_RGBA $w $h 0 GL_RGBA \ GL_UNSIGNED_BYTE $textureImg # Don't use texture filtering glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_NEAREST glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_NEAREST # Repeat texture if texture coords are outside [0, 1]. glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S $::GL_REPEAT glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T $::GL_REPEAT # When applying the texture, use RGB from texture and leave A alone. glTexEnvi GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE $::GL_MODULATE $textureImg delete } proc CreateCallback { toglwin } { CreateTexture } proc ReshapeCallback { toglwin { w -1 } { h -1 } } { set w [$toglwin width] set h [$toglwin height] glViewport 0 0 $w $h glMatrixMode GL_PROJECTION glLoadIdentity gluPerspective 45.0 [expr double($w)/double($h)] 0.1 40.0 } proc DisplayCallback { toglwin } { global gDemo glClearColor 0.1 0.2 0.3 1.0 glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT | $::GL_STENCIL_BUFFER_BIT] glEnable GL_DEPTH_TEST glEnable GL_LIGHTING glEnable GL_NORMALIZE glEnable GL_CULL_FACE glMatrixMode GL_MODELVIEW glLoadIdentity gluLookAt $gDemo(cameraX) 4.0 $gDemo(cameraZ) \ $gDemo(lookAtX) [expr (2.0 * $::COLUMN_FOOT_Y) + ($::COLUMN_BASE_Y)] 0.0 \ 0.0 1.0 0.0 # Set light sources SetLightSources # Draw columns glFrontFace GL_CCW SetColumnMaterial DrawColumns # Draw platonic solids SetPlatonicMaterial DrawPlatonics $::NO_MIRROR # If there's a mirror image, draw it if { $gDemo(mirrorImage) } { # Draw floor polygon in stencil buffer and configure stencil test glEnable GL_STENCIL_TEST glStencilFunc GL_ALWAYS 1 0xffffffff ; # Draw 1s glStencilOp GL_REPLACE GL_REPLACE GL_REPLACE ; # Replace stencil values with reference DrawStencil ; # Draw the stencil (= floor polygon) glStencilFunc GL_EQUAL 1 0xffffffff ; # Configure stencil test: look for 1s glStencilOp GL_KEEP GL_KEEP GL_KEEP ; # Keep stencil values # Draw mirror image SetColumnMaterial glScalef 1.0 -1.0 1.0 glFrontFace GL_CW DrawColumns DrawPlatonics $::MIRROR glDisable GL_STENCIL_TEST # Draw the floor itself glFrontFace GL_CCW SetFloorMaterial glEnable GL_BLEND glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA if { $gDemo(drawTexture) } { glEnable GL_TEXTURE_2D } DrawFloor glDisable GL_TEXTURE_2D glDisable GL_BLEND } else { # Draw the floor polygon glFrontFace GL_CCW SetFloorMaterial if { $gDemo(drawTexture) } { glEnable GL_TEXTURE_2D } DrawFloor glDisable GL_TEXTURE_2D } if { [info exists ::animateId] } { UpdateCamera } $toglwin swapbuffers } 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 } } proc Cleanup {} { glDeleteTextures 1 [$::gDemo(texture) get 0] $::gDemo(texture) delete uplevel #0 unset gDemo } # Put all exit related code here. proc ExitProg {} { exit } # Create the OpenGL window and some Tk helper widgets. proc CreateWindow {} { frame .fr pack .fr -expand 1 -fill both # Create Our OpenGL Window togl .fr.toglwin -width $::gDemo(winWidth) -height $::gDemo(winHeight) \ -swapinterval 1 \ -double true -depth true -stencil true \ -createproc CreateCallback \ -reshapeproc ReshapeCallback \ -displayproc DisplayCallback listbox .fr.usage -font $::gDemo(listFont) -height 8 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: The six platonic solids" # Watch For ESC Key And Quit Messages wm protocol . WM_DELETE_WINDOW "ExitProg" bind .