# Demo Gear Generator  -- with improved variable names and comments.
# based on standard gear design techniques; Ref. J. E. Shigley
# still hacked to accommodate procedural generation of cog instances
# To do this right, see Instancing.slf
# C.H. Sequin, 2/24/00
########################################################################

tclinit {
#______________ UI _____________________
  set rootWindow ".slfWindow"
  toplevel $rootWindow.carloUI

puts __start__tclinit__

  proc ValueUpdate { value } {
    global fModule fPressAngle fOffset nSamples fSepar \
      TA fPitchRadA fBaseRadA fSweepA fFacetA nTeethA fPitchA fGapA fScaleA fBottomA fTopA \
      TB fPitchRadB fBaseRadB fSweepB fFacetB nTeethB fPitchB fGapB fScaleB fBottomB fTopB

    if { $fPressAngle < [expr 180.0/$nTeethA ] } {
      set fPressAngle [expr 180.0/$nTeethA ]
    }
    if { $fPressAngle < [expr 180.0/$nTeethB ] } {
      set fPressAngle [expr 180.0/$nTeethB ]
    }
    ### This should be the other way round: make PressAngle limit # of teeth ! ### FIX

    ### Basic Gear Dimensions
    set fPitchRadA [expr 0.5*$fModule*$nTeethA ]
    set fPitchRadB [expr 0.5*$fModule*$nTeethB ]
    set fBaseRadA [expr cos($fPressAngle/57.296)*$fPitchRadA ]
    set fBaseRadB [expr cos($fPressAngle/57.296)*$fPitchRadB ]
    set fBottomA [expr $fPitchRadA - 1.25*$fModule ]
    set fBottomB [expr $fPitchRadB - 1.25*$fModule ]
    set fTopA [expr $fPitchRadA + $fModule ]
    set fTopB [expr $fPitchRadB + $fModule ]
    set fSepar [expr $fPitchRadA + $fPitchRadB ]

    ### Set proper wheel rotation phase for touching at Pitch point
    # deviation in degrees of base point of cog face from intersection with pitch circle
    # (difference of wound-up half-action-line and projection of it).
    set fOffset [expr (57.296*tan($fPressAngle/57.296)-$fPressAngle ) ]
  
    ### limit tooth height -- currently too big ! *** FIX
    if { $fSweepA > [expr 180.0/$nTeethA + $fPressAngle ] } {
      set fSweepA [expr 180.0/$nTeethA + $fPressAngle ]
    }
    if { $fSweepB > [expr 180.0/$nTeethB + $fPressAngle ] } {
      set fSweepB [expr 180.0/$nTeethB + $fPressAngle ]
    }

    ### basic wheel period
    set fPitchA [expr 360.0/$nTeethA]
    set fPitchB [expr 360.0/$nTeethB]
    ### facetting of involute
    set fFacetA [expr $fSweepA/$nSamples]  
    set fFacetB [expr $fSweepB/$nSamples]
    set TA [expr 3.1415*$fFacetA/90.0]   
    set TB [expr 3.1415*$fFacetB/90.0]   
    ### set proper gap width between teeth at base circle
    set fGapA [expr 0.5*$fPitchA - 2.0*$fOffset]
    set fGapB [expr 0.5*$fPitchB - 2.0*$fOffset]

  } 
#---end ValueUpdate---

puts __done_first_ValueUpdate__

  ### Some reasonable defaults -- could be made adjustable
  set nSamples 10.0
  set fModule 1.0
 
  set nTeethA 11 
  scale $rootWindow.carloUI.var1 -label "# of TEETH : A"  -variable nTeethA \
    -from 3 -to 20 -resolution 1 -tickint 4 -length 400 -orient horizontal \
    -command ValueUpdate 

  set nTeethB 9 
  scale $rootWindow.carloUI.var2 -label "# of TEETH : B"  -variable nTeethB \
    -from 3 -to 20 -resolution 1 -tickint 4 -length 400 -orient horizontal \
    -command ValueUpdate 

  set fPressAngle 20.0 
  scale $rootWindow.carloUI.var3 -label "GEAR SYSTEM FORCE ANGLE (degrees) {limited by min # teeth}"  -variable fPressAngle \
    -from 0.0 -to 80.0 -resolution 1.0 -tickint 10 -length 400 -orient horizontal \
    -command ValueUpdate 

  set fSweepA 27.0 
  scale $rootWindow.carloUI.var4 -label "COG FACE SWEEP : A  (degrees) {limited by # teeth A}"  -variable fSweepA \
    -from 0.0 -to 80.0 -resolution 1.0 -tickint 10 -length 400 -orient horizontal \
    -command ValueUpdate 
    
  set fSweepB 30.0 
  scale $rootWindow.carloUI.var5 -label "COG FACE SWEEP : B  (degrees) {limited by # teeth B}"  -variable fSweepB \
    -from 0.0 -to 80.0 -resolution 1.0 -tickint 10 -length 400 -orient horizontal \
    -command ValueUpdate 
    
  set fRot 0.0
  scale $rootWindow.carloUI.var6 -label "ROTATION -- SEE THE WHEELS TURN !"  -variable fRot \
    -from -1000.0 -to 1000.0 -resolution 0.1 -tickint 500.0 -length 400 -orient horizontal

  pack \
    $rootWindow.carloUI.var1 \
    $rootWindow.carloUI.var2 \
    $rootWindow.carloUI.var3 \
    $rootWindow.carloUI.var4 \
    $rootWindow.carloUI.var5 \
    $rootWindow.carloUI.var6 \
    -side top -fill x

puts __sliders_established__

  ValueUpdate 1.0

puts __again_ValueUpdate



# ---  Make the cog faces ----
  for { set i 0 } { $i < $nSamples } { incr i } {
      slide create point "a[subst $i]"  [list [list expr ( cos( $i * {$TA} ) + $i * {$TA} * sin( $i * {$TA} ) ) ] \
                                       [list expr ( sin( $i * {$TA} ) - $i * {$TA} * cos( $i * {$TA} ) ) ] 0.0 ]
      lappend FA "a[subst $i]"
   }
  slide create point "ac" { 0 0 0 }
  lappend FA "ac"
  slide create face FaceA $FA  



  for { set i 0 } { $i < $nSamples } { incr i } {
      slide create point "b[subst $i]"  [list [list expr ( cos( $i * {$TB} ) + $i * {$TB} * sin( $i * {$TB} ) ) ] \
                                       [list expr ( sin( $i * {$TB} ) - $i * {$TB} * cos( $i * {$TB} ) ) ] 0.0 ]
puts [list      slide create point "b[subst $i]"  [list [list expr ( cos( $i * {$TB} ) + $i * {$TB} * sin( $i * {$TB} ) ) ] \
                                       [list expr ( sin( $i * {$TB} ) - $i * {$TB} * cos( $i * {$TB} ) ) ] 0.0 ] ]
      lappend FB "b[subst $i]"
   }
  slide create point "bc" { 0 0 0 }
  lappend FB "bc"

  slide create face FaceB $FB  
puts $FB


# --- instantiate the cog faces into a wheel

  proc TeethLOD { i var } {
    global $var SLF_FULL SLF_OFF

    if { $i < [subst $$var] } then {
      expr $SLF_FULL
    } else {
      expr $SLF_OFF
    }
  }

    set nTeethAMax 50

    slide create group halfgearA
    for {set i 0} {$i < $nTeethAMax} {incr i} {
puts [list -lod [list TeethLOD $i nTeethA]]

        slide create instance iA halfgearA cogA \
          -lod [list TeethLOD $i nTeethA] \
          -xforms [list [list rotate 0 0 1 [list expr ( $i * {$fPitchA} )]]]
     }

    set nTeethBMax 50

    slide create group halfgearB
    for {set i 0} {$i < $nTeethBMax} {incr i} {
        slide create instance iB halfgearB cogB \
          -lod [list TeethLOD $i nTeethB] \
          -xforms [list [list rotate 0 0 1 [list expr ( $i * {$fPitchB} )]]]
     }

puts __prototype_gears_done__
puts __tclinit_done
}

