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