#!/bin/sh
# \
   exec wish "$0" ${1+"$@"}

########################################################################
# ksc - Ken's Scientific desktop Calculator, v0.19
#
# Copyright (c) 1997-2000 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 Ken St-Cyr, October 2000
#    - fix bug in reading floating point numbers less than 1

########################################################################
# Modifications by Ken St-Cyr, March 1999
#
#    - incorporate Tom's changes into non-mpexpr version, except:
#      . precision pop up
#      . prime numbers
#      . other mpexpr-specific functions
#      The non-mpexpr ksc is in parallel to the mpexpr version, for
#      those who don't want the performance hit caused by mpexpr or who
#      don't have mpexpr installed.  This would mean you wouldn't get
#      the groovy mpexpr functions
#    - redo the user input procedure (accum) to display input verbatim;
#      this fixes a bug reported by Jim Graham, in which the display was
#      not updated when a zero is entered after a decimal point, until a
#      non-zero number was entered; the fix uses string operations
#      instead of treating the input like a number.  The variable frac
#      is no longer needed
#    - tried to pretty up the help text

########################################################################
#
# Modifications by Jim Graham, March 1999  jim@n5ial.gnt.net
#
#    - a few additional key bindings.  Basically, the idea is to support
#      the numeric keypad as well as the ``normal'' digit keys.

########################################################################
#
# 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 . Calculator
wm resizable . 0 0


################################ GLOBALS ###############################

set version "0.19"
set tcl_precision 12

global fnt
if {$tcl_platform(platform) == "unix"} {
   set fnt(display) "-*-courier-medium-r-normal-*-18-*-*-*-*-*-*-*"
   set fnt(smbutns) "-*-helvetica-medium-r-normal-*-10-*-*-*-*-*-*-*"   
   set fnt(buttons) "-*-helvetica-medium-r-normal-*-12-*-*-*-*-*-*-*"  
   set fnt(title) "-*-helvetica-bold-r-normal-*-18-*-*-*-*-*-*-*"
} else {
   set fnt(display) "Courier 14"
   set fnt(smbutns) "Helvetica 8"
   set fnt(buttons) "Helvetica 10"
   set fnt(title)   "Helvetica 16"
}

global dims
if {$tcl_platform(platform) == "unix"} {
   set dims(long) 3
   set dims(short) 2
} else {
   set dims(long) 5
   set dims(short) 4
}

set stack {} ;# hold arguments to math functions
set valx 0   ;# value to be pushed onto stack
set loose 1  ;# whether or not valx has been pushed onto stack
set last 0
set mem1 0

set pi 3.14159265359

set angle(rad) 1
set angle(deg) [expr $pi / 180]
set angle(grd) [expr $pi / 200]

set mode(angle) "rad"
set mode(precision) "12"
set mode(coords) "rect"
set mode(base)  "dec"

######################### BUTTON DEFINITIONS ###########################

set mods {{"CNST" "consts"  "1"}
          {"CVRT" "cvrt"    "1"}
          {"TRIG" "trig"    "1"}
          {"USER" "options" "1"}
          {"VER"  "about"   "1"}
          {"HELP" "help"    "1"}}

