>> 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)}]
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.