# 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

