# teapots.tcl
#
# An example of the OpenGL red book modified to work with Tcl3D.
# The original C sources are Copyright (c) 1993-2003, Silicon Graphics, Inc.
# The Tcl3D sources are Copyright (c) 2005-2022, Paul Obermeier.
# See file LICENSE for complete license information.
#
# This program demonstrates lots of material properties.
# A single light source illuminates the objects.

package require tcl3d

# Font to be used in the Tk listbox.
set listFont {-family {Courier} -size 10}

# 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 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 {0.0 3.0 3.0 0.0}
 
    set lmodel_ambient {0.2 0.2 0.2 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
 
    glFrontFace GL_CW
    glEnable GL_LIGHTING
    glEnable GL_LIGHT0
    glEnable GL_AUTO_NORMAL
    glEnable GL_NORMALIZE
    glEnable GL_DEPTH_TEST

    set teapotList [glGenLists 1]
    glNewList $teapotList GL_COMPILE
        glutSolidTeapot 1.0
    glEndList
}

# Move object into position.  Use 3rd through 12th 
# parameters to specify the material property.  Draw a teapot.
#
proc renderTeapot { x y ambr ambg ambb difr difg difb \
                    specr specg specb shine } {
    global teapotList

    glPushMatrix
    glTranslatef $x $y 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 $teapotList
    glPopMatrix
}

# First column:  emerald, jade, obsidian, pearl, ruby, turquoise
# 2nd column:  brass, bronze, chrome, copper, gold, silver
# 3rd column:  black, cyan, green, red, white, yellow plastic
# 4th column:  black, cyan, green, red, white, yellow rubber
#
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]

    renderTeapot 2.0 17.0 0.0215 0.1745 0.0215 \
                 0.07568 0.61424 0.07568 0.633 0.727811 0.633 0.6
    renderTeapot 2.0 14.0 0.135 0.2225 0.1575 \
                 0.54 0.89 0.63 0.316228 0.316228 0.316228 0.1
    renderTeapot 2.0 11.0 0.05375 0.05 0.06625 \
                 0.18275 0.17 0.22525 0.332741 0.328634 0.346435 0.3
    renderTeapot 2.0 8.0 0.25 0.20725 0.20725 \
                 1 0.829 0.829 0.296648 0.296648 0.296648 0.088
    renderTeapot 2.0 5.0 0.1745 0.01175 0.01175 \
                 0.61424 0.04136 0.04136 0.727811 0.626959 0.626959 0.6
    renderTeapot 2.0 2.0 0.1 0.18725 0.1745 \
                 0.396 0.74151 0.69102 0.297254 0.30829 0.306678 0.1
    renderTeapot 6.0 17.0 0.329412 0.223529 0.027451 \
                 0.780392 0.568627 0.113725 0.992157 0.941176 0.807843 \
                 0.21794872
    renderTeapot 6.0 14.0 0.2125 0.1275 0.054 \
                 0.714 0.4284 0.18144 0.393548 0.271906 0.166721 0.2
    renderTeapot 6.0 11.0 0.25 0.25 0.25 \
                 0.4 0.4 0.4 0.774597 0.774597 0.774597 0.6
    renderTeapot 6.0 8.0 0.19125 0.0735 0.0225 \
                 0.7038 0.27048 0.0828 0.256777 0.137622 0.086014 0.1
    renderTeapot 6.0 5.0 0.24725 0.1995 0.0745 \
                 0.75164 0.60648 0.22648 0.628281 0.555802 0.366065 0.4
    renderTeapot 6.0 2.0 0.19225 0.19225 0.19225 \
                 0.50754 0.50754 0.50754 0.508273 0.508273 0.508273 0.4
    renderTeapot 10.0 17.0 0.0 0.0 0.0 0.01 0.01 0.01 \
                 0.50 0.50 0.50 .25
    renderTeapot 10.0 14.0 0.0 0.1 0.06 0.0 0.50980392 0.50980392 \
                 0.50196078 0.50196078 0.50196078 .25
    renderTeapot 10.0 11.0 0.0 0.0 0.0 \
                 0.1 0.35 0.1 0.45 0.55 0.45 .25
    renderTeapot 10.0 8.0 0.0 0.0 0.0 0.5 0.0 0.0 \
                 0.7 0.6 0.6 .25
    renderTeapot 10.0 5.0 0.0 0.0 0.0 0.55 0.55 0.55 \
                 0.70 0.70 0.70 .25
    renderTeapot 10.0 2.0 0.0 0.0 0.0 0.5 0.5 0.0 \
                 0.60 0.60 0.50 .25
    renderTeapot 14.0 17.0 0.02 0.02 0.02 0.01 0.01 0.01 \
                 0.4 0.4 0.4 .078125
    renderTeapot 14.0 14.0 0.0 0.05 0.05 0.4 0.5 0.5 \
                 0.04 0.7 0.7 .078125
    renderTeapot 14.0 11.0 0.0 0.05 0.0 0.4 0.5 0.4 \
                 0.04 0.7 0.04 .078125
    renderTeapot 14.0 8.0 0.05 0.0 0.0 0.5 0.4 0.4 \
                 0.7 0.04 0.04 .078125
    renderTeapot 14.0 5.0 0.05 0.05 0.05 0.5 0.5 0.5 \
                 0.7 0.7 0.7 .078125
    renderTeapot 14.0 2.0 0.05 0.05 0.0 0.5 0.5 0.4 \
                 0.7 0.7 0.04 .078125
    glFlush
    $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
    if { $w <= $h } {
        glOrtho 0.0 16.0 0.0 [expr 16.0*double($h)/double($w)] -10.0 10.0
    } else {
        glOrtho 0.0 [expr 16.0*double($w)/double($h)] 0.0 16.0 -10.0 10.0
    }
    glMatrixMode GL_MODELVIEW
}

frame .fr
pack .fr -expand 1 -fill both
togl .fr.toglwin -width 500 -height 600 -double true -depth true \
                 -createcommand CreateCallback \
                 -reshapecommand ReshapeCallback \
                 -displaycommand DisplayCallback 
listbox .fr.usage -font $::listFont -height 1
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 Red Book example teapots"

bind . <Key-Escape> "exit"

.fr.usage insert end "Key-Escape Exit"
.fr.usage configure -state disabled

PrintInfo [tcl3dOglGetInfoString]
