# Lesson32.tcl
#
# Jeff Molofee's Picking Tutorial
# nehe.gamedev.net
# 2001
#
# Modified for Tcl3D by Paul Obermeier 2012/01/28
# See www.tcl3d.org for the Tcl3D extension.

package require Img
package require tcl3d

# Optional: Snack extension for playing WAV sound files
set retVal [catch {package require sound} soundVersion] 
set gDemo(haveSnack) [expr !$retVal]

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

# Display mode.
set gDemo(fullScreen) false

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

# A stop watch to get current time.
set gDemo(stopWatch) [tcl3dNewSwatch]
tcl3dStartSwatch $gDemo(stopWatch)
set gDemo(lastTime) [tcl3dLookupSwatch $gDemo(stopWatch)]

# Current mouse position.
set gDemo(mouseX) 0
set gDemo(mouseY) 0

# Some game parameters.
set gDemo(roll)  0.0
set gDemo(level) 1
set gDemo(miss)  0
set gDemo(kills) 0
set gDemo(score) 0
set gDemo(game)  false

# Vector for 10 texture identifiers.
set gTextureIds [tcl3dVector GLuint 10]

# Size of the objects: Blueface, Bucket, Target, Coke, Vase
set gSizes(0,w) 1.0
set gSizes(0,h) 1.0
set gSizes(1,w) 1.0
set gSizes(1,h) 1.0
set gSizes(2,w) 1.0
set gSizes(2,h) 1.0
set gSizes(3,w) 0.5
set gSizes(3,h) 1.0
set gSizes(4,w) 0.75
set gSizes(4,h) 1.5

# 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 {} {
    global gDemo

    if { ! $gDemo(fullScreen) } {
        SetFullScreenMode .
        set gDemo(fullScreen) true
    } else {
        SetWindowMode . $gDemo(restoreWidth) $gDemo(restoreHeight)
        set gDemo(fullScreen) false
    }
}

proc LoadTexture { index imgName } {
    global gDemo
    global gTextureIds

    set img [tcl3dReadImg [file join $gDemo(scriptDir) "Data" $imgName]]

    glBindTexture GL_TEXTURE_2D [$gTextureIds get $index]
    glTexParameterf GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_LINEAR
    glTexParameterf GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_LINEAR

    glTexImage2D GL_TEXTURE_2D 0 [dict get $img format] \
                 [dict get $img width] [dict get $img height] 0 \
                 [dict get $img format] GL_UNSIGNED_BYTE [dict get $img data]

}

# Build the font display list
proc BuildFont {} {
    global gDemo
    global gTextureIds

    set gDemo(base) [glGenLists 95]
    glBindTexture GL_TEXTURE_2D [$gTextureIds get 9]
    for { set loop 0 } { $loop < 95 } { incr loop } {
        set cx [expr {double($loop%16)/16.0}]
        set cy [expr {double($loop/16)/ 8.0}]

        glNewList [expr {$gDemo(base)+$loop}] GL_COMPILE
        glBegin GL_QUADS
        glTexCoord2f $cx                 [expr {1.0-$cy-0.120}] ; glVertex2i  0  0
        glTexCoord2f [expr {$cx+0.0625}] [expr {1.0-$cy-0.120}] ; glVertex2i 16  0
        glTexCoord2f [expr {$cx+0.0625}] [expr {1.0-$cy}]       ; glVertex2i 16 16
        glTexCoord2f $cx                 [expr {1.0-$cy}]       ; glVertex2i  0 16
        glEnd
        glTranslated 10 0 0
        glEndList
    }
}

proc glPrint { x y str } {
    global gDemo
    global gTextureIds

    glBindTexture GL_TEXTURE_2D [$gTextureIds get 9]
    glPushMatrix
    glLoadIdentity
    glTranslated $x $y 0
    glListBase $gDemo(base)

    set len [string length $str]
    set sa [tcl3dVectorFromString GLubyte $str]
    $sa addvec -32 0 $len
    glCallLists $len GL_UNSIGNED_BYTE $sa
    $sa delete

    glPopMatrix
}

# Generate a random integer number.
proc Rand {} {
    return [expr {int (rand() * 65535.0)}]
}

