Philip Quaife 27 Aug 05This is a more advanced demo for the openGL widget
tclogl. I have inlined the datafile that specifies the gear train.
In the original they did not cull back facing polygons, but some of the belt has been drawn with the wrong normals so they are not rendered correctly.
if {0} {
/*
* 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
#
set PI 3.14159265
set T0 0
set Frames 0
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} {
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
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 tclReshapeFunc { toglwin width height } {
glViewport 0 0 $width $height
glMatrixMode GL_PROJECTION
glLoadIdentity
if { $width > $height } {
set w [expr double ($width) / double ($height)]
glFrustum [expr -1.0*$w] $w -1.0 1.0 5.0 70.0
} else {
set h [expr double ($height) / double ($width)]
glFrustum -1.0 1.0 [expr -1.0*$h] $h 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_AMBIENT_AND_DIFFUSE $Scene($axle,color)
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_AMBIENT_AND_DIFFUSE $Scene($gear,color)
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 tclCreateFunc {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 tclDisplayFunc {toglwin} {
variable Scene
set sc $Scene(Scale)
glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]
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"
eval destroy [winfo children .]
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 \
-createproc tclCreateFunc \
-reshapeproc tclReshapeFunc \
-displayproc tclDisplayFunc
listbox .fr.usage -height 3
grid .fr.toglwin -row 0 -column 0 -sticky news
grid .fr.usage -row 1 -column 0 -sticky news
grid rowconfigure .fr 0 -weight 1
grid columnconfigure .fr 0 -weight 1
bind . <Key-Escape> "exit"
.fr.usage insert end "bind . <Key-Escape> exit"
.fr.usage insert end "bind . <B1-Motion> Rotate"
.fr.usage insert end "bind . <B2-Motion> Zoom"
event add <<ScaleSet>> <ButtonPress-2>
event add <<ScaleDrag>> <B2-Motion>
event add <<ScaleSet>> <ButtonPress-3>
event add <<ScaleDrag>> <B3-Motion>
}
#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 Togl
package require tclogl
main
