#!/afs/net/project/tcl/wish -f
#
# calculator.tk -- Four banger calculator written in TK.
#
# This was written under inspiration by Dave Taylor when he asked
# on Usenet whether anyone knew of a good calculator.  He had
# in mind something the size of the Calculator-DA on a MacIntosh.
# The operative word there is small... which means (at first blush)
# that it be simple and simple minded.
#
# However we've hidden some power under the hood.  Namely the "Extras"
# menu and what it can eventually do.
#
# TODO
#
# Add second line to number display; this will show current
# `top of stack' and `saved operation'.
#
# Add memory register(s).
#
# Add constant(s) with an easily configurable list which
# the user can add in themselves.
#
# Detect overflow and do something reasonable.
#
# Insert error messages so that user'll know what's wrong.
#
# Allow for mouse clicks to make selections.
#
# New stuff for EXTRAS menu
#
#	Memory register control & display
#
#	Stack display and operations
#
#	Logic functions (we are programmers, after all)
#	User definable functions?
#
#	Constants.  The initial list of constants should be
#	stored in a TCL script stored in the users home directory.
#	As the user creates new constants, this file gets rewritten
#	and the screen is redrawn.
#
# Embed a long-precision math package and use that for all calcualtions.
#
# Stack display and controls (mentioned under EXTRAS menu) would contain
#
#	LISTBOX to show current stack.
#
#	Allowance for arbitrary number of entries on stack.
#
#	Operations to move things around on the stack.
#
#	Operators operate (by default) on top member of stack.  Have
#	way that operators can work with an arbitrary member of stack.
#	User probably should choose those operands with SELECTions.
#
# Can we support both RPN and INFIX with the same UI?  It is, after
# all, very similar and is mostly just doing a couple things in CMD
# in a different order than they are done now.
#


source [info library]/init.tcl


################ Build visual things on the screen


# BUILD:numberPad{} -- Build the 0-9 keys.

proc BUILD:numberPad {top} {

	frame $top.np -borderwidth 3 -relief sunken

	frame $top.np.row1
	frame $top.np.row2
	frame $top.np.row3
	frame $top.np.row4
	pack append $top.np	$top.np.row1 {top fill expand} \
			$top.np.row2 {top fill expand} \
			$top.np.row3 {top fill expand} \
			$top.np.row4 {top fill expand}

	button $top.np.row1.btn_7	-text "7"	-command {CMD:digit "7"}
	button $top.np.row1.btn_8	-text "8"	-command {CMD:digit "8"}
	button $top.np.row1.btn_9	-text "9"	-command {CMD:digit "9"}
	pack append $top.np.row1	$top.np.row1.btn_7 {left fill expand} \
					$top.np.row1.btn_8 {left fill expand} \
					$top.np.row1.btn_9 {left fill expand}

	button $top.np.row2.btn_4	-text "4"	-command {CMD:digit "4"}
	button $top.np.row2.btn_5	-text "5"	-command {CMD:digit "5"}
	button $top.np.row2.btn_6	-text "6"	-command {CMD:digit "6"}
	pack append $top.np.row2	$top.np.row2.btn_4 {left fill expand} \
					$top.np.row2.btn_5 {left fill expand} \
					$top.np.row2.btn_6 {left fill expand}


	button $top.np.row3.btn_1	-text "1"	-command {CMD:digit "1"}
	button $top.np.row3.btn_2	-text "2"	-command {CMD:digit "2"}
	button $top.np.row3.btn_3	-text "3"	-command {CMD:digit "3"}
	pack append $top.np.row3	$top.np.row3.btn_1 {left fill expand} \
					$top.np.row3.btn_2 {left fill expand} \
					$top.np.row3.btn_3 {left fill expand}


	button $top.np.row4.btn_0	-text "0"	-command {CMD:digit "0"}
	button $top.np.row4.btn_dot	-text "."	-command {CMD:period}
	button $top.np.row4.btn_inv	-text "+/-"	-command {CMD:invert}
	pack append $top.np.row4	$top.np.row4.btn_0   {left fill expand} \
					$top.np.row4.btn_dot {left fill expand} \
					$top.np.row4.btn_inv  {left fill expand}
}

