# Lesson27.tcl
#
# "Banu Octavian & NeHe's Shadow Casting Tutorial"
#
# This code has been created by Banu Octavian aka Choko - 20 may 2000
# and uses NeHe tutorials as a starting point (window initialization,
# texture loading, GL initialization and code for keypresses) - very good
# tutorials, Jeff. If anyone is interested about the presented algorithm
# please e-mail me at boct@romwest.ro
# Attention!!! This code is not for beginners.
#
# Modified for Tcl3D by Paul Obermeier 2007/02/27
# See www.tcl3d.org for the Tcl3D extension.

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]]

# Display mode.
set gDemo(fullScreen) true

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

set gDemo(xrot)   0.0                   ; # X Rotation & X Speed
set gDemo(xspeed) 0.0                   ; # X Rotation & X Speed
set gDemo(yrot)   0.0                   ; # Y Rotation & Y Speed
set gDemo(yspeed) 0.5                   ; # Y Rotation & Y Speed

set LightPos { 0.0  5.0 -4.0 1.0}       ; # Light Position
set LightAmb { 0.2  0.2  0.2 1.0}       ; # Ambient Light Values
set LightDif { 0.6  0.6  0.6 1.0}       ; # Diffuse Light Values
set LightSpc {-0.2 -0.2 -0.2 1.0}       ; # Specular Light Values

set MatAmb {0.4 0.4 0.4 1.0}            ; # Material - Ambient Values
set MatDif {0.2 0.6 0.9 1.0}            ; # Material - Diffuse Values
set MatSpc {0.0 0.0 0.0 1.0}            ; # Material - Specular Values
set MatShn {0.0}                        ; # Material - Shininess

set ObjPos    {-2.0 -2.0 -5.0}          ; # Object Position
set SpherePos {-4.0 -5.0 -6.0}          ; # Sphere Position

# 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 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 { $::gDemo(fullScreen) } {
        SetFullScreenMode .
        set ::gDemo(fullScreen) false
    } else {
        SetWindowMode . $::gDemo(winWidth) $::gDemo(winHeight)
        set ::gDemo(fullScreen) true
    }
}

proc Reset {} {
    global gDemo

    set gDemo(xrot)    0.0
    set gDemo(yrot)    0.0
    set gDemo(xspeed)  0.0
    set gDemo(yspeed)  0.0
    set ::ObjPos    {-2.0 -2.0 -5.0}
    set ::SpherePos {-4.0 -5.0 -6.0}
    .fr.toglwin postredisplay
}

# Set x speed.
proc SetXSpeed { val } {
    set ::gDemo(xspeed) [expr {$::gDemo(xspeed) + $val}]
    .fr.toglwin postredisplay
}

# Set y speed.
proc SetYSpeed { val } {
    set ::gDemo(yspeed) [expr {$::gDemo(yspeed) + $val}]
    .fr.toglwin postredisplay
}

# Set x light position.
proc SetXLightPos { val } {
    lset ::LightPos 0 [expr {[lindex $::LightPos 0] + $val}]
    .fr.toglwin postredisplay
}

# Set y light position.
proc SetYLightPos { val } {
    lset ::LightPos 1 [expr {[lindex $::LightPos 1] + $val}]
    .fr.toglwin postredisplay
}

# Set z light position.
proc SetZLightPos { val } {
    lset ::LightPos 2 [expr {[lindex $::LightPos 2] + $val}]
    .fr.toglwin postredisplay
}

# Set x object position.
proc SetXObjectPos { val } {
    lset ::ObjPos 0 [expr {[lindex $::ObjPos 0] + $val}]
    .fr.toglwin postredisplay
}

# Set y object position.
proc SetYObjectPos { val } {
    lset ::ObjPos 1 [expr {[lindex $::ObjPos 1] + $val}]
    .fr.toglwin postredisplay
}

# Set z object position.
proc SetZObjectPos { val } {
    lset ::ObjPos 2 [expr {[lindex $::ObjPos 2] + $val}]
    .fr.toglwin postredisplay
}

