Demo 11 of 17 in category tcl3dOgl
 |
# 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
# 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]
if { $gDemo(speed) < 0.0 } {
set gDemo(speed) 0.0
}
.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 \
-createcommand CreateCallback \
-reshapecommand ReshapeCallback \
-displaycommand 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 . <Key-Escape> "ExitProg"
bind . <Key-plus> "IncrSpeed 0.05"
bind . <Key-minus> "IncrSpeed -0.05"
bind . <Key-m> "ToggleMirror"
bind . <Key-p> "ToggleTeapot"
bind . <Key-t> "ToggleTextures"
bind . <Key-0> "ToggleLight0"
bind . <Key-1> "ToggleLight1"
bind .fr.toglwin <1> "StartAnimation"
bind .fr.toglwin <2> "StopAnimation"
bind .fr.toglwin <3> "StopAnimation"
bind .fr.toglwin <Control-Button-1> "StopAnimation"
.fr.usage insert end "Key-Escape Exit"
.fr.usage insert end "Mouse-L|MR Start|Stop animation"
.fr.usage insert end "Key-m Toggle mirror"
.fr.usage insert end "Key-p Toggle teapotahedron"
.fr.usage insert end "Key-t Toggle textures"
.fr.usage insert end "Key-0 Toggle light 0"
.fr.usage insert end "Key-1 Toggle light 1"
.fr.usage insert end "Key-+|- Increment|Decrement camera speed"
.fr.usage configure -state disabled
}
CreateWindow
PrintInfo [tcl3dOglGetInfoString]
if { [file tail [info script]] eq [file tail $::argv0] } {
# If started directly from tclsh or wish, then start animation.
update
StartAnimation
}
|
