# oglmodes.tcl
#
# Tcl3D demo showing 3 possible modes of OpenGL execution:
#
# Normal mode: Use the OpenGL functions as wrapped by SWIG.
#              This is the fastest mode. If using an
#              OpenGL function not available in the used driver
#              implementation, this mode will dump core.
# Safe mode:   In this mode every OpenGL function is checked for
#              availability in the driver before execution.
#              If it's not available, a message is printed out.
# Debug mode:  This mode checks the availability of an OpenGL function
#              like the safe mode, and additionally prints out each
#              OpenGL function before execution.
#
# The program allows to insert an unavailable command in the display
# callback to see the impact on execution. Currently this command is
# set to "glFinishTextureSUNX", which is an old, not widely used extension
# and therefore should not be available in most driver implementations
# currently in the wild.
#
# Author: Paul Obermeier
# Date: 2009-01-10

package require tcl3d

# Font to be used in the Tk text widget for debugging output.
set gDemo(listFont) {-family {Courier} -size 10}

# Window size.
set gDemo(winWidth)  400
set gDemo(winHeight) 300

# Start rotation angles for the triangle and the quad.
set gDemo(triAngle)  0.0
set gDemo(quadAngle) 0.0

# Rotation increments for the triangle and the quad.
set gDemo(triIncr)   0.50
set gDemo(quadIncr) -0.25

# Flag indicating usage of the "bad" unavailable command.
set gDemo(useBadCmd) 0

# The name of the "bad" unavailable command.
set gDemo(badCmd) "glFinishTextureSUNX"

set gDemo(animStarted) 0

# 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 label widget at the bottom of the window.
proc PrintInfo { msg } {
    if { [winfo exists .fr.info] } {
        .fr.info configure -text $msg
    }
}

# Print debug message into text widget at the bottom of the window.
proc PrintDebug { msg } {
    global gDemo

    if { [winfo exists $gDemo(out)] } {
        $gDemo(out) insert end "$msg\n"
        $gDemo(out) see end
    }
}

# Print body of OpenGL command glBegin.
proc PrintProcBody {} {
    global gDemo

    if { [winfo exists $gDemo(out)] } {
        $gDemo(out) insert end "Body of procedure glBegin in $gDemo(mode) mode:\n"
        set retVal [catch {info body glBegin}]
        if { $retVal == 0 } {
            $gDemo(out) insert end [info body glBegin]
        } else {
            $gDemo(out) insert end "$::errorInfo"
        }
        $gDemo(out) insert end "\n"
        $gDemo(out) see end
    }
}

# Clear contents of the debug text widget.
proc ClearDebug {} {
    global gDemo

    if { [winfo exists $gDemo(out)] } {
        $gDemo(out) delete 1.0 end
    }
}

proc CreateCallback { toglwin } {
    glShadeModel GL_SMOOTH
    glClearColor 0.0 0.0 0.0 0.5
    glClearDepth 1.0
    glEnable GL_DEPTH_TEST
    glDepthFunc GL_LEQUAL
}

proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
    global gDemo

    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 100.0

    glMatrixMode GL_MODELVIEW
    glLoadIdentity
}

proc DisplayCallback { toglwin } {
    global gDemo

    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]

    glLoadIdentity
    glTranslatef -1.5 0.0 -6.0
    glRotatef $gDemo(triAngle) 0.0 1.0 0.0
    glBegin GL_TRIANGLES
        glColor3f 1.0 0.0 0.0
        glVertex3f  0.0  1.0 0.0
        glColor3f 0.0 1.0 0.0
        glVertex3f -1.0 -1.0 0.0
        glColor3f 0.0 0.0 1.0
        glVertex3f  1.0 -1.0 0.0
    glEnd
    glLoadIdentity
    glTranslatef 1.5 0.0 -6.0
    glRotatef $gDemo(quadAngle) 1.0 0.0 0.0
    glColor3f 0.5 0.5 1.0
    glBegin GL_QUADS
        glVertex3f -1.0  1.0 0.0
        glVertex3f  1.0  1.0 0.0
        glVertex3f  1.0 -1.0 0.0
        glVertex3f -1.0 -1.0 0.0
    glEnd
    set gDemo(triAngle)  [expr $gDemo(triAngle)  + $gDemo(triIncr)]
    set gDemo(quadAngle) [expr $gDemo(quadAngle) + $gDemo(quadIncr)]
    
    if { $gDemo(useBadCmd) } {
        # Call the unavailable command.
        eval $gDemo(badCmd)
    }

    $toglwin swapbuffers
}

proc NextStep {} {
    PrintDebug "Next Step"
    .fr.toglwin postredisplay
}

proc Animate {} {
    global gDemo

    if { $gDemo(animStarted) == 0 } {
        return
    }
    .fr.toglwin postredisplay
    set ::animateId [tcl3dAfterIdle Animate]
}

proc StartAnimation {} {
    global gDemo

    set gDemo(animStarted) 1
    if { ! [info exists ::animateId] } {
        Animate
    }
}

proc StopAnimation {} {
    global gDemo

    if { [info exists ::animateId] } {
        after cancel $::animateId
        unset ::animateId
        set gDemo(animStarted) 0
    }
}