# Set x sphere position.
proc SetXSpherePos { val } {
    lset ::SpherePos 0 [expr {[lindex $::SpherePos 0] + $val}]
    .fr.toglwin postredisplay
}

# Set y sphere position.
proc SetYSpherePos { val } {
    lset ::SpherePos 1 [expr {[lindex $::SpherePos 1] + $val}]
    .fr.toglwin postredisplay
}

# Set z sphere position.
proc SetZSpherePos { val } {
    lset ::SpherePos 2 [expr {[lindex $::SpherePos 2] + $val}]
    .fr.toglwin postredisplay
}

proc readstr { fp } {
    while { 1 } {
        gets $fp line
        # Empty line or comment: Read next line
        if { ($line eq "") || ([string index $line 0] eq "/") } {
            continue
        } else {
            break
        }
    }
    return $line
}

# Load object
proc ReadObject { name o } {
    global gObjs

    set fileName [file join $::gDemo(scriptDir) "Data" $name]
    set filein [open $fileName r]

    # points
    set line [readstr $filein]
    scan $line "%d" nPoints
    set gObjs($o,nPoints) $nPoints
    for { set i 1 } { $i <= $nPoints } { incr i } {
        set line [readstr $filein]
        scan $line "%f %f %f" x y z
        set gObjs($o,points,$i) [list $x $y $z]
    }
    # planes
    set line [readstr $filein]
    scan $line "%d" nPlanes
    set gObjs($o,nPlanes) $nPlanes
    for { set i 0 } { $i < $nPlanes } { incr i } {
        set line [readstr $filein]
        scan $line "%d %d %d  %f %f %f  %f %f %f  %f %f %f" \
                    p0 p1 p2  x0 y0 z0  x1 y1 z1  x2 y2 z2
        set gObjs($o,planes,$i,p,0) $p0
        set gObjs($o,planes,$i,p,1) $p1
        set gObjs($o,planes,$i,p,2) $p2

        set gObjs($o,planes,$i,normals,0) [list $x0 $y0 $z0]
        set gObjs($o,planes,$i,normals,1) [list $x1 $y1 $z1]
        set gObjs($o,planes,$i,normals,2) [list $x2 $y2 $z2]
    }
    close $filein
}

# Connectivity procedure
# Based on Gamasutra's article. Hard to explain here
proc SetConnectivity { o } {
    global gObjs

    set nPlanes $gObjs($o,nPlanes)
    set nPlanes1 [expr $nPlanes-1]

    for { set i 0 } { $i < $nPlanes } { incr i } {
        for { set ki 0 } { $ki < 3 } { incr ki } {
            set gObjs($o,planes,$i,neigh,$ki) 0
        }
    }

    for { set i 0 } { $i < $nPlanes1 } { incr i } {
        for { set j [expr {$i+1}] } { $j < $nPlanes } { incr j } {
            for { set ki 0 } { $ki < 3 } { incr ki } {
                if { ! $gObjs($o,planes,$i,neigh,$ki) } {
                    for { set kj 0 } { $kj < 3 } { incr kj } {

                        set p1i $ki
                        set p1j $kj
                        set p2i [expr {($ki+1)%3}]
                        set p2j [expr {($kj+1)%3}]

                        set p1i $gObjs($o,planes,$i,p,$p1i)
                        set p2i $gObjs($o,planes,$i,p,$p2i)
                        set p1j $gObjs($o,planes,$j,p,$p1j)
                        set p2j $gObjs($o,planes,$j,p,$p2j)

                        set P1i [expr {(($p1i+$p2i)-abs($p1i-$p2i))/2}]
                        set P2i [expr {(($p1i+$p2i)+abs($p1i-$p2i))/2}]
                        set P1j [expr {(($p1j+$p2j)-abs($p1j-$p2j))/2}]
                        set P2j [expr {(($p1j+$p2j)+abs($p1j-$p2j))/2}]

                        if { ($P1i==$P1j) && ($P2i==$P2j) } {
                            # they are neighbours
                            set gObjs($o,planes,$i,neigh,$ki) [expr {$j+1}];     
                            set gObjs($o,planes,$j,neigh,$kj) [expr {$i+1}];     
                        }
                    }
                }
            }
        }
    }
}

