#!/usr/local/bin/wish -f

#this creates the frames:
frame .numf
frame .colf
frame .fk
frame .fx
frame .fy
frame .fdim
frame .butt

#this creates the labels for the entry spaces:
label .numf.label1 -text "Enter a number n:"
label .fx.label3 -text "Enter a range for x: from"
label .fx.label4 -text "to"
label .fy.label5 -text "Enter a range for y: from"
label .fy.label6 -text "to"
label .fdim.label7 -text "Enter the number of sampling points for each variable:"
label .fk.label8 -text "Enter a number k:"

#this creates the entry spaces:
entry .numf.num -width 6 -relief sunken -textvariable n
entry .colf.color -width 10 -relief sunken -textvariable col
entry .fk.kfactor -width 6 -relief sunken -textvariable k
entry .fx.xmin -width 6 -relief sunken -textvariable xmin
entry .fx.xmax -width 10 -relief sunken -textvariable xmax
entry .fy.ymin -width 6 -relief sunken -textvariable ymin
entry .fy.ymax -width 10 -relief sunken -textvariable ymax
entry .fdim.dim -width 6 -relief sunken -textvariable dim

#this inserts default values of the variables into the entry spaces:
.numf.num insert 0 "4"
.fk.kfactor insert 0 "1"
.fx.xmin insert 0 "0"
.fx.xmax insert 0 "3.14159/2"
.fy.ymin insert 0 "0"
.fy.ymax insert 0 "2*3.14159"
.fdim.dim insert 0 "41"

#this creates the buttons:
button .butt.start -text "Make Boy's Surface" -background blue -activebackground white -foreground white -activeforeground blue -command "Boys"
button .butt.quit -text QUIT -background red -activebackground white -foreground white -activeforeground red -command "Quit"
button .butt.instruct -text "Instructions" -background "lime green" -activebackground white -foreground white -activeforeground "lime green" -command "Instructions" 
button .default -text "Create a default Boy's Surface" -background #ff6600 -activebackground white -foreground white -activeforeground #ff6600 -command "DefaultBoys"
button .equations -text "See the equations for Boy's Surface" -background purple -activebackground white -foreground white -activeforeground purple -command "Equations"

radiobutton .colf.choice -variable option -text "Tricolor" -value 1
radiobutton .colf.blah -variable option -text "Choose your own color" -value 0

.colf.blah select

#this packs everything into the frames:
pack .numf.label1 .numf.num -side left
pack .colf.choice .colf.blah .colf.color -side left
pack .fk.label8 .fk.kfactor -side left
pack .fx.label3 .fx.xmin .fx.label4 .fx.xmax -side left
pack .fy.label5 .fy.ymin .fy.label6 .fy.ymax -side left
pack .fdim.label7 .fdim.dim -side left 
pack .butt.instruct .butt.start .butt.quit -side left

#this packs the frames into the window:
pack .colf .fx .fy .fdim .numf .fk .butt .default .equations

#this creates the Instructions window that pops up if the "Instructions"
#button is pushed
proc Instructions { } {
    toplevel .help
    
    label .help.one -text "INSTRUCTIONS"
    label .help.two -text "This program will create a Boy's Surface using your specifications."
    label .help.three -text "Choose a color, a x-range, a y-range, the dimension, and a k-value."
    label .help.four -text "The constant k will control the height-width ratio of your Boy's Surface."
    label .help.five -text "The constant n will control the size of the legs."

    button .help.done -text "Close instructions window" -background violet -activebackground indigo -foreground indigo -activeforeground violet -command "destroy .help"

    pack .help.one .help.two .help.three .help.four .help.five .help.done
}