# BUILD:bangers{} -- The part which provides the four bangs.

proc BUILD:bangers {top} {
	frame $top.bangers -borderwidth 3 -relief sunken

	button $top.bangers.divide	-text "/"	-command {CMD:divide}
	button $top.bangers.multiply	-text "*"	-command {CMD:multiply}
	button $top.bangers.subtract	-text "-"	-command {CMD:subtract}
	button $top.bangers.add		-text "+"	-command {CMD:add}
	button $top.bangers.equal	-text "="	-command {CMD:equal}
	pack append $top.bangers	$top.bangers.divide	{top fill expand} \
					$top.bangers.multiply	{top fill expand} \
					$top.bangers.subtract	{top fill expand} \
					$top.bangers.add	{top fill expand} \
					$top.bangers.equal	{top fill expand}
}

# BUILD:calcWin{} -- Put everything together.

proc BUILD:calcWin {} {

#	toplevel $top
#	wm geometry $top 
	wm minsize  . 1 1

	frame .value	-relief raised
	frame .btns	-relief raised
	frame .control  -relief flat
	pack append .	.control {top fillx} \
			.value {top fillx} \
			.btns {top fill expand} 

	label .value.current		-relief sunken -anchor e
	frame .value.indicators		-relief flat
	pack append .value	.value.current {top fillx} \
				.value.indicators {top fillx}

	BUILD:numberPad	".btns"
	BUILD:bangers	".btns"

	pack append .btns	.btns.np	{left fill expand} \
				.btns.bangers	{left fill expand}

	button .control.exit		-text "Off"	-command {exit}
	button .control.clear		-text "C"	-command {CMD:clear}
	button .control.clearAll	-text "CA"	-command {CMD:clearAll}
	menubutton .control.xtras		-text "Extras"	-menu .control.xtras.m
	pack append .control	.control.exit		{left fillx expand} \
				.control.clear		{left fillx expand} \
				.control.clearAll	{left fillx expand} \
				.control.xtras		{left fillx expand}

	menu .control.xtras.m
	.control.xtras.m add command -label "Trig"	-command mkTrigDialog
	.control.xtras.m add command -label "Constants" -command mkConstantsDialog

	INIT:keyBindings
	ENTRY:clear
}


################ TRIG dialog

proc mkTrigDialog {} {
	if {![catch {winfo ismapped .trig}]} {
		return
	}

	toplevel .trig -class Dialog
	wm minsize  .trig 1 1

	frame .trig.btns
	pack append .trig .trig.btns {top fill expand}

	button .trig.btns.cos	-text "COS"	-command "TRIG:unary cos"
	button .trig.btns.sin	-text "SIN"	-command "TRIG:unary sin"
	button .trig.btns.tan	-text "TAN"	-command "TRIG:unary tan"
	button .trig.btns.sqrt	-text "SQRT"	-command "TRIG:unary sqrt"
	button .trig.btns.exp	-text "e^x"	-command "TRIG:unary exp"
	button .trig.btns.ln	-text "ln"	-command "TRIG:unary ln"
	button .trig.btns.log10	-text "log10"	-command "TRIG:unary log10"
	button .trig.btns.kill  -text "Dismiss"	-command {catch {destroy .trig}}

	pack append .trig.btns	.trig.btns.cos	{top fillx expand} \
				.trig.btns.sin	{top fillx expand} \
				.trig.btns.tan	{top fillx expand} \
				.trig.btns.sqrt	{top fillx expand} \
				.trig.btns.exp	{top fillx expand} \
				.trig.btns.ln	{top fillx expand} \
				.trig.btns.log10 {top fillx expand} \
				.trig.btns.kill {top fillx expand}
}

