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 ([email protected]) # # 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)}]
ReadLoopI 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)} expressionproc ReadLoop {} {
while {1} {
puts -nonewline "> "
flush stdout
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.