# ClipPlanes.tcl
#
# Clip Earth Demo. Demo for "User Clip Planes" section.
# See http://glbook.gamedev.net/GLBOOK/glbook.gamedev.net/moglgp/advclip.html
# 
# Author: Andrei Gradinari
# Based on Dave Astle's application template
# 
# Written for More OpenGL Game Programming
# August, 2005
#
# Modified for Tcl3D by Paul Obermeier 2016/10/31
# See www.tcl3d.org for the Tcl3D extension.

package require Img
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]]

# Window dimensions
set gDemo(winWidth)  640
set gDemo(winHeight) 480

# Texture name
set gDemo(texture) [tcl3dVector GLuint 1]

set gDemo(elapsedTime) 0.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 widget a the bottom of the window.
proc PrintInfo { msg } {
    if { [winfo exists .fr.info] } {
        .fr.info configure -text $msg
    }
}

proc Init {} {
    global gDemo
    global gEarth

    # EARTH TEXTURE
    set texName [file join $gDemo(scriptDir) "Data" "earth.tga"]
    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 n [tcl3dPhotoChans $phImg]
        set textureImg [tcl3dVectorFromPhoto $phImg 3]
        image delete $phImg
    }

    glGenTextures 1 $::gDemo(texture)
    glBindTexture GL_TEXTURE_2D [$::gDemo(texture) get 0]
    glTexParameterf GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_LINEAR_MIPMAP_LINEAR
    glTexParameterf GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_LINEAR
    glTexParameterf GL_TEXTURE_2D GL_TEXTURE_WRAP_S $::GL_REPEAT
    glTexParameterf GL_TEXTURE_2D GL_TEXTURE_WRAP_T $::GL_REPEAT
    
    gluBuild2DMipmaps GL_TEXTURE_2D 3 $w $h GL_RGB GL_UNSIGNED_BYTE $textureImg

    $textureImg delete

    # EARTH MODEL  
    set gEarth(0) [glmReadOBJ [file join $gDemo(scriptDir) "Data" "core.obj"]]
    set gEarth(1) [glmReadOBJ [file join $gDemo(scriptDir) "Data" "middle.obj"]]
    set gEarth(2) [glmReadOBJ [file join $gDemo(scriptDir) "Data" "surface.obj"]]
}

proc SetupEarthMaterial { objIndex } {
    set ambt { 0.4 0.4 0.4 1.0 }
    set emis { 0.0 0.0 0.0 0.0 }
    set shine 0
    set isTextured false
    
    # 0: core
    # 1: mantle
    # 2: surface
    # 3: surface textured
    switch -exact -- $objIndex {
        0 {
            set diff  { 0.5 0.3 0.15 1.0 }
            set emis  { 1.0 0.6 0.3  1.0 }
            set spec  $diff
            set shine 25
        } 
        1 {
            set diff  { 1.0 0.8 0.4 1.0 }
            set ambt  $diff
            set spec  { 0.5 0.4 0.2 0.5 }
            set emis  { 0.5 0.4 0.2 0.5 }
            set shine 15
        }
        2 {
            set diff  { 0.3 0.3 0.6 1.0 }
            set emis  { 0.15 0.15 0.3 1.0 }
            set spec  { 0.09 0.09 0.18 0.3 }
        }
        3 {
            set diff  { 0.7 0.7 0.7 1.0 }
            set spec  { 1.0 1.0 1.0 1.0 }
            set isTextured true
            set shine 50
        }
    }

    glMaterialf GL_FRONT GL_SHININESS $shine
    
    glMaterialfv GL_FRONT GL_AMBIENT  $ambt
    glMaterialfv GL_FRONT GL_DIFFUSE  $diff
    glMaterialfv GL_FRONT GL_SPECULAR $spec
    glMaterialfv GL_FRONT GL_EMISSION $emis

    if { $isTextured } {
        glEnable GL_TEXTURE_2D
    } else {
        glDisable GL_TEXTURE_2D
    }
}

proc GetPlaneEquation { p0 p1 p2 } {
    set normal [tcl3dVectorFromArgs GLfloat 0.0 0.0 0.0]
    set equat  [tcl3dVectorFromArgs GLfloat 0.0 0.0 0.0 0.0]

    tcl3dVec3fPlaneNormal $p0 $p1 $p2 $normal

    # Positive normal
    $equat set 0 [$normal get 0]
    $equat set 1 [$normal get 1]
    $equat set 2 [$normal get 2]
    $equat set 3 [expr \
                     [$equat get 0] * [$p0 get 0] + \
                     [$equat get 1] * [$p0 get 1] + \
                     [$equat get 2] * [$p0 get 2]]
    $normal delete
    return $equat
}

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

proc CreateCallback { toglwin } {
    Init
}

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 1000.0

    glEnable GL_DEPTH_TEST
    glEnable GL_CULL_FACE
    glCullFace GL_BACK
}