# function for computing a plane equation given 3 points
proc CalcPlane { o plane } {
    global gObjs

    for { set i 0 } { $i < 3 } { incr i } {
        set ind [expr {$i + 1}]
        set pInd $gObjs($o,planes,$plane,p,$i)
        set v($ind) $gObjs($o,points,$pInd)
    }

    # a = v1.y*(v2.z-v3.z) + v2.y*(v3.z-v1.z) + v3.y*(v1.z-v2.z);
    # b = v1.z*(v2.x-v3.x) + v2.z*(v3.x-v1.x) + v3.z*(v1.x-v2.x);
    # c = v1.x*(v2.y-v3.y) + v2.x*(v3.y-v1.y) + v3.x*(v1.y-v2.y);
    # d =-( v1.x*(v2.y*v3.z - v3.y*v2.z) +
    #       v2.x*(v3.y*v1.z - v1.y*v3.z) +
    #       v3.x*(v1.y*v2.z - v2.y*v1.z) );
    set gObjs($o,planes,$plane,PlaneEq,a) [expr { \
        [lindex $v(1) 1] * ([lindex $v(2) 2] - [lindex $v(3) 2]) + \
        [lindex $v(2) 1] * ([lindex $v(3) 2] - [lindex $v(1) 2]) + \
        [lindex $v(3) 1] * ([lindex $v(1) 2] - [lindex $v(2) 2]) }]
    set gObjs($o,planes,$plane,PlaneEq,b) [expr { \
        [lindex $v(1) 2] * ([lindex $v(2) 0] - [lindex $v(3) 0]) + \
        [lindex $v(2) 2] * ([lindex $v(3) 0] - [lindex $v(1) 0]) + \
        [lindex $v(3) 2] * ([lindex $v(1) 0] - [lindex $v(2) 0]) }]
    set gObjs($o,planes,$plane,PlaneEq,c) [expr { \
        [lindex $v(1) 0] * ([lindex $v(2) 1] - [lindex $v(3) 1]) + \
        [lindex $v(2) 0] * ([lindex $v(3) 1] - [lindex $v(1) 1]) + \
        [lindex $v(3) 0] * ([lindex $v(1) 1] - [lindex $v(2) 1]) }]
    set gObjs($o,planes,$plane,PlaneEq,d) [expr { \
        -1.0 * ( [lindex $v(1) 0] * ([lindex $v(2) 1]*[lindex $v(3) 2] - [lindex $v(3) 1]*[lindex $v(2) 2]) +
                 [lindex $v(2) 0] * ([lindex $v(3) 1]*[lindex $v(1) 2] - [lindex $v(1) 1]*[lindex $v(3) 2]) +
                 [lindex $v(3) 0] * ([lindex $v(1) 1]*[lindex $v(2) 2] - [lindex $v(2) 1]*[lindex $v(1) 2]) ) }]
}

# Procedure for drawing the object - very simple
proc DrawGLObject { o } {
    global gObjs

    glBegin GL_TRIANGLES
    for { set i 0 } { $i < $gObjs($o,nPlanes) } { incr i } {
        for { set j 0 } { $j < 3 } { incr j } {
            glNormal3fv $gObjs($o,planes,$i,normals,$j)
            set ind $gObjs($o,planes,$i,p,$j)
            glVertex3fv $gObjs($o,points,$ind)
        }
    }
    glEnd
}

