#!/usr/local/tcl/bin/wish -f
#  Script to put the outside reverse fold into Geomview

wm title . "Generic reverse fold"

#----------------------------------------------------------------------------
#  to run geomview from this Tk script, uncomment the first set line
#  to run as an external module, uncomment the second set line
#    put a line in the .geomview file if you want these to appear in the menu
#----------------------------------------------------------------------------

set f [open {|geomview -c -} w]
# set   f stdout


#----------------------------------------------------------------------------
# Basic spherical trig formulae;  pt is pi/2
#----------------------------------------------------------------------------

proc SAS { x y z} {
  return [expr acos( cos($x)*cos($z)+sin($x)*sin($z)*cos($y))]
}

proc SSS { x y z} {
  return [expr acos(( cos($y)-cos($x)*cos($z))/(sin($x)*sin($z)))]
}

set pt [expr asin(1)]

#----------------------------------------------------------------------------
#  define the folds on the sheet of paper
#    the values are the angles in radians
#  cx parametrizes the degree of folding
#----------------------------------------------------------------------------

set ab [expr 1.5 * $pt]
set ad [expr 1.5 * $pt]
set bc [expr 0.5 * $pt]
set cd [expr 0.5 * $pt]
set cy $pt

#----------------------------------------------------------------------------
#  compute the direction cosines of the folds
#  then find the vectors along the folds
#----------------------------------------------------------------------------

proc recalc {} {
  global pt a b c d ab bc cd ad cx cy 

        set c_s [expr 1/sqrt(2)]
	set ac [expr $pt + $cx]
	  set acb [SSS $ac $ab $bc] 
	set bx [SAS $cx $acb $bc]
	  set bac [SSS $ab $bc $ac]
	set by [SAS $ab [expr $pt - $bac] $pt]
	  set acd [SSS $ac $ad $cd]
	set dx [SAS $cx $acd $cd]
	  set dac [SSS $ad $cd $ac]
	set dy [expr 2 * $pt - [SAS $ad [expr $pt - $dac] $pt]]

	set   a { 0 0 1 }
	set   b [list [expr cos($bx)] [expr cos($by)] [expr cos($ab)] ] 
	set   c [list [expr $c_s*cos($cx)] [expr $c_s*cos($cy)] \
                      [expr $c_s*cos($ac)] ] 
	set   d [list [expr cos($dx)] [expr cos($dy)] [expr cos($ad)] ] 
}

#-----------------------------------------------------------------------------
#  send the Polylist geometry item to Geomview
#    the argument cxx is cx in degrees rather than radians
#-----------------------------------------------------------------------------
proc sendit {cxx} {
  global f a b c d cx

  set cx [expr $cxx * 0.017453293]
  recalc
  puts $f "(geometry g1 OFF
5 4 0
    0 0 0
    $a
    $b
    $c
    $d
    3 0 1 2  1 0 1 1
    3 0 2 3  1 0 1 1
    3 0 3 4  1 0 1 1
    3 0 4 1  1 0 1 1
)"
  flush $f
}

#--------------------------------------------------------------------------
#  change the fold angle on the sheet of paper itself
#--------------------------------------------------------------------------
proc foldit {dxx} {
  global ab bc ad cd pt

  set bc [expr ($dxx + [.steppp get]) * 0.017453293]
  set cd [expr ($dxx - [.steppp get]) * 0.017453293]
  set ab [expr $pt + $pt - $bc]
  set ad [expr $pt + $pt - $cd]
  sendit [.step get]
}

#--------------------------------------------------------------------------
# layout the controls
#--------------------------------------------------------------------------
frame .bf

scale .step -label "Folding Angle: 90 = flat -> 0 = folded" -from 89 -to 0 \
      -length 10c  -orient horizontal

button .bf.home -text "Close" -command {
    .step set 1
    sendit 1
    flush $f
}

button .bf.move -text "Open" -command {
    .step set 89
    sendit 89 
    flush $f
}

button .bf.hyper -text "Hyperbolic" -command {
    puts $f "(space hyperbolic)"
    puts $f "(hmodel c0 conformal)"
    puts $f "(set-conformal-refine 0.97)"
    flush $f
}

scale .stepp -label "Angle on Paper" -from 0 -to 90 \
      -length 10c  -orient horizontal

scale .steppp -label "Asymmetry" -from -20 -to 20 \
      -length 10c  -orient horizontal

button .bf.quit -text "Quit" -command {
  puts $f "(exit)"
  destroy .
}

bind .step <ButtonRelease-1> {sendit [.step get]}
bind .stepp <ButtonRelease-1> {foldit [.stepp get]}
bind .steppp <ButtonRelease-1> {foldit [.stepp get]}

pack .bf.home .bf.move .bf.hyper .bf.quit -side left
pack append . .step {top}
pack append . .bf {top}
pack append . .stepp {top}
pack append . .steppp {top}

#----------------------------------------------------------------------------
# put some initial fold on the screen
#---------------------------------------------------------------------------
.step set 45
.stepp set 45
.steppp set 0 
sendit 45 
puts $f "(transform g1 g1 focus rotate -1  0 0)"
puts $f "(transform g1 g1 focus rotate  0 -1 0)"
flush $f