# GearTrain.tcl
#
# GearTrain Simulator * Version: 1.00
#
# Copyright (C) 1999 Shobhan Kumar Dutta All Rights Reserved.
# <skdutta@del3.vsnl.net.in>
#
# Permission is hereby granted, free of charge, to any person obtaining a
# copy of this software and associated documentation files (the "Software"),
# to deal in the Software without restriction, including without limitation
# the rights to use, copy, modify, merge, publish, distribute, sublicense,
# and/or sell copies of the Software, and to permit persons to whom the
# Software is furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included
# in all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
# OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
# SHOBHAN KUMAR DUTTA BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
# WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT
# OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
# SOFTWARE.
#
#
# Tcl conversion Copyright Philip Quaife August 2005.
#
# This file is placed in the public domain
#
# Slightly modified for Tcl3D presentation by Paul Obermeier 2006/08/02
# See www.tcl3d.org for the Tcl3D extension.
# Font to be used in the Tk listbox.
set listFont {-family {Courier} -size 10}
set PI 3.14159265
set T0 0
set Frames 0
# 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 getdata {filename} {
variable Scene
if {[info exists ::$filename]} {
array set Scene [set ::$filename]
} else {
set f [open $filename r]
array set Scene [read $f]
close $f
}
foreach what [concat $Scene(Axles) $Scene(Gears) $Scene(Belts)] {
set Scene($what,face) 0
foreach {param value} $Scene($what) {
set Scene($what,[string range [string tolower $param] 1 end]) $value
}
}
}
proc Vsincos {r angle w {xo 0} {yo 0}} {
glVertex3f [expr {$r * cos($angle)} + $xo] \
[expr {$r * sin($angle)} + $yo] \
$w
}
proc axle {radius length} {
set incr [expr {10.0 * $::M_PI / 180.0}]
#/* draw main cylinder */
glBegin GL_QUADS
for {set angle 0} {$angle < 360} { incr angle 5} {
set rad [expr {$angle * $::M_PI / 180.0}]
glNormal3f [expr {cos($rad)}] [expr {sin($rad)}] 0.0
glVertex3f [expr {$radius * cos ($rad)}] [expr {$radius * sin($rad)}] [expr {$length / 2}]
glVertex3f [expr {$radius * cos ($rad)}] [expr {$radius * sin($rad)}] [expr {-$length / 2}]
glVertex3f [expr {$radius * cos ($rad+$incr)}] [expr {$radius * sin($rad+$incr)}] [expr {-$length / 2}]
glVertex3f [expr {$radius * cos ($rad+$incr)}] [expr {$radius * sin($rad+$incr)}] [expr {$length / 2}]
}
glEnd
#/* draw front face */
glNormal3f 0.0 0.0 1.0
glBegin GL_TRIANGLES
for {set angle 0} {$angle < 360} {incr angle 5} {
set rad [expr {$angle * $::M_PI / 180.0}]
glVertex3f 0.0 0.0 [expr {$length / 2}]
glVertex3f [expr {$radius * cos ($rad)}] [expr {$radius * sin($rad)}] [expr {$length / 2}]
glVertex3f [expr {$radius * cos ($rad+$incr)}] [expr {$radius * sin($rad+$incr)}] [expr {$length / 2}]
glVertex3f 0.0 0.0 [expr {$length / 2}]
}
glEnd
#/* draw back face */
glNormal3f 0.0 0.0 -1.0
glBegin GL_TRIANGLES
for {set angle 0} {$angle < 360} {incr angle 5} {
set rad [expr {$angle * $::M_PI / 180.0}]
glVertex3f 0.0 0.0 [expr {-$length / 2}]
glVertex3f [expr {$radius * cos ($rad+$incr)}] [expr {$radius * sin($rad+$incr)}] [expr {-$length / 2}]
glVertex3f [expr {$radius * cos ($rad)}] [expr {$radius * sin($rad)}] [expr {-$length / 2}]
glVertex3f 0.0 0.0 [expr {-$length / 2}]
}
glEnd
}
proc lrev l {
set n {}
foreach i $l {
set n [concat $i $n]
}
set n
}
set ::rot 20
proc gPos {g} {
variable Scene
set axle $Scene($g,axle)
foreach {ax ay az} $Scene($axle,position) {break}
foreach {x y z} {0 0 0} {break}
if {$Scene($axle,axis) == 0} {
set x 1.0
} elseif {$Scene($axle,axis) == 1} {
set y 1.0
} else {
set z 1.0
}
list [expr {$ax + $x * $Scene($g,position)} ] \
[expr {$ay + $y * $Scene($g,position)}] \
[expr {$az + $z * $Scene($g,position)}]
}
proc gear {gear type radius width teeth tooth_depth } {
variable Scene
set fraction 0.5
set n 1.0
set hw [expr {$width * 0.5}]
set mhw [expr {$width * -0.5}]
set r0 0 ;# No inner radius since axle is at center
set r1 [expr {$radius - $tooth_depth}]
set r2 $radius
set ra [expr {($type eq {NORMAL}) ? $r1 : $r1 - ($width / 1) }]
set rb [expr {($type eq {NORMAL}) ? $r2 : $r2 - ($width / 1) }]
set da [expr { 2.0 * $::M_PI / $teeth / 4.0}]
set 2da [expr {2.0 * $da}]
set 3da [expr {3.0 * $da}]
set 4da [expr {4.0 * $da}]
for { set i 0 } { $i < $teeth } { incr i } {
lappend angles [expr {$i * 2.0 * $::M_PI / $teeth}]
}
set angles1 $angles
set ::a $angles
set rangles [lrev $angles]
lappend angles1 [expr {2.0 * $::M_PI }]
if {$Scene($gear,face) } {
set fraction -0.5
set n -1.0 ; swap normal and hw with mn and mhw
}
if {$type ne {NORMAL}} {
set fraction 0.5
set n 1.0
}
set mn [expr {-1.0 * $n}]
#/* draw front and back faces */
if {1} {
#Front Face anti clockwise
glNormal3f 0.0 0.0 1
glBegin GL_TRIANGLE_FAN
Vsincos 0 0 $hw
foreach angle $angles {
Vsincos $r1 $angle $hw
Vsincos $r1 [expr {$angle + $3da}] $hw
lappend xx $angle [expr {$angle + $3da}]
}
Vsincos $r1 0.0 $hw
lappend xx 0.0
glEnd
}
if {1} {
# Back face clockwise.
glNormal3f 0.0 0.0 -1
glBegin GL_TRIANGLE_FAN
Vsincos 0 0 $mhw
foreach angle [lrev $xx] {
Vsincos $ra $angle $mhw
}
glEnd
}
if {1} {
#/* draw front and back sides of teeth */
if { 1 || ($type eq {NORMAL}) } {
foreach fa [list $angles $rangles] dir {1 -1} fw [list $hw $mhw] fn [list $n $mn] r1a [list $ra $r1] r1b [list $rb $r2] {
glNormal3f 0.0 0.0 1
glBegin GL_QUADS
foreach angle $fa {
Vsincos $r1 $angle $fw
Vsincos $r2 [expr {$angle + $dir * $da}] $fw
Vsincos $r2 [expr {$angle + $dir * $2da}] $fw
Vsincos $r1 [expr {$angle + $dir * $3da}] $fw
}
glEnd
break
}
glNormal3f 0.0 0.0 -1
glBegin GL_QUADS
foreach angle $angles {
Vsincos $ra [expr {$angle + $3da}] $mhw
Vsincos $rb [expr {$angle + $2da}] $mhw
Vsincos $rb [expr {$angle + $da}] $mhw
Vsincos $ra $angle $mhw
}
glEnd
}
}
#/* draw outward faces of teeth */
glNormal3f 0.0 0.0 -1.0
glBegin GL_QUAD_STRIP
foreach angle $angles {
glNormal3f [expr cos($angle)] [expr sin($angle)] 0.0
Vsincos $r1 $angle $hw
Vsincos $ra $angle $mhw
set u [expr {$r2 * cos($angle + $da) - $r1 * cos($angle)}]
set v [expr {$r2 * sin($angle + $da) - $r1 * sin($angle)}]
set len [expr {sqrt($u * $u + $v * $v)}]
set u [expr {$u / $len}]
set v [expr {$v / $len}]
glNormal3f $v [expr -1.0 * $u] 0.0
Vsincos $r2 [expr {$angle + $da}] $hw
Vsincos $rb [expr {$angle + $da}] $mhw
glNormal3f [expr cos($angle+$2da)] [expr sin($angle+$2da)] 0
Vsincos $r2 [expr {$angle + $2da}] $hw
Vsincos $rb [expr {$angle + $2da}] $mhw
set u [expr $r1 * cos($angle + $3da) - $r2 * cos($angle + $2da)]
set v [expr $r1 * sin($angle + $3da) - $r2 * sin($angle + $2da)]
set len [expr {sqrt($u * $u + $v * $v)}]
set u [expr {$u / $len}]
set v [expr {$v / $len}]
glNormal3f $v [expr -1.0 * $u] $n
Vsincos $r1 [expr {$angle + $3da}] $hw
Vsincos $ra [expr {$angle + $3da}] $mhw
}
glNormal3f 1 0 0
Vsincos $r1 0.0 $hw
Vsincos $ra 0.0 $mhw
glEnd
}
proc belt {g1 g2} {
variable Scene
set col {0 0 0}
set width [expr {$Scene($g1,width) < $Scene($g2,width) ? $Scene($g1,width) : $Scene($g2,width)}]
set D [expr {sqrt(pow($Scene($g1,x) - $Scene($g2,x), 2) + \
pow($Scene($g1,y) - $Scene($g2,y), 2) + \
pow($Scene($g1,z) - $Scene($g2,z), 2))}]
set alpha [expr {acos(($Scene($g2,x) - $Scene($g1,x)) / $D)}]
set phi [expr {acos (($Scene($g1,radius) - $Scene($g2,radius)) / $D)}]
glBegin GL_QUADS
glColor3fv $col
glMaterialiv GL_FRONT GL_COLOR_INDEXES {0 0 0}
set hw [expr {$width / 2.0}]
set mhw [expr {-$hw}]
set incr [expr {1.2 * 360.0 / $Scene($g1,teeth) * $::M_PI / 180.00}]
for {set angle [expr {$alpha + $phi}]} { $angle <= 2 * $::M_PI - $phi + $alpha} { set angle [expr {$angle + 360.0 / $Scene($g1,teeth) * $::M_PI / 180.00}]} {
glNormal3f [expr {cos ($angle)}] [expr {sin($angle)}] 0.0
Vsincos $Scene($g1,radius) $angle $hw
Vsincos $Scene($g1,radius) $angle $mhw
Vsincos $Scene($g1,radius) [expr {$angle + $incr}] $mhw
Vsincos $Scene($g1,radius) [expr {$angle + $incr}] $hw
}
glEnd
glBegin GL_QUADS
glColor3fv $col
glMaterialiv GL_FRONT GL_COLOR_INDEXES {0 0 0}
set incr [expr {1.2 * 360.0 / $Scene($g2,teeth) * $::M_PI / 180.00}]
for {set angle [expr {$alpha - $phi}]} { $angle <= $phi + $alpha} { set angle [expr {$angle + 360.0 / $Scene($g1,teeth) * $::M_PI / 180.00}]} {
glNormal3f [expr {cos ($angle)}] [expr {sin($angle)}] 0.0
glVertex3f [expr {$Scene($g2,radius) * cos ($angle) + $Scene($g2,x) - $Scene($g1,x)}] \
[expr {$Scene($g2,radius) * sin ($angle) + $Scene($g2,y) - $Scene($g1,y)}] \
$hw
glVertex3f [expr {$Scene($g2,radius) * cos ($angle) + $Scene($g2,x) - $Scene($g1,x)}] \
[expr {$Scene($g2,radius) * sin ($angle) + $Scene($g2,y) - $Scene($g1,y)}] \
$mhw
glVertex3f [expr {$Scene($g2,radius) * cos ($angle + $incr) + $Scene($g2,x) - $Scene($g1,x)}] \
[expr {$Scene($g2,radius) * sin ($angle + $incr) + $Scene($g2,y) - $Scene($g1,y)}] \
$mhw
glVertex3f [expr {$Scene($g2,radius) * cos ($angle + $incr) + $Scene($g2,x) - $Scene($g1,x)}] \
[expr {$Scene($g2,radius) * sin ($angle + $incr) + $Scene($g2,y) - $Scene($g1,y)}] \
$hw
}
glEnd
glBegin GL_QUADS
glColor3fv $col
glMaterialiv GL_FRONT GL_COLOR_INDEXES {0 0 0}
Vsincos $Scene($g1,radius) [expr {$alpha + $phi}] $hw
Vsincos $Scene($g1,radius) [expr {$alpha + $phi}] $mhw
Vsincos $Scene($g2,radius) [expr {$alpha + $phi}] $mhw [expr {$Scene($g2,x) - $Scene($g1,x)}] [expr {$Scene($g2,y) - $Scene($g1,y)}]
Vsincos $Scene($g2,radius) [expr {$alpha + $phi}] $hw [expr {$Scene($g2,x) - $Scene($g1,x)}] [expr {$Scene($g2,y) - $Scene($g1,y)}]
Vsincos $Scene($g1,radius) [expr {$alpha - $phi}] $hw
Vsincos $Scene($g1,radius) [expr {$alpha - $phi}] $mhw
Vsincos $Scene($g2,radius) [expr {$alpha - $phi}] $mhw [expr {$Scene($g2,x) - $Scene($g1,x)}] [expr {$Scene($g2,y) - $Scene($g1,y)}]
Vsincos $Scene($g2,radius) [expr {$alpha - $phi}] $hw [expr {$Scene($g2,x) - $Scene($g1,x)}] [expr {$Scene($g2,y) - $Scene($g1,y)}]
glEnd
}
proc process {} {
variable Scene
foreach g $Scene(Gears) {
set Scene($g,direction) 1
set Scene($g,velocity) 0
set Scene($g,motored) 0
set Scene($g,angle) 0
foreach [list Scene($g,x) Scene($g,y) Scene($g,z)] [gPos $g] {break}
if {$Scene($Scene($g,axle),motored) } {
set Scene($g,direction) $Scene($Scene($g,axle),direction)
set Scene($g,velocity) $Scene($Scene($g,axle),velocity)
}
}
foreach a $Scene(Axles) {
foreach g1 $Scene(Gears) {
if {$Scene($g1,axle) ne $a} {continue}
if {$Scene($a,motored) } {
set Scene($g1,motored) 1
set Scene($g1,velocity) $Scene($a,velocity)
set Scene($g1,direction) [expr {$Scene($a,direction)}]
}
foreach g2 $Scene(Gears) {
if {$Scene($g2,axle) eq $a} {
set Scene($g2,velocity) $Scene($g1,velocity)
set Scene($g2,motored) $Scene($g1,motored)
set Scene($g2,direction) [expr {$Scene($a,direction)}]
continue
}
foreach belt $Scene(Belts) {
if {$g1 ne $Scene($belt,gear1name) && $g1 ne $Scene($belt,gear2name)} {continue}
if {$g2 ne $Scene($belt,gear1name) && $g2 ne $Scene($belt,gear2name)} {continue}
set Scene($g2,velocity) [expr {$Scene($g1,velocity) * $Scene($g1,radius) / $Scene($g2,radius)}]
set Scene($g2,motored) $Scene($g1,motored)
set Scene($Scene($g2,axle),direction) [expr {$Scene($a,direction)}]
set Scene($Scene($g2,axle),velocity) [expr {$Scene($g1,velocity)}]
continue
}
switch $Scene($a,axis) {
0 {set dist [expr {$Scene($g1,x) - $Scene($g2,x)}] }
1 {set dist [expr {$Scene($g1,y) - $Scene($g2,y)}] }
default {set dist [expr {$Scene($g1,z) - $Scene($g2,z)}] }
}
set dist [expr {abs($dist)}]
set D [expr {sqrt(pow($Scene($g1,x) - $Scene($g2,x), 2) + \
pow($Scene($g1,y) - $Scene($g2,y), 2) + \
pow($Scene($g1,z) - $Scene($g2,z), 2))}]
if {$Scene($g1,motored) && ! $Scene($g2,motored) && ($D < 0.95 * ($Scene($g1,radius) + $Scene($g2,radius))) } {
if {$Scene($g1,type) eq {NORMAL} && $Scene($a,axis) != $Scene($Scene($g2,axle),axis) } {continue}
set Scene($g2,motored) 1
set Scene($Scene($g2,axle),motored) 1
if {$Scene($g1,type) eq {NORMAL} } {
set Scene($g2,direction) [expr {-$Scene($a,direction)}]
} else {
set Scene($g2,direction) [expr {$Scene($a,direction)}]
}
set Scene($Scene($g2,axle),direction) [expr {-$Scene($a,direction)}]
set v [expr {$Scene($g1,velocity) * $Scene($g1,teeth) / $Scene($g2,teeth)}]
set Scene($g2,velocity) $v
set Scene($Scene($g2,axle),velocity) $v
}
}
}
}
}
variable t0 -1
variable T0 -1
variable TLoop -1
proc Idle {toglwin} {
variable Scene
set t [clock clicks -milli]
if {$Scene(Update) == 0} {
set ::animId [after 1000 Idle $toglwin]
return {}
}
variable t0
variable T0
variable TLoop
if {$t0 != -1 } {
set elap [expr {$t - $t0}]
set T0 [expr {$T0 - $T0 / 100.0 + $elap}]
set TLoop [expr {$T0 / 100}]
set time [expr {$Scene(Update) + ($Scene(Update) - $elap)}]
if { $time < 0 } {set time 10}
if {$time > $Scene(Update)} {set time $Scene(Update)}
} else {
set time idle
}
set t0 $t
set ::animId [after $time Idle $toglwin]
list
set dt $Scene(Delta)
foreach gear $Scene(Gears) {
set Scene($gear,angle) [expr {$Scene($gear,angle) + $Scene($gear,velocity) * $dt}]
}
$toglwin postredisplay
}
proc StopAnimation {} {
if { [info exists ::animId] } {
after cancel $::animId
}
}
proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
set w [$toglwin width]
set h [$toglwin height]
glViewport 0 0 $w $h
glMatrixMode GL_PROJECTION
glLoadIdentity
if { $w > $h } {
set width [expr double ($w) / double ($h)]
glFrustum [expr -1.0*$width] $width -1.0 1.0 5.0 70.0
} else {
set height [expr double ($h) / double ($w)]
glFrustum -1.0 1.0 [expr -1.0*$height] $height 5.0 70.0
}
glMatrixMode GL_MODELVIEW
glLoadIdentity
glTranslatef 0.0 0.0 -40.0
glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]
}
proc clear {} {
glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]
}
proc MakeScene {} {
variable Scene
set nlists [llength $Scene(Gears)]
incr nlists [expr {[llength $Scene(Axles)] * 2} ]
incr nlists [llength $Scene(Belts)]
incr nlists
set dlist [glGenLists $nlists]
set idx 1
foreach axle $Scene(Axles) {
set Scene(DList,$axle) [expr {$idx + $dlist}]
glNewList $Scene(DList,$axle) GL_COMPILE
incr idx
glPushMatrix
foreach {x y z} $Scene($axle,position) {break}
glTranslatef $x $y $z
foreach {x y z} {0 0 0} {break}
if {$Scene($axle,axis) == 0} {
set y 1.0
} elseif {$Scene($axle,axis) == 1} {
set x 1.0
} else {
set z 1.0
}
if {$z != 1.0} {
glRotatef 90.0 $x $y $z
}
glMaterialfv GL_FRONT GL_SPECULAR $Scene($axle,color)
glColor4fv $Scene($axle,color)
axle $Scene($axle,radius) $Scene($axle,length)
glPopMatrix
glEndList
}
foreach gear $Scene(Gears) {
set Scene(DList,$gear,pre) [expr {$idx + $dlist}]
glNewList $Scene(DList,$gear,pre) GL_COMPILE
incr idx
glPushMatrix
foreach {x y z} [gPos $gear] {break}
glTranslatef $x $y $z
set axle $Scene($gear,axle)
foreach {x y z} {0 0 0} {break}
if {$Scene($axle,axis) == 0} {
set y 1.0
} elseif {$Scene($axle,axis) == 1} {
set x 1.0
} else {
set z 1.0
}
if {$z != 1.0} {
glRotatef 90.0 $x $y $z
}
glEndList
glRotatef [expr {$Scene($gear,direction) * $Scene($gear,angle)}] 0.0 0.0 1.0
set Scene(DList,$gear,post) [expr {$idx + $dlist}]
glNewList $Scene(DList,$gear,post) GL_COMPILE
incr idx
glMaterialfv GL_FRONT GL_SPECULAR $Scene($gear,color)
glColor4fv $Scene($gear,color)
gear $gear $Scene($gear,type) $Scene($gear,radius) \
$Scene($gear,width) $Scene($gear,teeth) $Scene($gear,toothdepth)
glPopMatrix
glEndList
}
foreach belt $Scene(Belts) {
set Scene(DList,$belt) [expr {$idx + $dlist}]
glNewList $Scene(DList,$belt) GL_COMPILE
incr idx
glPushMatrix
glDisable GL_CULL_FACE
foreach {x y z} [gPos $Scene($belt,gear1name)] {break}
glTranslatef $x $y $z
set axle $Scene($Scene($belt,gear1name),axle)
foreach {x y z} {0 0 0} {break}
if {$Scene($axle,axis) == 0} {
set y 1.0
} elseif {$Scene($axle,axis) == 1} {
set x 1.0
} else {
set z 1.0
}
if {$z != 1.0} {
glRotatef 90.0 $x $y $z
}
belt $Scene($belt,gear1name) $Scene($belt,gear2name)
glEnable GL_CULL_FACE
glPopMatrix
glEndList
}
set Scene(DList,allaxles) $dlist
glNewList $Scene(DList,allaxles) GL_COMPILE
foreach axle $Scene(Axles) {
glCallList $Scene(DList,$axle)
}
foreach belt $Scene(Belts) {
glCallList $Scene(DList,$belt)
}
glEndList
}
proc CreateCallback {toglwin} {
variable Scene
eval glClearColor $Scene(BACKGROUND) 1.0
glMaterialf GL_FRONT_AND_BACK GL_SHININESS 20.0
glLightfv GL_LIGHT0 GL_POSITION {0.7 0.7 1.25 0.5}
glEnable GL_LIGHT0
glEnable GL_CULL_FACE
glEnable GL_DEPTH_TEST
glEnable GL_NORMALIZE
glEnable GL_LIGHTING
glShadeModel GL_FLAT
glEnable GL_COLOR_MATERIAL
glShadeModel GL_SMOOTH
MakeScene
bind $toglwin <ButtonPress-1> {
set startx %x
set starty %y
}
bind $toglwin <B1-Motion> {
set yangle [expr $Scene(Roty) + (%x - $startx)]
set xangle [expr $Scene(Rotx) + (%y - $starty)]
set startx %x
set starty %y
set Scene(Rotx) $xangle
set Scene(Roty) $yangle
%W postredisplay
}
bind $toglwin <<ScaleSet>> {
set startx %x
set starty %y
set scale0 $Scene(Scale)
}
bind $toglwin <<ScaleDrag>> {
set q [ expr ($starty - %y) / 400.0 ]
set Scene(Scale) [expr $scale0 * exp($q)]
%W postredisplay
}
Idle $toglwin
}
proc DisplayCallback {toglwin} {
variable Scene
set sc $Scene(Scale)
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]
glPushMatrix
glRotatef $Scene(Rotx) 1.0 0.0 0.0
glRotatef $Scene(Roty) 0.0 1.0 0.0
glRotatef $Scene(Rotz) 0.0 0.0 1.0
glScalef $sc $sc $sc
glRotatef $Scene(Angle) 0.0 0.0 1.0
# Draw all axles and belts (Static items)
glCallList $Scene(DList,allaxles)
foreach gear $Scene(Gears) {
glCallList $Scene(DList,$gear,pre)
glRotatef [expr {$Scene($gear,direction) * $Scene($gear,angle)}] 0.0 0.0 1.0
glCallList $Scene(DList,$gear,post)
}
glPopMatrix
$toglwin swapbuffers
}
proc main {} {
if {$::argc < 2} {
set file geartrain.dat
} else {
set file [lindex $::argv 1]
}
getdata $file
process
wm title . "Gear Train Simulation - Q Solutions"
frame .fr
pack .fr -expand 1 -fill both
togl .fr.toglwin -width 400 -height 400 -double true \
-alpha true -depth true -rgba true -privatecmap false \
-createcommand CreateCallback \
-reshapecommand ReshapeCallback \
-displaycommand DisplayCallback
listbox .fr.usage -height 3 -font $::listFont
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
bind . <Key-Escape> "exit"
.fr.usage insert end "Key-Escape Exit"
.fr.usage insert end "Mouse-L Rotate"
.fr.usage insert end "Mouse-MR Zoom"
.fr.usage configure -state disabled
event add <<ScaleSet>> <ButtonPress-2>
event add <<ScaleDrag>> <B2-Motion>
event add <<ScaleSet>> <ButtonPress-3>
event add <<ScaleDrag>> <B3-Motion>
PrintInfo [tcl3dOglGetInfoString]
}
#Include data file here for wiki demo
set geartrain.dat {
BACKGROUND { 0.000 0.500 0.700}
AXLE1 {
ANAME AXLE1
ARADIUS 0.500
AAXIS 2
APOSITION {-6.000 0.000 0.000}
ACOLOR {0.900 0.300 0.300}
ALENGTH 6.000
AMOTORED 1
AVELOCITY 90.000
ADIRECTION 1
}
AXLE2 {
ANAME AXLE2
ARADIUS 1.000
AAXIS 2
APOSITION {-3.000 0.000 0.000}
ACOLOR {0.800 0.500 0.200}
ALENGTH 12.000
AMOTORED 0
}
AXLE3 {
ANAME AXLE3
ARADIUS 1.000
AAXIS 2
APOSITION {1.000 0.000 0.000}
ACOLOR {0.800 0.500 0.200}
ALENGTH 6.000
AMOTORED 0
}
AXLE4 {
ANAME AXLE4
ARADIUS 1.000
AAXIS 2
APOSITION {8.000 0.000 0.000}
ACOLOR {0.800 0.500 0.200}
ALENGTH 18.000
AMOTORED 0
}
AXLE5 {
ANAME AXLE5
ARADIUS 1.000
AAXIS 1
APOSITION {8.000 -8.200 -7.400}
ACOLOR {0.200 0.200 0.600}
ALENGTH 12.000
AMOTORED 0
}
AXLE6 {
ANAME AXLE5
ARADIUS 2.000
AAXIS 1
APOSITION {-10.000 -14.200 0.400}
ACOLOR {0.000 0.100 0.600}
ALENGTH 4.000
AMOTORED 0
ADIRECTION -1
}
GEAR1 {
GNAME GEAR1
GTYPE NORMAL
GRADIUS 1.000
GWIDTH 3.500
GTEETH 10
GTOOTHDEPTH 0.500
GCOLOR {0.500 0.500 0.500}
GAXLE AXLE1
GPOSITION 0.000
}
GEAR2 {
GNAME GEAR2
GTYPE NORMAL
GRADIUS 2.200
GWIDTH 3.000
GTEETH 30
GTOOTHDEPTH 0.500
GCOLOR { 0.500 0.500 0.500}
GAXLE AXLE2
GPOSITION 0.000
}
GEAR3 {
GNAME GEAR3
GTYPE NORMAL
GRADIUS 2.200
GWIDTH 3.000
GTEETH 20
GTOOTHDEPTH 0.500
GCOLOR {0.500 0.500 0.500}
GAXLE AXLE3
GPOSITION 0.000
}
GEAR4 {
GNAME GEAR4
GTYPE NORMAL
GRADIUS 1.700
GWIDTH 1.000
GTEETH 20
GTOOTHDEPTH 0.500
GCOLOR {0.500 0.500 0.500}
GAXLE AXLE2
GPOSITION 5.000
}
GEAR5 {
GNAME GEAR5
GTYPE NORMAL
GRADIUS 6.000
GWIDTH 1.000
GTEETH 20
GTOOTHDEPTH 0.500
GCOLOR {0.500 0.500 0.500}
GAXLE AXLE4
GPOSITION 5.000
}
GEAR6 {
GNAME GEAR6
GTYPE BEVEL
GFACE 0
GRADIUS 4.000
GWIDTH 1.000
GTEETH 10
GTOOTHDEPTH 1.700
GCOLOR {0.500 0.500 0.500}
GAXLE AXLE4
GPOSITION -4.000
}
GEAR7 {
GNAME GEAR7
GTYPE BEVEL
GFACE 0
GRADIUS 4.000
GWIDTH 1.000
GTEETH 10
GTOOTHDEPTH 1.700
GCOLOR {0.500 0.500 0.500}
GAXLE AXLE5
GPOSITION 5.000
}
GEAR8 {
GNAME GEAR8
GTYPE NORMAL
GFACE 0
GRADIUS 4.600
GWIDTH 2.000
GTEETH 20
GTOOTHDEPTH 1.50
GCOLOR {0.100 0.200 0.600}
GAXLE AXLE5
GPOSITION -6.000
}
GEAR9 {
GNAME GEAR9
GTYPE NORMAL
GFACE 0
GRADIUS 16.1
GWIDTH 2.200
GTEETH 70
GTOOTHDEPTH 2.50
GCOLOR {0.000 0.800 0.000}
GAXLE AXLE6
GPOSITION 0.0
}
BELT1 {
BELTNAME BELT1
BGEAR1NAME GEAR5
BGEAR2NAME GEAR4
}
Belts {BELT1}
Gears {GEAR1 GEAR2 GEAR3 GEAR4 GEAR5 GEAR6 GEAR7 GEAR8 GEAR9}
XGears {GEAR1 GEAR2}
Axles {AXLE1 AXLE2 AXLE3 AXLE4 AXLE5 AXLE6}
}
set Scene(Delta) 0.05
set Scene(Scale) 0.5
set Scene(Angle) 0
set Scene(Rotx) 45
set Scene(Roty) 45
set Scene(Rotz) 0
set Scene(Update) 20
package require tcl3d
main
|