proc Cleanup {} {
    global gDemo

    # Restore mode. Needed, if run from the presentation framework.
    tcl3dOglSetMode $gDemo(initmode)

    uplevel #0 unset gDemo
}

proc ExitProg {} {
    exit
}

# OpenGL function "glFunc" is renamed to create either a debug version
# or a safe version.
proc CreateSafeOrDebugFunc { glFunc debugFlag normalFlag { cmd puts } } {
    if { [info commands ${glFunc}Standard] eq "${glFunc}Standard" } {
        rename ::${glFunc} {}
        rename ::${glFunc}Standard $glFunc
    }
    if { $normalFlag } {
        return
    }
    set code \
        [format "
        if { \[__%sAvail\] } {
            if { %d } {
                %s \"%s \$args\"
            }
            eval %sStandard \$args
        } else {
            %s \">>> %s \$args (N/A in driver)\"
        }" \
        $glFunc $debugFlag $cmd $glFunc $glFunc $cmd $glFunc]
    
    uplevel "proc ${glFunc}Safe args { $code }"

    rename ::$glFunc ::${glFunc}Standard
    rename ::${glFunc}Safe ::$glFunc
}

# Create the widgets and bindings.
proc CreateWindow {} {
    global gDemo

    frame .fr
    pack .fr -expand 1 -fill both
    # Create the OpenGL widget.
    togl .fr.toglwin -width $gDemo(winWidth) -height $gDemo(winHeight) \
                     -swapinterval 0 \
                     -double true -depth true \
                     -createcommand CreateCallback \
                     -reshapecommand ReshapeCallback \
                     -displaycommand DisplayCallback 
    frame .fr.frBtns
    frame .fr.frDebug
    label .fr.info
    grid .fr.toglwin -row 0 -column 0 -sticky news
    grid .fr.frBtns  -row 1 -column 0 -sticky news
    grid .fr.frDebug -row 2 -column 0 -sticky news
    grid .fr.info    -row 3 -column 0 -sticky news
    grid rowconfigure .fr 0 -weight 1
    grid columnconfigure .fr 0 -weight 1
    wm title . "Tcl3D demo: OpenGL execution modes"

    labelframe .fr.frBtns.frModes -text "Execution modes"
    pack  .fr.frBtns.frModes -side left -padx 2
    radiobutton .fr.frBtns.frModes.normal -text "Normal" \
                 -variable gDemo(mode) -value "Normal" -command "tcl3dOglSetNormalMode PrintDebug"
    radiobutton .fr.frBtns.frModes.safe -text "Safe" \
                 -variable gDemo(mode) -value "Safe" -command "tcl3dOglSetSafeMode PrintDebug"
    radiobutton .fr.frBtns.frModes.debug -text "Debug" \
                 -variable gDemo(mode) -value "Debug" -command "tcl3dOglSetDebugMode PrintDebug"
    eval pack [winfo children .fr.frBtns.frModes] -side left \
               -anchor w -expand 1 -fill x

    labelframe .fr.frBtns.frMisc -text "Settings"
    pack  .fr.frBtns.frMisc -side left -padx 2
    checkbutton .fr.frBtns.frMisc.bad -text "Call $gDemo(badCmd)" \
                -variable gDemo(useBadCmd) \
                -indicatoron [tcl3dShowIndicator]
    tcl3dToolhelpAddBinding .fr.frBtns.frMisc.bad \
        "Switching on this flag and the normal mode will dump core."
    eval pack [winfo children .fr.frBtns.frMisc] -side left \
               -anchor w -expand 1 -fill x

    labelframe .fr.frBtns.frCmds -text "Commands"
    pack  .fr.frBtns.frCmds -side left -padx 2
    button .fr.frBtns.frCmds.clear -text "Clear" -command ClearDebug
    button .fr.frBtns.frCmds.body -text "Show" -command PrintProcBody
    button .fr.frBtns.frCmds.step -text "Step" -command NextStep
    checkbutton .fr.frBtns.frCmds.pause -text "Animate" \
                -variable gDemo(animStarted) -command Animate \
                -indicatoron [tcl3dShowIndicator]
    tcl3dToolhelpAddBinding .fr.frBtns.frCmds.clear \
        "Clear debug log window"
    tcl3dToolhelpAddBinding .fr.frBtns.frCmds.body \
        "Show body of OpenGL function glBegin in current mode"
    tcl3dToolhelpAddBinding .fr.frBtns.frCmds.step \
        "Advance one rotation step"
    tcl3dToolhelpAddBinding .fr.frBtns.frCmds.pause \
        "Startt/Stop animation"
    eval pack [winfo children .fr.frBtns.frCmds] -side left \
               -anchor w -expand 1 -fill x -padx 1

    set gDemo(out) [tcl3dCreateScrolledText .fr.frDebug "" \
                    -height 11 -borderwidth 1 -font $gDemo(listFont)]

    wm protocol . WM_DELETE_WINDOW "ExitProg"
    bind . <Key-Escape> "ExitProg"
}

# Get OpenGL execution mode at startup.
set gDemo(mode) [tcl3dOglGetMode]
set gDemo(initmode) $gDemo(mode)

CreateWindow

PrintInfo [tcl3dOglGetInfoString]

if { [file tail [info script]] eq [file tail $::argv0] } {
    # If started directly from tclsh or wish, then start animation.
    update
    StartAnimation
}
