# Lesson37.tcl
#
# Sami Hamlaoui's Cel-Shading Code
#
# Note: The original article for this code can be found at:
#       http://www.gamedev.net/reference/programming/features/celshading
#
# If You've Found This Code Useful, Please Let Me Know.
# Visit My Site At nehe.gamedev.net
#
# Modified for Tcl3D by Paul Obermeier 2006/08/22
# See www.tcl3d.org for the Tcl3D extension.

package require Img
package require tcl3d

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

# Determine the directory of this script.
set gDemo(scriptDir) [file dirname [info script]]

# Display mode.
set fullScreen false

# Window size.
set gDemo(winWidth)  640
set gDemo(winHeight) 480

set stopwatch [tcl3dNewSwatch]

set outlineDraw true                    ; # Flag To Draw The Outline
set outlineSmooth false                 ; # Flag To Anti-Alias The Lines
set outlineColor {0.0 0.0 0.0}          ; # Color Of The Lines
set outlineWidth 3.0                    ; # Width Of The Lines

set lightAngle [tcl3dVector GLfloat 3]  ; # The Direction Of The Light
set lightRotate false                   ; # Flag To See If We Rotate The Light

set modelAngle 0.0                      ; # Y-Axis Angle Of The Model

set polyNum 0                           ; # Number Of Polygons

set optimizedVersion true               ; # Flag to switch between optimized/simple C->Tcl conversion

set shaderTexture [tcl3dVector GLuint 1]; # Storage For One Texture

set TmpMatrix [tcl3dVector GLfloat 16]  ; # Temporary MATRIX Structure
set TmpVector [tcl3dVector GLfloat 3]   ; # Temporary VECTOR Structures
set TmpNormal [tcl3dVector GLfloat 3]   ; # Temporary VECTOR Structures

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

# Print info message into widget at the bottom of the window.
proc PrintTimeInfo { msg } {
    if { [winfo exists .fr.timeinfo] } {
        .fr.timeinfo configure -text $msg
    }
}

proc SetFullScreenMode { win } {
    set sh [winfo screenheight $win]
    set sw [winfo screenwidth  $win]

    wm minsize $win $sw $sh
    wm maxsize $win $sw $sh
    set fmtStr [format "%dx%d+0+0" $sw $sh]
    wm geometry $win $fmtStr
    wm overrideredirect $win 1
    focus -force $win
}

proc SetWindowMode { win w h } {
    set sh [winfo screenheight $win]
    set sw [winfo screenwidth  $win]

    wm minsize $win 10 10
    wm maxsize $win $sw $sh
    set fmtStr [format "%dx%d+0+25" $w $h]
    wm geometry $win $fmtStr
    wm overrideredirect $win 0
    focus -force $win
}

# Toggle between windowing and fullscreen mode.
proc ToggleWindowMode {} {
    if { $::fullScreen } {
        SetFullScreenMode .
        set ::fullScreen false
    } else {
        SetWindowMode . $::gDemo(winWidth) $::gDemo(winHeight)
        set ::fullScreen true
    }
}

proc GetElapsedSeconds {} {
    set currentTime [tcl3dLookupSwatch $::stopwatch]
    set sec [expr $currentTime - $::elapsedLastTime]
    set ::elapsedLastTime $currentTime
    return $sec
}

proc ToggleConversionMethod { toglwin } {
    set ::optimizedVersion [expr ! $::optimizedVersion]
    $toglwin postredisplay
}

proc ToggleOutlineSmooth { toglwin } {
    set ::outlineSmooth [expr ! $::outlineSmooth]
    $toglwin postredisplay
}

proc ToggleOutlineDraw { toglwin } {
    set ::outlineDraw [expr ! $::outlineDraw]
    $toglwin postredisplay
}

proc IncrOutlineWidth { toglwin val } {
    set ::outlineWidth [expr $::outlineWidth + $val]
    $toglwin postredisplay
}

# Reads The Contents Of The binary "model.txt" File.
# The file is built up of a simple header: The number of polygons (==triangles) of the model
# followed by the polygon data as a series of binary 32bit floats giving the normal vector
# and position of a vertex.
#
#               Vertex1                 Vertex2            Vertex3
# Polygon 1: (Nx,Ny,Nz)(Px,Py,Pz) (Nx,Ny,Nz)(Px,Py,Pz) (Nx,Ny,Nz)(Px,Py,Pz) 
# Polygon 2: (Nx,Ny,Nz)(Px,Py,Pz) (Nx,Ny,Nz)(Px,Py,Pz) (Nx,Ny,Nz)(Px,Py,Pz)
# ...