proc CastShadow { o lp } {
    global gObjs

    # set visual parameter
    for { set i 0 } { $i < $gObjs($o,nPlanes) } { incr i } {
        # check to see if light is in front or behind the plane (face plane)
        set side [expr { \
                 $gObjs($o,planes,$i,PlaneEq,a) * [lindex $lp 0] + \
                 $gObjs($o,planes,$i,PlaneEq,b) * [lindex $lp 1] + \
                 $gObjs($o,planes,$i,PlaneEq,c) * [lindex $lp 2] + \
                 $gObjs($o,planes,$i,PlaneEq,d) * [lindex $lp 3] }]
        if { $side > 0.0 } {
            set gObjs($o,planes,$i,visible) true
        } else {
            set gObjs($o,planes,$i,visible) false
        }
    }

    glDisable GL_LIGHTING
    glDepthMask GL_FALSE
    glDepthFunc GL_LEQUAL

    glEnable GL_STENCIL_TEST
    glColorMask 0 0 0 0
    glStencilFunc GL_ALWAYS 1 0xffffffff

    # first pass, stencil operation decreases stencil value
    glFrontFace GL_CCW
    glStencilOp GL_KEEP GL_KEEP GL_INCR
    for { set i 0 } { $i < $gObjs($o,nPlanes) } { incr i } {
        if { $gObjs($o,planes,$i,visible) } {
            for { set j 0 } { $j < 3 } { incr j } {
                set k $gObjs($o,planes,$i,neigh,$j)
                set k1 [expr { $k - 1 }]
                if { (!$k) || (! $gObjs($o,planes,$k1,visible)) } {
                    # here we have an edge, we must draw a polygon
                    set p1 $gObjs($o,planes,$i,p,$j)
                    set jj [expr { ($j+1)%3 }]
                    set p2 $gObjs($o,planes,$i,p,$jj)

                    # calculate the length of the vector
                    set v1_x [expr { ([lindex $gObjs($o,points,$p1) 0] - [lindex $lp 0])*100 }]
                    set v1_y [expr { ([lindex $gObjs($o,points,$p1) 1] - [lindex $lp 1])*100 }]
                    set v1_z [expr { ([lindex $gObjs($o,points,$p1) 2] - [lindex $lp 2])*100 }]

                    set v2_x [expr { ([lindex $gObjs($o,points,$p2) 0] - [lindex $lp 0])*100 }]
                    set v2_y [expr { ([lindex $gObjs($o,points,$p2) 1] - [lindex $lp 1])*100 }]
                    set v2_z [expr { ([lindex $gObjs($o,points,$p2) 2] - [lindex $lp 2])*100 }]

                    # draw the polygon
                    glBegin GL_TRIANGLE_STRIP
                    glVertex3fv $gObjs($o,points,$p1)
                    glVertex3f [expr { [lindex $gObjs($o,points,$p1) 0] + $v1_x }] \
                               [expr { [lindex $gObjs($o,points,$p1) 1] + $v1_y }] \
                               [expr { [lindex $gObjs($o,points,$p1) 2] + $v1_z }]

                    glVertex3fv $gObjs($o,points,$p2)
                    glVertex3f [expr { [lindex $gObjs($o,points,$p2) 0] + $v2_x }] \
                               [expr { [lindex $gObjs($o,points,$p2) 1] + $v2_y }] \
                               [expr { [lindex $gObjs($o,points,$p2) 2] + $v2_z }]
                    glEnd
                }
            }
        }
    }

    # second pass, stencil operation increases stencil value
    glFrontFace GL_CW
    glStencilOp GL_KEEP GL_KEEP GL_DECR
    for { set i 0 } { $i < $gObjs($o,nPlanes) } { incr i } {
        if { $gObjs($o,planes,$i,visible) } {
            for { set j 0 } { $j < 3 } { incr j } {
                set k $gObjs($o,planes,$i,neigh,$j)
                set k1 [expr { $k - 1 }]
                if { (!$k) || (! $gObjs($o,planes,$k1,visible)) } {
                    # here we have an edge, we must draw a polygon
                    set p1 $gObjs($o,planes,$i,p,$j)
                    set jj [expr { ($j+1)%3 }]
                    set p2 $gObjs($o,planes,$i,p,$jj)

                    # calculate the length of the vector
                    set v1_x [expr { ([lindex $gObjs($o,points,$p1) 0] - [lindex $lp 0])*100 }]
                    set v1_y [expr { ([lindex $gObjs($o,points,$p1) 1] - [lindex $lp 1])*100 }]
                    set v1_z [expr { ([lindex $gObjs($o,points,$p1) 2] - [lindex $lp 2])*100 }]

                    set v2_x [expr { ([lindex $gObjs($o,points,$p2) 0] - [lindex $lp 0])*100 }]
                    set v2_y [expr { ([lindex $gObjs($o,points,$p2) 1] - [lindex $lp 1])*100 }]
                    set v2_z [expr { ([lindex $gObjs($o,points,$p2) 2] - [lindex $lp 2])*100 }]

                    # draw the polygon
                    glBegin GL_TRIANGLE_STRIP
                    glVertex3fv $gObjs($o,points,$p1)
                    glVertex3f [expr { [lindex $gObjs($o,points,$p1) 0] + $v1_x }] \
                               [expr { [lindex $gObjs($o,points,$p1) 1] + $v1_y }] \
                               [expr { [lindex $gObjs($o,points,$p1) 2] + $v1_z }]

                    glVertex3fv $gObjs($o,points,$p2)
                    glVertex3f [expr { [lindex $gObjs($o,points,$p2) 0] + $v2_x }] \
                               [expr { [lindex $gObjs($o,points,$p2) 1] + $v2_y }] \
                               [expr { [lindex $gObjs($o,points,$p2) 2] + $v2_z }]
                    glEnd
                }
            }
        }
    }

    glFrontFace GL_CCW
    glColorMask 1 1 1 1

    # draw a shadowing rectangle covering the entire screen
    glColor4f 0.0 0.0 0.0 0.4
    glEnable GL_BLEND
    glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
    glStencilFunc GL_NOTEQUAL 0 0xffffffff
    glStencilOp GL_KEEP GL_KEEP GL_KEEP
    glPushMatrix
    glLoadIdentity
    glBegin GL_TRIANGLE_STRIP
    glVertex3f -0.1  0.1 -0.10
    glVertex3f -0.1 -0.1 -0.10
    glVertex3f  0.1  0.1 -0.10
    glVertex3f  0.1 -0.1 -0.10
    glEnd
    glPopMatrix
    glDisable GL_BLEND

    glDepthFunc GL_LEQUAL
    glDepthMask GL_TRUE
    glEnable GL_LIGHTING
    glDisable GL_STENCIL_TEST
    glShadeModel GL_SMOOTH
}

