calc

AMG: Here is a Tcl/Tk calculator application I developed.

Prerequisites

Tcl 8.6
Tk
yeti
struct (part of tcllib, required by yeti)
cmdline (part of tcllib, required by struct)
wcb (part of tklib)

Design and Features

At first I thought I'd just wrap around [expr], but then I realized I wanted the operations to work a little bit differently. For example, I want "1/2" to evaluate to "0.5" and not be truncated to "0". Thus, I decided to use yeti to implement my own expression parser which can call custom math operation and function procedures having my desired behaviors. I left out a lot of operations not typically found in a calculator, mainly comparisons and logical operations.

I also decided to hide and rename a few of the standard math functions. Given my redesigned division operator, double isn't useful, so get rid of it. entier, on the other hand, is very useful, but most folks expect it to be named int, so rename it. And so forth.

As for the user interface, having to click on the buttons of a simulated calculator face is not so great when you have a mouse and keyboard, so I went with a text widget instead. This gave me room to show history as well as the current computation. Though, to make the user interface look good, I made heavy use of tags to colorize and otherwise format everything.

The standard bindings for text aren't really appropriate. Mainly, the user should only be allowed to type in the entry field, not overwrite history. The easiest way to filter and customize widget bindings is wcb, so I used that.

Speaking of history, I automatically store each result value into a new variable that can be accessed just by typing its name into the expression (no $ needed). For extra convenience, the most recent result is always called "ans" in addition to its permanent variable name, which is shown in the log.

Since I do a lot of GIS work, I thought it would be cool to support sexagesimal numbers, i.e. angles divided into degrees, minutes, and/or seconds. Just type DD:MM or DD:MM:SS, with an optional sign prefix and fractional suffix. The sign prefix can be any of [+NnEe] for positive or [-SsWw] for negative.

For documentation, start the program and press F1.

Ideas

Color-matching parentheses

AMG: As discussed below, I'm trying to push back against the proliferation of parentheses. Another thing that might help is to make each pair of parentheses a different color so they can be visually matched.

Omitting parentheses from function calls

AMG: Some prior versions of this page have a BNF allowing parentheses to be omitted from function calls, a la Perl, since I found the reduction in parentheses to be convenient during interactive use. However, this resulted in an ambiguous BNF because of the collision between a parenthesized single-argument function call and a non-parenthesized single-argument function call whose argument is itself surrounded by parentheses. Confused about the distinction? So is the computer.

Consider ln(2**999)/ln(2). The argument to the first ln could be either 2**999 or (2**999)/ln(2). My attempted fix was to have the non-parenthesized single-argument function call descend into a second copy of the BNF that omits grouping, but this causes ln a+b to be ln(a+b), whereas ln a+(b) becomes ln(a)+b.

The real fix would be not using parentheses both for grouping and for function calls. If function call argument lists were surrounded with brackets or braces rather than parentheses, there would be no ambiguity. However, this syntax is mildly unconventional, though not completely unheard-of, so I'm leaving it out until actually needed.

FM and if the solution was to avoid parenthesis from function call, to Keep them for grouping, but to separate function call arguments by commas, included between the 0th argument, the name of the func, and the first ?

Consider ln(2**999)/ln(2).

It would become : (ln, 2**999)/(ln,2)

Last parenthesis beeing optionnal.

AMG: Interesting. I hadn't considered that. Having any kind of special character (token) to separate the function call from the first argument would succeed in disambiguating. Comma works, though it's a bit unconventional. The only other place I've seen that syntax is in the $(call) construct in make, for example $(call myfunc,arg1,arg2). Incidentally it also has surrounding parentheses, so it's a bit belt-and-suspenders, solving the same problem two ways.

Rather than comma, how about colon? "(ln:2**999)/ln:2". I like the appearance a bit better. For a complex sequence, try "bin:int:acosd:sqrt:1/2", which arguably looks better than "bin(int(acosd(sqrt(1/2))))".

Today I plan to deploy this application to a group of users I work with, the ones who needed it in the first place. I will be sure to ask them for feedback.

I went ahead and implemented colon notation because it was really easy to add. Pleas give it a try.

FM : options -selectforeground didn't work for me. I had to remove those lines. Colon or comma, it's a matter of taste. Personnaly, I prefer Comma, to get this analogy with plain tcl, "commas are to spaces as parenthesis are to brackets". The former separate arguments, the latter evaluate a result.

(1+sqrt,5)/2 look better than (1+sqrt(5))/2.

It can avoid some mistakes (is this parenthesis to enclose argument or to group ?), espacially when the computation is complex. Ex :

tan,2*atan,(3/(1+sqrt,1+3**2))

instead of

tan(2*atan(3/(1+sqrt(1+3**2))))

This possibility to build complex sequences is very fine.

