#!/bin/sh # \ exec wish "$0" ${1+"$@"} ######################################################################## # ksc - Ken's Scientific desktop Calculator, v0.19 # # Copyright (c) 1997-2000 by Ken St-Cyr # # 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 "accum $i" bind all "accum $i" } foreach i {Insert End Down Next Left Begin Right Home Up Prior} { bind all "accum %A" } foreach i {plus minus asterisk slash} { bind all "arith %A" } foreach i {Add Subtract Multiply Divide} { bind all "arith %A" } bind all "accum ." bind all "accum ." bind all "accum ." bind all "accum ." bind all "decum" bind all "push" bind all "push" bind all "revsign" bind all {catch {set valx [selection get]}} bind all {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 {set constd "Avogadro's Number, 1/mol"} bind .const.a.b0 {set constd ""} bind .const.a.b1 {set constd "Speed of Light, m/s"} bind .const.a.b1 {set constd ""} bind .const.a.b2 {set constd "The number e"} bind .const.a.b2 {set constd ""} bind .const.a.b3 {set constd "Planck's Constant, J-s"} bind .const.a.b3 {set constd ""} bind .const.a.b4 \ {set constd "Gravitational acceleration, m/s^2"} bind .const.a.b4 {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 \ {set constd "Universal gas constant, J/mol*K"} bind .const.b.b0 {set constd ""} bind .const.b.b1 \ {set constd "Ideal gas at STP, m^3/mol"} bind .const.b.b1 {set constd ""} bind .const.b.b2 {set constd "Elementary charge, C"} bind .const.b.b2 {set constd ""} bind .const.b.b3 {set constd "Boltzmann constant, J/K"} bind .const.b.b3 {set constd ""} bind .const.b.b4 \ {set constd "Gravitational constant, N*m^2/kg^2"} bind .const.b.b4 {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 "$fn 0" bind $parent.set "$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 }