# TRIG:unary -- Do the operation.  We can only support, for now, single
# operand operations here.  An x^y requires a different procedure
# from this.  At any rate, doing UNARY commands is pretty simple.
# All's that's necessary is to get the value, calculate new one, and
# put it back.

proc TRIG:unary {cmd} {
	if {[ENTRY:state] == "error"} {
		return
	}

	set current [ENTRY:get]
	if {[catch {case $cmd {
			cos	{ set current [cos $current] }
			sin	{ set current [sin $current] }
			tan	{ set current [tan $current] }
			sqrt	{ set current [sqrt $current] }
			exp	{ set current [exp $current] }
			ln	{ set current [log $current] }
			log10	{ set current [log10 $current] }
			}
		} errorInfo]} {
		ENTRY:errorState $errorInfo
	} else {
		ENTRY:set $current
	}
}

################ CONSTANTS dialog

proc mkConstantsDialog {} {
}


################ Handle input, either from keyboard or button presses.

proc INIT:keyBindings {} {
	bind all <Key-0>	{CMD:digit "0"}
	bind all <Key-1>	{CMD:digit "1"}
	bind all <Key-2>	{CMD:digit "2"}
	bind all <Key-3>	{CMD:digit "3"}
	bind all <Key-4>	{CMD:digit "4"}
	bind all <Key-5>	{CMD:digit "5"}
	bind all <Key-6>	{CMD:digit "6"}
	bind all <Key-7>	{CMD:digit "7"}
	bind all <Key-8>	{CMD:digit "8"}
	bind all <Key-9>	{CMD:digit "9"}

	bind all <period>	CMD:period
	bind all <slash>	CMD:divide
	bind all <asterisk>	CMD:multiply
	bind all <minus>	CMD:subtract
	bind all <plus>		CMD:add
	bind all <equal>	CMD:equal

	bind all <Control-c>	CMD:clear
	bind all <M-c>		CMD:clearAll

	bind all <M-q>		exit
}

proc CMD:clear {} {
	ENTRY:clear
}

proc CMD:clearAll {} {
	ENTRY:clear
	STACK:clear
}

# CMD:digit -- Handle pressing numbers on `keypad'.
#
# If state is `newNumber' then we are to start a new number.
# Otherwise it suffices to append the pressed digit to the
# end of the number string.

proc CMD:digit {pressed} {
	set state [ENTRY:state]
	if {$state == "error"} {
		return
	}
	set current [ENTRY:get]
	if {$state == "newNumber"} {
		set new "$pressed"
		ENTRY:setState number
	} else {
		set new "${current}${pressed}"
	}
	ENTRY:set $new
}

# CMD:period -- There can be only one `.' in a number.

proc CMD:period {} {
	if {[ENTRY:state] == "error"} {
		return
	}
	set current [ENTRY:get]
	if {[string first "." $current] >= 0} {
		ENTRY:errorState "Too many periods"
		return
	}
	set new "${current}."
	ENTRY:set $new
	ENTRY:setState number
}

proc CMD:invert {} {
	if {[ENTRY:state] == "error"} {
		return
	}
	set current [ENTRY:get]
	set new [expr ${current}*(-1)]
	ENTRY:set $new
}


# CMD:{divide,multiply,subtract,add} -- Do the indicated operation.
# This is kinda hard-wired for INFIX operations.  This is because:
#
#	We first do any pending operations.
#	We then save this operation & value onto the top of the `stack'.
#
# If we were to do RPN operations the differences would be:
#
#	We'd have a `real' stack with at least two entries.
#	We'd pop both off, do the operation, and push the result.
#	We'd always be displaying the top of the stack.
#
# We enter state:newNumber after all these because the user is to
# type in a new number.  Note that if they do not type a new number
# but immediately do another operation, the second operand of it
# will be `0'.  I don't think this is a problem.
#

