# KleinBoth.slf
# A single filament covering whole surface
# of a figure-8 Klein bottle
# also including the body of the bottle for reference
# CHS 3/26/00
#--
# Twist is not uniform along the surface of a twisted fig8 structure !
# May have to use the warping feature extensively !
#####################################################


################## INITIALIZATIONS #########################

tclinit {
  set winName .slfWindow

  source SLIDEUI.tcl
  source MATH.tcl

  set to_rad [expr $SLF_PI/180.0 ]
  CreateGroupUI $winName gRoot
}
 
####### SURFACES #################### 

surface SURF
  color (1 1 0.4)
endsurface

surface BACK
  color (0.8 0.2 0.3)
endsurface


surface BLU
  color (0.7 0.9 1.0)
endsurface


######## THE SWEEP PATH ###########

tclinit {
  global pathPoints 

  set pathPoints ""

  proc DeletePath { } {
    global pathPoints 

    foreach ipa $pathPoints {
      slide delete point $ipa
    }
  }


  ### generate the klein bottle surface path

  proc CreatePath { slices } {
    global SLF_PI to_rad  pathPoints path_a path_b path_c path_p path_q path_flips

    set pathPoints ""

    for {set j 0} {$j <= $slices} {incr j} {

      set name pa[subst $j]
      set pathPoints [concat $pathPoints "$name"]

      set t [expr $j * 4 * $SLF_PI / 2772 ]

      set lemx [expr cos($path_q*$t)/(1+sin($path_q*$t)*sin($path_q*$t)) ]

      set rad [expr  $path_a + $path_b * $lemx * cos(0.5*$path_p*$path_flips*$t) \
		   - $path_c * sin($path_q*$t) * $lemx * sin(0.5*$path_p*$path_flips*$t) ]
		
      set x [expr $rad * cos($path_p*$t)]
      set y [expr $rad * sin($path_p*$t)]
      set z [expr $path_b * $lemx * sin(0.5*$path_p*$path_flips*$t) \
		+ $path_c * sin($path_q*$t) * $lemx * cos(0.5*$path_p*$path_flips*$t) ]


      eval "slide create point $name {$x $y $z}"
    }
    slide modify polyline pPath -pointlist $pathPoints 
  }


  proc PathUpdate { value } {
    global path_lslices path_a path_b path_c path_p path_q
    DeletePath
    CreatePath $path_lslices
  }


  ### SWEEP PATH UI

  proc CreatePathUI { parent name } {
    set subname "slf_[subst $name]"

    if { $parent == {} } {
	set root .$subname
    } elseif { $parent == "." } {
	set root .$subname
    } else {
	set root $parent.$subname
    }

    toplevel $root

    set a [CreateScaleCmd $name $root a "KB-BAND: big radius" 8.0 0.5 10 0.1 1 horizontal PathUpdate]
    set b [CreateScaleCmd $name $root b "b: fig8 amplitude" 3.0 0.5 10 0.1 1 horizontal PathUpdate]
    set c [CreateScaleCmd $name $root c "c: fig8 bulge-width" 5.0 0.5 10 0.1 1 horizontal PathUpdate]
    set p [CreateScaleCmd $name $root p "p: # big loops" 11 1 20 1 1 horizontal PathUpdate]
    set q [CreateScaleCmd $name $root q "q: # fig8 traversals" 21 1 30 1 1 horizontal PathUpdate]
    set flips [CreateScaleCmd $name $root flips "180-flips" 0 -3 3 1 1 horizontal PathUpdate]
    set lslices [CreateScaleCmd $name $root lslices "length-slices" 40 5 2772 1 1 horizontal PathUpdate]

    pack $a $b $c $p $q $flips  $lslices  -side top -fill x
  }

  CreatePathUI $winName path
}


### PATH INITIALIZATION ###

point pai0 ( 0 0 0) endpoint
point pai1 ( 0 0 1) endpoint

polyline pPath
  pointlist (pai0 pai1 )
endpolyline



### PROFILE ###


point ppi0 ( 0.2  0.2 0) endpoint
point ppi1 ( -0.2  0.2 0) endpoint
point ppi2 ( -0.2  -0.2 0) endpoint
point ppi3 ( 0.2  -0.2 0) endpoint

polyline pPIPE
  pointlist (ppi0 ppi3 ppi2 ppi1 ppi0 )
endpolyline



point pri0 ( 0.0   {expr $sweep_size} 0) endpoint
point pri1 ( -0.0   {expr $sweep_size} 0) endpoint
point pri2 ( -0.0   {expr -$sweep_size} 0) endpoint
point pri3 ( 0.0   {expr -$sweep_size} 0) endpoint

polyline pSURF
  pointlist (pri0 pri3 )
endpolyline

polyline pBACK
  pointlist (pri2 pri1 )
endpolyline



################# PUTTING THE SWEEP TOGETHER  #############

