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

[calc.png]

**Prerequisites**

   * Tcl 8.6
   * Tk
   * [yeti]
   * [struct] (part of [tcllib], required by yeti)
   * [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.

To use this calculator, simply type the math expression.  The result will update continuously.  If the result is an error (for example, if the input is incomplete), the result will be empty until the input is valid.  Pressing Enter will cause the current entry and result to be moved to the history, at which point they can be accessed again via the "ans" variable or a numbered "a" variable.  They can also be accessed by moving the cursor upward (or clicking) then using Ctrl+C to copy, after which Ctrl+V will paste into the entry field, as per usual.

**Operators and Functions**

The following table lists all supported operators, constants, variables, and functions.  The operators are listed in increasing order of precedence.

%|Expression     |Result                        |%
&|a [<<pipe>>] 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                |&
&|phi            |Golden ratio                  |&
&|[inf]          |Infinity                      |&
&|ans            |Most recent result            |&
&|a1 a2 ... aN   |Numbered result               |&
%|               |                              |%
&|bin(a)         |Binary format                 |&
&|oct(a)         |Octal format                  |&
&|hex(a)         |Hexadecimal format            |&
&|dm(a)          |Degrees:minutes format        |&
&|dms(a)         |Degrees:minutes:seconds format|&
&|deg(a)         |Convert radians to degrees    |&
&|rad(a)         |Convert degrees to radians    |&
%|               |                              |%
&|[abs](a)       |Absolute value                |&
&|[ceil](a)      |Ceiling                       |&
&|int(a)         |Whole number                  |&
&|[floor](a)     |Floor                         |&
&|[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                       |&
&|[rand]()       |Random number in [[0,1)       |&
%|               |                              |%
&|[isqrt](a)     |Integer square root           |&
&|[sqrt](a)      |Real square root              |&
&|[hypot](a,b)   |Length of hypotenuse          |&
%|               |                              |%
&|[cos](a)       |Cosine (radians)              |&
&|cosd(a)        |Cosine (degrees)              |&
&|[sin](a)       |Sine (radians)                |&
&|sind(a)        |Sine (degrees)                |&
&|[tan](a)       |Tangent (radians)             |&
&|tand(a)        |Tangent (degrees)             |&
%|               |                              |%
&|[acos](a)      |Inverse cosine (radians)      |&
&|acosd(a)       |Inverse cosine (degrees)      |&
&|[asin](a)      |Inverse sine (radians)        |&
&|asind(a)       |Inverse sine (degrees)        |&
&|[atan](a)      |Inverse tangent (radians)     |&
&|atand(a)       |Inverse tangent (degrees)     |&
&|[atan2](a,b)   |Argument (radians)            |&
&|atand2(a,b)    |Argument (degrees)            |&
%|               |                              |%
&|[cosh](a)      |Hyperbolic cosine             |&
&|[sinh](a)      |Hyperbolic sine               |&
&|[tanh](a)      |Hyperbolic tangent            |&
%|               |                              |%

**Code**

======
#!/usr/bin/env tclsh
# Tcl/Tk calculator program.
# This program is released under BSD license without any warranties.
# Copyright (C) 2019 Andy Goth <andrew.m.goth@gmail.com>

# 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.
}

# 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*)?}
    NAME        {[a-zA-Z_]\w*<END>}
}
::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 ior
::calc::ParserBuilder code error {}
::calc::ParserBuilder add {
    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 {( ior )}       {return $2}
      | fun             {return $1}
      | var             {return $1}
      | VAL             {return $1}
    fun {NAME ( )}      {return [::calc::math::$1]}
      | {NAME ( arg )}  {return [::calc::math::$1 {*}$3]}
    arg ior             {return [list $1]}
      | {arg , ior}     {return [list {*}$1 $3]}
    var NAME            {return [set ::calc::math::$1]}
}
eval [::calc::ParserBuilder dump]
::calc::ParserClass ::calc::Parser -scanner ::calc::Scanner
::calc::ParserBuilder destroy

# ::calc::EncodeDms --
# Encodes a degrees-minutes or degrees-minutes-seconds value.
proc ::calc::EncodeDms {enableSec a} {
    # Decode the input.
    set a [DecodeNumber $a]

    # Process the sign.
    if {$a < 0} {
        set sign -
        set a [expr {-$a}]
    } else {
        set sign {}
    }

    if {$enableSec} {
        # Encode degrees-minutes-seconds.
        set deg [expr {int($a)}]
        set fix [expr {int(($a - $deg) * 3600000000 + 0.5)}]
        set min [expr {$fix / 60000000 % 60}]
        set sec [expr {$fix / 1000000 % 60}]
        set frac [expr {$fix % 1000000}]
        format %s%d:%02d:%02d.%06d $sign $deg $min $sec $frac
    } else {
        # Encode degrees-minutes.
        set deg [expr {int($a)}]
        set fix [expr {int(($a - $deg) * 60000000 + 0.5)}]
        set min [expr {$fix / 1000000 % 60}]
        set frac [expr {$fix % 1000000}]
        format %s%d:%02d.%06d $sign $deg $min $frac
    }
}

# ::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       rand  rand      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 to 32 bits.
    foreach {name code} {bin b oct o hex x} {
        proc $name {a} [string map [list %CODE% [list $code]] {
            if {$a < 0} {
                set a [expr {$a & 0xffffffff}]
            }
            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 phi [expr {(1 + sqrt(5)) / 2}]
    set inf Inf
}

# ::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]
    }

    # 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"} {
                # 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]

                    # 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 {
                # Ensure the input is tagged correctly.
                if {"entry" ni $tags} {
                    lappend tags entry
                }

                # Simplify input whitespace.
                wcb::replace $i [expr {$i + 1}] [string map\
                        {\f {} \n " " \r {} \t " " \v {}}\
                        [string trim $string \n\t]] $tags

                # 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 callback.
    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])} {
            # Cancel attempts to leave the entry field using left or right.
            wcb::cancel {}
        }
    }}}
    wcb::callback $win after motion {apply {{win index} {
        if {[$win compare insert < entry.first]} {
            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 {*}$match]
                    break
                }
            }
        } elseif {[$win compare $index >= entry.last]} {
            catch {$win tag remove sel sel.first sel.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
        }}}
    }
}

# ::calc::eval --
# Evaluates the math expression.
proc ::calc::eval {expr} {
    Parser reset
    Scanner start $expr
    Parser parse
}

# Create user interface.
wm title . Calculator
text .calc -highlightthickness 0 -setgrid 1 -background palegreen\
        -yscrollcommand {.scroll set}
.calc tag configure oldEntry -font {-family monospace -size 14}\
        -selectforeground chartreuse -selectbackground forestgreen\
        -foreground olivedrab
.calc tag configure oldVar -font {-family monospace -size 10}\
        -selectforeground chartreuse -selectbackground forestgreen\
        -foreground seagreen
.calc tag configure oldResult -font {-family monospace -size 14}\
        -selectforeground chartreuse -selectbackground forestgreen\
        -foreground green
.calc tag configure entry -font {-family monospace -size 18}\
        -borderwidth 2 -relief groove\
        -foreground darkslategray -background greenyellow\
        -selectforeground chartreuse -selectbackground darkgreen\
        -lmargin1 4 -rmargin 4 -spacing1 2 -spacing3 2
.calc tag configure result -font {-family monospace -size 18 -weight bold}\
        -selectforeground chartreuse -selectbackground forestgreen\
        -foreground green -justify right
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

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

<<categories>> Tk | Application