AMG: The goal isn't to replicate Tcl syntax or even to make a parallel universe Tcl syntax using different symbols for analogous purposes. The goal is to make a calculator convenient for interactive use. So even though my comma happens to be functionally equivalent to Tcl's space for the purpose of separating arguments, the fact is that in this calculator's language, there is a sharp distinction between function names and argument values, whereas Tcl treats them all as words in a command prefix list. Therefore I feel free to use different symbols to separate arguments and to separate a function name from its arguments. Using the same symbol is indeed an option, but it's not an option I wish to exercise. I feel comma's purpose is to delimit a list, yet in this language, the function name is not regarded as part of the list, but rather the entity which receives the list, so in my mind, comma would be a confusing choice. The feedback from my users on colon has been positive, though today I will ask their opinion on using comma in its place.

Further expanding on the notion of using different symbols, surrounding the argument list with parentheses is another example of that, and an uncontroversial one which I indeed retain. All I'm doing is providing a shorthand alternative for the common case of having a sometimes-long pipeline of functions, each applied directly to the output of the last, with no branching, except possibly in the expression forming the input to the innermost function. Parentheses are superfluous in the situation I describe, and keeping them matched is a pain with no gain. But again, this is merely an option, and parentheses remain available for more complex situations, as well as for users who simply prefer their use.

I will now repeat your examples, though with comma in place of colon, to show that they can accomplish the same things. Also let me note that in your final example, the parentheses surrounding the argument to atan are superfluous, so I took the liberty of removing them.

Colon	Comma	Parentheses
(1+sqrt:5)/2	(1+sqrt,5)/2	(1+sqrt(5))/2
tan:2atan:3/(1+sqrt:1+3*2)	tan,2atan,3/(1+sqrt,1+3*2)	tan(2atan(3/(1+sqrt(1+3*2))))

When you say -selectforeground doesn't work for you, do you mean that as a matter of preference or that it is actively causing a problem? Can you elaborate? In this initial release, I simply hard-coded things like this, but I am planning to make it all configurable, the next time I have a chance to devote to personal programming projects.

FM I admit that colons are more readable. Well... we all learned to read, that's why to enclose arguments between parenthesis, as the canonical pratice in classical mathematics, is used allmost everywhere, even if it leads to an ambigous grammaar, and if it's paine to keep parenthesis to match. Whatever, I like to mention exceptions to this classical convention : In his lessons, H. Poincare (a famous Mathematicien), was using a dot e.g -> cos.a;

In the version I have (Tk 8.6, Windows), the tag command of the text widget didn't recognized the option -selectforeground.

Code

#!/usr/bin/env tclsh
# Tcl/Tk calculator program.
# This program is released under BSD license without any warranties.
# Copyright (C) 2019 Andy Goth <[email protected]>
# Source: https://wiki.tcl-lang.org/page/calc

# Load required packages.
lappend auto_path [file join [file dirname [info script]] lib]
package require Tcl 8.6
package require Tk
package require yeti
package require ylex
package require wcb

# Create the ::calc namespace.
namespace eval ::calc {
    variable Count 0        ;# Number of items in the history.
    variable Assigns {}     ;# List of pending assignments.
    variable Consts {}      ;# List of constants.
}

# ::calc::EncodeDms --
# Encodes a degrees-minutes or degrees-minutes-seconds value.
proc ::calc::EncodeDms {enableSec a {digits 6}} {
    # Decode the input.
    set a [DecodeNumber $a]
    if {![string is integer -strict $digits] || $digits < 0} {
        return -code error "digit count must be a nonnegative integer"
    }

    # Perform common processing.
    if {$a < 0} {
        set result -
        set a [expr {-$a}]
    } else {
        set result {}
    }
    set deg [expr {int($a)}]
    set scalar [expr {10 ** $digits}]

    if {$enableSec} {
        # Encode degrees-minutes-seconds.
        set fix [expr {int(($a - $deg) * 3600 * $scalar + 0.5)}]
        set min [expr {$fix / (60 * $scalar) % 60}]
        set sec [expr {$fix / $scalar % 60}]
        append result [format %d:%02d:%02d $deg $min $sec]
    } else {
        # Encode degrees-minutes.
        set fix [expr {int(($a - $deg) * 60 * $scalar + 0.5)}]
        set min [expr {$fix / $scalar % 60}]
        append result [format %d:%02d $deg $min]
    }

    # Append fractional digits if enabled.
    if {$digits} {
        append result [format .%0*d $digits [expr {$fix % $scalar}]]
    }
    return $result
}

