#!/bin/sh
# If running in a UNIX shell, restart wish on the next line \
exec wish "$0" ${1+"$@"}


#####   SitePlot.tcl  #####

# Copyright (c) 2003, 2009 Oscar Garcia

# Permission is hereby granted, free of charge, to any person obtaining a
# copy of this software and associated documentation files (the
# "Software"), to deal in the Software without restriction, including
# without limitation the rights to use, copy, modify, merge, publish,
# distribute, sublicense, and/or sell copies of the Software, and to
# permit persons to whom the Software is furnished to do so, subject to
# the following conditions:
# 
# The above copyright notice and this permission notice shall be included
# in all copies or substantial portions of the Software.
# 
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
# OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
# IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
# CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
# TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
# SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.


package require Tk  ;#  for tclkit

set progID {SitePlot 2.1}

global glob nextFlag

set glob(title) {}
set glob(dataFile) {}
set glob(ageScale) 10
set glob(htScale) 10
set glob(model) 0
set glob(equation) {}
set glob(ageLabel) {Age (years)}
set glob(ageFrom) 0
set glob(ageTo) {}
set glob(htLabel) {Top Height (m)}
set glob(htFrom) 0
set glob(htTo) {}
set glob(siteFrom) 10
set glob(siteTo) 30
set glob(siteBy) 5
set glob(indexAge) 50
set glob(grid) 0
set glob(lineType) 2


proc Help {} {
	set helpText {GRAPHING HEIGHT-AGE DATA, SITE CURVES, OR BOTH

Title:  Optional, appears at top of graph.
Data file:  Optional.  File name, as used in EasySDE,
	to graph the data.
Scaling:  As used in EasySDE, restore parameter values
	to original data units.  
Model:  Optional. Click to select for graphing curves.
	Models 11 to 13 and 16 to 18 are not available.
Parameters:  Globals.  Can be scaled back automatically.
Equation:  Site Index equation.  Original data units.
	Symbols: t = age, S = site index, ts = index age.
Axes labels:  Any string.
Axes ranges:  Blank means automatic, from the data.
Site:  Site index curves to be drawn.
Grid:  Optional grid lines.
Line type:  Dashed, etc., for site curves.  See
	gnuplot Help.

You are left in gnuplot, free to modify the graph.
The gnuplot commands are left in file SitePlot.plt,
can be loaded later, possibly after manual editing.
	}
	option add *Dialog.msg.wrapLength 6i
	tk_messageBox -type ok -title Help -message $helpText
}

proc Validate {} {
	global glob

	# numbers
	if {! [string is double -strict $glob(ageScale)]} {return "Age scale"}
	if {! [string is double -strict $glob(htScale)]} {return "Height scale"}
	if {! [string is double -strict $glob(siteFrom)]} {return "Site index From"}
	if {! [string is double -strict $glob(siteTo)]} {return "Site index To"}
	if {! [string is double -strict $glob(siteFrom)]} {return "Site index By"}
	if {! [string is double -strict $glob(lineType)]} {return "Curves line type"}

	# numbers or blank
	if {! [string is double $glob(ageFrom)]} {return "Age axis From"}
	if {! [string is double $glob(ageTo)]} {return "Age axis To"}
	if {! [string is double $glob(htFrom)]} {return "Height axis From"}
	if {! [string is double $glob(ageTo)]} {return "Height axis To"}

	if {$glob(model) != 0} {
		foreach p {a b c t0 h0c} {
			if {[string compare $glob($p) local] == 0  ||
                [string compare $glob($p) bt] == 0  ||
				[string compare $glob($p) bh^c] == 0} continue 
			if {! [string is double -strict $glob($p)]} {return "$p"}
		}
	}

	set glob(dataFile) [string trim $glob(dataFile)]
	if {[string length $glob(dataFile)]} {
		if {! [file exists $glob(dataFile)]} {return "Data file not found"}
	} else {
		if {! [string is double -strict $glob(ageFrom)]} {return "Age axis From"}
		if {! [string is double -strict $glob(ageTo)]} {return "Age axis To"}
	}

	return ""
}
	
