# Stack operation code for Tk-based RPN calculator
#
# This code is in the public domain. See the main program
# file for a disclaimer of liability.
#
# $Header: /home/neil/src/tcl/calc/RCS/calcstck,v 1.4 2000/12/28 14:42:31 neil Exp $

# Get the routine that makes listbox items draggable.

source [file join $calcSrcDir mlbid]

# MakeStackBox makes a box in widget "path" containing
# the operation stack and a set of buttons for manipulating it.

proc MakeStackBox {path} {
    global calcStackInfo

    # Just in case "path" is "."

    set pathpref $path
    if {[string compare $path "."] == 0} {
	set pathpref ""
    }

    listbox $pathpref.stack -height 10 -width 25 \
			-yscrollcommand [list $pathpref.stackscroll set]
    scrollbar $pathpref.stackscroll -orient vertical \
			-command [list $pathpref.stack yview]
    grid $pathpref.stackscroll -row 0 -column 0 -sticky ns
    grid $pathpref.stack -row 0 -column 1 -sticky nsew
    grid columnconfigure $path 1 -weight 1

    # Make the items in the stack draggable.

    MakeListboxItemsDraggable $pathpref.stack

    # This is a table describing all the stack operation buttons.
    # The entries in this list come in multiples of seven; the
    # entries are, in order:
    #
    #	The button name
    #	The text on the button
    #	The row where the button is gridded
    #	The grid row where the button stops (usually the same
    #		as the previous entry; a larger number indicates
    #		that the button spans more than one row.)
    #	The column where the button is gridded
    #	The grid column where the button stops (again, usually
    #		the same as the previous entry, and a larger
    #		number indicates that the button spans multiple columns)
    #	The code to execute when the button is pressed.

    set kpButtonList [list \
	pop	"Pop Stack"	0	0	0	1 \
				[list PopStack $path] \
	clr	"Clear Stack"	0	0	2	3 \
				[list ClearStack $path] \
	sin	"Sin"		1	1	0	0 \
				[list TrigFunc $path sin] \
	cos	"Cos"		1	1	1	1 \
				[list TrigFunc $path cos] \
	tan	"Tan"		1	1	2	2 \
				[list TrigFunc $path tan] \
	deg	"Deg"		1	1	3	3 \
				[list TrigMode $path deg] \
	arcsin	"ArcSin"	2	2	0	0 \
				[list InvTrigFunc $path asin] \
	arccos	"ArcCos"	2	2	1	1 \
				[list InvTrigFunc $path acos] \
	arctan	"ArcTan"	2	2	2	2 \
				[list InvTrigFunc $path atan] \
	rad	"Rad"		2	2	3	3 \
				[list TrigMode $path rad] \
	ln	"ln"		3	3	0	0 \
				[list ApplyFunc $path log] \
	exp	"exp"		3	3	1	1 \
				[list ApplyFunc $path exp] \
	log10	"log10"		3	3	2	2 \
				[list ApplyFunc $path log10] \
	tenx	"10^X"		3	3	3	3 \
				[list TenX $path] \
	sinh	"Sinh"		4	4	0	0 \
				[list ApplyFunc $path sinh] \
	cosh	"Cosh"		4	4	1	1 \
				[list ApplyFunc $path cosh] \
	tanh	"Tanh"		4	4	2	2 \
				[list ApplyFunc $path tanh] \
	pi	"Pi"		4	4	3	3 \
				[list Pi $path] \
	chs	"+/-"		5	5	0	0 \
				[list ChSign $path] \
	int	"Int"		5	5	1	1 \
				[list ApplyFunc $path int] \
	frac	"Frac"		5	5	2	2 \
				[list Frac $path] \
	round	"Round"		5	5	3	3 \
				[list ApplyFunc $path round] \
	recip	"1/X"		6	6	0	0 \
				[list Recip $path] \
	dup	"Dup"		6	6	1	1 \
				[list DupStack $path] \
	sqr	"X^2"		6	6	2	2 \
				[list SqrFunc $path] \
	sqrt	"Sqrt"		6	6	3	3 \
				[list ApplyFunc $path sqrt] \
	plus	"+"		7	7	0	0 \
				[list BinOp $path +] \
	minus	"-"		7	7	1	1 \
				[list BinOp $path -] \
	times	"*"		7	7	2	2 \
				[list BinOp $path *] \
	div	"/"		7	7	3	3 \
				[list BinOp $path /] \
    ]

    frame $pathpref.buttonbox
    grid $pathpref.buttonbox -row 0 -column 2 -sticky nsew

    foreach {name symbol startRow endRow startCol endCol proc} $kpButtonList {
	button $pathpref.buttonbox.$name -text $symbol -command $proc
	set rowSpan [expr {$endRow - $startRow + 1}]
	set colSpan [expr {$endCol - $startCol + 1}]
	grid $pathpref.buttonbox.$name -row $startRow -rowspan $rowSpan \
		-column $startCol -columnspan $colSpan \
		-sticky nsew
    }

    # Initialize stuff properly.

    TrigMode $path deg
}