proc ReadMesh {} {
    set modelFileName [file join $::gDemo(scriptDir) "Data" "Model.txt"]
    set retVal [catch {set fp [open $modelFileName "r"]} err]    ; # Open The Model File
    if { $retVal != 0 } {
        error "Error reading model file $modelFileName ($err)"
    } else {
        fconfigure $fp -translation binary
        # Read The Header: Number Of Polygons (as an integer in Little Endian format)
        set polyStr [read $fp 4]
        binary scan $polyStr i ::polyNum

        # Allocate The Memory: One polygon is 3 vertices a 2 vectors (pos, nor) a 3 floats
        set numFloats [expr $::polyNum * 3 * 2 * 3]
        set ::polyData [tcl3dVector GLfloat $numFloats]

        # Now read all the data into a binary Tcl string and copy this data 1:1 into the
        # allocated tcl3dVector.
        set dataStr [read -nonewline $fp]
        tcl3dByteArray2Vector $dataStr $::polyData [expr $numFloats * 4] 0 0

        # For speed optimization, we copy the position data into an array of lists for faster
        # transmission (no conversion) to glVertex3fv in the display function.
        set indPos 3            ; # Vertex has normals (3 floats) first, then position (3 floats)
        for { set i 0 } { $i < $::polyNum } { incr i } { 
            for { set j 0 } { $j < 3 } { incr j } { 
                set posX [$::polyData get $indPos]
                set posY [$::polyData get [expr {$indPos +1}]]
                set posZ [$::polyData get [expr {$indPos +2}]]
                set ::polyList($i,$j) [list $posX $posY $posZ]

                incr indPos 6
            }
        }
        close $fp
    }
}


# Resize And Initialize The GL Window
proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
    set w [$toglwin width]
    set h [$toglwin height]

    glViewport 0 0 $w $h                ; # Reset The Current Viewport
    glMatrixMode GL_PROJECTION          ; # Select The Projection Matrix
    glLoadIdentity                      ; # Reset The Projection Matrix

    # Calculate The Aspect Ratio Of The Window
    gluPerspective 45.0 [expr double($w)/double($h)] 1.0 100.0

    glMatrixMode GL_MODELVIEW           ; # Select The Modelview Matrix
    glLoadIdentity                      ; # Reset The Modelview Matrix
    set ::gDemo(winWidth)  $w
    set ::gDemo(winHeight) $h
}

# All Setup For OpenGL Goes Here
proc CreateCallback { toglwin } {
    set shaderData [tcl3dVector GLfloat [expr 32*3]]            ; # Storate For The 96 Shader Values

    # Start Of User Initialization
    glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST ; # Really Nice perspective calculations
    
    glClearColor 0.7 0.7 0.7 0.0                    ; # Light Grey Background
    glClearDepth 1.0                                ; # Depth Buffer Setup

    glEnable GL_DEPTH_TEST                          ; # Enable Depth Testing
    glDepthFunc GL_LESS                             ; # The Type Of Depth Test To Do

    glShadeModel GL_SMOOTH                          ; # Enables Smooth Color Shading
    glDisable GL_LINE_SMOOTH                        ; # Initially Disable Line Smoothing

    glEnable GL_CULL_FACE                           ; # Enable OpenGL Face Culling

    glDisable GL_LIGHTING                           ; # Disable OpenGL Lighting

    set shaderFileName [file join $::gDemo(scriptDir) "Data" "Shader.txt"]
    set retVal [catch {set fp [open $shaderFileName "r"]} err]    ; # Open The Shader File
    if { $retVal != 0 } {
        error "Error reading shader file $shaderFileName ($err)"
    } else {
        # Loop Though The 32 Greyscale Values
        for { set i 0 } { $i < 32 } { incr i } { 
            if { [eof $fp] } {
                # Check For The End Of The File
                break;
            }

            gets $fp line                   ; # Get The Current Line
            scan $line "%f" val

            # Copy Over The Value
            $shaderData set [expr $i*3 +0] $val
            $shaderData set [expr $i*3 +1] $val
            $shaderData set [expr $i*3 +2] $val
        }
        close $fp
    }

    glGenTextures 1 $::shaderTexture    ; # Get A Free Texture ID

    # Bind This Texture. From Now On It Will Be 1D
    glBindTexture GL_TEXTURE_1D [$::shaderTexture get 0]

    # For Crying Out Loud Don't Let OpenGL Use Bi/Trilinear Filtering!
    glTexParameteri GL_TEXTURE_1D GL_TEXTURE_MAG_FILTER $::GL_NEAREST 
    glTexParameteri GL_TEXTURE_1D GL_TEXTURE_MIN_FILTER $::GL_NEAREST

    glTexImage1D GL_TEXTURE_1D 0 $::GL_RGB 32 0 GL_RGB GL_FLOAT $shaderData

    $::lightAngle set 0  0.0            ; # Set The X Direction
    $::lightAngle set 1  0.0            ; # Set The Y Direction
    $::lightAngle set 2  1.0            ; # Set The Z Direction

    tcl3dVec3fNormalize $::lightAngle   ; # Normalize The Light Direction

    ReadMesh

    tcl3dResetSwatch $::stopwatch
    set ::elapsedLastTime [tcl3dLookupSwatch $::stopwatch]
}

