#!/bin/sh
# \
exec /usr/bin/wish8.0 "$0" "$@"
package require Mpexpr
########################################################################
# ksc - Ken's Scientific desktop Calculator, v0.15
#
# Copyright (c) 1997,1998 by Ken St-Cyr <kenstcyr@cs.pdx.edu>
#
# Permission to use, copy, modify, and distribute this software
# for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies.
#
# The author makes no representations about the suitability of
# this software for any purpose. The software is provided "as is"
# without express or implied warranty.
#
########################################################################
#
# Modifications by Tom Poindexter, November, 1998 tpoindex@nyx.net
#
# -use Mpexpr for calcuations
# -make stack into listbox
# -add scrollbars for accum, make window resizable
# -add precision pop up
# -add prime numbers pop up
# -add additional mpexpr functions
# -remove 'stat' pop up
# -replace some coded functions for mpexpr functions (pi, root, fact)
# -replace EXP key with POP
# -add binding to allow paste into accum; normal listbox binding allow select
# -try to make fonts portable to windows, mac; change error messages to upper
# -catch possible error when binding keypad keys on windows
#
wm title . MP:Calculator
wm resizable . 1 0
################################ GLOBALS ###############################
set version "0.15"
set mp_precision 17
set mp_precision_shad 17
if {"$tcl_platform(platform)" == "unix" } {
set fnt(display) "-*-terminal-medium-r-normal-*-18-*-*-*-*-*-*-*"
set fnt(smbutns) "-*-fixed-medium-r-normal-*-10-*-*-*-*-*-*-*"
set fnt(buttons) "-*-fixed-bold-r-normal-*-12-*-*-*-*-*-*-*"
set fnt(title) "-*-helvetica-bold-r-normal-*-18-*-*-*-*-*-*-*"
} else {
set fnt(display) [font create -family courier -size 14]
set fnt(smbutns) [font create -family courier -size 10]
set fnt(buttons) [font create -family courier -size 12 -weight bold]
set fnt(title) [font create -family times -size 16 -weight bold]
}
set stack {} ;# hold arguments to math functions
set valx 0 ;# value to be pushed onto stack
set frac 0 ;# fractional part of valx
set loose 1 ;# whether or not valx has been pushed onto stack
set last 0
set mem1 0
set pi [mpexpr pi()]
set angle(rad) 1
set angle(deg) [expr $pi / 180]
set angle(grd) [expr $pi / 200]
set mode(angle) "rad"
# set mode(base) "dec"
######################### BUTTON DEFINITIONS ###########################
set mods {{"CNST" "consts" "1"}
{"CVRT" "cvrt" "1"}
{"PREC" "prec" "1"}
{"PRIM" "prim" "1"}
{"TRIG" "trig" "1"}
{"USER" "about" "1"}
{"HELP" "help" "1"}}
set funs {{{"Gcd(y,x)" "fun2 gcd" "1"}
{"Lcm(y,x)" "fun2 lcm" "1"}
{"Fib" "fun1 fib" "1"}
{"Perm(y,x)" "fun2 perm" "1"}
{"Comb(y,x)" "fun2 comb" "1"}}
{{"x root y" "fun2 root" "1"}
{"e^x" "fun1 exp" "1"}
{"LN" "fun1 log" "1"}
{"y^x" "fun2 pow" "1"}
{"LOG" "fun1 log10" "1"}}
{{"pi" {eval set valx [mpexpr pi()]; set loose 1} "1"}
{"HYP" "fun2 hypot" "1"}
{"1/x" "reciprocol" "1"}
{"x!" "fun1 fact" "1"}
{"POP" "pop" "1"}}
{{"ENTER" "push" "2"}
{"LAST" "getlast" "1"}
{"STO" "store" "1"}
{"RCL" "recall" "1"}}}
set nums {{"7" "accum 7" "1"}
{"8" "accum 8" "1"}
{"9" "accum 9" "1"}
{"4" "accum 4" "1"}
{"5" "accum 5" "1"}
{"6" "accum 6" "1"}
{"1" "accum 1" "1"}
{"2" "accum 2" "1"}
{"3" "accum 3" "1"}
{"0" "accum 0" "1"}
{"." "set frac 1" "1"}
{"\xB1" "revsign" "1"}}
set ops1 {{"<->" "swap" "1"}
{"C" "set valx 0; set frac 0" "1"}
{"CA" "set valx 0; set stack {}; .st_frm.stack delete 0 end; set frac 0" "1"}
{"OFF" "exit" "1"}}
set ops2 {{"\xF7" "arith /" "1"}
{"\xD7" "arith *" "1"}
{"-" "arith -" "1"}
{"+" "arith +" "1"}}
######################### INTERFACE ROUTINES ###########################
########################################################################
# appMain
#=======================================================================
proc appMain {} {
global fnt
#wm title . "Buttons"
. configure -bg gray50
frame .st_frm -bg gray50
listbox .st_frm.stack -height 5 -relief sunken -bg aquamarine3 \
-font $fnt(display) -bd 4 \
-xscrollcommand ".st_frm.bot.stack_scrx set" \
-yscrollcommand ".st_frm.stack_scry set"
frame .st_frm.bot -bg gray50
scrollbar .st_frm.bot.stack_scrx -orient horizontal \
-command ".st_frm.stack xview"
scrollbar .st_frm.stack_scry -orient vertical \
-command ".st_frm.stack yview"
set pad [expr [.st_frm.stack_scry cget -width] + 2* \
([.st_frm.stack_scry cget -bd] + \
[.st_frm.stack_scry cget -highlightthickness])]
frame .st_frm.bot.pad -bg gray50 -width $pad -height $pad
pack .st_frm.bot.pad -side left
pack .st_frm.bot.stack_scrx -side right -fill x -expand 1
pack .st_frm.bot -side bottom -fill x
pack .st_frm.stack_scry -side left -fill y
pack .st_frm.stack -side right -fill both -expand 1
frame .sc_frm -bg gray50
entry .sc_frm.screen -textvariable valx -relief sunken -bg aquamarine3 \
-justify left -font $fnt(display) -bd 4 \
-xscrollcommand ".sc_frm.screen_scr set"
bindtags .sc_frm.screen ignore
scrollbar .sc_frm.screen_scr -orient horizontal \
-command ".sc_frm.screen xview"
pack .sc_frm.screen .sc_frm.screen_scr -side top -fill x -expand 1
pack .st_frm .sc_frm -side top -fill x -padx 8 -pady 8 -expand 0
frame .main -bd 2 -relief raised
pack .main -side top -anchor nw
makeModButs .main.fns
makeFunButs .main.ops
makeWorkArea .main.work
}
########################################################################
# makeModButs
#=======================================================================
proc makeModButs {parent} {
global fnt
global mods
frame $parent -bd 2 -relief sunken -bg gray50
pack $parent -side top -fill both -expand 1 -anchor nw
# row of 7
for {set col 0} {$col < 7} {incr col} {
set elem [lindex $mods $col]
set txt [lindex $elem 0]
set cmd [lindex $elem 1]
set btn [button $parent.r0c${col} \
-highlightbackground gray30 \
-font $fnt(smbutns) \
-text $txt \
-width 4 \
-command $cmd]
grid $btn -column $col -row 0 -sticky news
}
}
########################################################################
# makeFunButs
#=======================================================================
proc makeFunButs {parent} {
global fnt
global funs
frame $parent -bg gray50
pack $parent -side top -fill both -expand 1 -anchor nw
# 4 x 5 block
set nrows [llength $funs]
for {set row 0} {$row < $nrows} {incr row} {
set relem [lindex $funs $row]
set col 0
set idx 0
while {$col < 5} {
set elem [lindex $relem $idx]
set txt [lindex $elem 0]
set cmd [lindex $elem 1]
set spn [lindex $elem 2]
set btn [button $parent.r${row}c${col} \
-text $txt \
-bg gray30 \
-fg ivory \
-highlightbackground gray50 \
-width 6 \
-command $cmd]
grid $btn -row $row -column $col -columnspan $spn -sticky news
incr col $spn
incr idx
}
}
}
########################################################################
# makeWorkArea
#=======================================================================
proc makeWorkArea {parent} {
global ops1
global ops2
frame $parent -bg gray50
pack $parent -side top -fill both -expand 1 -anchor nw
makeOpButs $parent.op1 "left" $ops1
makeNumButs $parent.num
makeOpButs $parent.op2 "right" $ops2
}
########################################################################
# makeOpButs
#=======================================================================
proc makeOpButs {parent pos ops} {
global fnt
frame $parent -bg gray50
pack $parent -side $pos -fill both -expand 1 -anchor nw
for {set row 0} {$row < 4} {incr row} {
set elem [lindex $ops $row]
set txt [lindex $elem 0]
set cmd [lindex $elem 1]
set btn [button $parent.r${row}c0 \
-font $fnt(buttons) \
-text $txt \
-width 5 \
-bg gray30 \
-fg ivory \
-highlightbackground gray50 \
-command $cmd]
grid $btn -column 0 -row $row -sticky news
}
}
########################################################################
# makeNumButs
#=======================================================================
proc makeNumButs {parent} {
global fnt
global nums
frame $parent -bd 2 -relief groove -bg gray80
pack $parent -side left -fill both -expand 1 -anchor nw
# 3 x 4 block
for {set row 0} {$row < 4} {incr row} {
set col 0
set idx 0
while {$col < 3} {
set elem [lindex $nums [expr ($row*3)+$idx]]
set txt [lindex $elem 0]
set cmd [lindex $elem 1]
set spn [lindex $elem 2]
set btn [button $parent.r${row}c${col} \
-font $fnt(buttons) \
-text $txt \
-width 6 \
-bg gray30 \
-fg ivory \
-highlightbackground gray50 \
-command $cmd]
grid $btn -row $row -column $col -columnspan $spn -sticky news
incr col $spn
incr idx
}
}
}
######################## FUNCTIONAL ROUTINES ###########################
########################################################################
# pop - remove value from end of stack and return it
#=======================================================================
proc pop {} {
global stack
global valx
if {[llength $stack] < 1} {
set valx "ERR: STACK EMPTY"
push
return "ERR"
}
set value [lindex $stack 0]
set stack [lreplace $stack 0 0]
.st_frm.stack delete 0
return $value
}
########################################################################
# push - append new value to end of stack
#=======================================================================
proc push {} {
global stack
global valx
global loose
global last
global frac
set stack [linsert $stack 0 $valx]
.st_frm.stack insert 0 $valx
set last $valx
set valx 0
set loose 0
set frac 0
}
########################################################################
# accum - add new digit to current variable
#=======================================================================
proc accum {n} {
global valx
global frac
global loose
set loose 1
if {$frac == 0} {
set valx [mpexpr $valx * 10 + $n]
} else {
set valx [mpexpr $valx + ($n / pow(10, $frac))]
incr frac 1
}
}
########################################################################
# revsign - reverse sign of current variable
#=======================================================================
proc revsign {} {
global valx
if {$valx < 0} {
set valx abs($valx)
} elseif {$valx > 0} {
set valx -$valx
}
}
########################################################################
# arith - perform arithmetic on top two elements of stack
#=======================================================================
proc arith {op} {
global valx
global loose
if {$loose == 1} {push}
set y [pop]
set x [pop]
if {($y == "ERR") || ($x == "ERR")} {
return {}
}
if {$op == "/"} {
if {$y == 0} {
set valx "ERR: DIV BY 0"
} else {
set valx [mpexpr double($x) / $y]
}
} else {
set valx [mpexpr $x $op $y]
}
push
}
########################################################################
# fun1 - perform function of one variable
#=======================================================================
proc fun1 {op} {
global valx
global loose
if {$loose == 1} {push}
set x [pop]
if {$x == "ERR"} {
return {}
}
set valx [mpexpr $op ($x)]
push
}
########################################################################
# fun2 - perform function of two variables
#=======================================================================
proc fun2 {op} {
global valx
global loose
if {$loose == 1} {push}
set x [pop]
set y [pop]
if {($y == "ERR") || ($x == "ERR")} {
return {}
}
set valx [mpexpr $op ($y, $x)]
push
}
########################################################################
# fac - factorial function
#=======================================================================
proc fac {} {
global valx
global loose
if {$loose == 1} {push}
set j [pop]
if {$j == "ERR"} {
return {}
}
for {set i 1} {$j > 1} {incr j -1} {
set i [mpexpr $i * $j]
}
set valx $i
push
}
########################################################################
# getlast - restores last value of valx
#=======================================================================
proc getlast {} {
global valx
global last
set valx $last
push
}
########################################################################
# reciprocol - replace current variable with its reciprocol
#=======================================================================
proc reciprocol {} {
global valx
global loose
if {$loose == 1} {push}
set x [pop]
if {$x == "ERR"} {
return {}
}
set valx [mpexpr 1.0 / $x]
push
}
########################################################################
# recall - restore value from memory
#=======================================================================
proc recall {} {
global valx
global mem1
set valx $mem1
push
}
########################################################################
# store - store current variable in memory
#=======================================================================
proc store {} {
global valx
global mem1
set mem1 $valx
push
}
########################################################################
# swap - exchange current variable with top of stack
#=======================================================================
proc swap {} {
global valx
global loose
set value [pop]
if {$value == "ERR"} {
return {}
}
push
set valx $value
set loose 1
}
########################################################################
# xrty - take xth root of y; x is current variable, y is top of stack
#=======================================================================
proc xrty {} {
global valx
global loose
if {$loose == 1} {push}
set x [pop]
set y [pop]
if {($y == "ERR") || ($x == "ERR")} {
return {}
}
set x [mpexpr 1.0 / $x]
set valx [mpexpr pow ($y, $x)]
push
}
############################# KEY BINDINGS #############################
foreach i {1 2 3 4 5 6 7 8 9 0} {
bind all <KeyPress-$i> "accum $i"
}
foreach i {Insert End Down Next Left Begin Right Home Up Prior} {
catch { bind all <KeyPress-KP_$i> "accum %A" }
}
foreach i {plus minus asterisk slash} {
bind all <KeyPress-$i> "arith %A"
}
foreach i {Add Subtract Multiply Divide} {
catch { bind all <KeyPress-KP_$i> "arith %A" }
}
bind all <KeyPress-period> "set frac 1"
catch { bind all <KeyPress-KP_Delete> "set frac 1" }
bind all <KeyPress-Return> "push"
catch { bind all <KeyPress-KP_Enter> "push" }
bind all <KeyPress-asciitilde> "revsign"
bind all <Button-2> {catch {set valx [selection get]}}
bind all <Control-Key-v> {catch {set valx [selection get]}}
################################ STARTUP ###############################
appMain
########################### MODULES DEFINITIONS ########################
########################################################################
# butnrow - create a row of n buttons
# blist contains text and command for each button
#=======================================================================
proc butnrow {p n blist {bwidth 3}} {
for {set i 0} {$i < $n} {incr i} {
set curr [lindex $blist $i]
button $p.b$i -text [lindex $curr 0] \
-command [lindex $curr 1] \
-width $bwidth \
-bg gray30 \
-fg ivory \
-highlightbackground gray50
pack $p.b$i -side left -fill x
}
}
########################### CONSTANTS MODULE ###########################
########################################################################
# consts - main constants window
#=======================================================================
proc consts {} {
if ([winfo exists .const]) {
raise .const
focus .const
return
}
toplevel .const
wm title .const Constants
wm resizable .const 0 0
set constd ""
frame .const.top -relief flat -bg gray50 -bd 2 \
-highlightbackground gray50
pack .const.top -side top -fill x
label .const.top.l -textvariable constd -relief groove \
-bg gray80 -bd 2
pack .const.top.l -side top -fill x -padx 2 -pady 2
# button definitions; use this section as a model for
# new constants
frame .const.a -bg gray80
pack .const.a -side top -fill x
butnrow .const.a 5 {
{"A" "set valx 6.0221367e23; set loose 1"}
{"c" "set valx 2.99792458e8; set loose 1"}
{"e" "set valx 2.718281828; set loose 1"}
{"h" "set valx 6.6260755e-34; set loose 1"}
{"g" "set valx 9.80665; set loose 1"}
}
bind .const.a.b0 <Enter> {set constd "Avogadro's Number, 1/mol"}
bind .const.a.b0 <Leave> {set constd ""}
bind .const.a.b1 <Enter> {set constd "Speed of Light, m/s"}
bind .const.a.b1 <Leave> {set constd ""}
bind .const.a.b2 <Enter> {set constd "The number e"}
bind .const.a.b2 <Leave> {set constd ""}
bind .const.a.b3 <Enter> {set constd "Planck's Constant, J-s"}
bind .const.a.b3 <Leave> {set constd ""}
bind .const.a.b4 <Enter> \
{set constd "Gravitational acceleration, m/s^2"}
bind .const.a.b4 <Leave> {set constd ""}
frame .const.b -bg gray80
pack .const.b -side top -fill x
butnrow .const.b 5 {
{"R" "set valx 8.314510; set loose 1"}
{"V" "set valx 2.241409e-2; set loose 1"}
{"E" "set valx 1.60217738e-19; set loose 1"}
{"k" "set valx 1.380657e-23; set loose 1"}
{"G" "set valx 6.67260e-11; set loose 1"}
}
bind .const.b.b0 <Enter> \
{set constd "Universal gas constant, J/mol*K"}
bind .const.b.b0 <Leave> {set constd ""}
bind .const.b.b1 <Enter> \
{set constd "Ideal gas at STP, m^3/mol"}
bind .const.b.b1 <Leave> {set constd ""}
bind .const.b.b2 <Enter> {set constd "Elementary charge, C"}
bind .const.b.b2 <Leave> {set constd ""}
bind .const.b.b3 <Enter> {set constd "Boltzmann constant, J/K"}
bind .const.b.b3 <Leave> {set constd ""}
bind .const.b.b4 <Enter> \
{set constd "Gravitational constant, N*m^2/kg^2"}
bind .const.b.b4 <Leave> {set constd ""}
# end of button definitions
frame .const.bottom -relief flat -bg gray50 -bd 2 \
-highlightbackground gray50
pack .const.bottom -side bottom -fill x
button .const.bottom.z -highlightbackground gray50 \
-text Close -command "destroy .const"
pack .const.bottom.z -side right
}
########################## CONVERSIONS MODULE ##########################
########################################################################
# convert - standard conversions of a single factor
#=======================================================================
proc convert {factor} {
global valx
global loose
if {$loose == 1} {push}
set x [pop]
if {$x == "ERR"} {
return {}
}
set valx [mpexpr $x * $factor]
push
}
########################################################################
# f2c - convert fahrenheit to celsius
#=======================================================================
proc f2c {} {
global valx
global loose
if {$loose == 1} {push}
set x [pop]
if {$x == "ERR"} {
return {}
}
set valx [mpexpr ($x - 32) * (5.0 / 9)]
push
}
########################################################################
# c2f - convert celsius to fahrenheit
#=======================================================================
proc c2f {} {
global valx
global loose
if {$loose == 1} {push}
set x [pop]
if {$x == "ERR"} {
return {}
}
set valx [mpexpr ($x * (9.0 / 5)) + 32]
push
}
########################################################################
# cvrt - main conversions window
#=======================================================================
proc cvrt {} {
if ([winfo exists .cvrt]) {
raise .cvrt
focus .cvrt
return
}
toplevel .cvrt
wm title .cvrt Conversions
wm resizable .cvrt 0 0
frame .cvrt.a -bg gray80
pack .cvrt.a -side top -fill x
butnrow .cvrt.a 4 {
{"in>cm" "convert 2.54"}
{"cm>in" "convert 0.3937"}
{"lb>kg" "convert 0.4536"}
{"kg>lb" "convert 2.2046"}
}
frame .cvrt.b -bg gray80
pack .cvrt.b -side top -fill x
butnrow .cvrt.b 4 {
{"ft>m" "convert 0.3048"}
{"m>ft" "convert 3.2808"}
{"F>C" "f2c"}
{"C>F" "c2f"}
}
frame .cvrt.c -bg gray80
pack .cvrt.c -side top -fill x
butnrow .cvrt.c 4 {
{"mi>km" "convert 1.6093"}
{"km>mi" "convert 0.6214"}
{"L>gal" "convert 0.2642"}
{"gal>L" "convert 3.7853"}
}
frame .cvrt.bottom -relief flat -bg gray50 -bd 2 \
-highlightbackground gray50
pack .cvrt.bottom -side bottom -fill x
button .cvrt.bottom.z -highlightbackground gray50 \
-text Close -command "destroy .cvrt"
pack .cvrt.bottom.z -side right
}
###############################################################################
# set mp precision
#
proc incr_prec {v} {
global mp_precision
global mp_precision_shad
if {[scan $mp_precision_shad %d x] != 1} {
set mp_precision_shad 17
set mp_precision 17
return 0
}
set mp_precision_shad $x
incr mp_precision_shad $v
if {$mp_precision_shad < 0} {set mp_precision_shad 0}
if {$mp_precision_shad > 10000} {set mp_precision_shad 10000}
set mp_precision $mp_precision_shad
return 1
}
proc prec {} {
global mp_precision
global fnt
if ([winfo exists .prec]) {
raise .prec
focus .prec
return
}
toplevel .prec
wm title .prec Precision
wm resizable .prec 0 0
frame .prec.a -bg gray80
pack .prec.a -side top -fill x
button .prec.a.incr -text + \
-command "incr_prec 1" \
-width 1 \
-bg gray30 \
-fg ivory \
-highlightbackground gray50
pack .prec.a.incr -side left -fill x -pady 2 -pady 2
entry .prec.a.prec -textvariable mp_precision_shad \
-justify right \
-width 7 \
-relief sunken \
-bg aquamarine3 \
-font $fnt(display) -bd 4
pack .prec.a.prec -side left -fill x -pady 2 -pady 2
bind .prec.a.prec <Enter> "incr_prec 0"
bind .prec.a.prec <FocusOut> "incr_prec 0"
bindtags .prec.a.prec {.prec.a.prec Entry}
button .prec.a.decr -text - \
-command "incr_prec -1" \
-width 1 \
-bg gray30 \
-fg ivory \
-highlightbackground gray50
pack .prec.a.decr -side left -fill x -pady 2 -pady 2
frame .prec.b -bg gray50
pack .prec.b -side top -fill x
button .prec.b.ok -text Close \
-highlightbackground gray50 \
-command "if {[incr_prec 0]} {destroy .prec}"
bind .prec.b.ok <Enter> "incr_prec 0"
bindtags .prec.b.ok {.prec.b.ok Button}
pack .prec.b.ok -side right
}
###############################################################################
# prime and associate funcs
#
proc prim {} {
if ([winfo exists .prim]) {
raise .prim
focus .prim
return
}
global valx
set constd ""
toplevel .prim
wm title .prim Prime
wm resizable .prim 0 0
frame .prim.top -relief flat -bg gray50 -bd 2 \
-highlightbackground gray50
pack .prim.top -side top -fill x
label .prim.top.l -textvariable constd -relief groove \
-bg gray80 -bd 2
pack .prim.top.l -side top -fill x -padx 2 -pady 2
frame .prim.a -bg gray80
pack .prim.a -side top -fill x
frame .prim.b -bg gray50
pack .prim.b -side top -fill x
butnrow .prim.b 3 {
{ProdPrime {fun1 pfact}}
{IsPrime {push; set valx 100; set loose 1; fun2 prime}}
{LowFact {push; set valx 100; set loose 1; fun2 lfactor}}
{GcdRem(y,x) {fun2 gcdrem}}
{RelPrime(y,x) {fun2 relprime}}
} 10
frame .prim.c -bg gray50
pack .prim.c -side top -fill x
butnrow .prim.c 2 {
{GcdRem(y,x) {fun2 gcdrem}}
{RelPrime(y,x) {fun2 relprime}}
} 10
bind .prim.b.b0 <Enter> {set constd "product of primes up to x"}
bind .prim.b.b0 <Leave> {set constd ""}
bind .prim.b.b1 <Enter> {set constd "test is x prime"}
bind .prim.b.b1 <Leave> {set constd ""}
bind .prim.b.b2 <Enter> {set constd "lowest prime factor of x"}
bind .prim.b.b2 <Leave> {set constd ""}
bind .prim.c.b0 <Enter> {set constd "relatively prime gcd divisor of y & x"}
bind .prim.c.b0 <Leave> {set constd ""}
bind .prim.c.b1 <Enter> {set constd "y relatively prime to x"}
bind .prim.c.b1 <Leave> {set constd ""}
button .prim.c.z -highlightbackground gray50 \
-text Close -command "destroy .prim"
pack .prim.c.z -side right -padx 10
}
######################### TRIGONOMETRY MODULE ##########################
########################################################################
# trig - main trignometry window
#=======================================================================
proc trig {} {
if ([winfo exists .trig]) {
raise .trig
focus .trig
return
}
global mode
global angle
global valx
toplevel .trig
wm title .trig Trigonometry
wm resizable .trig 0 0
frame .trig.a -bg gray80
pack .trig.a -side top -fill x
frame .trig.b -bg gray50
pack .trig.b -side top -fill x
butnrow .trig.b 3 {
{COSH "set valx [mpexpr $valx*$angle($mode(angle))]; fun1 cosh"}
{SINH "set valx [mpexpr $valx*$angle($mode(angle))]; fun1 sinh"}
{TANH "set valx [mpexpr $valx*$angle($mode(angle))]; fun1 tanh"}
}
frame .trig.c -bg gray50
pack .trig.c -side top -fill x
butnrow .trig.c 3 {
{ACOS "set valx [mpexpr $valx*$angle($mode(angle))]; fun1 acos"}
{ASIN "set valx [mpexpr $valx*$angle($mode(angle))]; fun1 asin"}
{ATAN "set valx [mpexpr $valx*$angle($mode(angle))]; fun1 atan"}
}
frame .trig.d -bg gray50
pack .trig.d -side top -fill x
butnrow .trig.d 3 {
{"COS" "set valx [mpexpr $valx*$angle($mode(angle))]; fun1 cos"}
{"SIN" "set valx [mpexpr $valx*$angle($mode(angle))]; fun1 sin"}
{"TAN" "set valx [mpexpr $valx*$angle($mode(angle))]; fun1 tan"}
}
frame .trig.e -bg gray50
pack .trig.e -side top -fill x
butnrow .trig.e 3 {
{"DEG" "set mode(angle) deg"}
{"RAD" "set mode(angle) rad"}
{"GRD" "set mode(angle) grd"}
}
frame .trig.bottom -relief flat -bg gray50 -bd 2 \
-highlightbackground gray50
pack .trig.bottom -side bottom -fill x
label .trig.bottom.y -textvariable mode(angle)
pack .trig.bottom.y -side left
button .trig.bottom.z -highlightbackground gray50 \
-text Close -command "destroy .trig"
pack .trig.bottom.z -side right
}
########################################################################
# stat - main statistics window
#=======================================================================
proc stat {} {
if ([winfo exists .stat]) {
raise .stat
focus .stat
return
}
toplevel .stat
wm title .stat Statistics
wm resizable .stat 0 0
frame .stat.a -bg gray80
pack .stat.a -side top -fill x
frame .stat.bottom -relief flat -bg gray50 -bd 2 \
-highlightbackground gray50
pack .stat.bottom -side bottom -fill x
button .stat.bottom.z -highlightbackground gray50 \
-text Close -command "destroy .stat"
pack .stat.bottom.z -side right
}
########################################################################
# help - main help window
#=======================================================================
proc help {} {
if ([winfo exists .help]) {
raise .help
focus .help
return
}
toplevel .help
wm title .help Help
wm resizable .help 0 0
set helptext \
"Ken's Scientific desktop Calculator performs its operations on a stack.
Two arguments must be entered first, followed by an operation to perform
on those arguments.
The display area consists of two parts. The top area is the stack. The
topmost element is designated by the variable y. The bottom
area of the display is the user workspace. Its contents are designated
by the variable x.
Gcd(y,x) greatest common divisor
Lcm(y,x) least common multiple
Fib Fibonnaci number
Perm(y,x) permutations of y, x at a time
Comb(y,x) combinations of y, x at a time
x root y get xth root of y.
e^x raise the number e to x
LN get natural log of x
y^x raise y to x
LOG get base-10 log of x
pi the number pi
HYP get hypotenuse from x and y
1/x get reciprocal of x
x! get x factorial
EXP removes top of stack
LAST recall last value of x
STO store current value of x
RCL recall stored value
<-> exchange x for top of stack"
frame .help.a -bg gray80
pack .help.a -side top -fill x
message .help.a.m -text $helptext -bd 2
pack .help.a.m -side top -fill both
frame .help.bottom -relief flat -bg gray50 -bd 2 \
-highlightbackground gray50
pack .help.bottom -side bottom -fill x
button .help.bottom.z -highlightbackground gray50 \
-text Close -command "destroy .help"
pack .help.bottom.z -side right
}
########################################################################
# about - about box
#=======================================================================
proc about {} {
if {[winfo exists .about]} {
raise .about
focus .about
return
}
global version
global fnt
toplevel .about
wm title .about "About"
wm resizable .about 0 0
frame .about.text -relief groove -bd 2
label .about.text.title -text "Calculator $version" -font $fnt(title)
label .about.text.t -text "by Ken St-Cyr"
label .about.text.u -text "Mpexpr modifications by Tom Poindexter"
pack .about.text.title .about.text.t .about.text.u -side top -fill x
pack .about.text -side top -expand 1 -fill x
button .about.ok -command {destroy .about} -text "OK"
pack .about.ok -side top -expand 1
return
}
syntax highlighted by Code2HTML, v. 0.9.1