[Arjen Markus] (3 november 2004) The script below may not appeal to anyone who is used to handheld calculators and their software implementations. 
It is a script that mimicks the interface of the UNIX program ''bc''. 
Rather than punching in the buttons on a small keypad, you can just type expressions like "1+2.3" and then press the Enter key to get the result.

This version allows you to define functions too, so that you do not have to repeat the whole expression when you need to fill in various values. For instance:

If you need to compute sin(2x) for a bunch of values for x, just do:

 >> f(x)=sin(2*x)
 >>f(1.)
 >>f(2)
 >>1/(1+f(3))

etc.

(Oh, it does not work yet with functions of more than one argument and there are numerous other improvements possible).

----
======
 # calc2.tcl --
 #    Script to emulate a calculator, allows the on-the-spot
 #    evaluation of expressions as well the definition of
 #    functions
 #
 #    Allow function definitions:
 #    >> f(x) = x*x + 2
 #    >> g(x) = 1/(x+1)
 #    >> f(4)*g(5)
 #    3.0
 #
 # Author: Arjen Markus (arjen.markus@wldelft.nl)
 #
 # Notes:
 #    Improvements to be made:
 #    - Nice interface to Tk (distinguish from Tcl)
 #    - Run-time check for recursion
 #    - On-line help
 #    - Hexadecimal/decimal conversions
 #

 # Functions --
 #    Namespace for the user-defined macros
 #
 namespace eval ::Functions {
 }

 # Calculator --
 #    Namespace for the public commands
 #
 namespace eval ::Calculator {
     variable hexmode    0
     variable hexprompt  "(HEX)>> "
     variable decprompt  ">> "
     variable prompt     $decprompt
 }

 # Standard functions --
 #    Define the standard functions
 #
 # Arguments:
 #    arglist     List of variables
 #    expression  Expression to be evaluated
 #    values      List of actual values
 # Return value:
 #    Value of the expression
 #
 namespace eval ::Functions {
     #
     # Note: no braces! - sin(1.0+2.0) would not work then
     #
     set prototype {
 proc ::Functions::<name> { arg } {
     expr <name>($arg)
 }}
     foreach f {exp sin cos tan log abs atan acos asin} {
         eval [string map [list "<name>" $f] $prototype]
     }

     set prototype {
 proc ::Functions::<name> { arg1 arg2 } {
     expr <name>($arg1,$arg2)
 }}
     foreach f {atan2 hypot} {
         eval [string map [list "<name>" $f] $prototype]
     }

     #
     # _id_
     #
     proc ::Functions::_id_ {arg} {
         expr $arg
     }
     #
     # min, max
     #
     proc ::Functions::min {arg1 arg2} {
         expr ($arg1)<($arg2)? ($arg1) : ($arg2)
     }
     proc ::Functions::max {arg1 arg2} {
         expr ($arg1)<($arg2)? ($arg1) : ($arg2)
     }
 }

 # HandleCommand --
 #    Identify the type of command and handle accordingly
 #
 # Arguments:
 #    command     Command that must be handled
 # Return value:
 #    {} if the command is a definition or the value of the expression.
 # Side effects:
 #    Definitions are handled directly
 #
 proc ::Calculator::HandleCommand { command } {
     set new_command [string map { " " "" "\t" "" } $command]

     #
     # Definitions take the form "name(x)=some expression"
     #
     if { [regexp {^[A-Za-z_][A-Za-z0-9]*\(.+\)=} $new_command] } {
         HandleDefinition $new_command
         return ""
     } else {
         switch -- $command {
             "?" - "help" {
                 ShowHelp
             }
             "hex" {
                 set ::Calculator::hexmode 1
                 set ::Calculator::prompt  $::Calculator::hexprompt
             }
             "dec" {
                 set ::Calculator::hexmode 0
                 set ::Calculator::prompt  $::Calculator::decprompt
             }
             default {
                 Evaluate $new_command
             }
         }
     }
 }

 # Evaluate --
 #    Evaluate the expression
 #
 # Arguments:
 #    command     Command that must be evaluated
 # Return value:
 #    The value of the expression.
 #
 proc ::Calculator::Evaluate { command } {
     variable hexmode
     if { $hexmode == 0 } {
         regsub -all {([a-zA-Z][a-zA-Z_0-9]*)\(} $command {[\1 } command
         regsub -all {[^ ]\(} $command {[_id_ } command
         set command [string map { ")" "]" } $command]

         namespace eval ::Functions [list expr $command]

     } else {
         # TODO: big-endian/little-endian?
         scan $command %x intv
         binary scan [binary format i $intv] f realv
         return "Integer:\t$intv\nFloat:  \t$realv"
     }
 }

 # HandleDefinition --
 #    Define the macro based on the given command
 #
 # Arguments:
 #    command     Command that represents a definition
 # Return value:
 #    The value of the expression.
 #
 proc ::Calculator::HandleDefinition { command } {

     regexp {(^[A-Za-z_][A-Za-z0-9]*)\(([^)])\)=(.*)} $command \
         matched fname arg body
     puts "$matched"

     regsub -all "\\\m($arg)\\\M" $body "(\$$arg)" body
     proc ::Functions::$fname $arg "expr $body"
     return
 }

 # ShowHelp --
 #    Show basic help information
 #
 # Arguments:
 #    None
 # Return value:
 #    None
 #
 proc ::Calculator::ShowHelp { } {
     puts "
 Calculator commands:
 ?/help     This overview
 hex        Go into hex mode - convert hexadecimal numbers
            into decimal ones
 dec        Go into ordinary mode
 quit       Leave the calculator

 Calculations:
 1.0+3/4.0  gives the answer 1.75
 sin(1)     gives the answer 0.84147098...

 Defining functions:
 f(a)=sin(a)/a
            defines a function that takes one argument,
            so:
 f(1)       gives the answer 0.84147098...
            and:
 f(2.0*3.0) gives the answer -0.0465692...
 5*f(2)     gives the answer 2.27324356...
 "
 }

 # main code --
 #    In a loop, read the expressions and evaluate them
 #
 puts "Calculator:
    Example (define a function):

    >> f(a)=a*a
    >> f(3)
    9
    >>1.0+2.0+3.0
    6.0
    (Use quit to exit the program, ? or help for online help)"

 while { 1 } {
     puts -nonewline $::Calculator::prompt
     flush stdout
     gets stdin line

     if { $line == "quit" } {
         break
     } else {
         if { [ catch {
                    puts [::Calculator::HandleCommand $line]
                } message ] != 0 } {
            puts "Error: [lindex [split $message "\n"] 0]"
         }
     }
 }
======

----
[AM] (2 january 2008) I seem to be re-inventing this wheel every few years, but Tcl 8.5 makes 
it very easy:

======

# calculator.tcl --
#     Basic programmable calculator
#
#     Note:
#     It uses Tcl 8.5 characterstics to do the programmable bits
#
#     Example:
#        (pi is a predefined constant)
#        f(a) = sin(2.0*a)
#     defines a function f that you can use like this:
#        pi+f(2.0)
#     to print the value of 3.1415... + sin(4.0)
#

#
# We need Tcl 8.5, so be explicit about it
#
package require Tcl 8.5

# ReadLoop --
#     Present a prompt and handle the command
#
# Arguments:
#     None
#
# Result:
#     None
#
# Side effects:
#     The command "q" or "quit" stops the program
#
proc ReadLoop {} {

    while {1} {
        puts -nonewline "(? for help) > "
        flush stdout

        set input [gets stdin]

        switch -re -- $input {
            "\\?" {
                PresentHelp
            }
            {^[A-Za-z ][A-Za-z _0-9()]*=[^=]} {
                HandleDefinition $input
            }
            "q" - "quit" {
                exit
            }
            default {
                puts [EvalExpression $input]
            }
        }
    }
}


# PresentHelp --
#     Present help text
#
# Arguments:
#     None
#
# Result:
#     None
#
proc PresentHelp {} {
    puts "
Simple calculator:


>> 1+2

==> 3

>> f(a) = sin(2.0*a)

==> function f defined

>> f(1.0)

0.909297426826

>> pi = 3.14

==>
Type \"q\" or \"quit\"to stop the program"
}


# EvalExpression --
#     Evaluate an expression
#
# Arguments:
#     expression         Expression to be evaluated
#
# Result:
#     Value of the expression
#
proc EvalExpression {expression} {

    #
    # Prefix variable references with a $
    #
    regsub -all {[A-Za-z][A-Za-z_0-9]*[^\(]} "$expression " {$\0} expression
    regsub -all {\$([A-Za-z][A-Za-z_0-9]*\()} "$expression" {\1} expression
    regsub -all {([0-9.])\$[eE]} "$expression" {\1e} expression

    if { [catch {
               set value [uplevel #0 expr [list $expression]]
           } msg] } {
        puts $msg
       #puts $::errorInfo
        return {}
    }
    return $value
}


# HandleDefinition --
#     Define a variable or a function
#
# Arguments:
#     definition         Definition to be handled
#
# Result:
#     None
#
proc HandleDefinition {definition} {

    #
    # Variable definition?
    #
    if { [regexp {\) *=} $definition] == 0 } {
        regexp {([A-Za-z][A-Za-z_0-9]*) *= *(.*)} $definition ==> varname value

        uplevel #0 set $varname [EvalExpression $value]
    } else {
        #
        # Function definition
        #
        regexp {([^=]+) *= *(.*)} $definition ==> function body
        set function [string map {" " "" ( " {" ) "} " , " "} $function]

        regsub -all {[A-Za-z][A-Za-z_0-9]*[^\(]} "$body " {$\0} body
        regsub -all {\$([A-Za-z][A-Za-z_0-9]*\()} "$body" {\1} body
        regsub -all {([0-9.])\$[eE]} "$body" {\1e} body

        uplevel #0 proc tcl::mathfunc::$function [list "expr {$body}"]
    }
}

# main --
#     Get the thing going
#
set pi [expr {4.0*atan(1.0)}]

ReadLoop
======

I added an automatic result variable y, so that the result of any previous calculation can be reused.
Moreover, I moved the help hint to display only upon start of the script.
Little problem in Unix/Linux: cursor up does not return the previous readline content.

[AK]: Have a look at [Pure-tcl readline2] and [linenoise]. The issue is that you are using the stdin in cooked mode. You get the fully-edited line back on the [[gets]], but know nothing about cursor operations which were done. The aforementioned references are an (1) exposed read-loop in Tcl using stdin in raw-mode and handling all editing itself, making it possible to add a history, and (2) a C library with Tcl binding which does the same and exposes the blocks needed for a history. The [Cmdr] package and framework is user of the latter, i.e. [linenoise].

[RJM]: thanks, `using package require tclreadline` I modified the Readloop below and that works well:

Further, I added a regsub in EvalExpression that interprets ^ as the pow() operator
    # replace ^ by pow(...) constructs - at the cost of the xor operator
    regsub -all {(\(.+\)|([\w.]+))\^(\(.+\)|([\w.]+))} "$expression" {pow(\2,\3)} expression

======
proc ReadLoop {} {

    while {1} {
        set input [tclreadline::readline read "> "]

        switch -re -- $input {
            "\\?" {
                PresentHelp
            }
            {^[A-Za-z ][A-Za-z _0-9()]*=[^=]} {
                HandleDefinition $input
            }
            "q" - "quit" {
                exit
            }
            default {
                set ::y [EvalExpression $input] 
                puts $::y
            }
        }
    }
}
puts "(? for help)" 

======

No need for complicated manipulations of the expressions and commands you type
to get a user-defined function to work properly. Just make sure it is in the
tcl::mathfunc namespace (relative to the current!) and [[expr]] takes care
of the rest.

<<categories>> Mathematics | Application