surface RED color (0.9 0.1 0.3) 
endsurface
surface ORANGE color (0.8 0.4 0.2) 
endsurface
surface YELLOW color (0.9 0.8 0) 
endsurface
surface CYAN color (0 0.9 0.9) 
endsurface
surface GREEN color (0.3 0.9 0.3) 
endsurface
surface BLUE color (0.3 0.3 0.9) 
endsurface

###__define_some_simple_geometrical_primitives__

point L1 ( 0 1 0) endpoint
point L0 ( 0 -1 0) endpoint

polyline actionline 
  pointlist (L0 L1)
  surface YELLOW
endpolyline


### unit circle
cone ring
  radius 1.0
  height 0.01
  zmax  0.01
  zmin  0.0
  zslices 1
  thetaslices 40
  shading SLF_FLAT
endcone

### unit disk
cone disk
  radius 1.0
  height 0.01
  zmax  1.0
  zmin  0.0
  zslices 1
  thetaslices 40
  shading SLF_FLAT
endcone

###__build_the_actual_gears__

object cogA 
  (FaceA)
  shading SLF_FLAT
  solid SLF_HOLLOW
endobject


object cogB 
  (FaceB)
  shading SLF_FLAT
  solid SLF_HOLLOW
endobject


group gearA
  instance halfgearA
    scale ( {expr $fBaseRadA} {expr $fBaseRadA} 1 )
  endinstance
  instance halfgearA
    rotate ( 0 0 1) ( {expr $fGapA } )
    scale ( {expr $fBaseRadA} {expr -$fBaseRadA} 1 )
  endinstance
  instance ring
    scale ( {expr $fBaseRadA} {expr $fBaseRadA} 1 )
    translate (0 0 0.1)
    surface GREEN
  endinstance
  instance ring
    scale ( {expr $fPitchRadA} {expr $fPitchRadA} 1 )
    translate (0 0 0.1)
    surface CYAN
  endinstance
  instance ring
    scale ( {expr $fTopA} {expr $fTopA} 1 )
    translate (0 0 0.1)
    surface RED
  endinstance
  instance disk
    scale ( {expr $fBottomA} {expr $fBottomA} 1 )
    translate ( 0 0 0.05 )
    surface RED
  endinstance
