# Copyright:      2006-2025 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

# 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]
    if { $::xspeed < 0.0 } {
        set ::xspeed 0.0
    }
}

proc SetYSpeed { val } {
    set ::yspeed [expr $::yspeed + $val]
    if { $::yspeed < 0.0 } {
        set ::yspeed 0.0
    }
}

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 \
                     -createcommand CreateCallback \
                     -reshapecommand ReshapeCallback \
                     -displaycommand 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 . <Key-Escape> "ExitProg"
    bind . <Key-r>      "ResetRotation"
    bind . <Key-Up>     "SetXSpeed -0.1"
    bind . <Key-Down>   "SetXSpeed  0.1"
    bind . <Key-Left>   "SetYSpeed -0.1"
    bind . <Key-Right>  "SetYSpeed  0.1"

    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 "Key-r          Reset rotation"
    .fr.usage insert end "Key-Up|Down    Decrease|Increase x rotation speed"
    .fr.usage insert end "Key-Left|Right Decrease|Increase y rotation speed"
    .fr.usage insert end "Mouse-L|MR     Start|Stop animation"

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