# Lesson24.tcl
#
# NeHe's Token, Extensions, Scissoring & TGA Loading Tutorial
#
# This Code Was Created By Jeff Molofee 2000
# 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/25
# 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 scroll    0         ; # Used For Scrolling The Screen
set maxtokens 0         ; # Keeps Track Of The Number Of Extensions Supported
set swidth    0         ; # Scissor Width
set sheight   0         ; # Scissor Height

set texture [tcl3dVector GLuint 1]   ; # The Font Texture

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

proc SetScroll { dir } {
    set maxScroll [expr {32*($::maxtokens-9)}]
    set ::scroll [expr $::scroll + $dir]
    if { $::scroll < 0 } {
        set ::scroll 0
    } elseif { $::scroll > $maxScroll  } {
        set ::scroll $maxScroll
    }
    .fr.toglwin postredisplay
}

proc LoadImage { imgName } {
    set texName [file join $::gDemo(scriptDir) "Data" $imgName]
    set retVal [catch {set phImg [image create photo -file $texName]} err1]
    if { $retVal != 0 } {
        error "Error reading image $texName ($err1)"
    } else {
        set w [image width  $phImg]
        set h [image height $phImg]
        set numChans [tcl3dPhotoChans $phImg]
        set texImg [tcl3dVectorFromPhoto $phImg $numChans]
        image delete $phImg
    }
    if { $numChans == 3 } {
        set type $::GL_RGB
    } else {
        set type $::GL_RGBA
    }
    return [list $texImg $w $h $type]
}

proc LoadFontTexture {} {
    # Load font texture.
    set imgInfo [LoadImage "Font.tga"]
    set imgData   [lindex $imgInfo 0]
    set imgWidth  [lindex $imgInfo 1]
    set imgHeight [lindex $imgInfo 2]
    set imgType   [lindex $imgInfo 3]

    # Create The Textures
    glGenTextures 1 $::texture 
    glBindTexture GL_TEXTURE_2D [$::texture get 0]
    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 $imgType $imgWidth $imgHeight \
                     0 $imgType GL_UNSIGNED_BYTE $imgData

    # Delete the image data vector.
    $imgData delete
}

# Build Our Font Display List
proc BuildFont {} {
    set ::base [glGenLists 256]                         ; # Creating 256 Display Lists
    glBindTexture GL_TEXTURE_2D [$::texture get 0]      ; # Select Our Font Texture
    # Loop Through All 256 Lists
    for { set loop1 0 } { $loop1 < 256 } { incr loop1 } {
        set cx [expr double($loop1%16)/16.0]            ; # X Position Of Current Character
        set cy [expr double($loop1/16)/16.0]            ; # Y Position Of Current Character

        glNewList [expr $::base+$loop1] GL_COMPILE      ; # Start Building A List
            glBegin GL_QUADS                            ; # Use A Quad For Each Character
                glTexCoord2f $cx [expr 1.0-$cy-0.0625]               ; # Texture Coord (Bottom Left)
                glVertex2d 0 16                                      ; # Vertex Coord (Bottom Left)
                glTexCoord2f [expr $cx+0.0625] [expr 1.0-$cy-0.0625] ; # Texture Coord (Bottom Right)
                glVertex2i 16 16                                     ; # Vertex Coord (Bottom Right)
                glTexCoord2f [expr $cx+0.0625] [expr 1.0-$cy-0.001]  ; # Texture Coord (Top Right)
                glVertex2i 16 0                                      ; # Vertex Coord (Top Right)
                glTexCoord2f $cx [expr 1.0-$cy-0.001]                ; # Texture Coord (Top Left)
                glVertex2i 0 0                                       ; # Vertex Coord (Top Left)
            glEnd                                       ; # Done Building Our Quad (Character)
            glTranslated 14 0 0                         ; # Move To The Right Of The Character
        glEndList                                       ; # Done Building The Display List
    }
}

proc glPrint { x y cset fmt args } {
    set text [format $fmt $args]
    if { $cset > 1 } {
        # Did User Choose An Invalid Character Set?
        set cset 1                                          ; # If So, Select Set 1 (Italic)
    }
    glEnable GL_TEXTURE_2D                                  ; # Enable Texture Mapping
    glLoadIdentity                                          ; # Reset The Modelview Matrix
    glTranslated $x $y 0                                    ; # Position The Text (0,0 - Bottom Left)
    glListBase [expr {$::base+(128*$cset)}]                 ; # Choose The Font Set (0 or 1)

    set len [string length $text]
    set sa [tcl3dVectorFromString GLubyte $text]
    $sa addvec -32 0 $len
    glScalef 1.0 2.0 1.0                                    ; # Make The Text 2X Taller
    glCallLists $len GL_UNSIGNED_BYTE $sa                   ; # Write The Text To The Screen
    $sa delete
    glDisable GL_TEXTURE_2D                                 ; # Disable Texture Mapping
}

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

    set ::swidth $w                     ; # Set Scissor Width To Window Width
    set ::sheight $h                    ; # Set Scissor Height To Window Height
    glViewport 0 0 $w $h                ; # Reset The Current Viewport
    glMatrixMode GL_PROJECTION          ; # Select The Projection Matrix
    glLoadIdentity                      ; # Reset The Projection Matrix

    glOrtho 0.0 640 480 0.0 -1.0 1.0    ; # Create Ortho 640x480 View (0,0 At Top Left)

    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 } {
    LoadFontTexture                                 ; # Load The Font Texture
    BuildFont                                       ; # Build The Font

    glShadeModel GL_SMOOTH                          ; # Enable Smooth Shading
    glClearColor 0.0 0.0 0.0 0.5                    ; # Black Background
    glClearDepth 1.0                                ; # Depth Buffer Setup
    glBindTexture GL_TEXTURE_2D [$::texture get 0]  ; # Select Our Font Texture

    set ::glInfo [tcl3dOglGetExtensions $toglwin "all"] ; # Get list of extensions
    # Calculate number of extensions (GL and GLU)
    set ::maxtokens [llength $::glInfo]
}