#this creates the Equations window that pops up if the "See the equations
#for Boy's Surface" button is pushed:
proc Equations { } {
    toplevel .eq -background white
    
    label .eq.one -background white -text "First, s and t coordinates are taken from a plane to a sphere with x, y, and z coordinates, using the following equations:"
    label .eq.x -background white -text "X =  0.577295*cos(s) - 0.577295*cos(t)*sin(s) - 0.39504259905*sin(s)*sin(t)"
    label .eq.y -background white -text "Y = 0.577295*cos(s) + 0.577295*cos(t)*sin(s) - 0.333365118676*sin(s)*sin(t)"
    label .eq.z -background white -text "Z = 0.57746*cos(s) + 0.728199303743*sin(s)*sin(t)"
    label .eq.blank -background white -text " "
    label .eq.two -background white -text "Then, the points on the sphere are mapped to Boy's Surface with these equations:"
    label .eq.f -background white -text "F = ((1.73205)/2)*((y^2 - z^2)*k + z*x*(z^2 - x^2) + x*y*(y^2 - x^2))"
    label .eq.g -background white -text "G = ((2*x^2 - y^2 - z^2)*k + 2*y*z*(y^2 - z^2) + z*x*(x^2 - z^2) + x*y*(y^2 - x^2))/2"
    label .eq.h -background white -text "H = (x + y + z)*((x + y + z)^3 +n*(y-x)*(z-y)*(x-z))/8"
    button .eq.done -text "Close equations window" -background violet -activebackground indigo -foreground indigo -activeforeground violet -command "destroy .eq"

pack .eq.one .eq.x .eq.y .eq.z .eq.blank .eq.two .eq.f .eq.g .eq.h .eq.done
}

#this closes the TCL program if the Quit button is pushed:
proc Quit { } {
    exit
}

#here, the x, y, and z funtions are defined:
proc Xfunc {s t} {
    expr 0.577295*cos($s) - 0.577295*cos($t)*sin($s) - 0.39504259905*sin($s)*sin($t)
}

proc Yfunc {s t} {
    expr 0.577295*cos($s) + 0.577295*cos($t)*sin($s) - 0.333365118676*sin($s)*sin($t)
}

proc Zfunc {s t} {
    expr 0.57746*cos($s) + 0.728199303743*sin($s)*sin($t) 
}

#here the f, g, and h functions are defined:
proc G {x y z} {
    global k
    expr ((1.73205)/2)*(($y*$y - $z*$z)*$k + $z*$x*($z*$z - $x*$x) + $x*$y*($y*$y - $x*$x))
}

proc F {x y z} {
    global k
    expr ((2*$x*$x - $y*$y - $z*$z)*$k + 2*$y*$z*($y*$y - $z*$z) + $z*$x*($x*$x - $z*$z) + $x*$y*($y*$y - $x*$x))/2
}

proc H {x y z} {
    global n
    expr ($x + $y + $z)*(($x + $y + $z)*($x + $y + $z)*($x + $y + $z) +$n*($y-$x)*($z-$y)*($x-$z))/8
}

#q is the variable that renames each Boy's Surface and its handle in Geomview, 
#so that you can make as many surfaces as you like.
set q 0