tclinit {

  ### SWEEP ASSEMBLY UI

  proc CreateSweepUI { parent name } {
    set subname "slf_[subst $name]"

    if { $parent == {} } {
	set root .$subname
    } elseif { $parent == "." } {
	set root .$subname
    } else {
	set root $parent.$subname
    }

    toplevel $root

    set closed [CreateScale $name $root closed "KB-BAND: closed" 1 0 1 1 1 horizontal]	
    set minTorsion [CreateScale $name $root minTorsion "minTorsion" 1 0 1 1 1 horizontal]
    set drawSweep [CreateScale $name $root drawSweep "drawSweep" 1 0 1 1 1 horizontal]
    set drawPath [CreateScale $name $root drawPath "drawPath" 0 0 1 1 1 horizontal]
    set size [CreateScale $name $root size "size" 0.3 0.1 1.0 0.05 1 horizontal]
    set wslices [CreateScale $name $root wslices "wslices" 6 4 12 1 1 horizontal]
    set azim [CreateScale $name $root azim "BAND -azimuth" 0 -180 180 1 1 horizontal]
    set ftwist [CreateScale $name $root ftwist "fine twist" 0  -180 180 1 1 horizontal]
    set turns [CreateScale $name $root turns "complete turns" -6  -100 100 1 1 horizontal]

    pack $closed $minTorsion $drawSweep $drawPath $size $wslices $azim $ftwist $turns  -side top -fill x
  }

  CreateSweepUI $winName sweep
}


### THE SWEEP CONSTRUCT ####



(* DISCONNECTED ===
sweep pipe
  path pPath
    minimizetorsion {expr $sweep_minTorsion}
    azimuth {expr $sweep_azim}
    twist {expr ($sweep_ftwist + $sweep_turns*360)*$path_lslices/2772}
  endpath

  #crosssection polyline pPIPE
  #endcrosssection

  crosssection circle
    radius {expr $sweep_size}
    slices {expr $sweep_wslices}
  endcrosssection

  surface SURF
  drawpath {expr $sweep_drawPath}
  drawsweep {expr $sweep_drawSweep}
  #solid SLF_HOLLOW
endsweep
*)

crosssection cSURF
  type polyline pSURF
endcrosssection

sweep bandF
  path pPath
    minimizetorsion {expr $sweep_minTorsion}
    azimuth {expr $sweep_azim}
    twist {expr ($sweep_ftwist + $sweep_turns*360)*$path_lslices/2772}
  endpath

  crosssection cSURF
  endcrosssection

  surface SURF
  drawpath {expr $sweep_drawPath}
  drawsweep {expr $sweep_drawSweep}
  #solid SLF_HOLLOW
endsweep


crosssection cBACK
  type polyline pBACK
endcrosssection


sweep bandB
  path pPath
    minimizetorsion {expr $sweep_minTorsion}
    azimuth {expr $sweep_azim}
    #twist {expr $sweep_twist}
    #twist {expr $sweep_ftwist + $sweep_turns*360}
    twist {expr ($sweep_ftwist + $sweep_turns*360)*$path_lslices/2772}
  endpath

  crosssection cBACK
  endcrosssection

  surface BACK
  drawpath {expr $sweep_drawPath}
  drawsweep {expr $sweep_drawSweep}
  #solid SLF_HOLLOW
endsweep

###########################################################################
### BODY OF THE KLEIN BOTTLE ###


######## THE BOTTLE PATH ###########

tclinit {
  global circPoints 

  set circPoints ""

  proc DeleteKBPath { } {
    global circPoints 

    foreach ipa $circPoints {
      slide delete point $ipa
    }
  }


  ### generate a circle-path

  proc CreateKBPath { slices } {
    global SLF_PI to_rad  circPoints path_a

    set circPoints ""

    for {set j 0} {$j <= $slices} {incr j} {

      set name pc[subst $j]
      set circPoints [concat $circPoints "$name"]

      set theta [expr $to_rad * $j * 360 / $slices ]
      set x [expr $path_a * cos($theta) ]
      set y [expr $path_a * sin($theta) ]
      eval "slide create point $name {$x $y 0}"
    }
    slide modify polyline kbPath -pointlist $circPoints 
  }


  proc KBPathUpdate { value } {
    global kb_lslices 
    DeleteKBPath
    CreateKBPath $kb_lslices
  }

}


### PATH INITIALIZATION ###

point pci0 ( 0 0 0) endpoint
point pci1 ( 0 0 1) endpoint

polyline kbPath
  pointlist (pci0 pci1 )
endpolyline



######## THE KB PROFILE ###########