# ::calc::DecodeDms --
# Decodes a degrees-minutes-seconds value.  The seconds field is optional.
proc ::calc::DecodeDms {a} {
    # Split the value into fields.
    regexp {^([-+NnSsEeWw]?)0*(\d+)(?::0*(\d+))(?::0*(\d+))?(\.\d*)?$} $a _\
            hemi deg min sec frac

    # Treat degenerate fractions as zero.
    if {$frac in {{} .}} {
        set frac 0
    }

    # Add the fraction to the least-significant place.
    if {$min >= 60} {
        return -code error "minutes field too large"
    } elseif {$sec eq {}} {
        set min [expr {$min + $frac}]
        set sec 0
    } elseif {$sec >= 60} {
        return -code error "seconds field too large"
    } else {
        set sec [expr {$sec + $frac}]
    }

    # Compute the result.  Negate the southern and western hemispheres.
    if {$hemi in {- S s W w}} {
        expr {-$deg - $min / 60.0 - $sec / 3600.0}
    } else {
        expr {+$deg + $min / 60.0 + $sec / 3600.0}
    }
}

# ::calc::DecodeNumber --
# Attempts to decode any number in a recognized format.
proc ::calc::DecodeNumber {a} {
    if {[string is double -strict $a]} {
        return $a
    } else {
        ::calc::DecodeDms $a
    }
}

# ::calc::Call --
# Calls a function with all arguments decoded as numbers.
proc ::calc::Call {func args} {
    {*}$func {*}[lmap arg $args {DecodeNumber $arg}]
}

# Create the ::calc::math namespace to contain all math functions and operators.
namespace eval ::calc::math {
    # Create selected math functions, renaming a few of them along the way.
    foreach {from to} {
        abs   abs       acos  acos      asin  asin      atan  atan
        atan2 atan2     ceil  ceil      cos   cos       cosh  cosh
        int   entier    isqrt isqrt     exp   exp       floor floor
        hypot hypot     ln    log       log   log10     max   max
        min   min       round round     sqrt  sqrt      sin   sin
        sinh  sinh      tan   tan       tanh  tanh
    } {
        interp alias {} ::calc::math::$from {} ::calc::Call ::tcl::mathfunc::$to
    }

    # Create functions to format in degrees-minutes and degrees-minutes-seconds.
    interp alias {} ::calc::math::dm  {} ::calc::EncodeDms 0
    interp alias {} ::calc::math::dms {} ::calc::EncodeDms 1

    # Create functions to convert between degrees and radians.
    proc deg {a} {variable pi; expr {$a * 180 / $pi}}
    proc rad {a} {variable pi; expr {$a * $pi / 180}}

    # Create trigonometric functions that work in degrees.
    proc acosd {a} {deg [expr {acos($a)}]}
    proc asind {a} {deg [expr {asin($a)}]}
    proc atand {a} {deg [expr {atan($a)}]}
    proc atan2d {a b} {deg [expr {atan2($a, $b)}]}
    proc cosd {a} {expr {cos([rad $a])}}
    proc sind {a} {expr {sin([rad $a])}}
    proc tand {a} {expr {tan([rad $a])}}

    # Create functions to format numbers in binary, octal, and hexadecimal.
    # When given a negative number, truncate the two's-complement.
    foreach {name code} {bin b oct o hex x} {
        proc $name {a {size 32}} [string map [list %CODE% [list $code]] {
            if {$a < 0} {
                set a [expr {$a & (1 << $size) - 1}]
            }
            format 0%CODE%%ll%CODE% $a
        }]
    }

    # Create math operations that recognize DMS inputs as well as numbers.
    foreach op {+ - * / % ** << >> & ^ |} {
        interp alias {} ::calc::math::$op {} ::calc::Call ::tcl::mathop::$op
    }

    # ::calc::math::/ --
    # Custom division operation that avoids truncation.
    proc / {a b} {
        if {[string is integer -strict $a] && [string is integer -strict $b]
         && !($a % $b)} {
            expr {$a / $b}
        } else {
            expr {double([::calc::DecodeNumber $a]) / [::calc::DecodeNumber $b]}
        }
    }

    # ::calc::math::% --
    # Custom modulo operation that works with integers and real numbers.
    proc % {a b} {
        if {[string is integer -strict $a] && [string is integer -strict $b]} {
            expr {$a % $b}
        } else {
            expr {fmod([::calc::DecodeNumber $a], [::calc::DecodeNumber $b])}
        }
    }

    # Clean up temporary variables.
    unset from to name code op

    # Create constants.
    set pi  [expr {acos(-1)}]
    set e   [expr {exp(1)}]
    set inf Inf
}

# Create the list of constants.
namespace eval ::calc {
    set Consts [lmap var [info vars math::*] {namespace tail $var}]
    unset var
}