proc InitObject { num } {
    global gDemo
    global gObjects

    set level $gDemo(level)

    # Rotation (0-None, 1-Clockwise, 2-Counter Clockwise)
    set gObjects($num,rot)   1
    set gObjects($num,spin)  0.0
    set gObjects($num,frame) 0
    set gObjects($num,hit)   false
    set gObjects($num,texid) [expr {[Rand]%5}]
    set gObjects($num,distance) [expr {-double([Rand]%4001)/100.0}]
    set dist $gObjects($num,distance)

    # Random Starting X Position Based On Distance Of Object
    # And Random Amount For A Delay (Positive Value)
    set gObjects($num,y) [expr {-1.5+(double([Rand]%451)/100.0)}]
    set gObjects($num,x) [expr {(($dist-15.0)/2.0) - \
                                (5*$level)-double([Rand]%(5*$level))}]
    set gObjects($num,dir) [expr {[Rand]%2}]

    if { $gObjects($num,dir) == 0 } {
        set gObjects($num,rot) 2
        set gObjects($num,x) [expr {-$gObjects($num,x)}]
    }

    if { $gObjects($num,texid) == 0 } {
        # Blue Face Always Rolling On The Ground
        set gObjects($num,y) -2.0
    }

    if { $gObjects($num,texid) == 1 } {
        set gObjects($num,dir) 3  
        set gObjects($num,x) [expr {double([Rand]%int($dist-10.0)) + (($dist-10.0)/2.0)}]
        set gObjects($num,y) 4.5
    }

    if { $gObjects($num,texid) == 2 } {
        set gObjects($num,dir) 2
        set gObjects($num,x) [expr {double([Rand]%int($dist-10.0))+(($dist-10.0)/2.0)}]
        set gObjects($num,y) [expr {-3.0-double([Rand]%(5*$level))}]
    }
}

proc CreateCallback { toglwin } {
    global gTextureIds

    glGenTextures 10 $gTextureIds

    LoadTexture 0 "BlueFace.tga"
    LoadTexture 1 "Bucket.tga"
    LoadTexture 2 "Target.tga"
    LoadTexture 3 "Coke.tga"
    LoadTexture 4 "Vase.tga"
    LoadTexture 5 "Explode.tga"
    LoadTexture 6 "Ground.tga"
    LoadTexture 7 "Sky.tga"
    LoadTexture 8 "Crosshair.tga"
    LoadTexture 9 "Font.tga"

    BuildFont

    glClearColor 0.0 0.0 0.0 0.0
    glClearDepth 1.0
    glDepthFunc GL_LEQUAL   
    glEnable GL_DEPTH_TEST 
    glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
    glEnable GL_BLEND
    glEnable GL_TEXTURE_2D
    glEnable GL_CULL_FACE

    for {set loop 0 } { $loop < 30 } { incr loop } {
        InitObject $loop
    }
}


proc Selection { x y } {
    global gDemo
    global gObjects

    if { $gDemo(game) } {
        return
    }
    
    if { $gDemo(haveSnack) } {
        $gDemo(snd) play -blocking false
    }

    set buffer [tcl3dVector GLuint 512]

    set viewport [tcl3dVector GLint 4]
    glGetIntegerv GL_VIEWPORT $viewport

    glSelectBuffer 512 $buffer

    glRenderMode GL_SELECT

    glInitNames
    glPushName 0

    glMatrixMode GL_PROJECTION
    glPushMatrix
    glLoadIdentity

    set v0 [$viewport get 0]
    set v1 [$viewport get 1]
    set v2 [$viewport get 2]
    set v3 [$viewport get 3]

    gluPickMatrix $x [expr {$v3 - $y}] 1.0 1.0 $viewport

    gluPerspective 45.0 [expr {double($v2-$v0) / double($v3-$v1)}] 0.1 100.0
    glMatrixMode GL_MODELVIEW
    DrawTargets
    glMatrixMode GL_PROJECTION
    glPopMatrix
    glMatrixMode GL_MODELVIEW
    set hits [glRenderMode GL_RENDER]
    if { $hits > 0 } {
        set choose [$buffer get 3]
        set depth  [$buffer get 1]

        for {set loop 1 } { $loop < $hits } { incr loop } {
            if { [$buffer get [expr {$loop*4+1}]] < $depth } {
                set choose [$buffer get [expr {$loop*4+3}]]
                set depth  [$buffer get [expr {$loop*4+1}]]
            }
        }

        if { ! $gObjects($choose,hit) } {
            set gObjects($choose,hit) true
            incr gDemo(score)
            incr gDemo(kills)
            if { $gDemo(kills) > [expr {$gDemo(level)*5}] } {
                set gDemo(miss)  0
                set gDemo(kills) 0
                incr gDemo(level)
                if { $gDemo(level) > 30 } {
                    set gDemo(level) 30
                }
            }
        }
    }
    $buffer   delete
    $viewport delete
}

proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
    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)}] 1.0 100.0

    glMatrixMode GL_MODELVIEW
    glLoadIdentity
    set ::gDemo(winWidth)  $w
    set ::gDemo(winHeight) $h
}

proc Reset {} {
    global gDemo

    if { [info exists gDemo(game)] && $gDemo(game) } {
        for {set loop 0 } { $loop < 30 } { incr loop } {
            InitObject $loop
        }

        set gDemo(game)  false
        set gDemo(score) 0
        set gDemo(level) 1
        set gDemo(kills) 0
        set gDemo(miss)  0
    }
}

proc Update {} {
    global gDemo
    global gObjects

    set curTime [tcl3dLookupSwatch $gDemo(stopWatch)]
    set elapsedTime [expr {$curTime - $gDemo(lastTime)}]
    set gDemo(lastTime) $curTime
    set milliseconds [expr {int($elapsedTime * 1000.0)}]

    set gDemo(roll) [expr {$gDemo(roll) - $milliseconds * 0.00005}]

    for {set loop 0 } { $loop < $gDemo(level) } { incr loop } {
        # If Rotation Is Clockwise, Spin Clockwise
        if { $gObjects($loop,rot) == 1 } {
            set gObjects($loop,spin) [expr {$gObjects($loop,spin) - 0.2*double($loop+$milliseconds)}]
        }

        # If Rotation Is Counter Clockwise, Spin Counter Clockwise
        if { $gObjects($loop,rot) == 2 } {
            set gObjects($loop,spin) [expr {$gObjects($loop,spin) + 0.2*double($loop+$milliseconds)}]
        }

        # If Direction Is Right, Move Right
        if { $gObjects($loop,dir) == 1 } {
            set gObjects($loop,x) [expr {$gObjects($loop,x) + 0.012*double($milliseconds)}]
        }

        # If Direction Is Left, Move Left
        if { $gObjects($loop,dir) == 0 } {
            set gObjects($loop,x) [expr {$gObjects($loop,x) - 0.012*double($milliseconds)}]
        }

        # If Direction Is Up, Move Up
        if { $gObjects($loop,dir) == 2 } {
            set gObjects($loop,y) [expr {$gObjects($loop,y) + 0.012*double($milliseconds)}]
        }

        # If Direction Is Down, Move Down
        if { $gObjects($loop,dir) == 3 } {
            set gObjects($loop,y) [expr {$gObjects($loop,y) - 0.0025*double($milliseconds)}]
        }
        
        # If We Are To Far Left, Direction Is Left And The Object Was Not Hit
        if { $gObjects($loop,x) < ($gObjects($loop,distance)-15.0)/2.0 && \
             $gObjects($loop,dir) == 0 && ! $gObjects($loop,hit) } {
            incr gDemo(miss)
            set gObjects($loop,hit) true
        }

        # If We Are Too Far Right, Direction Is Left And The Object Was Not Hit
        if { $gObjects($loop,x) > -($gObjects($loop,distance)-15.0)/2.0 && \
             $gObjects($loop,dir) == 1 && ! $gObjects($loop,hit) } {
            incr gDemo(miss)
            set gObjects($loop,hit) true
        }

        # If We Are To Far Down, Direction Is Down And The Object Was Not Hit
        if { $gObjects($loop,y) < -2.0 && $gObjects($loop,dir) == 3 && ! $gObjects($loop,hit) } {
            incr gDemo(miss)
            set gObjects($loop,hit) true
        }

        # If We Are To Far Up And The Direction Is Up
        if { $gObjects($loop,y) > 4.5 && $gObjects($loop,dir) == 2 } {
            set gObjects($loop,dir) 3
        }
    }
}

proc Object { width height texid } {
    global gTextureIds

    glBindTexture GL_TEXTURE_2D [$gTextureIds get $texid]
    glBegin GL_QUADS
        glTexCoord2f 0.0 0.0 ; glVertex3f -$width -$height 0.0
        glTexCoord2f 1.0 0.0 ; glVertex3f  $width -$height 0.0
        glTexCoord2f 1.0 1.0 ; glVertex3f  $width  $height 0.0
        glTexCoord2f 0.0 1.0 ; glVertex3f -$width  $height 0.0
    glEnd
}