# Here's Where We Do All The Drawing
proc DisplayCallback { toglwin } {

    # Update Angle Based On The Clock
    set ::modelAngle [expr $::modelAngle + [GetElapsedSeconds] * 100.0]

    set t0 [tcl3dLookupSwatch $::stopwatch]
    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

    # Check To See If We Want Anti-Aliased Lines
    if { $::outlineSmooth } {
        glHint GL_LINE_SMOOTH_HINT GL_NICEST        ; # Use The Good Calculations
        glEnable GL_LINE_SMOOTH                     ; # Enable Anti-Aliasing
    } else {
        # We Don't Want Smooth Lines
        glDisable GL_LINE_SMOOTH                    ; # Disable Anti-Aliasing
    }

    glTranslatef 0.0 0.0 -2.0                       ; # Move 2 Units Away From The Screen
    glRotatef $::modelAngle 0.0 1.0 0.0             ; # Rotate The Model On It's Y-Axis

    glGetFloatv GL_MODELVIEW_MATRIX $::TmpMatrix    ; # Get The Generated Matrix

    # Cel-Shading Code
    glEnable GL_TEXTURE_1D                          ; # Enable 1D Texturing
    glBindTexture GL_TEXTURE_1D [$::shaderTexture get 0]    ; # Bind Our Texture

    glColor3f 1.0 1.0 1.0                           ; # Set The Color Of The Model

    glBegin GL_TRIANGLES
        # Loop Through Each Polygon And Each Vertex
        set indNor 0        ; # Vertex has normals (3 floats) first, then position (3 floats)
        set indPos 3
        for { set i 0 } { $i < $::polyNum } { incr i } {
            for { set j 0 } { $j < 3 } { incr j } {
                # Rotate This By The Matrix
                if { $::optimizedVersion } {
                    # Just use a pointer into the normal/position vector.
                    tcl3dMatfTransformVector [GLfloat_ind $::polyData $indNor] $::TmpMatrix $::TmpVector
                } else {
                    # Build up a new temp. vector like in C. Very slow.
                    $::TmpNormal set 0 [$::polyData get $indNor]
                    $::TmpNormal set 1 [$::polyData get [expr {$indNor+1}]]
                    $::TmpNormal set 2 [$::polyData get [expr {$indNor+2}]]
                    tcl3dMatfTransformVector $::TmpNormal $::TmpMatrix $::TmpVector
                }

                tcl3dVec3fNormalize $::TmpVector                                ; # Normalize The New Normal

                set TmpShade [tcl3dVec3fDotProduct $::TmpVector $::lightAngle]  ; # Calculate The Shade Value

                if { $TmpShade < 0.0 } {
                    set TmpShade 0.0                    ; # Clamp The Value to 0 If Negative
                }

                glTexCoord1f $TmpShade                  ; # Set The Texture Co-ordinate As The Shade Value

                if { $::optimizedVersion } {
                    # As the vertex positions do not change, we can use the array of lists
                    # precalculated in the CreateCallback.
                    glVertex3fv $::polyList($i,$j)          ; # Send The Vertex Position
                } else {
                    # glVertex3fv needs a Tcl list as argument. Position data is in
                    # a vector, so we cannot use it directly.
                    set posX [$::polyData get $indPos]
                    set posY [$::polyData get [expr {$indPos+1}]]
                    set posZ [$::polyData get [expr {$indPos+2}]]
                    glVertex3f $posX $posY $posZ          ; # Send The Vertex Position
                }

                incr indNor 6
                incr indPos 6
            }
        }
    glEnd
    set t1 [tcl3dLookupSwatch $::stopwatch]

    glDisable GL_TEXTURE_1D

    # Outline Code
    if { $::outlineDraw } {
        glEnable GL_BLEND
        glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA

        glPolygonMode GL_BACK GL_LINE       ; # Draw Backfacing Polygons As Wireframes
        glLineWidth $::outlineWidth         ; # Set The Line Width

        glCullFace GL_FRONT                 ; # Don't Draw Any Front-Facing Polygons

        glDepthFunc GL_LEQUAL               ; # Change The Depth Mode

        glColor3fv $::outlineColor          ; # Set The Outline Color

        glBegin GL_TRIANGLES
            set indPos 3
            # Loop Through Each Polygon And Each Vertex
            for { set i 0 } { $i < $::polyNum } { incr i } { 
                for { set j 0 } { $j < 3 } { incr j } { 
                    if { $::optimizedVersion } {
                        # As the vertex positions do not change, we can use the array of lists
                        # precalculated in the CreateCallback.
                        glVertex3fv $::polyList($i,$j)          ; # Send The Vertex Position
                    } else {
                        # glVertex3fv needs a Tcl list as argument. Position data is in
                        # a vector, so we cannot use it directly.
                        set posX [$::polyData get $indPos]
                        set posY [$::polyData get [expr {$indPos+1}]]
                        set posZ [$::polyData get [expr {$indPos+2}]]
                        glVertex3f $posX $posY $posZ          ; # Send The Vertex Position
                    }
                    incr indPos 6
                }
            }
        glEnd

        glDepthFunc GL_LESS                 ; # Reset The Depth-Testing Mode
        glCullFace GL_BACK                  ; # Reset The Face To Be Culled
        glPolygonMode GL_BACK GL_FILL       ; # Reset Back-Facing Polygon Drawing Mode
        glDisable GL_BLEND                  ; # Disable Blending
    }
    set t2 [tcl3dLookupSwatch $::stopwatch]
    set msg [format "Draw: %d msec Outline: %d msec" [expr int (($t1-$t0)*1000.0)] [expr int  (($t2-$t1)*1000.0)]]
    PrintTimeInfo $msg
    $toglwin swapbuffers
}

