# 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
}