# Here's Where We Do All The Drawing
proc DisplayCallback { toglwin } {
    # Clear Screen And Depth Buffer
    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]

    glColor3f 1.0 0.5 0.5                       ; # Set Color To Bright Red
    glPrint 50 16 1 "Renderer"                  ; # Display Renderer
    glPrint 80 48 1 "Vendor"                    ; # Display Vendor Name
    glPrint 66 80 1 "Version"                   ; # Display Version

    glColor3f 1.0 0.7 0.4                       ; # Set Color To Orange
    glPrint 200 16 1 [glGetString GL_RENDERER]  ; # Display Renderer
    glPrint 200 48 1 [glGetString GL_VENDOR]    ; # Display Vendor Name
    glPrint 200 80 1 [glGetString GL_VERSION]   ; # Display Version

    glColor3f 0.5 0.5 1.0                       ; # Set Color To Bright Blue
    # Write NeHe Productions (and info about Tcl3D) At The Bottom Of The Screen
    glPrint 72 432 1 "NeHe Productions (powered by Tcl3D)"        
    glLoadIdentity                              ; # Reset The ModelView Matrix
    glColor3f 1.0 1.0 1.0                       ; # Set The Color To White
    glBegin GL_LINE_STRIP                       ; # Start Drawing Line Strips (Something New)
        glVertex2d 639 417                      ; # Top Right Of Bottom Box
        glVertex2d   0 417                      ; # Top Left Of Bottom Box
        glVertex2d   0 480                      ; # Lower Left Of Bottom Box
        glVertex2d 639 480                      ; # Lower Right Of Bottom Box
        glVertex2d 639 128                      ; # Up To Bottom Right Of Top Box
    glEnd                                       ; # Done First Line Strip
    glBegin GL_LINE_STRIP                       ; # Start Drawing Another Line Strip
        glVertex2d   0 128                      ; # Bottom Left Of Top Box
        glVertex2d 639 128                      ; # Bottom Right Of Top Box
        glVertex2d 639   1                      ; # Top Right Of Top Box
        glVertex2d   0   1                      ; # Top Left Of Top Box
        glVertex2d   0 417                      ; # Down To Top Left Of Bottom Box
    glEnd

    # Define Scissor Region
    glScissor 1 [expr {int(0.135416*$::sheight)}] \
              [expr {$::swidth-2}] [expr {int(0.597916*$::sheight)}] ;
    glEnable GL_SCISSOR_TEST                    ; # Enable Scissor Testing

    # Loop through GL and GLU extensions list
    set cnt 1
    foreach token $::glInfo {
        # Set Color To Bright Green
        glColor3f 0.5 1.0 0.5
        # Print Current Extension Number
        glPrint 0 [expr {96+($cnt*32)-$::scroll}] 0 [format "%i" $cnt]
        # Set Color To Yellow
        glColor3f 1.0 1.0 0.5
        # Print The Current Token (Parsed Extension Name)
        glPrint 50 [expr {96+($cnt*32)-$::scroll}] 0 $token
        incr cnt
    }
    glDisable GL_SCISSOR_TEST               ; # Disable Scissor Testing

    glFlush                                 ; # Flush The Rendering Pipeline
    $toglwin swapbuffers                    ; # Swap Buffers
}

proc Cleanup {} {
    if { [info exists ::base] } {
        glDeleteLists $::base 256
    }
}

# 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 -alpha true \
                     -createcommand CreateCallback \
                     -reshapecommand ReshapeCallback \
                     -displaycommand DisplayCallback 
    listbox .fr.usage -font $::listFont -height 5
    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: NeHe's Token, Extensions, Scissoring & TGA Loading Tutorial (Lesson 24)"

    # Watch For ESC Key And Quit Messages
    wm protocol . WM_DELETE_WINDOW "ExitProg"
    bind . <Key-Escape> "ExitProg"
    bind . <Key-F1>     "ToggleWindowMode"
    bind . <Key-Up>     "SetScroll -32"
    bind . <Key-Down>   "SetScroll  32"
    bind . <Key-Prior>  "SetScroll [expr -32*9]"
    bind . <Key-Next>   "SetScroll [expr  32*9]"
    bind . <Key-Home>   "SetScroll -10000"
    bind . <Key-End>    "SetScroll  10000"

    .fr.usage insert end "Key-Escape      Exit"
    .fr.usage insert end "Key-F1          Toggle window mode"
    .fr.usage insert end "Key-Up|Down     Line up|down"
    .fr.usage insert end "Key-PgUp|PgDown Page up|down"
    .fr.usage insert end "Key-Home|End    First|last page"

    .fr.usage configure -state disabled
}

CreateWindow
PrintInfo [tcl3dOglGetInfoString]