proc Animate {} {
    .fr.toglwin postredisplay
    set ::animateId [tcl3dAfterIdle Animate]
}

proc StartAnimation {} {
    tcl3dStartSwatch $::stopwatch
    if { ! [info exists ::animateId] } {
        Animate
    }
}

proc StopAnimation {} {
    tcl3dStopSwatch $::stopwatch
    if { [info exists ::animateId] } {
        after cancel $::animateId 
        unset ::animateId
    }
}

proc Cleanup {} {
    if { [info exists ::shaderTexture] } {
        glDeleteTextures 1 [$::shaderTexture get 0] ; # Delete The Shader Texture
        unset ::shaderTexture
    }
    if { [info exists ::polyData] } {
        $::polyData delete                          ; # Delete The Polygon Data
        unset ::polyData
    }
}

# 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) \
                     -double true -depth true \
                     -createcommand CreateCallback \
                     -reshapecommand ReshapeCallback \
                     -displaycommand DisplayCallback 
    listbox .fr.usage -font $::listFont -height 7
    label   .fr.timeinfo -bg white
    label   .fr.info
    grid .fr.toglwin  -row 0 -column 0 -sticky news
    grid .fr.usage    -row 1 -column 0 -sticky news
    grid .fr.timeinfo -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: Sami Hamlaoui's Cel-Shading Tutorial (Lesson 37)"

    # Watch For ESC Key And Quit Messages
    wm protocol . WM_DELETE_WINDOW "ExitProg"
    bind . <Key-Escape> "ExitProg"
    bind . <Key-F1>     "ToggleWindowMode"
    bind . <Key-o>      "ToggleConversionMethod .fr.toglwin"
    bind . <Key-1>      "ToggleOutlineDraw .fr.toglwin"
    bind . <Key-2>      "ToggleOutlineSmooth .fr.toglwin"
    bind . <Key-Up>     "IncrOutlineWidth .fr.toglwin 1"
    bind . <Key-Down>   "IncrOutlineWidth .fr.toglwin -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-F1      Toggle window mode"
    .fr.usage insert end "Key-o       Toggle optimized vs. simple version"
    .fr.usage insert end "Key-1       Toggle outline draw"
    .fr.usage insert end "Key-2       Toggle outline smooth"
    .fr.usage insert end "Key-Up|Down Increase|Decrease outline width"
    .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
}