tclinit {
  global profilePoints 

  set profilePoints ""

  proc DeleteProfile { } {
    global profilePoints
    foreach ipr $profilePoints {
      slide delete point $ipr
    }
  }


  ### generate an S-profile

  proc CreateProfile { slices } {
    global profilePoints SLF_PI to_rad  kb_size path_b path_c

    set profilePoints ""
    for {set i 0} {$i <= $slices} {incr i} {

      set name pr[subst $i]
      set profilePoints [concat $profilePoints "$name"]

      set phi [expr $to_rad*(-180 + $i * 360 / $slices) ]
      set lemx [expr $kb_size * cos($phi) / (1 + sin($phi) * sin($phi) )]

      set x [expr $path_b * $lemx ]
      set y [expr $path_c * sin($phi) * $lemx ]
      eval "slide create point $name {$x $y 0}"
    }
    slide modify polyline pProfile -pointlist $profilePoints 
  }


  proc ProfileUpdate { value } {
    global kb_wslices 

    DeleteProfile
    CreateProfile $kb_wslices
  }

}


### PROFILE INITIALIZATION ###

point pkbi0 ( 0  0 0) endpoint
point pkbi1 ( 1  1 0) endpoint

polyline pProfile
  pointlist (pkbi0 pkbi1 )
endpolyline



################# PUTTING THE KB SWEEP TOGETHER  #############

tclinit {

  ### SWEEP ASSEMBLY UI

  proc CreateSweepUI { parent name } {
    set subname "slf_[subst $name]"

    if { $parent == {} } {
	set root .$subname
    } elseif { $parent == "." } {
	set root .$subname
    } else {
	set root $parent.$subname
    }

    toplevel $root

    set closed [CreateScale $name $root closed "BOTTLE: closed" 0 0 1 1 1 horizontal]	
    set minTorsion [CreateScale $name $root minTorsion "minTorsion" 1 0 1 1 1 horizontal]
    set drawSweep [CreateScale $name $root drawSweep "drawSweep" 1 0 1 1 1 horizontal]
    set drawPath [CreateScale $name $root drawPath "drawPath" 0 0 1 1 1 horizontal]
    set azim [CreateScale $name $root azim "azimuth" 0 -180 180 1 1 horizontal]
    #set twist [CreateScale $name $root twist "overall twist" 540 -540 540 1 1 horizontal]
    set size [CreateScaleCmd $name $root size "BODY - shrink" 0.9 0.5 1.2 0.02 1 horizontal ProfileUpdate ]
    set wslices [CreateScaleCmd $name $root wslices "width-slices" 30 6 60 1 1 horizontal ProfileUpdate ]
    set lslices [CreateScaleCmd $name $root lslices "length-slices" 60 3 100 1 1 horizontal KBPathUpdate]

    pack $closed $minTorsion $drawSweep $drawPath $azim $size $wslices $lslices  -side top -fill x
  }

  CreateSweepUI $winName kb
  puts "created sweepUI"
}


### THE SWEEP CONSTRUCT ####

crosssection cEIGHT
  type polyline pProfile
endcrosssection


sweep bottle
  path kbPath
    minimizetorsion {expr $kb_minTorsion}
    azimuth {expr $kb_azim}
    twist {expr -$path_flips*180}
  endpath

  crosssection cEIGHT
  endcrosssection

  surface BLU
  drawpath {expr $kb_drawPath}
  drawsweep {expr $kb_drawSweep}
  solid SLF_HOLLOW
endsweep


################ PUTTING THE WORLD TOGETHER ###########################

group assembly
  lod {expr $gRoot_lod}
  shading {expr $gRoot_shading}
  instance bandF
    scale (0.5 0.5 0.5)
  endinstance
  instance bandB
    scale (0.5 0.5 0.5)
  endinstance
  (*
  instance pipe
    scale (0.5 0.5 0.5)
  endinstance
  *)
  instance bottle
    scale (0.5 0.5 0.5)
  endinstance
endgroup


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

light amb
  type SLF_AMBIENT
  color (0.2 0.2 0.2)
endlight

light sun
  type SLF_DIRECTIONAL
  color (0.8 0.8 0.8)
endlight

light anti_sun
  type SLF_DIRECTIONAL
  color (0.4 0.4 0.4)
endlight

group world
  instance assembly   
    scale ( 0.02 0.02 0.02 )
  endinstance

  instance amb
    id main_amb
  endinstance
  instance sun
    id front_sun
    rotate (0 1 0) (-30)
    rotate (0 0 1) (-45)
  endinstance
  instance anti_sun
    id back_sun
    rotate (1 0 0) (180)
    rotate (0 1 0) (-30)
    rotate (0 0 1) (-45)
  endinstance
endgroup

camera cam
   projection SLF_PERSPECTIVE
  frustum ( -0.1 -0.1 -20 ) ( 0.1 0.1 -0.01)
endcamera

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

window Window
  background (0.3 0.9 0.5)
endwindow

viewport vp Window
endviewport

render vp gCam.iCam.cam world 
  light world.front_sun.sun
  light world.back_sun.anti_sun
  light world.main_amb.amb
endrender