proc ChkScale {p} {
	global glob

	switch $p {
		a {
			if {$glob(model) <= 6} {
				set result local
			} elseif {[catch {expr {$glob(a) * $glob(htScale)}} result]} {
				set result {}
			}
		}
		b {

			if {$glob(model) > 6} {
				set result local
			} elseif {[catch {expr {$glob(b) / $glob(ageScale)}} result]} {
				set result {}
			}
		}
		c {
			if {[string is double -strict $glob(c)]} {
				set result [expr $glob(c)*1.0]
			} else {
				set result {}
			}
		}
		t0 {
			if {[string compare $glob(t0) {bt}] == 0} {
				set result 0.5
			} elseif {[catch {expr {$glob(t0) * $glob(ageScale)}} result]} {
				set result {}
			}
		}
		h0c {
			if {[string compare $glob(h0c) {bh^c}] == 0} {
				set result [expr pow(1.3,$glob(c))]
			} elseif {[catch {expr {$glob(h0c) * pow($glob(htScale),$glob(c))}} result]} {
				set result {}
			}
		}
	}
	return $result
}


proc ShowEquation {} {
	global glob

	if {$glob(model) < 1} {
		set glob(equation) {}
		return OK
	}

	# check and scale
	foreach p {a b c t0 h0c} {
		set x [ChkScale $p]
		if {$x == {}} {
			tk_messageBox -type ok -icon error -message "Missing or invalid info: $p"
			set glob{equation} {}
			return error
		}
		set $p $x
	}

	set cinv [expr {1. / $c}]
	if {$t0 == 0} {
		set dt t
		set ds ts
	} else {
		set dt "(t-$t0)"
		set ds "(ts-$t0)"
	}

	if {[string compare $b local] == 0} {
		if {[string is integer $a]} {
			set afloat $a.
		} else {
			set afloat $a
		}
		if {$h0c == 0} {
			set glob(equation) "$a*(1-(1-(S/$afloat)**$c)**($dt/$ds))**$cinv"
		} else {
			set m0 [expr {1 - $h0c / pow($a,$c)}]
			set glob(equation) "$a*(1-$m0*((1-(S/$afloat)**$c)/$m0)**($dt/$ds))**$cinv"
		}
	} elseif {[string compare $a local] == 0} {
		if {$h0c == 0} {
			set glob(equation) "S*((1-exp(-$b*$dt))/(1-exp(-$b*$ds)))**$cinv"
		} elseif {$h0c > 0} {
			set glob(equation) "((S**$c-$h0c)*(1-exp(-$b*$dt))/(1-exp(-$b*$ds))+$h0c)**$cinv"
		} else {
			set glob(equation) "((S**$c+[expr -$h0c])*(1-exp(-$b*$dt))/(1-exp(-$b*$ds))$h0c)**$cinv"
		}
	} else {
	error "Oops!  I'm confused"
	}
	return OK
}

set tcl_precision  4

wm title . $progID

# Trick to get focus
update idletasks
wm deiconify .

source Plot.ui.tcl
Plot_ui .
focus .titleEntry

set err start
while 1 {
	tkwait variable nextFlag
	set err [Validate]
	if {[string length $err]} {
		tk_messageBox -type ok -icon error -message "Missing or invalid info: $err"
	} else {
		if {[ShowEquation] == "OK"} break
	}
}


destroy .

set f [open SitePlot.plt w]
puts $f "set title \"$glob(title)\"
set xlabel \"$glob(ageLabel)\"
set ylabel \"$glob(htLabel)\"
set xrange \[$glob(ageFrom):$glob(ageTo)\]
set yrange \[$glob(htFrom):$glob(htTo)\]
set style data lines
unset key"

if {$glob(grid)} {puts $f "set grid"}

if {$glob(model) > 0} {
	set x $glob(indexAge)
	if {[string is integer $x]} {
		set x $x.
	}
	puts $f "h(t,S)=$glob(equation)
ts=$x
set dummy t
set style line 9 lt $glob(lineType)
"
}

if {[string length $glob(dataFile)]} {
	puts -nonewline $f "plot '$glob(dataFile)' using 2:3"
}

if {$glob(model) > 0} {
	if {[string length "$glob(dataFile)"]} {
		puts $f ",\\"
	} else {
		puts $f "plot \\"
	}
	for {set S $glob(siteFrom)} {$S <= $glob(siteTo)} {incr S $glob(siteBy)} {
		append commands "h(t,$S) with lines ls 9,\\\n"
	}
	puts $f [string trimright $commands ,\\\n]
}

puts $f {}
close $f
exec ./wgnuplot -noend SitePlot.plt

