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