#this makes the Boy's Surface, using the user input values of the variables
# when the "Make Boy's Surface" button is pushed:
proc Boys { } {
    global col xmax xmin ymax ymin dim q option
    
    #this translates the color name into an RGB color:
    if { $col == "red" } {
	set r 1; set gr 0; set b 0
    } elseif { $col == "green" } {
	set r 0; set gr .545; set b .1
    } elseif { $col == "blue" } {
	set r 0; set gr 0; set b 1
    } elseif { $col == "yellow" } {
	set r 1; set gr 1; set b 0
    } elseif { $col == "purple" || $col == "violet"} {
	set r 0.5; set gr 0; set b 1 
    } elseif { $col == "orange" } {
	set r 1; set gr 0.3; set b 0
    } elseif { $col == "pink" } {
	set r 1; set gr 0.3; set b 0.4
    } elseif { $col == "magenta" || $col == "fushia"} {
	set r 1; set gr 0; set b 1
    } elseif { $col == "gray" || $col == "grey"} {
	set r 0.5; set gr 0.5; set b 0.5
    } elseif { $col == "aquamarine" || $col == "turquoise" || $col == "cyan"} {
	set r 0; set gr 1; set b 1
    } elseif { $col == "light green"} {
	set r 0; gr 1; set b 0
    } else {
	set r 1; set gr 1; set b 1
    }
    
    set q [expr $q + 1]
    set dt .01
    set dx [expr (($xmax - $xmin)/($dim-1))]
    set dy [expr (($ymax - $ymin)/($dim-1))]

    #these are the instructions given to Geomview:
    puts stdout {(bbox-draw "worldgeom" off)}
    puts stdout {(normalization "worldgeom" none)}
    flush stdout

    puts stdout "\(geometry boys$q \{ :foo$q\}\)\n"
    puts stdout "(read geometry { define foo$q \n"
    flush stdout

    puts stdout "CMESH\n"
    puts stdout "$dim $dim\n"
    for {set i 0; set y $ymin} {$i < $dim} {incr i} {
	for {set j 0; set x $xmin} {$j < $dim} {incr j} {
	    set boysx [Xfunc $x $y]
	    set boysy [Yfunc $x $y]
	    set boysz [Zfunc $x $y]
	    
	    set g [G $boysx $boysy $boysz]
	    set h [H $boysx $boysy $boysz]
	    set f [F $boysx $boysy $boysz]
	    
	    if { $option == 0 } {
	    puts stdout "$g $f $h $r $gr $b 1"
	    } elseif { $option == 1 } {
		if { $y <= (2*3.14159)/3.0 } {
		    puts stdout "$g $f $h 0 1 1 1"
		} elseif { $y <= (4*3.14159)/3.0 } {
		    puts stdout "$g $f $h .6 1 .6 1"
		} else {
		    puts stdout "$g $f $h 1 .8 .8 1"
		}
	    }
	    set x [expr ($x + $dx)]
	}
	puts stdout "\n"
	set y [expr ($y + $dy)]
    }
    puts stdout "\ } \ ) \n"
    flush stdout
}

#this procedure makes a Boy's Surface using the default values of the 
#variables if the "Create a default Boy's Surface" button is pushed. 
proc DefaultBoys { } {

    #this puts the default values back into the entry spaces:
    .numf.num delete 0 10
    .fk.kfactor delete 0 10
    .fx.xmin delete 0 10
    .fx.xmax delete 0 10
    .fy.ymin delete 0 10
    .fy.ymax delete 0 10
    .fdim.dim delete 0 10

    .numf.num insert 0 "4"
    .fk.kfactor insert 0 "1"
    .fx.xmin insert 0 "0"
    .fx.xmax insert 0 "3.14159/2"
    .fy.ymin insert 0 "0"
    .fy.ymax insert 0 "2*3.14159"
    .fdim.dim insert 0 "41" 
    .colf.blah select

    #this sets the variables to their default values:
    set xmin 0
    set xmax 3.14159/2
    set ymin 0
    set ymax 2*3.14159
    set dim 41
    set n 4
    set k 1
    set r 0
    set gr 0.2
    set b 1

    set dt .01
    set dx [expr (($xmax - $xmin)/($dim-1))]
    set dy [expr (($ymax - $ymin)/($dim-1))]

    #this gives geomview the instructions to make Boy's Surface:
    puts stdout {(bbox-draw "worldgeom" off)}
    puts stdout {(normalization "worldgeom" none)}
    flush stdout

    puts stdout "\(geometry standard \{ :pie\}\)\n"
    puts stdout "(read geometry { define pie \n"
    flush stdout

    puts stdout "CMESH\n"
    puts stdout "$dim $dim\n"
    for {set i 0; set y $ymin} {$i < $dim} {incr i} {
	for {set j 0; set x $xmin} {$j < $dim} {incr j} {
	    set boysx [Xfunc $x $y]
	    set boysy [Yfunc $x $y]
	    set boysz [Zfunc $x $y]
	    
	    set g [G $boysx $boysy $boysz]
	    set h [H $boysx $boysy $boysz]
	    set f [F $boysx $boysy $boysz]
	    
	    puts stdout "$g $f $h $r $gr $b 1"
	    set x [expr ($x + $dx)]
	}
	puts stdout "\n"
	set y [expr ($y + $dy)]
    }
    puts stdout "\ } \ ) \n"
    flush stdout
}