set funs {{{"xrty"  "xrty"       "1"}
           {"e^x"   "fun1 exp"   "1"}
           {"LN"    "fun1 log"   "1"}
           {"y^x"   "fun2 pow"   "1"}
           {"LOG"   "fun1 log10" "1"}}
          {{"pi"    "set valx $pi; set loose 1" "1"}
           {"HYP"   "fun2 hypot" "1"}                   
           {"1/x"   "reciprocol" "1"}
           {"x!"    "fac"        "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"}
          {"." "accum ." "1"}
          {"\xB1" "revsign" "1"}}

set ops1 {{"<->" "swap" "1"}
          {"C"   "set valx 0" "1"}
          {"CA"  "set valx 0; set stack {}; .st_frm.stack delete 0 end" "1"}
          {"OFF" "exit" "1"}}

set ops2 {{"\xF7" "arith /" "1"}
          {"\xD7" "arith *" "1"}
          {"-"    "arith -" "1"}
          {"+"    "arith +" "1"}}


######################### INTERFACE ROUTINES ###########################

########################################################################
# appMain
#=======================================================================

   proc appMain {} {
      global fnt

      . configure -bg gray50
      frame .st_frm -bg gray50
      listbox .st_frm.stack \
               -height 5 \
               -width 10 \
               -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 \
                 -width 12 \
                 -command ".st_frm.stack xview"
      scrollbar .st_frm.stack_scry \
                 -orient vertical \
                 -width 12 \
                 -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 \
             -width 10 \
             -relief sunken \
             -bg aquamarine3 \
             -justify right \
             -font $fnt(display) \
             -bd 4 \
             -xscrollcommand ".sc_frm.screen_scr set"
      bindtags .sc_frm.screen ignore
      scrollbar .sc_frm.screen_scr \
                 -orient horizontal \
                 -width 12 \
                 -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
      global dims

      frame $parent -bd 2 -relief sunken -bg gray30
      pack $parent -side top -fill both -expand 1
      # row of 6
      for {set col 0} {$col < 6} {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 $dims(short)         \
                     -command $cmd]
         grid $btn -column $col -row 0 -sticky news
      }
   }


########################################################################
# makeFunButs
#=======================================================================

   proc makeFunButs {parent} {
      global fnt
      global funs
      global dims

      frame $parent -bg gray30
      pack $parent -side top -fill both -expand 1
      # 3 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                  \
                        -font $fnt(buttons)         \
                        -bg gray30                  \
                        -fg ivory                   \
                        -highlightbackground gray50 \
                        -width $dims(long)          \
                        -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
      makeOpButs $parent.op1 "left" $ops1
      makeNumButs $parent.num
      makeOpButs $parent.op2 "right" $ops2
   }


########################################################################
# makeOpButs
#=======================================================================

   proc makeOpButs {parent pos ops} {
      global fnt
      global dims

      frame $parent -bg gray50
      pack $parent -side $pos -fill both -expand 1
      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 $dims(long)    \
                     -bg gray30            \
                     -fg ivory             \
                     -highlightbackground gray50 \
                     -command $cmd]
         grid $btn -column 0 -row $row -sticky news
      }
   }


########################################################################
# makeNumButs
#=======================================================================

   proc makeNumButs {parent} {
      global fnt
      global nums
      global dims

      frame $parent -bd 2 -relief groove -bg gray80
      pack $parent -side left -fill both -expand 1
      # 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 $dims(short) \
                        -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
      set stack [linsert $stack 0 $valx]
      .st_frm.stack insert 0 $valx
      set last $valx
      set valx 0
      set loose 0
   }

########################################################################
# accum - add new digit to current variable
#=======================================================================

   proc accum {n} {
      global valx
      global loose
      set loose 1

      if {[string compare $valx "0"] == 0} {
         set valx $n
      } elseif {[string compare $n "."] == 0} {
         regsub {[\.]} $valx {} valx
         append valx "."
      } else {
         append valx $n
      }
   }

########################################################################
# decum - remove a digit from the current variable
#=======================================================================

   proc decum {} {
      global valx

      if {$valx == "0"} {
      } else {
         set valx [string range $valx 0 [expr [string length $valx] - 2]]
      }
   }

