# atlantis.tcl
#
# Copyright (c) Mark J. Kilgard, 1994. */
#
# (c) Copyright 1993, 1994, Silicon Graphics, Inc.
# ALL RIGHTS RESERVED
# Permission to use, copy, modify, and distribute this software for
# any purpose and without fee is hereby granted, provided that the above
# copyright notice appear in all copies and that both the copyright notice
# and this permission notice appear in supporting documentation, and that
# the name of Silicon Graphics, Inc. not be used in advertising
# or publicity pertaining to distribution of the software without specific,
# written prior permission.
#
# THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
# AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
# INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
# FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
# GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
# SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
# KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
# LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
# THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
# ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
# ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
# POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
#
# US Government Users Restricted Rights
# Use, duplication, or disclosure by the Government is subject to
# restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
# (c)(1)(ii) of the Rights in Technical Data and Computer Software
# clause at DFARS 252.227-7013 and/or in similar or successor
# clauses in the FAR or the DOD or NASA FAR Supplement.
# Unpublished-- rights reserved under the copyright laws of the
# United States.  Contractor/manufacturer is Silicon Graphics,
# Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
#
# OpenGL(TM) is a trademark of Silicon Graphics, Inc.
#
# Original sources available at:
# http://www.opengl.org/resources/code/samples/glut_examples/demos/demos.html
#
# Modified for Tcl3D by Paul Obermeier 2005/08/14
# See www.tcl3d.org for the Tcl3D extension.

package require Tk
package require tcl3d

set scriptDir [file dirname [info script]]
source [file join $scriptDir "atlantis.tclinc"]
source [file join $scriptDir "dolphin.tclinc"]
source [file join $scriptDir "whale.tclinc"]
source [file join $scriptDir "shark.tclinc"]
source [file join $scriptDir "swim.tclinc"]

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

# Show errors occuring in the Togl callbacks.
proc bgerror { msg } {
    tk_messageBox -icon error -type ok -message "Error: $msg\n\n$::errorInfo"
    exit
}

# 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 poMisc:Abs { a } {
    if { $a < 0 } {
        return [expr -1 * $a]
    } else {
        return $a
    }
}

proc InitFishs {} {
    set dummy [expr srand (1)]
    for { set i 0 } { $i < $::NUM_SHARKS } { incr i } {
        set ::sharks($i,x) [expr 70000.0 + int (6000.0 * rand()) % 6000]
        set ::sharks($i,y) [expr double (int (6000.0 * rand()) % 6000)]
        set ::sharks($i,z) [expr double (int (6000.0 * rand()) % 6000)]
        set ::sharks($i,xt) 0.0
        set ::sharks($i,yt) 0.0
        set ::sharks($i,zt) 0.0
        set ::sharks($i,v) 1.0
        set ::sharks($i,psi) [expr int (6000.0 * rand()) % 360 - 180.0]
        set ::sharks($i,phi) 0.0
        set ::sharks($i,theta) 0.0
        set ::sharks($i,dtheta) 0.0
        set ::sharks($i,htail) 0.0
        set ::sharks($i,vtail) 0.0
        set ::sharks($i,spurt) 0
        set ::sharks($i,attack) 0
    }

    set ::dolph(0,x) 30000.0
    set ::dolph(0,y) 0.0
    set ::dolph(0,z) 6000.0
    set ::dolph(0,xt) 0.0
    set ::dolph(0,yt) 0.0
    set ::dolph(0,zt) 0.0
    set ::dolph(0,v) 3.0
    set ::dolph(0,psi) 90.0
    set ::dolph(0,phi) 0.0
    set ::dolph(0,theta) 0.0
    set ::dolph(0,dtheta) 0.0
    set ::dolph(0,htail) 0.0
    set ::dolph(0,vtail) 0.0
    set ::dolph(0,spurt) 0
    set ::dolph(0,attack) 0

    set ::momWhale(0,x) 70000.0
    set ::momWhale(0,y) 0.0
    set ::momWhale(0,z) 0.0
    set ::momWhale(0,xt) 0.0
    set ::momWhale(0,yt) 0.0
    set ::momWhale(0,zt) 0.0
    set ::momWhale(0,v) 3.0
    set ::momWhale(0,psi) 90.0
    set ::momWhale(0,phi) 0.0
    set ::momWhale(0,theta) 0.0
    set ::momWhale(0,dtheta) 0.0
    set ::momWhale(0,htail) 0.0
    set ::momWhale(0,vtail) 0.0
    set ::momWhale(0,spurt) 0
    set ::momWhale(0,attack) 0

    set ::babyWhale(0,x) 60000.0
    set ::babyWhale(0,y) -2000.0
    set ::babyWhale(0,z) -2000.0
    set ::babyWhale(0,xt) 0.0
    set ::babyWhale(0,yt) 0.0
    set ::babyWhale(0,zt) 0.0
    set ::babyWhale(0,v) 3.0
    set ::babyWhale(0,psi) 90.0
    set ::babyWhale(0,phi) 0.0
    set ::babyWhale(0,theta) 0.0
    set ::babyWhale(0,dtheta) 0.0
    set ::babyWhale(0,htail) 0.0
    set ::babyWhale(0,vtail) 0.0
    set ::babyWhale(0,spurt) 0
    set ::babyWhale(0,attack) 0
}