endgroup

group gearB
  instance halfgearB
    scale ( {expr $fBaseRadB} {expr $fBaseRadB} 1 )
  endinstance
  instance halfgearB
    rotate ( 0 0 1) ( {expr $fGapB } )
    scale ( {expr $fBaseRadB} {expr -$fBaseRadB} 1 )
  endinstance
  instance ring
    scale ( {expr $fBaseRadB} {expr $fBaseRadB} 1 )
    translate (0 0 0.1)
    surface GREEN
  endinstance
  instance ring
    scale ( {expr $fPitchRadB} {expr $fPitchRadB} 1 )
    translate (0 0 0.1)
    surface CYAN
  endinstance
  instance ring
    scale ( {expr $fTopB} {expr $fTopB} 1 )
    translate (0 0 0.1)
    surface BLUE
  endinstance
  instance disk
    scale ( {expr $fBottomB} {expr $fBottomB} 1 )
    translate ( 0 0 0.05 )
    surface BLUE
  endinstance
endgroup

group gearpair
  instance gearA
    rotate ( 0 0 1) ( {expr -$fRot/$nTeethA -$fOffset } )
    translate (  {expr -$fPitchRadA} 0 0 )
    surface RED
  endinstance

  instance gearB
    rotate ( 0 0 1) ( {expr $fRot/$nTeethB -$fOffset+180.0 } )
    translate (  {expr $fPitchRadB} 0 0 )
    surface BLUE
  endinstance
endgroup

group assembly
  instance gearpair
    scale ( {expr 2.0/$fSepar} {expr 2.0/$fSepar} 1 )
  endinstance

  instance actionline
    rotate ( 0 0 1) ( {expr $fPressAngle } )
  endinstance
  instance actionline
    rotate ( 0 0 1) ( {expr -$fPressAngle } )
  endinstance
endgroup

###__world_has_been_defined__


##########################################
#include "viewing.slf"
# A generic setup for viewing SLF objects
##########################################

light amb
  type SLF_AMBIENT
  color (1 1 1)
endlight

group world
  instance assembly   
    scale (0.05 0.05 0.05)
    translate (0 0 0)
  endinstance

  instance amb
    id the_amb
  endinstance
endgroup

camera cam
  projection SLF_PARALLEL
  frustum ( -0.2 -0.2 -4 ) ( 0.2 0.2 -0.01 )
endcamera

group gCam
  instance cam
    id iCam
    translate ( 0.0 0.0 1.75 )
  endinstance
endgroup

window Window
  background (1 1 1)
endwindow

viewport vp Window
endviewport

render vp gCam.iCam.cam world  
  light world.the_amb.amb
endrender


###__viewing_and_rendering_defined__

####################################