########################################################################
# 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 ZERO"
         } else {
            set valx [expr double($x) / $y]
         }
      } else {
         set valx [expr $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 [expr $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 [expr $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 [expr $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 [expr 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 [expr 1.0 / $x]
      set valx [expr pow ($y, $x)]
      push
   }


############################# KEY BINDINGS #############################


foreach i {1 2 3 4 5 6 7 8 9 0} {
   bind all <KeyPress-$i> "accum $i"
   bind all <KeyPress-KP_$i> "accum $i"
}


foreach i {Insert End Down Next Left Begin Right Home Up Prior} {
   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} {
   bind all <KeyPress-KP_$i> "arith %A"
}

bind all <KeyPress-period> "accum ."
bind all <KeyPress-KP_Decimal> "accum ."
bind all <KeyPress-KP_Delete> "accum ."
bind all <KeyPress-Delete> "accum ."
bind all <KeyPress-BackSpace> "decum"

bind all <KeyPress-Return> "push"
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} {
      global fnt
      global dims

      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] \
                       -font $fnt(buttons)       \
                       -width $dims(long)        \
                       -bg gray30                \
                       -fg ivory                 \
                       -highlightbackground gray50
         pack $p.b$i -side left -fill x
      }
   }


########################### CONSTANTS MODULE ###########################

########################################################################
# consts - main constants window
#=======================================================================

   proc consts {} {
      global fnt
      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 -font $fnt(buttons)
      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 [expr $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 [expr ($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 [expr ($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
}

######################### 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 [expr $valx*$angle($mode(angle))]; fun1 cosh"}
      {SINH "set valx [expr $valx*$angle($mode(angle))]; fun1 sinh"}
      {TANH "set valx [expr $valx*$angle($mode(angle))]; fun1 tanh"}
   }

   frame .trig.c -bg gray50
   pack .trig.c -side top -fill x
   butnrow .trig.c 3 {
      {ACOS "fun1 acos; set valx [pop]; set valx [expr $valx/$angle($mode(angle))]; push"}
      {ASIN "fun1 asin; set valx [pop]; set valx [expr $valx/$angle($mode(angle))]; push"}
      {ATAN "fun1 atan; set valx [pop]; set valx [expr $valx/$angle($mode(angle))]; push"}
   }

   frame .trig.d -bg gray50
   pack .trig.d -side top -fill x
   butnrow .trig.d 3 {
      {"COS" "set valx [expr $valx*$angle($mode(angle))]; fun1 cos"}
      {"SIN" "set valx [expr $valx*$angle($mode(angle))]; fun1 sin"}
      {"TAN" "set valx [expr $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 {} {
   global fnt
   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
lowest or rightmost 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.

xrty\tget xth root of y.
e^x\traise the number e to x
LN\tget natural log of x
y^x\traise y to x
LOG\tget base-10 log of x
pi\tthe number pi
HYP\tget hypotenuse from x and y
1/x\tget reciprocal of x
x!\tget x factorial
POP\tremoves top of stack
LAST\trecall last value of x
STO\tstore current value of x
RCL\trecall stored value
<->\texchange 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 -font $fnt(buttons)
   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
}


########################################################################
# options  - set user options
#=======================================================================
proc incr_prec {v} {
   global mode
   global tcl_precision

   if {[scan $mode(precision) %d x] != 1} {
     set mode(precision) 12
     set tcl_precision   12
     return 0
   }

   set mode(precision)  $x
   incr mode(precision) $v
   if {$mode(precision) < 0}  {set mode(precision) 0}
   if {$mode(precision) > 16} {set mode(precision) 16}
   set tcl_precision $mode(precision)

   return 1
}

proc incr_arc {v} {
   global mode

   if {[scan $mode(angle) %s x] != 1} {
     set mode(angle) "rad"
     return 0
   }

   if {$v < 0} {
      if {[string compare $mode(angle) "rad"] == 0} {
         set mode(angle) deg
      } elseif {[string compare $mode(angle) "grd"] == 0} {
         set mode(angle) rad
      } elseif {[string compare $mode(angle) "deg"] == 0} {
         set mode(angle) grd
      }
   } elseif {$v > 0} {
      if {[string compare $mode(angle) "grd"] == 0} {
         set mode(angle) deg
      } elseif {[string compare $mode(angle) "deg"] == 0} {
         set mode(angle) rad
      } elseif {[string compare $mode(angle) "rad"] == 0} {
         set mode(angle) grd
      }
   }

   return 1
}

proc incr_coord {v} {
   global mode

   if {[scan $mode(coords) %s x] != 1} {
     set mode(coords) "rect"
     return 0
   }

   if {$v < 0} {
      if {[string compare $mode(coords) "rect"] == 0} {
         set mode(coords) "polar"
      } elseif {[string compare $mode(coords) "polar"] == 0} {
         set mode(coords) "rect"
      }
   } elseif {$v > 0} {
      if {[string compare $mode(coords) "polar"] == 0} {
         set mode(coords) "rect"
      } elseif {[string compare $mode(coords) "rect"] == 0} {
         set mode(coords) "polar"
      }
   }

   return 1
}

proc incr_base {v} {
   global mode

   if {[scan $mode(base) %s x] != 1} {
     set mode(base) "dec"
     return 0
   }

   if {$v < 0} {
      if {[string compare $mode(base) "dec"] == 0} {
         set mode(base) "hex"
      } elseif {[string compare $mode(base) "hex"] == 0} {
         set mode(base) "oct"
      } elseif {[string compare $mode(base) "oct"] == 0} {
         set mode(base) "dec"
      }
   } elseif {$v > 0} {
      if {[string compare $mode(base) "oct"] == 0} {
         set mode(base) "hex"
      } elseif {[string compare $mode(base) "dec"] == 0} {
         set mode(base) "oct"
      } elseif {[string compare $mode(base) "hex"] == 0} {
         set mode(base) "dec"
      }
   }

   return 1
}

proc makeRadioBox {parent var args} {
   global mode

   frame $parent -bg gray50
   pack $parent -side top -fill x

   radiobutton $parent.a \
               -text \
               -variable $mode($arg) \
               -value \
               -anchor w

   pack $parent.a
}

proc makeIncrBox {parent lbl v fn step} {
   global fnt
   global mode

   frame $parent -bg gray50
   pack  $parent -side top -fill x

   label $parent.lab -text $lbl -width 10 -bd 2
   pack $parent.lab -side left -fill x

   entry $parent.set                \
          -textvariable mode($v)    \
          -justify right            \
          -width 7                  \
          -relief sunken            \
          -bg aquamarine3           \
          -font $fnt(buttons) -bd 4
   pack $parent.set -side left -fill x -pady 2 -pady 2

   bind $parent.set <Enter> "$fn 0"
   bind $parent.set <FocusOut> "$fn 0"
   bindtags $parent.set {$parent.set Entry}

   button $parent.decr               \
           -text "-"                 \
           -command "$fn -$step"     \
           -width 1                  \
           -bg gray30                \
           -fg ivory                 \
           -highlightbackground gray50
   pack $parent.decr -side left -fill x -pady 2 -pady 2

   button $parent.incr               \
           -text "+"                 \
           -command "$fn $step"      \
           -width 1                  \
           -bg gray30                \
           -fg ivory                 \
           -highlightbackground gray50
   pack $parent.incr -side left -fill x -pady 2 -pady 2
}

proc options {} {
   if {[winfo exists .about]} {
      raise .options
      focus .options
      return
   }

   global mode
   global fnt

   toplevel .options
   wm title .options "Options"
   wm resizable .options 0 0

   makeIncrBox .options.a "precision" "precision" incr_prec 1
   makeIncrBox .options.b "arc" "angle" incr_arc 1
   makeIncrBox .options.c "coordinates" "coords" incr_coord 1
   makeIncrBox .options.d "base" "base" incr_base 1

   frame .options.z -bg gray50
   pack .options.z -side top -fill x
   button .options.z.ok -text Close   \
                         -highlightbackground gray50 \
                         -command {destroy .options}
   pack .options.z.ok -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"
  pack .about.text.title .about.text.t -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
}