proc CreateCallback { toglwin } {
    set ambient {0.1 0.1 0.1 1.0}
    set diffuse {1.0 1.0 1.0 1.0}
    set position {0.0 1.0 0.0 0.0}
    set mat_shininess {90.0}
    set mat_specular {0.8 0.8 0.8 1.0}
    set mat_diffuse {0.46 0.66 0.795 1.0}
    set mat_ambient {0.0 0.1 0.2 1.0}
    set lmodel_ambient {0.4 0.4 0.4 1.0}
    set lmodel_localviewer {0.0}

    glFrontFace GL_CW

    glDepthFunc GL_LEQUAL
    glEnable GL_DEPTH_TEST

    glLightfv GL_LIGHT0 GL_AMBIENT $ambient
    glLightfv GL_LIGHT0 GL_DIFFUSE $diffuse
    glLightfv GL_LIGHT0 GL_POSITION $position
    glLightModelfv GL_LIGHT_MODEL_AMBIENT $lmodel_ambient
    glLightModelfv GL_LIGHT_MODEL_LOCAL_VIEWER $lmodel_localviewer
    glEnable GL_LIGHTING
    glEnable GL_LIGHT0

    glMaterialfv GL_FRONT_AND_BACK GL_SHININESS $mat_shininess
    glMaterialfv GL_FRONT_AND_BACK GL_SPECULAR $mat_specular
    glMaterialfv GL_FRONT_AND_BACK GL_DIFFUSE $mat_diffuse
    glMaterialfv GL_FRONT_AND_BACK GL_AMBIENT $mat_ambient

    InitFishs

    glClearColor 0.0 0.5 0.9 0.0
}

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 400.0 2.0 10000.0 400000.0
    glMatrixMode GL_MODELVIEW
}

proc Animate {} {
    for { set i 0 } { $i < $::NUM_SHARKS } { incr i } {
        SharkPilot ::sharks $i
        SharkMiss ::sharks $i
    }
    WhalePilot ::dolph 0
    set ::dolph(0,phi) [expr $::dolph(0,phi) + 1.0]
    .fr.toglwin postredisplay
    WhalePilot ::momWhale 0
    set ::momWhale(0,phi) [expr $::momWhale(0,phi) + 1.0]
    WhalePilot ::babyWhale 0
    set ::babyWhale(0,phi) [expr $::babyWhale(0,phi) + 1.0]
    if { $::moving } {
        tcl3dAfterIdle Animate
    }
}

proc Step {} {
    if { ! $::moving } {
        Animate
    }
}

proc DisplayCallback { toglwin } {
    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]

    for { set i 0 } { $i < $::NUM_SHARKS } { incr i } {
        glPushMatrix
        FishTransform ::sharks $i
        DrawShark ::sharks $i
        glPopMatrix
    }

    glPushMatrix
    FishTransform ::dolph 0
    DrawDolphin ::dolph 0
    glPopMatrix

    glPushMatrix
    FishTransform ::momWhale 0
    DrawWhale ::momWhale 0
    glPopMatrix

    glPushMatrix
    FishTransform ::babyWhale 0
    glScalef 0.45 0.45 0.3
    DrawWhale ::babyWhale 0
    glPopMatrix

    $toglwin swapbuffers
}

proc StartAnimation {} {
    set ::moving 1
    Animate
}

proc StopAnimation {} {
    set ::moving 0
}

proc OpenMenu { x y } {
    set w .atlantis:contextMenu
    catch { destroy $w }
    menu $w -tearoff false -disabledforeground white
    $w add command -label "Atlantis menu" -state disabled -background "#303030"

    $w add command -label "Start motion" -command "StartAnimation"
    $w add command -label "Stop motion"  -command "StopAnimation"
    $w add command -label "Quit program" -command "exit"
    tk_popup $w $x $y
}

frame .fr
pack .fr -expand 1 -fill both
togl .fr.toglwin -width 500 -height 250 -double true -depth true \
                 -createcommand CreateCallback \
                 -displaycommand DisplayCallback \
                 -reshapecommand ReshapeCallback
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: Atlantis"

bind . <Key-Escape> "exit"
bind . <Key-n>      "Step"
bind . <Key-p>      "StartAnimation"
bind . <Key-s>      "StopAnimation"
bind . <Button-2>   "OpenMenu %X %Y"
bind . <Button-3>   "OpenMenu %X %Y"
bind . <Control-Button-1> "OpenMenu %X %Y"

.fr.usage insert end "Mouse-MR   PopupMenu"
.fr.usage insert end "Key-s      Stop"
.fr.usage insert end "Key-p      Play"
.fr.usage insert end "Key-n      Next step"
.fr.usage insert end "Key-Escape Exit"
.fr.usage configure -state disabled

PrintInfo [tcl3dOglGetInfoString]

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