[Philip Quaife] ''27 Aug 05''

This 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.

[http://qs.co.nz/Tcl/3D/geartrain.jpg]
 
 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
 
<<categories>> Category Graphics|Category 3D Graphics|Category Tcl3D|Category Example