# 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)] 0.001 100.0

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

# Initialize Objects
proc InitGLObjects {} {
    global gObjs

    # ReadObject "Object.txt" obj                ; # Read Object2 Into Object named obj
    # ReadObject "Object1.txt" obj               ; # Read Object2 Into Object named obj
    ReadObject "Object2.txt" obj                 ; # Read Object2 Into Object named obj

    SetConnectivity obj                          ; # Set Face To Face Connectivity

    # Loop Through All Object Planes
    for { set i 0 } { $i < $gObjs(obj,nPlanes) } { incr i } {
        CalcPlane obj $i                         ; # Compute Plane Equations For All Faces
    }
}

# All Setup For OpenGL Goes Here
proc CreateCallback { toglwin } {
    InitGLObjects                                     ; # Function For Initializing Our Object(s)
    glShadeModel GL_SMOOTH                            ; # Enable Smooth Shading
    glClearColor 0.0 0.0 0.0 0.5                      ; # Black Background
    glClearDepth 1.0                                  ; # Depth Buffer Setup
    glClearStencil 0                                  ; # Stencil Buffer Setup
    glEnable GL_DEPTH_TEST                            ; # Enables Depth Testing
    glDepthFunc GL_LEQUAL                             ; # The Type Of Depth Testing To Do
    glHint GL_PERSPECTIVE_CORRECTION_HINT  GL_NICEST  ; # Really Nice Perspective Calculations

    glLightfv GL_LIGHT1  GL_POSITION $::LightPos      ; # Set Light1 Position
    glLightfv GL_LIGHT1  GL_AMBIENT  $::LightAmb      ; # Set Light1 Ambience
    glLightfv GL_LIGHT1  GL_DIFFUSE  $::LightDif      ; # Set Light1 Diffuse
    glLightfv GL_LIGHT1  GL_SPECULAR $::LightSpc      ; # Set Light1 Specular
    glEnable GL_LIGHT1                                ; # Enable Light1
    glEnable GL_LIGHTING                              ; # Enable Lighting

    glMaterialfv GL_FRONT  GL_AMBIENT   $::MatAmb     ; # Set Material Ambience
    glMaterialfv GL_FRONT  GL_DIFFUSE   $::MatDif     ; # Set Material Diffuse
    glMaterialfv GL_FRONT  GL_SPECULAR  $::MatSpc     ; # Set Material Specular
    glMaterialfv GL_FRONT  GL_SHININESS $::MatShn     ; # Set Material Shininess

    glCullFace GL_BACK                                ; # Set Culling Face To Back Face
    glEnable GL_CULL_FACE                             ; # Enable Culling
    glClearColor 0.1 1.0 0.5 1.0                      ; # Set Clear Color (Greenish Color)

    set ::quadric [gluNewQuadric]                     ; # Initialize Quadratic
    gluQuadricNormals $::quadric GL_SMOOTH            ; # Enable Smooth Normal Generation
    gluQuadricTexture $::quadric GL_FALSE             ; # Disable Auto Texture Coords
}