proc Explosion { num } {
    global gObjects
    global gTextureIds

    set ex [expr {double(($gObjects($num,frame)/4)%4)/4.0}]
    set ey [expr {double(($gObjects($num,frame)/4)/4)/4.0}]

    glBindTexture GL_TEXTURE_2D [$gTextureIds get 5]
    glBegin GL_QUADS
        glTexCoord2f [expr {$ex+0.0 }] [expr {1.0-($ey     )}] ; glVertex3f -1.0 -1.0 0.0
        glTexCoord2f [expr {$ex+0.25}] [expr {1.0-($ey     )}] ; glVertex3f  1.0 -1.0 0.0
        glTexCoord2f [expr {$ex+0.25}] [expr {1.0-($ey+0.25)}] ; glVertex3f  1.0  1.0 0.0
        glTexCoord2f [expr {$ex+0.0 }] [expr {1.0-($ey+0.25)}] ; glVertex3f -1.0  1.0 0.0
    glEnd

    incr gObjects($num,frame)
    if { $gObjects($num,frame) > 63 } {
        InitObject $num
    }
}

proc DrawTargets {} {
    global gDemo
    global gObjects
    global gSizes

    glLoadIdentity
    glTranslatef 0.0 0.0 -10.0
    for {set loop 0 } { $loop < $gDemo(level) } { incr loop } {
        glLoadName $loop
        glPushMatrix
        glTranslatef $gObjects($loop,x) $gObjects($loop,y) $gObjects($loop,distance)
        if { $gObjects($loop,hit) } {
            Explosion $loop
        } else {
            glRotatef $gObjects($loop,spin) 0.0 0.0 1.0
            Object $gSizes($gObjects($loop,texid),w) \
                   $gSizes($gObjects($loop,texid),h) \
                   $gObjects($loop,texid)
        }
        glPopMatrix
    }
}

proc Draw {} {
    global gDemo
    global gTextureIds

    glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]
    glLoadIdentity

    glPushMatrix
    glBindTexture GL_TEXTURE_2D [$gTextureIds get 7]
    set roll  $gDemo(roll)
    set roll1 [expr {$gDemo(roll) / 1.5}]
    glBegin GL_QUADS
        glTexCoord2f 1.0 [expr {$roll1+1.0}] ; glVertex3f  28.0 +7.0 -50.0 ; # Top Right
        glTexCoord2f 0.0 [expr {$roll1+1.0}] ; glVertex3f -28.0 +7.0 -50.0 ; # Top Left
        glTexCoord2f 0.0 [expr {$roll1+0.0}] ; glVertex3f -28.0 -3.0 -50.0 ; # Bottom Left
        glTexCoord2f 1.0 [expr {$roll1+0.0}] ; glVertex3f  28.0 -3.0 -50.0 ; # Bottom Right

        glTexCoord2f 1.5 [expr {$roll+1.0}]  ; glVertex3f  28.0 +7.0 -50.0 ; # Top Right
        glTexCoord2f 0.5 [expr {$roll+1.0}]  ; glVertex3f -28.0 +7.0 -50.0 ; # Top Left
        glTexCoord2f 0.5 [expr {$roll+0.0}]  ; glVertex3f -28.0 -3.0 -50.0 ; # Bottom Left
        glTexCoord2f 1.5 [expr {$roll+0.0}]  ; glVertex3f  28.0 -3.0 -50.0 ; # Bottom Right

        glTexCoord2f 1.0 [expr {$roll1+1.0}] ; glVertex3f  28.0 +7.0   0.0 ; # Top Right
        glTexCoord2f 0.0 [expr {$roll1+1.0}] ; glVertex3f -28.0 +7.0   0.0 ; # Top Left
        glTexCoord2f 0.0 [expr {$roll1+0.0}] ; glVertex3f -28.0 +7.0 -50.0 ; # Bottom Left
        glTexCoord2f 1.0 [expr {$roll1+0.0}] ; glVertex3f  28.0 +7.0 -50.0 ; # Bottom Right

        glTexCoord2f 1.5 [expr {$roll+1.0}]  ; glVertex3f  28.0 +7.0   0.0 ; # Top Right
        glTexCoord2f 0.5 [expr {$roll+1.0}]  ; glVertex3f -28.0 +7.0   0.0 ; # Top Left
        glTexCoord2f 0.5 [expr {$roll+0.0}]  ; glVertex3f -28.0 +7.0 -50.0 ; # Bottom Left
        glTexCoord2f 1.5 [expr {$roll+0.0}]  ; glVertex3f  28.0 +7.0 -50.0 ; # Bottom Right
    glEnd

    glBindTexture GL_TEXTURE_2D [$gTextureIds get 6]
    glBegin GL_QUADS
        glTexCoord2f 7.0 [expr {4.0-$roll}] ; glVertex3f  27.0 -3.0 -50.0 ; # Top Right
        glTexCoord2f 0.0 [expr {4.0-$roll}] ; glVertex3f -27.0 -3.0 -50.0 ; # Top Left
        glTexCoord2f 0.0 [expr {0.0-$roll}] ; glVertex3f -27.0 -3.0   0.0 ; # Bottom Left
        glTexCoord2f 7.0 [expr {0.0-$roll}] ; glVertex3f  27.0 -3.0   0.0 ; # Bottom Right
    glEnd

    DrawTargets
    glPopMatrix

    # Crosshair (In Ortho View)
    glMatrixMode GL_PROJECTION
    glPushMatrix
    glLoadIdentity
    glOrtho 0 $::gDemo(winWidth) 0 $::gDemo(winHeight) -1 1
    glMatrixMode GL_MODELVIEW
    glTranslated $gDemo(mouseX) [expr {$::gDemo(winHeight) - $gDemo(mouseY)}] 0.0
    Object 16 16 8

    # Game Stats / Title
    glPrint 240 450 "Tcl3D Shooter"
    glPrint  10  10 [format "Level: %i" $gDemo(level)]
    glPrint 250  10 [format "Score: %i" $gDemo(score)]

    if { $gDemo(miss) > 9 } {
        set gDemo(miss) 9
        set gDemo(game) true
    }

    if { $gDemo(game) } {
        glPrint 490 10 "GAME OVER"
    } else {
        glPrint 490 10 [format "Morale: %i/10" [expr {10-$gDemo(miss)}]]
    }

    glMatrixMode GL_PROJECTION
    glPopMatrix
    glMatrixMode GL_MODELVIEW

    glFlush
}