proc DisplayCallback { toglwin } {
    global gDemo
    global gEarth

    set gDemo(elapsedTime) [expr $gDemo(elapsedTime) + 0.01]

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

    # Setup camera
    glMatrixMode GL_MODELVIEW
    glLoadIdentity
    gluLookAt 10.0 10.0 15.0 0.0 0.0 0.0 0.0 1.0 0.0
    set viewMat [tcl3dOglGetFloatState GL_MODELVIEW_MATRIX 16]
    
    # Setup lighting
    set pos  { -0.5 0.4 1.0 0.0 }
    set diff {  1.0 1.0 1.0 1.0 }
    set spec {  1.0 1.0 1.0 1.0 }

    glEnable GL_LIGHT0
    glEnable GL_LIGHTING
    glLightfv GL_LIGHT0 GL_POSITION $pos
    glLightfv GL_LIGHT0 GL_DIFFUSE  $diff
    glLightfv GL_LIGHT0 GL_SPECULAR $spec

    # Setup clip planes
    set verts(0,0) [tcl3dVectorFromArgs GLfloat  0  0  1]
    set verts(0,1) [tcl3dVectorFromArgs GLfloat  0  1  0]
    set verts(0,2) [tcl3dVectorFromArgs GLfloat  0  0 -1]
    set verts(0,3) [tcl3dVectorFromArgs GLfloat  0 -1  0]

    set verts(1,0) [tcl3dVectorFromArgs GLfloat  1  0  0]
    set verts(1,1) [tcl3dVectorFromArgs GLfloat  0  0  1]
    set verts(1,2) [tcl3dVectorFromArgs GLfloat -1  0  0]
    set verts(1,3) [tcl3dVectorFromArgs GLfloat  0  0 -1]

    set verts(2,0) [tcl3dVectorFromArgs GLfloat  1  0  0]
    set verts(2,1) [tcl3dVectorFromArgs GLfloat  0 -1  0]
    set verts(2,2) [tcl3dVectorFromArgs GLfloat -1  0  0]
    set verts(2,3) [tcl3dVectorFromArgs GLfloat  0  1  0]

    # Calculate plane equations
    for { set k 0 } { $k < 3 } { incr k } {
        set eq($k) [GetPlaneEquation $verts($k,0) $verts($k,1) $verts($k,2)]
    }

    # Imortant to define plane equations here before glRotate.
    # If you define them after glRotate, clip planes will rotate together with object 
    for { set k 0 } { $k < 3 } { incr k } {
        glClipPlane [expr $::GL_CLIP_PLANE0 + $k] [tcl3dVectorToList $eq($k) 4]
    }

    glRotatef [expr 10.0 * $gDemo(elapsedTime)] 0.0 1.0 0.0
    glRotatef -90.0 1.0 0.0 0.0

    for { set k 0 } { $k < 3 } { incr k } {
        for { set i 1 } { $i < 3 } { incr i } {
            if { $k == 1 && $i == 2 } {
                # Comment next line and see the difference
                continue
            }
            
            glEnable [expr $::GL_CLIP_PLANE0 + $k]
            glClear GL_STENCIL_BUFFER_BIT
            
            # Multipass rendering
            glDisable GL_DEPTH_TEST
            glColorMask GL_FALSE GL_FALSE GL_FALSE GL_FALSE
            glEnable GL_STENCIL_TEST

            # First pass: back face increment
            glStencilFunc GL_ALWAYS 0 0
            glStencilOp GL_KEEP GL_KEEP GL_INCR
            glCullFace GL_FRONT
            glmDraw $gEarth($i) [expr $::GLM_NONE]

            # Second pass: front face decrement
            glStencilOp GL_KEEP GL_KEEP GL_DECR
            glCullFace GL_BACK
            glmDraw $gEarth($i) [expr $::GLM_NONE]

            # Draw clip planes masked by stencil buffer content
            glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE
            glEnable GL_DEPTH_TEST
            glDisable [expr $::GL_CLIP_PLANE0 + $k]
            
            SetupEarthMaterial $i
            
            glStencilFunc GL_NOTEQUAL 0 0xffffffff

            # Render clip edges to frame buffer
            glPushMatrix
                # Clip plane had been set up after viewMat space, thus we need to lo load
                # viewMat matrix before rendering clip plane
                glLoadMatrixf $viewMat
                glBegin GL_QUADS
                    # We want plane to be lit properly, thus we need to specify it's normal.
                    set nrml [tcl3dVectorFromArgs GLfloat  0  0  0]
                    tcl3dVec3fPlaneNormal $verts($k,2) $verts($k,1) $verts($k,0) $nrml
                    glNormal3fv [tcl3dVectorToList $nrml 3]
                    $nrml delete

                    for { set j 3 } { $j >= 0 } { incr j -1 } {
                        # We need plane cover clip edge area thus multiply by 10 all coords 
                        glVertex3f \
                            [expr [$verts($k,$j) get 0] * 10] \
                            [expr [$verts($k,$j) get 1] * 10] \
                            [expr [$verts($k,$j) get 2] * 10]
                    }
                glEnd
            glPopMatrix
            
            # Render geometry to frame buffer           
            glDisable GL_STENCIL_TEST
            glEnable [expr $::GL_CLIP_PLANE0 + $k]

            SetupEarthMaterial [expr $i==2 ? 3 : $i]
            glmDraw $gEarth($i) [expr $::GLM_SMOOTH | $::GLM_TEXTURE]
            glDisable [expr $::GL_CLIP_PLANE0 + $k]
        }
    }

    # Draw earth's core
    SetupEarthMaterial 0
    glmDraw $gEarth(0) [expr $::GLM_SMOOTH]

    # Cleanup allocated tcl3dVectors
    for { set k 0 } { $k < 3 } { incr k } {
        $eq($k) delete
        for { set i 0 } { $i < 4 } { incr i } {
            $verts($k,$i) delete
        }
    }

    $toglwin swapbuffers
}

# 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 2
    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: More OpenGL Game Programming demo ClipPlanes"

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

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