# StackTop returns whatever value is on the top of the
# stack in widget "path". ("path" is assumed to be a
# stack widget as created by "MakeStackBox".)

proc StackTop {path} {
    set pathpref $path
    if {[string compare $path "."] == 0} {
	set pathpref ""
    }

    return [$pathpref.stack get end]
}

# PopStack pops the value that's on the top of the
# stack in widget "path", and throws it away. ("path"
# is assumed to be a stack widget as created by
# "MakeStackBox".)

proc PopStack {path} {
    set pathpref $path
    if {[string compare $path "."] == 0} {
	set pathpref ""
    }

    $pathpref.stack delete end
}

# PushStack pushes "val" onto the stack in widget "path".
# ("path" # is assumed to be a stack widget as created by
# "MakeStackBox".)

proc PushStack {path val} {
    set pathpref $path
    if {[string compare $path "."] == 0} {
	set pathpref ""
    }

    $pathpref.stack insert end $val
    $pathpref.stack see end
}

# ClearStack empties the stack represented by "path".

proc ClearStack {path} {
    set pathpref $path
    if {[string compare $path "."] == 0} {
	set pathpref ""
    }

    Error ""

    $pathpref.stack delete 0 end
}

# TrigFunc executes trig function "fn" on the value that's
# on top of the stack represented by "path". It does conversion
# from degrees to radians, if necessary.

proc TrigFunc {path fn} {
    global calcStackInfo

    set pathpref $path
    if {[string compare $path "."] == 0} {
	set pathpref ""
    }

    Error ""

    set retcode [catch [list expr "double([StackTop $path])"] num]
    if {$retcode != 0} {
	Error "Invalid number on stack"
	return
    }

    switch $calcStackInfo(trigmode,$path) {
	deg {
	    set num [expr {$num*3.141592653589793238/180.0}]
	}
	rad {
	    # Do nothing
	}
    }

    set retcode [catch [list expr "${fn}($num)"] fnVal]
    if {$retcode != 0} {
	Error $fnVal
	return
    }

    PopStack $path
    PushStack $path $fnVal
}

# InvTrigFunc executes inverse trig function "fn" on the value that's
# on top of the stack represented by "path". It does conversion
# from degrees to radians, if necessary.

proc InvTrigFunc {path fn} {
    global calcStackInfo

    set pathpref $path
    if {[string compare $path "."] == 0} {
	set pathpref ""
    }

    Error ""

    set retcode [catch [list expr "double([StackTop $path])"] num]
    if {$retcode != 0} {
	Error "Invalid number on stack"
	return
    }

    set retcode [catch [list expr "${fn}($num)"] fnVal]
    if {$retcode != 0} {
	Error $fnVal
	return
    }

    switch $calcStackInfo(trigmode,$path) {
	deg {
	    set fnVal [expr {$fnVal*180.0/3.141592653589793238}]
	}
	rad {
	    # Do nothing
	}
    }

    PopStack $path
    PushStack $path $fnVal
}

# TrigMode changes the trig mode (angle units) of stack "path"
# to "mode". Valid values of "mode" are "deg" for degrees, and
# "rad" for radians.

proc TrigMode {path mode} {
    global calcStackInfo

    Error ""
    set calcStackInfo(trigmode,$path) $mode

    set pathpref $path
    if {[string compare $path "."] == 0} {
	set pathpref ""
    }

    set thisModeBackground "#40ff40"
    set otherModeBackground [lindex [$pathpref.buttonbox.deg configure -background] 3]
    set thisModeActiveBackground "#80ff80"
    set otherModeActiveBackground [lindex [$pathpref.buttonbox.deg configure -activebackground] 3]

    switch $mode {
	deg {
	    $pathpref.buttonbox.deg configure -background $thisModeBackground
	    $pathpref.buttonbox.rad configure -background $otherModeBackground
	    $pathpref.buttonbox.deg configure \
			-activebackground $thisModeActiveBackground
	    $pathpref.buttonbox.rad configure \
			-activebackground $otherModeActiveBackground
	}
	rad {
	    $pathpref.buttonbox.deg configure -background $otherModeBackground
	    $pathpref.buttonbox.rad configure -background $thisModeBackground
	    $pathpref.buttonbox.deg configure \
			-activebackground $otherModeActiveBackground
	    $pathpref.buttonbox.rad configure \
			-activebackground $thisModeActiveBackground
	}
    }
}

