#!/usr/bin/wish
# Calculator, a la xcalc
# $Id: calc.tk,v 1.7 1997/06/05 23:06:23 kragen Exp kragen $

proc calcbutton {window} {
        button $window -width 3 
        pack $window -side left -padx 2 -pady 2
}

# args are window number ?nokey?
# If third arg is present, it means not to do a key binding.
proc numbutton {window args} {
	set number [lindex $args 0]
        calcbutton $window
        $window configure -text $number -command "num $number"
	if {[llength $args] <= 1} {
		bind all <Key-$number> "$window invoke"
		bind all <Key-KP_$number> "$window invoke"
	}
}

proc num {number} {
        global x entrydone
	if {$entrydone} {set x 0; set entrydone 0}
        set x "$x$number"
	# This is because of some problems with display updates; the display
	# gets the number before numberize does.
	set x $x
}

proc numberize {var sub w} {
        # Use this for making variables numeric, with trace 
        upvar $var variable
	# puts "setting variable $var to $variable"
        regexp ^0*(.*) $variable dummy variable
        if {$variable == ""} {set variable 0}
	# puts "returning it as $variable"
}
trace variable x w numberize

set gensymnum 0
proc gensym {} { global gensymnum; return g[incr gensymnum] }

proc defop {op body} {
	global optable
	set procname [gensym]
	proc $procname {y x} $body
	set optable($op) $procname
}

defop + { expr $y + $x }
defop - { expr $y - $x }
defop x { expr $y * $x }
defop / { expr $y / $x }
defop = { return $x }

proc defunaryop {op body} {
	global unaryoptable
	set procname [gensym]
	proc $procname {x} $body
	set unaryoptable($op) $procname
}

defunaryop ln { expr log($x) }
defunaryop e^x { expr exp($x) }
defunaryop 1/x { expr 1 / $x }
defunaryop +/- { expr - $x }

proc opbutton {window op} {
        calcbutton $window
        $window configure -text $op -command "enter_op $op"
}

proc unaryopbutton {window op} {
	calcbutton $window
	$window configure -text $op -command "enter_unaryop $op"
}

proc enter_op {new_op} {
        # This makes the number entry complete, does any pending operation,
        # copies x to y, and sets the 'current operation' register.
        global entrydone x y op
        set entrydone 1
        global optable
        set x [$optable($op) $y $x]
        set y $x
        set op $new_op
}

proc enter_unaryop {op} {
	global x entrydone unaryoptable
	set x [$unaryoptable($op) $x]
	set entrydone 1
}

proc shortcuts {button args} { 
	foreach key $args { bind all <Key-$key> "$button invoke" }
}

proc clearx {} { global x; set x 0 }
proc clearall {} { global x y op; set x 0; set y 0; set op + }

proc action_button {window label proc} {
	calcbutton $window
	$window configure -text "$label" -command "$proc"
}

proc mkdisplay {} {
	global x y op entrydone
	set x 0
	set y 0
	set entrydone 0
	set op +

	label .ydisp -bg grey40 -fg white -anchor e -textvariable y
	pack .ydisp -fill x

	frame .xdispframe
	pack .xdispframe -fill x
	label .op -bg grey40 -fg green -anchor e -textvariable op
	label .display -bg black -fg white -anchor e -textvariable x
	pack .op .display -fill x -in .xdispframe -side left
	pack .display -expand 1
}

proc mk4funcbuttons {} {
	foreach row {1 2 3 4 5} {
		frame .row$row
		pack .row$row -side top -fill x
	}

	numbutton .row4.point . no-key-binding
	shortcuts .row4.point period KP_Decimal comma

	foreach set {{1 {7 8 9}} {2 {4 5 6}} {3 {1 2 3}} {4 {0}}} {
		set row [lindex $set 0]
		foreach number [lindex $set 1] {
			numbutton .row$row.num$number $number
		}
	}

	opbutton .row4.equals =
	shortcuts .row4.equals equal KP_Enter Return
	opbutton .row4.plus +
	shortcuts .row4.plus plus KP_Add
	opbutton .row3.minus -
	shortcuts .row3.minus minus KP_Subtract
	opbutton .row2.times x
	shortcuts .row2.times asterisk x KP_Multiply
	opbutton .row1.divide /
	shortcuts .row1.divide slash KP_Divide

	unaryopbutton .row1.chs +/-
	shortcuts .row1.chs asciitilde p P
	unaryopbutton .row2.recip 1/x
	shortcuts .row2.recip backslash 

	# Keypads are always funny.  This ought to cover most 
	# Sun funky keypads and X setups.
	foreach list {{.row1.num7 R7 F27 Home} {.row1.num8 R8 Up F28} 
                      {.row1.num9 R9 F29 Prior} {.row2.num4 R10 Left F30}
		      {.row2.num5 R11 F31} {.row2.num6 R12 Right F32}
		      {.row3.num1 R13 F33 End} {.row3.num2 R14 F34 Down}
		      {.row3.num3 R15 F35 Next} {.row4.equals R4 F24}
		      {.row2.times R6 F26} {.row1.divide R5 F25}
		      {.row4.num0 Insert} {.row4.point Delete}} {
		eval shortcuts $list
	}
	unaryopbutton .row5.ln ln
	shortcuts .row5.ln L l
	unaryopbutton .row5.exp e^x
	shortcuts .row5.exp E e
	action_button .row5.c C clearx
	shortcuts .row5.c C c BackSpace
	action_button .row5.ac AC clearall
	shortcuts .row5.ac A a Escape
	
}

mkdisplay; mk4funcbuttons