# 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
# Added the cog top calculation to fall on addendum circle
# C.H. Sequin, 2/29/00
########################################################################

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

puts __start__tclinit__

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

    ### Basic Gear Dimensions -- calculated base on unit modulus
    ### --- scaled later to fit given axle separation.
    ### pitch radii are of two smooth touching rollers of appropriate ratio
    set fPitchRadA [expr 0.5*$fModule*$nTeethA ]
    set fPitchRadB [expr 0.5*$fModule*$nTeethB ]
    ### base radius, on which involute will be calculated
    set fBaseRadA [expr cos($fPressAngle/57.296)*$fPitchRadA ]
    set fBaseRadB [expr cos($fPressAngle/57.296)*$fPitchRadB ]

    ### custormary dedendum circle:
    set fBottomA [expr $fPitchRadA - 1.25*$fModule ]
    set fBottomB [expr $fPitchRadB - 1.25*$fModule ]
    ### custormary addendum circle:
    set fTopA [expr $fPitchRadA + $fModule ]
    set fTopB [expr $fPitchRadB + $fModule ]
    ### axle spacing
    set fSepar [expr $fPitchRadA + $fPitchRadB ]

    ### fSweep is the angle through which the involute has been unwound
    ### it is being calculated to sweep from unit-size base circle
    ### up to the properly scaled addendum circle
    ### fSweep in degrees:
    set fSweepA [expr $to_deg * sqrt( $fTopA*$fTopA / ($fBaseRadA*$fBaseRadA) - 1.0 )]
    set fSweepB [expr $to_deg * sqrt( $fTopB*$fTopB / ($fBaseRadB*$fBaseRadB) - 1.0 )]
    ### make (nSamples) facets on this involute
    set fFacetA [expr $fSweepFactorA *$fSweepA/$nSamples]  
    set fFacetB [expr $fSweepFactorB *$fSweepB/$nSamples]
    ### turn faceting step into radians
    set TA [expr $fFacetA * $to_rad]   
    set TB [expr $fFacetB * $to_rad]   

    ### 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 ) ]
    ### basic wheel period in degrees
    set fPitchA [expr 360.0/$nTeethA]
    set fPitchB [expr 360.0/$nTeethB]
    ### 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 __ValueUpdate_defined__

  ### some frequently used constants
  set to_deg [expr 180.0/$SLF_PI ]
  set to_rad [expr $SLF_PI/180.0 ]

  ### Some reasonable defaults -- could be made adjustable
  set nSamples 4
  set fModule 1.0
 
  set nTeethA 12 
  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 25.0 
  scale $rootWindow.carloUI.var3 -label "GEAR SYSTEM FORCE ANGLE (degrees)"  -variable fPressAngle \
    -from 10.0 -to 80.0 -resolution 1.0 -tickint 10 -length 400 -orient horizontal \
    -command ValueUpdate 

  set fSweepFactorA 1.0 
  scale $rootWindow.carloUI.var4 -label "COG FACE SWEEP FACTOR : A "  -variable fSweepFactorA \
    -from 0.1 -to 1.9 -resolution 0.1 -tickint 0.3 -length 400 -orient horizontal \
    -command ValueUpdate 
    
  set fSweepFactorB 1.0 
  scale $rootWindow.carloUI.var5 -label "COG FACE SWEEP FACTOR : B "  -variable fSweepFactorB \
    -from 0.1 -to 1.9 -resolution 0.1 -tickint 0.3 -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 ----
  ### Calculations are based on a unit-radius base circle. The half-wheel is caled later.

  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 ring
    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 ring
    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__

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