# Draw The Room (Box)
proc DrawGLRoom {} {
    glBegin GL_QUADS ;                               # Begin Drawing Quads
        # Floor
        glNormal3f 0.0  1.0  0.0 ;                   # Normal Pointing Up
        glVertex3f -10.0 -10.0 -20.0 ;               # Back Left
        glVertex3f -10.0 -10.0  20.0 ;               # Front Left
        glVertex3f  10.0 -10.0  20.0 ;               # Front Right
        glVertex3f  10.0 -10.0 -20.0 ;               # Back Right
        # Ceiling
        glNormal3f 0.0 -1.0  0.0 ;                   # Normal Point Down
        glVertex3f -10.0  10.0  20.0 ;               # Front Left
        glVertex3f -10.0  10.0 -20.0 ;               # Back Left
        glVertex3f  10.0  10.0 -20.0 ;               # Back Right
        glVertex3f  10.0  10.0  20.0 ;               # Front Right
        # Front Wall
        glNormal3f 0.0  0.0  1.0 ;                   # Normal Pointing Away From Viewer
        glVertex3f -10.0  10.0 -20.0 ;               # Top Left
        glVertex3f -10.0 -10.0 -20.0 ;               # Bottom Left
        glVertex3f  10.0 -10.0 -20.0 ;               # Bottom Right
        glVertex3f  10.0  10.0 -20.0 ;               # Top Right
        # Back Wall
        glNormal3f 0.0  0.0 -1.0 ;                   # Normal Pointing Towards Viewer
        glVertex3f  10.0  10.0  20.0 ;               # Top Right
        glVertex3f  10.0 -10.0  20.0 ;               # Bottom Right
        glVertex3f -10.0 -10.0  20.0 ;               # Bottom Left
        glVertex3f -10.0  10.0  20.0 ;               # Top Left
        # Left Wall
        glNormal3f 1.0  0.0  0.0 ;                   # Normal Pointing Right
        glVertex3f -10.0  10.0  20.0 ;               # Top Front
        glVertex3f -10.0 -10.0  20.0 ;               # Bottom Front
        glVertex3f -10.0 -10.0 -20.0 ;               # Bottom Back
        glVertex3f -10.0  10.0 -20.0 ;               # Top Back
        # Right Wall
        glNormal3f -1.0  0.0  0.0 ;                  # Normal Pointing Left
        glVertex3f  10.0  10.0 -20.0 ;               # Top Back
        glVertex3f  10.0 -10.0 -20.0 ;               # Bottom Back
        glVertex3f  10.0 -10.0  20.0 ;               # Bottom Front
        glVertex3f  10.0  10.0  20.0 ;               # Top Front
    glEnd ;                                          # Done Drawing Quads
}

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

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

    set Minv [tcl3dVector GLfloat 16]                  ; # Holds The Inverted Modelview Matrix
    set wlpList [list 0.0 0.0 0.0 1.0]

    # Clear Color Buffer, Depth Buffer, Stencil Buffer
    glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT | $::GL_STENCIL_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                                     ; # Reset Modelview Matrix
    glTranslatef 0.0 0.0 -20.0                         ; # Zoom Into Screen 20 Units
    glLightfv GL_LIGHT1 GL_POSITION $::LightPos        ; # Position Light1

    # Position The Sphere
    glTranslatef [lindex $::SpherePos 0] \
                 [lindex $::SpherePos 1] \
                 [lindex $::SpherePos 2] 
    gluSphere $::quadric 1.5 32 16                     ; # Draw The Sphere

    # calculate light's position relative to local coordinate system
    # dunno if this is the best way to do it, but it actually works
    # if u find another aproach, let me know ;)

    # we build the inversed matrix by doing all the actions in reverse order
    # and with reverse parameters (notice -xrot, -yrot, -ObjPos[], etc.)
    glLoadIdentity                                     ; # Reset Matrix
    glRotatef [expr {-1.0 * $gDemo(yrot)}] 0.0 1.0 0.0 ; # Rotate By -yrot On Y Axis
    glRotatef [expr {-1.0 * $gDemo(xrot)}] 1.0 0.0 0.0 ; # Rotate By -xrot On X Axis
    glGetFloatv GL_MODELVIEW_MATRIX $Minv              ; # Retrieve ModelView Matrix (Stores In Minv)
    set lp [tcl3dVectorFromList GLfloat $::LightPos]   ; # Store Light Position In lp vector
    tcl3dMatfTransformPoint $lp $Minv $lp              ; # We Store Rotated Light Vector In lp vector

    # Move Negative On All Axis Based On ObjPos[] Values (X, Y, Z)
    glTranslatef [expr { -1.0 * [lindex $::ObjPos 0]}] \
                 [expr { -1.0 * [lindex $::ObjPos 1]}] \
                 [expr { -1.0 * [lindex $::ObjPos 2]}]
    glGetFloatv GL_MODELVIEW_MATRIX $Minv              ; # Retrieve ModelView Matrix From Minv
    set wlp [tcl3dVectorFromList GLfloat $wlpList]     ; # Store World Local Coord In wlp vector
    tcl3dMatfTransformPoint $wlp $Minv $wlp            ; # We Store Rotated Light Vector In 'lp' Array
                                                         # Local Coord. System In 'wlp' Array

    # Adding These Two Gives Us The Position Of The Light Relative To The Local Coordinate System
    set lpList [list \
                   [expr {[$lp get 0] + [$wlp get 0]}] \
                   [expr {[$lp get 1] + [$wlp get 1]}] \
                   [expr {[$lp get 2] + [$wlp get 2]}] \
                   0.0]

    glColor4f 0.7 0.4 0.0 1.0                          ; # Set Color To An Orange
    glLoadIdentity                                     ; # Reset Modelview Matrix
    glTranslatef 0.0 0.0 -20.0                         ; # Zoom Into The Screen 20 Units
    DrawGLRoom                                         ; # Draw The Room
    glTranslatef [lindex $::ObjPos 0] \
                 [lindex $::ObjPos 1] \
                 [lindex $::ObjPos 2]
    glRotatef $gDemo(xrot) 1.0 0.0 0.0                 ; # Spin The Object On The X Axis By xrot
    glRotatef $gDemo(yrot) 0.0 1.0 0.0                 ; # Spin The Object On The Y Axis By yrot
    DrawGLObject obj                                   ; # Procedure For Drawing The Loaded Object
    CastShadow obj $lpList                             ; # Procedure For Casting The Shadow Based On The Silhouette

    glColor4f 0.7 0.4 0.0 1.0                          ; # Set Color To Purplish Blue
    glDisable GL_LIGHTING                              ; # Disable Lighting
    glDepthMask GL_FALSE                               ; # Disable Depth Mask
    # Translate To Light's Position. Notice We're Still In Local Coordinate System
    glTranslatef [lindex $lpList 0] \
                 [lindex $lpList 1] \
                 [lindex $lpList 2]
    gluSphere $::quadric 0.2 16 8                      ; # Draw A Little Yellow Sphere (Represents Light)
    glEnable GL_LIGHTING                               ; # Enable Lighting
    glDepthMask GL_TRUE                                ; # Enable Depth Mask

    if { [info exists ::animateId] } {
        # Increase xrot By xspeed, yrot By yspeed
        set gDemo(xrot) [expr {$gDemo(xrot) + $gDemo(xspeed)}] 
        set gDemo(yrot) [expr {$gDemo(yrot) + $gDemo(yspeed)}]
    }

    glFlush
    $toglwin swapbuffers

    # Delete the tcl3dVectors
    $Minv delete
    $lp   delete
    $wlp  delete
}