proc DisplayCallback { toglwin } {
    Update
    Draw
    $toglwin swapbuffers
}

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

proc StartAnimation {} {
    global gDemo

    if { ! [info exists ::animateId] } {
        Animate
        tcl3dStartSwatch $gDemo(stopWatch)
    }
}

proc StopAnimation {} {
    global gDemo

    if { [info exists ::animateId] } {
        after cancel $::animateId 
        unset ::animateId
        tcl3dStopSwatch $gDemo(stopWatch)
    }
}

proc SetMousePos { x y } {
    global gDemo

    set gDemo(mouseX) $x
    set gDemo(mouseY) $y
}

proc Cleanup {} {
    global gDemo
    global gTextureIds

    glDeleteLists $gDemo(base) 95
    tcl3dDeleteSwatch $gDemo(stopWatch)

    $gTextureIds delete
 
    # Unset all global variables. 
    # Needed when running the demo in the Tcl3D presentation framework.
    uplevel #0 unset gDemo
    uplevel #0 unset gObjects
    uplevel #0 unset gSizes
}

# Put all exit related code here.
proc ExitProg {} {
    exit
}

proc CreateWindow {} {
    frame .fr
    pack .fr -expand 1 -fill both
    togl .fr.toglwin -width $::gDemo(winWidth) -height $::gDemo(winHeight) \
                     -swapinterval 1 \
                     -double true -depth true \
                     -createcommand  CreateCallback \
                     -reshapecommand ReshapeCallback \
                     -displaycommand DisplayCallback 
    label   .fr.info
    grid .fr.toglwin -row 0 -column 0 -sticky news
    grid .fr.info    -row 1 -column 0 -sticky news
    grid rowconfigure .fr 0 -weight 1
    grid columnconfigure .fr 0 -weight 1
    wm title . "Tcl3D demo: NeHe's Picking Tutorial (Lesson 32)"

    # Watch For ESC Key And Quit Messages
    wm protocol . WM_DELETE_WINDOW "ExitProg"
    bind . <Key-Escape>       "ExitProg"
    bind . <Key-F1>           "ToggleWindowMode"
    bind . <space>            "Reset"

    bind .fr.toglwin <Motion> "SetMousePos %x %y"
    bind .fr.toglwin <1>      "Selection %x %y"
}

if { ! $gDemo(haveSnack) } {
    puts "No sound available (missing Snack extension)"
} else {
    set fullName [file join $gDemo(scriptDir) "Data" "Shot.wav"]
    set fullName [tcl3dGetExtFile $fullName]
    set gDemo(snd) [snack::sound -load $fullName]
}

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