# Create the scanner.
yeti::ylex ::calc::ScannerBuilder -name ::calc::ScannerClass
::calc::ScannerBuilder code error {}
::calc::ScannerBuilder macro {
    SPACE       {[ \f\n\r\t\v]+}
    END         {(?!\w)}
    OP          {<<|>>|\*\*|[-(),&|^+*/%:=]}
    DEC         {\d+<END>}
    BIN         {0[Bb][01]+<END>}
    OCT         {0[Oo][0-7]+<END>}
    HEX         {0[Xx][[:xdigit:]]+<END>}
    EXP         {[eE][+-]?\d+}
    REAL        {(?:\d+<EXP>|\d*\.\d+<EXP>?|\d+\.\d*<EXP>?)<END>}
    DMS         {[NnSsEeWw]?\d+(?::\d+){1,2}(?:\.\d*)?<END>}
    NAME        {[a-zA-Z_]\w*}
}
::calc::ScannerBuilder add {
    {<SPACE>}   {}
    {<OP>}      {return [list $yytext]}
    {<DEC>}     {return [list VAL [scan $yytext %lld]]}
    {<BIN>}     {return [list VAL [scan $yytext %llb]]}
    {<OCT>}     {return [list VAL [scan [regsub {..} $yytext {}] %llo]]}
    {<HEX>}     {return [list VAL [scan $yytext %llx]]}
    {<REAL>}    {return [list VAL [scan $yytext %f]]}
    {<DMS>}     {return [list VAL [::calc::DecodeDms $yytext]]}
    {<NAME>}    {return [list NAME $yytext]}
    {.}         {error "invalid character \"$yytext\""}
}
eval [::calc::ScannerBuilder dump]
::calc::ScannerClass ::calc::Scanner
::calc::ScannerBuilder destroy

# Create the parser.
yeti::yeti ::calc::ParserBuilder -name ::calc::ParserClass -start top
::calc::ParserBuilder code error {}
::calc::ParserBuilder add {
    top ior             {return $1}
      | {NAME = top}    {lappend ::calc::Assigns $1 $3; return $3}
    ior xor             {return $1}
      | {ior | xor}     {return [::calc::math::| $1 $3]}
    xor and             {return $1}
      | {xor ^ and}     {return [::calc::math::^ $1 $3]}
    and shf             {return $1}
      | {and & shf}     {return [::calc::math::& $1 $3]}
    shf add             {return $1}
      | {shf << add}    {return [::calc::math::<< $1 $3]}
      | {shf >> add}    {return [::calc::math::>> $1 $3]}
    add mul             {return $1}
      | {add + mul}     {return [::calc::math::+ $1 $3]}
      | {add - mul}     {return [::calc::math::- $1 $3]}
    mul exp             {return $1}
      | {mul * exp}     {return [::calc::math::* $1 $3]}
      | {mul / exp}     {return [::calc::math::/ $1 $3]}
      | {mul % exp}     {return [::calc::math::% $1 $3]}
    exp una             {return $1}
      | {una ** exp}    {return [::calc::math::** $1 $3]}
    una num             {return $1}
      | {+ una}         {return [::calc::math::+ $2]}
      | {- una}         {return [::calc::math::- $2]}
    num {( top )}       {return $2}
      | VAL             {return $1}
      | NAME            {return [set ::calc::math::$1]}
      | {NAME ( )}      {return [::calc::math::$1]}
      | {NAME ( arg )}  {return [::calc::math::$1 {*}$3]}
      | {NAME : arg}    {return [::calc::math::$1 {*}$3]}
    arg top             {return [list $1]}
      | {arg , top}     {return [list {*}$1 $3]}
}
eval [::calc::ParserBuilder dump]
::calc::ParserClass ::calc::Parser -scanner ::calc::Scanner
::calc::ParserBuilder destroy

# ::calc::eval --
# Evaluates the math expression.  Variable assignments will not take effect
# until [calc::assign] is called.
proc ::calc::eval {expr} {
    variable Assigns {}
    Parser reset
    Scanner start $expr
    Parser parse
}

# ::calc::assign --
# Carries out pending variable assignments from the most recent [calc::eval].
proc ::calc::assign {} {
    variable Assigns
    variable Consts
    foreach {var val} $Assigns {
        if {$var ni $Consts && ![regexp {^a\d+$} $var]} {
            set ::calc::math::$var $val
        }
    }
}