proc Cleanup {} {
    global gObjects gDemo

    catch { unset gObjects }
    catch { unset gDemo }

    if { [info exists ::quadric] } {
        gluDeleteQuadric $::quadric
    }
}

# 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 -stencil true \
                     -createcommand CreateCallback \
                     -reshapecommand ReshapeCallback \
                     -displaycommand DisplayCallback 
    listbox .fr.usage -font $::gDemo(listFont) -height 15
    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: Banu Octavian & NeHe's Shadow Casting Tutorial (Lesson 27)"

    # Watch For ESC Key And Quit Messages
    wm protocol . WM_DELETE_WINDOW "ExitProg"
    bind . <Key-Escape> "ExitProg"
    bind . <Key-F1>     "ToggleWindowMode"
    bind . <Key-Up>     "SetXSpeed  0.1"
    bind . <Key-Down>   "SetXSpeed -0.1"
    bind . <Key-Right>  "SetYSpeed  0.1"
    bind . <Key-Left>   "SetYSpeed -0.1"
    bind . <Key-l>      "SetXLightPos  0.05"
    bind . <Key-j>      "SetXLightPos -0.05"
    bind . <Key-i>      "SetYLightPos  0.05"
    bind . <Key-k>      "SetYLightPos -0.05"
    bind . <Key-o>      "SetZLightPos  0.05"
    bind . <Key-u>      "SetZLightPos -0.05"
    bind . <Key-6>      "SetXObjectPos  0.05"
    bind . <Key-4>      "SetXObjectPos -0.05"
    bind . <Key-8>      "SetYObjectPos  0.05"
    bind . <Key-5>      "SetYObjectPos -0.05"
    bind . <Key-9>      "SetZObjectPos  0.05"
    bind . <Key-7>      "SetZObjectPos -0.05"
    bind . <Key-d>      "SetXSpherePos  0.05"
    bind . <Key-a>      "SetXSpherePos -0.05"
    bind . <Key-w>      "SetYSpherePos  0.05"
    bind . <Key-s>      "SetYSpherePos -0.05"
    bind . <Key-e>      "SetZSpherePos  0.05"
    bind . <Key-q>      "SetZSpherePos -0.05"
    bind . <Key-r>      "Reset"

    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-Up|Down    Decrease|Increase x speed"
    .fr.usage insert end "Key-Left|Right Decrease|Increase y speed"
    .fr.usage insert end "Key-j|l        Move light left|right"
    .fr.usage insert end "Key-k|i        Move light bottom|up"
    .fr.usage insert end "Key-u|o        Move light far|near"
    .fr.usage insert end "Key-4|6        Move cross left|right"
    .fr.usage insert end "Key-5|8        Move cross bottom|up"
    .fr.usage insert end "Key-7|9        Move cross far|near"
    .fr.usage insert end "Key-a|d        Move sphere left|right"
    .fr.usage insert end "Key-s|w        Move sphere bottom|up"
    .fr.usage insert end "Key-q|e        Move sphere far|near"
    .fr.usage insert end "Key-r          Reset position and rotation"
    .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
}
