Demo 1 of 2 in category tcl3dGauges
 |
# Copyright: 2005-2024 Paul Obermeier (obermeier@tcl3d.org)
#
# See the file "Tcl3D_License.txt" for information on usage
# and redistribution of this file, and for a
# DISCLAIMER OF ALL WARRANTIES.
#
# Module: Tcl3D -> tcl3dGauges
# Filename: gaugedemo.tcl
#
# Author: Paul Obermeier
#
# Description: Demo program showing the use of the Tcl3D extension
# package gauge.
package require Tk
package require Img
package require tcl3d
set auto_path [linsert $auto_path 0 [file dirname [info script]]]
set PI 3.1415926
set fHeading 0.0
set fRoll 0.0
set fPitch 0.0
set fRollIncr 1.0
set fPitchIncr 0.3
set fAltitude 1.0
set fAltitudeIncr 0.1
set animStarted 0
set rarStarted 0
set iFrameCount 0
set fSpeed 200.0
set fSpeedIncr -2.0
set fCircleLen 700.0
set fCircleRadius [expr $fCircleLen * 0.5 / $PI]
set fJetDist 5.0
set fCircleScale [expr $fJetDist / $fCircleRadius]
set stopWatch [tcl3dNewSwatch]
tcl3dResetSwatch $stopWatch
tcl3dStartSwatch $stopWatch
# Determine the directory of this script.
set g_scriptDir [file dirname [info script]]
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 GetFPS { { elapsedFrames 1 } } {
set currentTime [tcl3dLookupSwatch $::stopWatch]
set fps [expr $elapsedFrames / ($currentTime - $::fLastTime)]
set ::fLastTime $currentTime
return $fps
}
proc DisplayFPS {} {
incr ::iFrameCount
if { $::iFrameCount == 100 } {
set msg [format "%s (%.0f fps)" $::appTitle [GetFPS $::iFrameCount]]
wm title . $msg
set ::iFrameCount 0
}
}
proc ReadObj { toglwin fileName } {
if { [info exists ::objId] } {
glmDeleteModel $::objId
}
set ::objId [glmReadOBJ $fileName]
puts "Model file : [file tail $fileName]"
puts "Number of vertices : [$::objId cget -numvertices]"
puts "Number of normals : [$::objId cget -numnormals]"
puts "Number of triangles: [$::objId cget -numtriangles]"
puts "Number of materials: [$::objId cget -nummaterials]"
puts "Number of groups : [$::objId cget -numgroups]"
puts "Number of texcoords: [$::objId cget -numtexcoords]"
set ::scaleFactor [glmUnitize $::objId]
glmFacetNormals $::objId
glmVertexNormals $::objId 90.0
}
proc CreateCallback { toglwin } {
glClearColor 0.0 0.0 0.4 0.0
set light_ambient { 0.0 0.0 0.0 1.0 }
set light_diffuse { 1.0 1.0 1.0 1.0 }
set light_specular { 1.0 1.0 1.0 1.0 }
set light_position { 100.0 100.0 100.0 0.0 }
glLightfv GL_LIGHT0 GL_AMBIENT $light_ambient
glLightfv GL_LIGHT0 GL_DIFFUSE $light_diffuse
glLightfv GL_LIGHT0 GL_SPECULAR $light_specular
glLightfv GL_LIGHT0 GL_POSITION $light_position
glEnable GL_DEPTH_TEST
glEnable GL_LIGHTING
glEnable GL_LIGHT0
tcl3dGetExtFile [file join $::g_scriptDir "f-16.mtl"]
set fullName [tcl3dGetExtFile [file join $::g_scriptDir "f-16.obj"]]
ReadObj $toglwin $fullName
}
proc DisplayCallback { toglwin } {
glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]
glColor3f 1.0 1.0 1.0
glPushMatrix
glutSolidSphere 1.0 20 16
glRotatef $::fHeading 0.0 1.0 0.0
glTranslatef $::fJetDist $::fAltitude 0.0
glRotatef $::fRoll 0.0 0.0 1.0
glRotatef $::fPitch 1.0 0.0 0.0
glRotatef 180.0 0.0 1.0 0.0
glmDraw $::objId [expr $::GLM_SMOOTH | $::GLM_MATERIAL]
glPopMatrix
$toglwin swapbuffers
if { $::animStarted } {
DisplayFPS
}
}
proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
set w [$toglwin width]
set h [$toglwin height]
set fov 60.0
set maxSize 15
set dist [expr 0.5 * $maxSize / tan ($::PI / 180.0 * (0.5 * $fov))]
glViewport 0 0 $w $h
glMatrixMode GL_PROJECTION
glLoadIdentity
gluPerspective $fov [expr double($w)/double($h)] 1.0 [expr 3 * $maxSize]
glMatrixMode GL_MODELVIEW
glLoadIdentity
gluLookAt 0.0 4.0 $dist 0.0 4.0 0.0 0.0 1.0 0.0
}
proc IncrSpeed { val } {
set ::fSpeed [expr $::fSpeed + $val]
if { $::fSpeed > 750.0 } {
set ::fSpeed 750.0
} elseif { $::fSpeed < 0.0 } {
set ::fSpeed 0.0
}
::airspeed::setSpeed $::speedWidget $::fSpeed
}
proc IncrRoll { val } {
set ::fRoll [expr ($::fRoll + $val)]
if { $::fRoll >= 180.0 } {
set ::fRoll [expr $::fRoll - 360.0]
} elseif { $::fRoll < -180.0 } {
set ::fRoll [expr 360.0 + $::fRoll]
}
::tiltmeter::setRoll $::tiltWidget $::fRoll
}
proc IncrPitch { val } {
set ::fPitch [expr ($::fPitch + $val)]
if { $::fPitch >= 180.0 } {
set ::fPitch [expr $::fPitch - 360.0]
} elseif { $::fPitch < -180.0 } {
set ::fPitch [expr 360.0 + $::fPitch]
}
::tiltmeter::setPitch $::tiltWidget $::fPitch
}
proc IncrHeight { val } {
set ::fAltitude [expr ($::fAltitude + $val)]
if { $::fAltitude > 10.0 } {
set ::fAltitude 10.0
} elseif { $::fAltitude < 0.0 } {
set ::fAltitude 0.0
}
::altimeter::setHeight $::heightWidget [expr $::fAltitude * 1000]
}
proc RockAndRoll {} {
if {$::fRoll > 70.0 || $::fRoll < -10.0} {
set ::fRollIncr [expr -1.0 * $::fRollIncr]
}
if {$::fPitch > 25.0 || $::fPitch < -25.0} {
set ::fPitchIncr [expr -1.0 * $::fPitchIncr]
}
set ::fAltitudeIncr [expr $::fPitch * 0.003]
IncrRoll $::fRollIncr
IncrPitch $::fPitchIncr
IncrHeight $::fAltitudeIncr
}
proc UpdatePosition {} {
set curTime [tcl3dLookupSwatch $::stopWatch]
set elapsedTime [expr $curTime - $::fStartTime]
set ::fStartTime $curTime
set headingOff [expr {360.0 / $::fCircleLen * $::fSpeed * $elapsedTime}]
set ::fHeading [expr {$::fHeading + $headingOff}]
set ::fHeading [expr fmod ($::fHeading, 360.0)]
::compass::setHeading $::compassWidget $::fHeading
if { $::rarStarted } {
RockAndRoll
}
}
proc ToggleRockAndRoll {} {
set ::rarStarted [expr 1 - $::rarStarted]
}
proc animate {} {
UpdatePosition
.fr.toglwin postredisplay
set ::animId [tcl3dAfterIdle animate]
}
proc StartAnimation {} {
# Update gauge values
IncrSpeed 0.0
IncrRoll 0.0
IncrPitch 0.0
IncrHeight 0.0
tcl3dStartSwatch $::stopWatch
set ::fLastTime [tcl3dLookupSwatch $::stopWatch]
set ::fStartTime $::fLastTime
animate
set ::animStarted 1
}
proc StopAnimation {} {
if { [info exists ::animId] } {
after cancel $::animId
}
tcl3dStopSwatch $::stopWatch
set ::animStarted 0
}
proc StartStopAnimation {} {
if { $::animStarted == 0 } {
StartAnimation
} else {
StopAnimation
}
}
proc Cleanup {} {
if { [info exists ::objId] } {
glmDeleteModel $::objId
unset ::objId
}
catch { destroy .help }
::airspeed::delete .fr.speed
::altimeter::delete .fr.alti
::compass::delete .fr.compass
::tiltmeter::delete .fr.tilt
}
proc ShowHelpWin {} {
toplevel .help
wm title .help "gaugedemo shortcuts"
listbox .help.info -height 11 -width 40
pack .help.info -expand 1 -fill both
.help.info insert end "<Key-s> Start/Stop Animation"
.help.info insert end "<Key-x> Start/Stop Rock & Roll"
.help.info insert end "<Key-r> Roll left"
.help.info insert end "<Key-R> Roll right"
.help.info insert end "<Key-p> Nose down"
.help.info insert end "<Key-P> Nose up"
.help.info insert end "<Key-u> Increase height (Up)"
.help.info insert end "<Key-d> Decrease height (Down)"
.help.info insert end "<Key-plus> Increase speed"
.help.info insert end "<Key-minus> Decrease speed"
.help.info insert end "<Key-Escape> Exit gauge demo"
}
set gaugeSize 128
set toglWidth [expr 4 * $gaugeSize]
set toglHeight [expr 2 * $gaugeSize]
set appTitle "Tcl3D demo: Fly around with gauges"
wm title . $appTitle
frame .fr
pack .fr -expand 1 -fill both
togl .fr.toglwin -width $toglWidth -height $toglHeight \
-double true -depth true\
-createcommand CreateCallback \
-reshapecommand ReshapeCallback \
-displaycommand DisplayCallback
set speedWidget [::airspeed::new .fr.speed -width $gaugeSize -height $gaugeSize]
set heightWidget [::altimeter::new .fr.alti -width $gaugeSize -height $gaugeSize]
set compassWidget [::compass::new .fr.compass -width $gaugeSize -height $gaugeSize]
set tiltWidget [::tiltmeter::new .fr.tilt -width $gaugeSize -height $gaugeSize]
::airspeed::reset $speedWidget
::altimeter::reset $heightWidget
::compass::reset $compassWidget
::tiltmeter::reset $tiltWidget
label .fr.info
grid .fr.toglwin -row 0 -column 0 -sticky news -columnspan 4
grid $speedWidget -row 1 -column 0 -sticky news
grid $heightWidget -row 1 -column 1 -sticky news
grid $compassWidget -row 1 -column 2 -sticky news
grid $tiltWidget -row 1 -column 3 -sticky news
grid .fr.info -row 2 -column 0 -sticky news -columnspan 4
grid rowconfigure .fr 0 -weight 2
grid rowconfigure .fr 1 -weight 1
grid columnconfigure .fr 0 -weight 1
grid columnconfigure .fr 1 -weight 1
grid columnconfigure .fr 2 -weight 1
grid columnconfigure .fr 3 -weight 1
bind . <Key-s> "StartStopAnimation"
bind . <Key-x> "ToggleRockAndRoll"
bind . <Key-r> "IncrRoll 1 ; .fr.toglwin postredisplay"
bind . <Key-R> "IncrRoll -1 ; .fr.toglwin postredisplay"
bind . <Key-p> "IncrPitch -1 ; .fr.toglwin postredisplay"
bind . <Key-P> "IncrPitch 1 ; .fr.toglwin postredisplay"
bind . <Key-u> "IncrHeight 0.05 ; .fr.toglwin postredisplay"
bind . <Key-d> "IncrHeight -0.05 ; .fr.toglwin postredisplay"
bind . <Key-plus> "IncrSpeed 5.0"
bind . <Key-minus> "IncrSpeed -5.0"
bind . <Key-Escape> "exit"
PrintInfo [tcl3dOglGetInfoString]
if { [file tail [info script]] eq [file tail $::argv0] } {
# If started directly from tclsh or wish, then start animation.
ShowHelpWin
update
StartAnimation
}
|