# ApplyFunc applies function "fn" to whatever value is on top
# of the stack represented by "path".

proc ApplyFunc {path fn} {
    set pathpref $path
    if {[string compare $path "."] == 0} {
	set pathpref ""
    }

    Error ""

    set num [StackTop $path]
    set retcode [catch [list expr "${fn}($num)"] fnVal]
    if {$retcode != 0} {
	Error $fnVal
	return
    }

    PopStack $path
    PushStack $path $fnVal
}

# TenX implements the function 10^X, where "X" is the value
# on top of the stack represented by "path".

proc TenX {path} {
    set pathpref $path
    if {[string compare $path "."] == 0} {
	set pathpref ""
    }

    Error ""

    set num [StackTop $path]
    set retcode [catch [list expr "pow(10.0,$num)"] fnVal]
    if {$retcode != 0} {
	Error $fnVal
	return
    }

    PopStack $path
    PushStack $path $fnVal
}

# Recip implements the function 1/X, where "X" is the value
# on top of the stack represented by "path".

proc Recip {path} {
    set pathpref $path
    if {[string compare $path "."] == 0} {
	set pathpref ""
    }

    Error ""

    set num [StackTop $path]
    set retcode [catch [list expr "1.0/$num"] fnVal]
    if {$retcode != 0} {
	Error $fnVal
	return
    }

    PopStack $path
    PushStack $path $fnVal
}

# SqrFunc implements the function X^2, where "X" is the value
# on top of the stack represented by "path".

proc SqrFunc {path} {
    set pathpref $path
    if {[string compare $path "."] == 0} {
	set pathpref ""
    }

    Error ""

    set retcode [catch [list expr "double([StackTop $path])"] num]
    if {$retcode != 0} {
	Error "Invalid number on stack"
	return
    }

    set retcode [catch [list expr "$num*$num"] fnVal]
    if {$retcode != 0} {
	Error $fnVal
	return
    }

    PopStack $path
    PushStack $path $fnVal
}

# ChSign implements the function -X, where "X" is the value
# on top of the stack represented by "path".

proc ChSign {path} {
    set pathpref $path
    if {[string compare $path "."] == 0} {
	set pathpref ""
    }

    Error ""

    set retcode [catch [list expr "double([StackTop $path])"] num]
    if {$retcode != 0} {
	Error "Invalid number on stack"
	return
    }

    set retcode [catch [list expr "-($num)"] fnVal]
    if {$retcode != 0} {
	Error $fnVal
	return
    }

    PopStack $path
    PushStack $path $fnVal
}

# Frac computes the fractional part of X, where "X" is the value
# on top of the stack represented by "path".

proc Frac {path} {
    set pathpref $path
    if {[string compare $path "."] == 0} {
	set pathpref ""
    }

    Error ""

    set retcode [catch [list expr "double([StackTop $path])"] num]
    if {$retcode != 0} {
	Error "Invalid number on stack"
	return
    }

    set retcode [catch [list expr "fmod($num,1.0)"] fnVal]
    if {$retcode != 0} {
	Error $fnVal
	return
    }

    PopStack $path
    PushStack $path $fnVal
}

# DupStack duplicates the top entry on the stack represented
# by "path", i.e. it pushes another copy of the top entry.

proc DupStack {path} {
    Error ""
    PushStack $path [StackTop $path]
}

# Pi pushes pi on the stack.

proc Pi {path} {
    Error ""
    PushStack $path 3.1415926535897932
}

# BinOp performs binary operation "op" on the top two
# elements of the stack represented by "path". "op"
# may be any binary infix operator used by Tcl's "expr"
# command.

proc BinOp {path op} {
    set pathpref $path
    if {[string compare $path "."] == 0} {
	set pathpref ""
    }

    Error ""

    set retcode [catch [list expr "double([StackTop $path])"] num2]
    if {$retcode != 0} {
	Error "Invalid number on stack"
	return
    }

    PopStack $path
    set retcode [catch [list expr "double([StackTop $path])"] num1]
    if {$retcode != 0} {
	Error "Invalid number on stack"
	return
    }


    set retcode [catch [list expr "$num1 $op $num2"] fnVal]
    if {$retcode != 0} {
	PushStack $path $num2
	Error $fnVal
	return
    }

    PopStack $path
    PushStack $path $fnVal
}

