# tcl3dGears.tcl
#
# Test Togl using GL Gears Demo
#
# This is a version of the original Togl gears demo written entirely in Tcl
# with the help of the Tcl3D package.
#
# Copyright (C) 1997 Philip Quaife (Original C/Tcl version)
# Copyright (C) 2005-2022 Paul Obermeier (Tcl3D version)
# See the LICENSE file for copyright details.
#
# Original sources available at: http://sourceforge.net/projects/togl/

package require tcl3d

set M_PI 3.14159265

proc bgerror { msg } {
    tk_messageBox -icon error -type ok -message "Error: $msg\n\n$::errorInfo"
    exit
}

proc gear { inner_radius outer_radius width teeth tooth_depth } {
    set r0  $inner_radius
    set r1  [expr $outer_radius - $tooth_depth / 2.0]
    set r2  [expr $outer_radius + $tooth_depth / 2.0]

    set da [expr 2.0 * $::M_PI / $teeth / 4.0]

    glShadeModel GL_FLAT

    glNormal3f 0.0 0.0 1.0

    glBegin GL_QUAD_STRIP
    for { set i 0 } { $i <= $teeth } { incr i } {
        set angle [expr $i * 2.0 * $::M_PI / $teeth]
        glVertex3f [expr $r0 * cos($angle)] \
                   [expr $r0 * sin($angle)] \
                   [expr $width * 0.5]
        glVertex3f [expr $r1 * cos($angle)] \
                   [expr $r1 * sin($angle)] \
                   [expr $width * 0.5]
        glVertex3f [expr $r0 * cos($angle)] \
                   [expr $r0 * sin($angle)] \
                   [expr $width * 0.5]
        glVertex3f [expr $r1 * cos($angle + 3 * $da)] \
                   [expr $r1 * sin($angle + 3 * $da)] \
                   [expr $width * 0.5]
    }
    glEnd

    glBegin GL_QUADS
    set da [expr 2.0 * $::M_PI / $teeth / 4.0]
    for { set i 0 } { $i < $teeth } { incr i } {
        set angle [expr $i * 2.0 * $::M_PI / $teeth]

        glVertex3f [expr $r1 * cos($angle)] \
                   [expr $r1 * sin($angle)] \
                   [expr $width * 0.5]
        glVertex3f [expr $r2 * cos($angle + $da)] \
                   [expr $r2 * sin($angle + $da)] \
                   [expr $width * 0.5]
        glVertex3f [expr $r2 * cos($angle + 2 * $da)] \
                   [expr $r2 * sin($angle + 2 * $da)] \
                   [expr $width * 0.5]
        glVertex3f [expr $r1 * cos($angle + 3 * $da)] \
                   [expr $r1 * sin($angle + 3 * $da)] \
                   [expr $width * 0.5]
    }
    glEnd

    glNormal3f 0.0 0.0 -1.0

    glBegin GL_QUAD_STRIP
    for { set i 0 } { $i <= $teeth } { incr i } {
        set angle [expr $i * 2.0 * $::M_PI / $teeth]

        glVertex3f [expr $r1 * cos($angle)] \
                   [expr $r1 * sin($angle)] \
                   [expr -1.0 * $width * 0.5]
        glVertex3f [expr $r0 * cos($angle)] \
                   [expr $r0 * sin($angle)] \
                   [expr -1.0 * $width * 0.5]
        glVertex3f [expr $r1 * cos($angle + 3 * $da)] \
                   [expr $r1 * sin($angle + 3 * $da)] \
                   [expr -1.0 * $width * 0.5]
        glVertex3f [expr $r0 * cos($angle)] \
                   [expr $r0 * sin($angle)] \
                   [expr -1.0 * $width * 0.5]
    }
    glEnd

    glBegin GL_QUADS
    set da [expr 2.0 * $::M_PI / $teeth / 4.0]
    for { set i 0 } { $i < $teeth } { incr i } {
        set angle [expr $i * 2.0 * $::M_PI / $teeth]

        glVertex3f [expr $r1 * cos($angle + 3 * $da)] \
                   [expr $r1 * sin($angle + 3 * $da)] \
                   [expr -1.0 * $width * 0.5]
        glVertex3f [expr $r2 * cos($angle + 2 * $da)] \
                   [expr $r2 * sin($angle + 2 * $da)] \
                   [expr -1.0 * $width * 0.5]
        glVertex3f [expr $r2 * cos($angle + $da)] \
                   [expr $r2 * sin($angle + $da)] \
                   [expr -1.0 * $width * 0.5]
        glVertex3f [expr $r1 * cos($angle)] \
                   [expr $r1 * sin($angle)] \
                   [expr -1.0 * $width * 0.5]
    }
    glEnd

    glBegin GL_QUAD_STRIP
    for { set i 0 } { $i < $teeth } { incr i } {
        set angle [expr $i * 2.0 * $::M_PI / $teeth]

        glVertex3f [expr $r1 * cos($angle)] \
                   [expr $r1 * sin($angle)] \
                   [expr $width * 0.5]
        glVertex3f [expr $r1 * cos($angle)] \
                   [expr $r1 * sin($angle)] \
                   [expr -1.0 * $width * 0.5]

        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
        glVertex3f [expr $r2 * cos($angle + $da)] \
                   [expr $r2 * sin($angle + $da)] \
                   [expr $width * 0.5]
        glVertex3f [expr $r2 * cos($angle + $da)] \
                   [expr $r2 * sin($angle + $da)] \
                   [expr -1.0 * $width * 0.5]

        glNormal3f [expr cos($angle)] [expr sin($angle)] 0.0
        glVertex3f [expr $r2 * cos($angle + 2 * $da)] \
                   [expr $r2 * sin($angle + 2 * $da)] \
                   [expr $width * 0.5]
        glVertex3f [expr $r2 * cos($angle + 2 * $da)] \
                   [expr $r2 * sin($angle + 2 * $da)] \
                   [expr -1.0 * $width * 0.5]

        set u [expr $r1 * cos($angle + 3 * $da) - $r2 * cos($angle + 2 * $da)]
        set v [expr $r1 * sin($angle + 3 * $da) - $r2 * sin($angle + 2 * $da)]
        glNormal3f $v [expr -1.0 * $u] 0.0
        glVertex3f [expr $r1 * cos($angle + 3 * $da)] \
                   [expr $r1 * sin($angle + 3 * $da)] \
                   [expr $width * 0.5]
        glVertex3f [expr $r1 * cos($angle + 3 * $da)] \
                   [expr $r1 * sin($angle + 3 * $da)] \
                   [expr -1.0 * $width * 0.5]
        glNormal3f [expr cos($angle)] [expr sin($angle)] 0.0
    }

    glVertex3f [expr $r1 * cos(0)] [expr $r1 * sin(0)] [expr $width * 0.5]
    glVertex3f [expr $r1 * cos(0)] [expr $r1 * sin(0)] [expr -1.0 * $width * 0.5]

    glEnd

    glShadeModel GL_SMOOTH

    glBegin GL_QUAD_STRIP
    for { set i 0 } { $i <= $teeth } { incr i } {
        set angle [expr $i * 2.0 * $::M_PI / $teeth]
        glNormal3f [expr -cos($angle)] [expr -sin($angle)] 0.0
        glVertex3f [expr $r0 * cos($angle)] \
                   [expr $r0 * sin($angle)] \
                   [expr -1.0 * $width * 0.5]
        glVertex3f [expr $r0 * cos($angle)] \
                   [expr $r0 * sin($angle)] \
                   [expr $width * 0.5]
    }
    glEnd
}