proc CMD:divide {} {
	if {[ENTRY:state] == "error"} {
		return
	}
	if {[STACK:doOperation]} {
		STACK:save divide
		ENTRY:setState newNumber
	}
}

proc CMD:multiply {} {
	if {[ENTRY:state] == "error"} {
		return
	}
	if {[STACK:doOperation]} {
		STACK:save multiply
		ENTRY:setState newNumber
	}
}

proc CMD:subtract {} {
	if {[ENTRY:state] == "error"} {
		return
	}
	if {[STACK:doOperation]} {
		STACK:save subtract
		ENTRY:setState newNumber
	}
}

proc CMD:add {} {
	if {[ENTRY:state] == "error"} {
		return
	}
	if {[STACK:doOperation]} {
		STACK:save add
		ENTRY:setState newNumber
	}
}

proc CMD:equal {} {
	if {[ENTRY:state] == "error"} {
		return
	}
	STACK:doOperation
	ENTRY:setState newNumber
}

################ Operations on a stack full of saved data.
#
# NOTE: For now the stack is only one operation/value deep.

proc STACK:clear {} {
	global STACK
	catch { unset STACK(savedValue) }
	catch { unset STACK(savedOperation) }
}

proc STACK:save {operation} {
	global STACK
	if {[ENTRY:state] == "error"} {
		return
	}
	set STACK(savedValue) [ENTRY:get]
	set STACK(savedOperation) $operation
}

# STACK:doOperation -- Do the operation saved on the stack.  The left
# operand comes from the stack, while the right operand comes from
# the screen.
#
# We check to make sure there is an operation saved before proceeding.
#
# We ensure there's one `.' in the number to ensure it is treated
# as floating point.

proc STACK:doOperation {} {
	global STACK
	if {![info exists STACK(savedValue)] ||
	    ![info exists STACK(savedOperation)]} {
		return 1
	}

	if {[ENTRY:state] == "error"} {
		return 0
	}

	set current [ENTRY:get]
	if { [string first "." $current] == -1} {
		set current "${current}."
	}
	if { [string first "." $STACK(savedValue)] == -1} {
		set STACK(savedValue) "$STACK(savedValue)."
	}
	case $STACK(savedOperation) {
	divide		{ if {$current == 0} {
				set new 0
				ENTRY:errorState "Division by zero"
				return 0
			  }
			  set new [expr "$STACK(savedValue) / ${current}" ]
			}
	multiply	{ set new [expr "$STACK(savedValue) * ${current}" ] }
	subtract	{ set new [expr "$STACK(savedValue) - ${current}" ] }
	add		{ set new [expr "$STACK(savedValue) + ${current}" ] }
	}

	ENTRY:set $new
	unset STACK(savedValue)
	unset STACK(savedOperation)

	return 1
}


################ Operations on the number-display where we show
################ the current `value' in the calculator.

# ENTRY:errorState -- Enter error state.  While in error state
# none of the stuff above will operate.  To find out if you're
# in error state do:
#
#	if {[ENTRY:state] == "error"} { ... }
#
# And to leave that state:
#
#	ENTRY:setState somethingElse

proc ENTRY:errorState {{msg "NONE"}} {
	ENTRY:setState error
	.value.current configure -text "EEEEEEEEEE"
}

proc ENTRY:setState {state} {
	global STACK
	set STACK(state) $state
}

proc ENTRY:state {} {
	global STACK
	return $STACK(state)
}

# ENTRY:clear -- Clear the screen.  Enter newNumber state as well.

proc ENTRY:clear {} {
	global STACK
	set STACK(currentValue) 0
	.value.current configure -text "0"
	ENTRY:setState newNumber
}

proc ENTRY:get {} {
	global STACK
	return $STACK(currentValue)
}

proc ENTRY:set {value} {
	global STACK
	set STACK(currentValue) $value
	.value.current configure -text "$value"
}


################ Start the display & program going

ENTRY:setState newNumber
BUILD:calcWin