# ::calc::help --
# Writes help text into a text widget.
proc ::calc::help {win} {
    # Configure tags.
    $win configure -wrap word
    set font [font actual [$win cget -font]]
    set mono [list -family [dict get [font actual TkFixedFont] -family]]
    $win tag configure normal -font $font
    $win tag configure header -font [list {*}$font -weight bold -underline 1]
    $win tag configure fixed -font [list {*}$font {*}$mono]\
            -background palegreen

    # Build reference table.
    set row 0
    set col(2) \u2502
    set col(5) \u2502
    foreach {col(0) col(1)} {
        Expression      Result
        {}              {}
        "name = a"      "Variable assignment"
        "a | b"         "Bitwise inclusive OR"
        "a ^ b"         "Bitwise exclusive OR"
        "a & b"         "Bitwise AND"
        "a << b"        "Shift left"
        "a >> b"        "Shift right"
        "a + b"         "Addition"
        "a - b"         "Subtraction"
        "a * b"         "Multiplication"
        "a / b"         "Division"
        "a % b"         "Remainder"
        "a ** b"        "Exponentiation"
        +a              "Passthrough"
        -a              "Negation"
        (a)             "Grouping"
        {}              {}
        pi              "Archimedes's constant"
        e               "Euler's number"
        inf             "Infinity"
        ans             "Most recent result"
        "a1 a2 ... aN"  "Numbered result"
        name            "Value of a variable"
    } {col(3) col(4)} {
        Expression      Result
        {}              {}
        bin(a[,bits])   "Binary format"
        oct(a[,bits])   "Octal format"
        hex(a[,bits])   "Hexadecimal format"
        {}              {}
        dm(a[,digits])  "Deg:min format"
        dms(a[,digits]) "Deg:min:sec format"
        {}              {}
        deg(a)          "Radians to degrees"
        rad(a)          "Degrees to radians"
        {}              {}
        abs(a)          "Absolute value"
        ceil(a)         "Ceiling"
        floor(a)        "Floor"
        int(a)          "Round toward zero"
        round(a)        "Round to nearest integer"
        {}              {}
        exp(a)          "e**a"
        ln(a)           "Natural logarithm"
        log(a)          "Base-10 logarithm"
        {}              {}
        max(a,b,...)    "Maximum"
        min(a,b,...)    "Minimum"
    } {col(6) col(7)} {
        Expression      Result
        {}              {}
        isqrt(a)        "Integer square root"
        sqrt(a)         "Real square root"
        hypot(a,b)      "Hypotenuse length"
        {}              {}
        cos(a)          "Cosine"
        sin(a)          "Sine"
        tan(a)          "Tangent"
        acos(a)         "Inverse cosine"
        asin(a)         "Inverse sine"
        atan(a)         "Inverse tangent"
        atan2(a,b)      "Argument"
        cosh(a)         "Hyperbolic cosine"
        sinh(a)         "Hyperbolic sine"
        tanh(a)         "Hyperbolic tangent"
        {}              {}
        cosd(a)         "Cosine (deg)"
        sind(a)         "Sine (deg)"
        tand(a)         "Tangent (deg)"
        acosd(a)        "Inverse cosine (deg)"
        asind(a)        "Inverse sine (deg)"
        atand(a)        "Inverse tangent (deg)"
        atan2d(a,b)     "Argument (deg)"
    } {
        foreach {tag i} {
            fixed 0 normal 1 normal 2 fixed 3 normal 4 normal 5 fixed 6 normal 7
        } {
            if {!$row && $col($i) ne "\u2502"} {
                set tag header
            }
            set w [font measure [$win tag cget $tag -font] $col($i)]
            if {![info exists width($i)] || $w > $width($i)} {
                set width($i) $w
            }
            if {$i} {
                $win insert end \t
            }
            $win insert end $col($i) $tag
        }
        $win insert end \n
        incr row
    }
    $win configure -tabs [lmap i {0 1 2 3 4 5 6 7} {
        incr accum [expr {5 + $width($i)}]
    }]

    # Configure widget size according to table size.
    set unit [font measure $font 0]
    $win configure -width [expr {($accum + $unit - 1) / $unit}]\
            -height [expr {$row + 2}]

    # Output the main help text.
    set sep {}
    foreach {header body} {
        "Basic Operation"
        "Simply type the math expression, and the displayed result will update
        continuously. If there is an error (e.g., incomplete input), the result
        will be blank until the input is valid. Pressing Enter moves the current
        entry and result to the history. Old result values can be recalled via
        the `ans` variable or the numbered `a` variables, e.g., `a1` for the
        first result. Old entries and results can be copied into the entry field
        by moving the cursor upward (or by clicking on them) and pressing Enter.
        Ctrl+C and Ctrl+V can be used to copy and paste between applications.
        Press Esc to clear the entry field."
        "Function Calls"
        "Functions such as `sin` and `ln` are called by writing the function
        name followed by its arguments in parentheses, or by writing a colon
        between the function name and its arguments. In some cases, the latter
        form can be a convenient alternative to matching parentheses. For
        example, these three expressions are equivalent: `(1+sqrt(5))/2`,
        `(1+sqrt:5)/2`, and `((sqrt:5)+1)/2`. Due to order of operations,
        `(sqrt:5+1)/2` is evaluated as `sqrt(5+1)/2`, so be cautious with colon
        notation. As a more complex example, `4*acos:sqrt:1/2` means
        `4*acos(sqrt(1/2))`, which evaluates to pi. `int:log:ln:exp:sqrt:1e4` is
        `int(log(ln(exp(sqrt(1e4)))))` and evaluates to `2`."
        "Variable Assignment"
        "Custom variables can be created using the `=` operator, for example by
        typing `phi=(1+sqrt:5)/2` then pressing Enter. Any attempt to replace
        predefined constants, the `ans` variable, or numbered `a` variables will
        be ignored. Variable names consist of \[`a-zA-Z0-9_`\] and must not
        start with a digit. The `=` operator may appear at the top level of the
        expression or nested within a subexpression."
        "Number Formats"
        "Integers and real numbers are normally entered in decimal. Integers can
        also be entered in binary, octal, or hexadecimal using `0b`, `0o`, or
        `0x` prefixes, e.g. `0b1101` for `13` in binary. The `bin`, `oct`, and
        `hex` functions convert to binary, octal, and hexadecimal. For example,
        `oct:255` evaluates to `0o377`. The inputs to these functions need not
        be written in decimal and can be the result of further computation, so
        `hex:0b10100101` returns `0xa5`, and `bin:int:acosd:sqrt:1/2` returns
        `0b101101`. By default, these functions truncate negative numbers to 32
        bits, but an optional second argument can be used to specify the bit
        count. For example, `hex:-100` yields `0xffffff9c`, whereas `hex:-100,8`
        yields `0x9c`."
        "Sexagesimal Notation"
        "Real numbers can be entered in sexagesimal (base-60) notation, which
        subdivides degrees into minutes and (optionally) seconds, with the
        places separated by colons. There are sixty minutes per degree and sixty
        seconds per minute. A sign prefix may be used, where \[`+NnEe`\] are
        positive and \[`-SsWw`\] are negative. Examples: `N32:26:06.630720` is
        `32.4351752` and `W097:00.252` is `-97.0042`. The `dm` and `dms`
        functions convert to deg:min and deg:min:sec, so `dm:-12.3456789`
        returns `-12:20.740734`, `dms:45.5+59.123456/3600` returns
        `45:30:59.123456`, and `dm:1:2:3.4` returns `1:02.056667`. These
        functions output six fractional digits by default, though this is
        controlled by the optional second argument. For example, `dm:1:2:3,2`
        gives `1:02.05` and `dms:22.22,0` gives `22:13:12`."
        "Degrees and Radians"
        "The normal trigonometry functions use radians due to the equivalence
        between the unit circle's arc angle and arc length. However, degrees are
        easier to conceptualize and communicate and are therefore more popular
        in practical applications. To use degrees instead of radians, add `d` to
        the name of the trigonometric function, for instance `sind` rather than
        `sin`. (The degree versions of hyperbolic functions are omitted.)
        `sind:90` is the same as `sin:pi/2`, and both evaluate to `1.0`. To
        directly convert to degrees from radians, use the `deg` function, or use
        `rad` to convert to radians from degrees. For example, `deg:pi/4`
        returns `45.0`, and `rad:180` returns `3.141592653589793`."
        "Precision"
        "Arbitrary-precision integers are used, so integer computations have no
        upper limit besides that imposed by memory and CPU time constraints.
        Some extremely large computations may effectively lock up the program.
        For real numbers, double-precision values are used. On most platforms,
        this gives 53 bits of significand, or about 16 decimal digits, with an
        exponent range of about \u00b1308 decimal digits."
        "Support"
        "For source code and community discussion, visit
        `https://wiki.tcl-lang.org/page/calc`."
        "License"
        "This software is copyrighted by Andy Goth <[email protected]>.
        The following terms apply to all files associated with the software
        unless explicitly disclaimed in individual files.

        The author(s) hereby grant permission to use, copy, modify, distribute,
        and license this software and its documentation for any purpose,
        provided that existing copyright notices are retained in all copies and
        that this notice is included verbatim in any distributions. No written
        agreement, license, or royalty fee is required for any of the authorized
        uses. Modifications to this software may be copyrighted by their authors
        and need not follow the licensing terms described here, provided that
        the new terms are clearly indicated on the first page of each file where
        they apply.

        IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY FOR
        DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING
        OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY DERIVATIVES
        THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE POSSIBILITY OF
        SUCH DAMAGE.

        THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
        INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
        MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.
        THIS SOFTWARE IS PROVIDED ON AN \"AS IS\" BASIS, AND THE AUTHORS AND
        DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT,
        UPDATES, ENHANCEMENTS, OR MODIFICATIONS.

        GOVERNMENT USE: If you are acquiring this software on behalf of the U.S.
        government, the Government shall have only \"Restricted Rights\" in the
        software and related documentation as defined in the Federal Acquisition
        Regulations (FARs) in Clause 52.227.19 (c) (2). If you are acquiring the
        software on behalf of the Department of Defense, the software shall be
        classified as \"Commercial Computer Software\" and the Government shall
        have only \"Restricted Rights\" as defined in Clause 252.227-7014 (b)
        (3) of DFARs. Notwithstanding the foregoing, the authors grant the U.S.
        Government and others acting in its behalf permission to use and
        distribute the software in accordance with the terms specified in this
        license."
    } {
        $win insert end $sep\n$header\n header
        foreach {_ normal fixed} [regexp -all -inline {([^`]*)(?:`([^`]*)`)?}\
                [regsub -all {\n +} [regsub -all {\n\n +} $body \n\n] " "]] {
            $win insert end $normal normal $fixed fixed
        }
        set sep \n
    }
}

# ::calc::setup --
# Configures a text widget to be a calculator.
proc ::calc::setup {win} {
    # Create entry and result fields.
    .calc insert end \n entry " " result
    .calc mark set insert entry.first

    # Create a tab stop at the right edge of the text widget.
    bind $win <Configure> {
        set box [%W bbox "1.0 lineend"]
        %W configure -tabs [list\
                [expr {[lindex $box 0] + [lindex $box 2] - 2}] right]
    }

    # Delete the entry when escape is pressed.
    bind $win <Key-Escape> {
        %W delete entry.first entry.last-1char
    }

    # Create input callback.
    wcb::callback $win before insert {apply {{win index args} {
        variable Count

        # Loop over each part being inserted.
        set i 1
        set cancel 1
        foreach {string tags} $args {
            if {$string eq "\n" && [$win compare $index < entry.first]} {
                # Interpret a bare newline before the entry field as a command
                # to replace the entry with the old entry or result.
                set index [$win index "$index lineend"]
                foreach tag {oldResult oldEntry} {
                    if {[set match [$win tag prevrange $tag $index]] ne {}
                     && [$win compare $index >= "[lindex $match 0] linestart"]
                     && [$win compare $index < "[lindex $match 1] lineend"]} {
                        lset match 1 [lindex $match 1]-1char
                        $win delete entry.first entry.last-1char
                        wcb::replace 0 end\
                                entry.first [$win get {*}$match] entry
                        $win tag remove sel sel.first sel.last
                        $win mark set insert entry.last-1char
                        set cancel 0
                        break
                    }
                }
            } elseif {$string eq "\n"} {
                # Interpret a bare newline as a command to store the result.
                catch {
                    # Get and evaluate the input expression.
                    set in [$win get entry.first entry.last-1char]
                    set out [calc::eval $in]

                    # Perform any variable assignments.
                    calc::assign

                    # Store the result into the history.
                    incr Count
                    set ::calc::math::ans $out
                    set ::calc::math::a$Count $out

                    # Display the result.
                    $win insert entry.first $in\n oldEntry\
                            "a$Count =\t" oldVar $out\n oldResult

                    # Clear the input.
                    $win replace result.first result.last " " result
                    $win delete entry.first entry.last-1char
                    $win see end
                }
                wcb::replace $i [expr {$i + 1}]
            } elseif {$string in {\f \r \t \v}} {
                # Disallow entering whitespace control characters by themselves.
                wcb::replace $i [expr {$i + 1}]
            } else {
                # Simplify input whitespace.
                wcb::replace $i [expr {$i + 1}] [string map\
                        {\f {} \n " " \r {} \t " " \v {}}\
                        [string trim $string \n\t]] entry

                # Clamp the insert position to the entry field.
                if {[$win compare $index < entry.first]} {
                    catch {$win tag remove sel sel.first sel.last}
                    $win mark set insert entry.first
                } elseif {[$win compare $index >= entry.last]} {
                    catch {$win tag remove sel sel.first sel.last}
                    $win mark set insert entry.last-1char
                }

                # Do not cancel the command if there is any good input.
                set cancel 0
            }
            incr i 2
        }

        # Cancel the command if all parts have been omitted.
        if {$cancel} {
            wcb::cancel
        }
    } ::calc}}

    # Create delete callback.
    wcb::callback $win before delete {apply {{win from {to {}}} {
        # Check if the selection is being deleted.
        set sel [expr {$from eq "sel.first" && $to eq "sel.last"}]

        # Fill in the default end index.
        if {$to eq {}} {
            set to $from+1char
        }

        # Clamp the start and/or end indexes to the entry field.
        set clampFrom [$win compare $from < entry.first]
        set clampTo [$win compare $to >= entry.last]
        if {$clampFrom || $clampTo} {
            # Clamp the indexes, or resolve the selection indexes.
            if {$clampFrom} {
                set from entry.first
            } elseif {$sel} {
                set from [$win index $from]
            }
            if {$clampTo} {
                set to entry.last-1char
            } elseif {$sel} {
                set to [$win index $to]
            }

            # Now that the indexes have been updated, take action.
            if {!$sel} {
                # If the selection is not being deleted, simply apply clamping.
                wcb::replace 0 1 $from $to
            } elseif {[$win compare $from >= $to]} {
                # Abort if clamping results in an empty range.
                wcb::cancel {}
            } else {
                # If the selection is being deleted, clamp the selection itself.
                $win tag remove sel sel.first sel.last
                $win tag add sel $from $to
            }
        }
    }}}

    # Create motion callbacks.
    wcb::callback $win before motion {apply {{win index} {
        if {($index eq "insert-1displayindices"
          && [$win compare insert == entry.first])
         || ($index eq "insert+1displayindices"
          && [$win compare insert == entry.last-1chars])
         || [$win compare $index >= result.first]
          && [$win get result.first result.last] eq " "} {
            # Cancel attempts to leave the entry field using left or right, as
            # well as attempts to move the cursor to the result when empty.
            wcb::cancel {}
        }
    }}}
    wcb::callback $win after motion {apply {{win index} {
        if {[$win compare insert < entry.first]} {
            # Automatically select the whole entry or result from the log.
            set index [$win index "insert lineend"]
            foreach tag {oldResult oldEntry} {
                if {[set match [$win tag prevrange $tag $index]] ne {}
                 && [$win compare $index >= "[lindex $match 0] linestart"]
                 && [$win compare $index < "[lindex $match 1] lineend"]} {
                    catch {$win tag remove sel sel.first sel.last}
                    after idle [list $win tag add sel\
                            [lindex $match 0] [lindex $match 1]-1char]
                    break
                }
            }
        } elseif {[$win compare insert >= result.first]} {
            # Automatically select the whole result.
            catch {$win tag remove sel sel.first sel.last}
            after idle [list $win tag add sel result.first result.last]
        }
    }}}

    # Create post-update callbacks.
    foreach event {insert delete} {
        wcb::callback $win after $event {apply {{win args} {
            try {
                # Attempt to evalute the input field.
                set out [calc::eval [$win get entry.first entry.last-1char]]
            } on error {} {
                # On failure, force the result to a single space.
                set out " "
            }

            # Put the result onscreen.
            if {[set match [$win tag ranges result]] eq {}} {
                $win insert end $out result
            } else {
                $win replace result.first result.last $out result
            }
            $win see end
        }}}
    }
}

# Create user interface.
set mono [list -family [dict get [font actual TkFixedFont] -family]]
wm title . Calculator
text .calc -highlightthickness 0 -background palegreen\
        -yscrollcommand {.scroll set}
.calc tag configure oldEntry -font [list {*}$mono -size 14]\
        -selectforeground chartreuse -selectbackground forestgreen\
        -foreground olivedrab
.calc tag configure oldVar -font [list {*}$mono -size 10]\
        -selectforeground chartreuse -selectbackground forestgreen\
        -foreground seagreen
.calc tag configure oldResult -font [list {*}$mono -size 14]\
        -selectforeground chartreuse -selectbackground forestgreen\
        -foreground green
.calc tag configure entry -font [list {*}$mono -size 18]\
        -borderwidth 2 -relief groove\
        -foreground darkslategray -background greenyellow\
        -selectforeground chartreuse -selectbackground darkgreen\
        -lmargin1 4 -lmargin2 4 -rmargin 4 -spacing1 2 -spacing3 2
.calc tag configure result -font [list {*}$mono -size 18 -weight bold]\
        -selectforeground chartreuse -selectbackground forestgreen\
        -foreground green -justify right
unset mono
ttk::scrollbar .scroll -command {.calc yview}
grid .calc .scroll -sticky nsew
grid columnconfigure . .calc -weight 1
grid rowconfigure . .calc -weight 1
focus .calc
calc::setup .calc

# Create help interface.
ttk::label .hint -text "Press F1 for help" -background palegreen
place .hint -anchor sw -relx 0 -x 1 -rely 1 -y -1
bind . <Key> {destroy .hint; bind . <Key> {}; continue}
bind . <Key-F1> {wm state .help normal; raise .help}
toplevel .help
wm title .help "Calculator Help"
wm withdraw .help
wm protocol .help WM_DELETE_WINDOW {wm withdraw .help}
bind .help <Key-Escape> {wm withdraw .help}
wm resizable .help 0 1
text .help.text -highlightthickness 0 -font TkDefaultFont\
        -yscrollcommand {.help.scroll set}
ttk::scrollbar .help.scroll -command {.help.text yview}
grid .help.text .help.scroll -sticky nsew
grid columnconfigure .help .help.text -weight 1
grid rowconfigure .help .help.text -weight 1
calc::help .help.text
.help.text configure -state disabled

# vim: set sts=4 sw=4 tw=80 et ft=tcl:

Category TK

Category Application