proc DisplayCallback { toglwin } {
    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]

    glDisable GL_TEXTURE_2D
    glPushMatrix
    glRotatef $::Wg($toglwin,Rotx) 1.0 0.0 0.0
    glRotatef $::Wg($toglwin,Roty) 0.0 1.0 0.0
    glRotatef $::Wg($toglwin,Rotz) 0.0 0.0 1.0

    glPushMatrix
    glTranslatef -3.0 -2.0 0.0
    glRotatef $::Wg($toglwin,Angle) 0.0 0.0 1.0
    glEnable GL_DEPTH_TEST
    glCallList $::Wg($toglwin,Gear1)
    glEnable GL_DEPTH_TEST
    glPopMatrix

    glPushMatrix
    glTranslatef 3.1 -2.0 0.0
    glRotatef [expr -2.0 * $::Wg($toglwin,Angle) - 9.0] 0.0 0.0 1.0
    glCallList $::Wg($toglwin,Gear2)
    glPopMatrix

    glPushMatrix
    glTranslatef -3.1 4.2 0.0
    glRotatef [expr -2.0 * $::Wg($toglwin,Angle) - 25.0] 0.0 0.0 1.0
    glCallList $::Wg($toglwin,Gear3)
    glPopMatrix

    glPopMatrix

    $toglwin swapbuffers
}


proc Idle { toglwin tick } {
    set ::Wg($toglwin,Angle) [expr $::Wg($toglwin,Angle) + 2.0]
    $toglwin postredisplay
    set ::Wg($toglwin,idleId) [after $tick "Idle $toglwin $tick"]
}


proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
    set width  [$toglwin width]
    set height [$toglwin 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 60.0
    } else {
        set h [expr double ($height) / double ($width)]
        glFrustum -1.0 1.0 [expr -1.0*$h] $h 5.0 60.0
    }

    glMatrixMode GL_MODELVIEW
    glLoadIdentity
    glTranslatef 0.0 0.0 -40.0
    glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]
}

proc CreateCallback { toglwin } {
    set red   { 0.8 0.1  0.0 1.0 }
    set green { 0.0 0.8  0.2 1.0 }
    set blue  { 0.2 0.2  1.0 1.0 }
    set pos   { 5.0 5.0 10.0 0.0 }
    glLightfv GL_LIGHT0 GL_POSITION $pos
    glEnable GL_CULL_FACE
    glEnable GL_LIGHTING
    glEnable GL_LIGHT0
    glEnable GL_DEPTH_TEST

    set ::Wg($toglwin,Gear1) [glGenLists 1]
    glNewList $::Wg($toglwin,Gear1) GL_COMPILE
    glMaterialfv GL_FRONT GL_AMBIENT_AND_DIFFUSE $red
    gear 1.0 4.0 1.0 20 0.7
    glEndList

    set ::Wg($toglwin,Gear2) [glGenLists 1]
    glNewList $::Wg($toglwin,Gear2) GL_COMPILE
    glMaterialfv GL_FRONT GL_AMBIENT_AND_DIFFUSE $green
    gear 0.5 2.0 2.0 10 0.7
    glEndList

    set ::Wg($toglwin,Gear3) [glGenLists 1]
    glNewList $::Wg($toglwin,Gear3) GL_COMPILE
    glMaterialfv GL_FRONT GL_AMBIENT_AND_DIFFUSE $blue
    gear 1.3 2.0 0.5 10 0.7
    glEndList

    glEnable GL_NORMALIZE
    set ::Wg($toglwin,Angle) 0.0
    set ::Wg($toglwin,Rotx)  0.0
    set ::Wg($toglwin,Roty)  0.0
    set ::Wg($toglwin,Rotz)  0.0
}

proc setup {} {
    global startx starty xangle0 yangle0 xangle yangle RotCnt
    global vTime
    set RotCnt 1
    set xangle 0.0
    set yangle 0.0
    set vTime 10
    wm title . "Tcl3D demo: Rotating Gear Widget Test"

    # Master frame. Needed to integrate demo into Tcl3D Starpack presentation.
    ttk::frame .fr
    pack .fr -expand 1 -fill both

    ttk::label .fr.t -text "Click and drag to rotate camera view"
    pack .fr.t -side top -padx 2 -pady 5
    ttk::frame .fr.f
    pack .fr.f -side top
    ttk::button .fr.f.a -text "Add"    -command AutoRot
    ttk::button .fr.f.r -text "Remove" -command DelRot
    ttk::label  .fr.f.l -text "Update rate:"
    ttk::entry .fr.f.t -width 4 -textvariable vTime
    pack .fr.f.a .fr.f.r .fr.f.l .fr.f.t -side left -anchor w -padx 2

    bind . <Key-Escape> "exit"

    AutoRot
}

proc AutoRot {} {
    global RotCnt vTime

    if { $vTime <= 0 } {
        set vTime 1
    }
    newRot .fr.w$RotCnt $vTime
    set RotCnt [expr $RotCnt + 1]
}

proc DelRot {} {
    global RotCnt vTime
    if { $RotCnt != 0 } {
        set RotCnt [expr $RotCnt - 1]
        after cancel $::Wg(.fr.w$RotCnt,idleId)
        destroy .fr.w$RotCnt
    }
}

proc newRot {win {tick 100} } {
    togl $win -width 400 -height 400 -rgba true -double true \
              -depth true -privatecmap false  \
              -createcommand  CreateCallback \
              -displaycommand DisplayCallback \
              -reshapecommand ReshapeCallback
    bind $win <ButtonPress-1> {RotStart %x %y %W}
    bind $win <B1-Motion> {RotMove %x %y %W}
    pack $win -expand true -fill both
    tcl3dAfterIdle "Idle $win $tick"
}

proc RotStart {x y W } {
    global startx starty xangle0 yangle0 xangle yangle
    set startx $x
    set starty $y
    set xangle0 $::Wg($W,Roty)
    set yangle0 $::Wg($W,Rotx)
    $W postredisplay
}

proc RotMove {x y W} {
    global startx starty xangle0 yangle0 xangle yangle
    set xangle [expr $xangle0 + ($x - $startx)]
    set yangle [expr $yangle0 + ($y - $starty)]
    set ::Wg($W,Roty) $xangle 
    set ::Wg($W,Rotx) $yangle
    $W postredisplay
}

setup
