mirror of
https://codeberg.org/scip/rpnc.git
synced 2025-12-17 04:21:01 +01:00
deprecate perl version, make go version the new one (2.0.0)
This commit is contained in:
264
archived/README.md
Normal file
264
archived/README.md
Normal file
@@ -0,0 +1,264 @@
|
||||
## Reverse Polish Notation Calculator for the commandline
|
||||
|
||||
This is a small commandline calculator which takes its input in
|
||||
[reverse polish notation](https://en.wikipedia.org/wiki/Reverse_Polish_notation)
|
||||
form.
|
||||
|
||||
It has an unlimited stack, supports various stack manipulation
|
||||
commands, can be used interactively or via a pipe and has a collector
|
||||
mode. It doesn't have any other dependencies than Perl.
|
||||
|
||||
## Usage
|
||||
|
||||
Calculate the summary resistance of parallel resistors with 220, 330
|
||||
and 440 Ohm using the following formula:
|
||||
|
||||
1 / (1/R1 + 1/R2 + 1/R3)
|
||||
|
||||
Here's the sample session:
|
||||
|
||||
0 % 1
|
||||
stack 1: 1
|
||||
|
||||
1 % 1
|
||||
stack 2: 1
|
||||
stack 1: 1
|
||||
|
||||
2 % 220
|
||||
stack 3: 1
|
||||
stack 2: 1
|
||||
stack 1: 220
|
||||
|
||||
3 % /
|
||||
stack 2: 1
|
||||
stack 1: 0.00454545454545455
|
||||
|
||||
=> 0.00454545454545455
|
||||
|
||||
2 % 1
|
||||
stack 3: 1
|
||||
stack 2: 0.00454545454545455
|
||||
stack 1: 1
|
||||
|
||||
3 % 330
|
||||
stack 4: 1
|
||||
stack 3: 0.00454545454545455
|
||||
stack 2: 1
|
||||
stack 1: 330
|
||||
|
||||
4 % /
|
||||
stack 3: 1
|
||||
stack 2: 0.00454545454545455
|
||||
stack 1: 0.00303030303030303
|
||||
|
||||
=> 0.00303030303030303
|
||||
|
||||
3 % 1
|
||||
stack 4: 1
|
||||
stack 3: 0.00454545454545455
|
||||
stack 2: 0.00303030303030303
|
||||
stack 1: 1
|
||||
|
||||
4 % 440
|
||||
stack 5: 1
|
||||
stack 4: 0.00454545454545455
|
||||
stack 3: 0.00303030303030303
|
||||
stack 2: 1
|
||||
stack 1: 440
|
||||
|
||||
5 % /
|
||||
stack 4: 1
|
||||
stack 3: 0.00454545454545455
|
||||
stack 2: 0.00303030303030303
|
||||
stack 1: 0.00227272727272727
|
||||
|
||||
=> 0.00227272727272727
|
||||
|
||||
4 % +
|
||||
stack 3: 1
|
||||
stack 2: 0.00454545454545455
|
||||
stack 1: 0.0053030303030303
|
||||
|
||||
=> 0.0053030303030303
|
||||
|
||||
3 % +
|
||||
stack 2: 1
|
||||
stack 1: 0.00984848484848485
|
||||
|
||||
=> 0.00984848484848485
|
||||
|
||||
2 % /
|
||||
stack 1: 101.538461538462
|
||||
|
||||
=> 101.538461538462
|
||||
|
||||
The *%* character denotes the interactive prompt. What we basically entered was:
|
||||
|
||||
1 1 220 / 1 330 / 1 440 / + + /
|
||||
|
||||
Which translates to:
|
||||
|
||||
1 ((1 / 220) + (1 / 330) + (1 / 440))
|
||||
|
||||
So, you're entering the numbers and operators as you would do on
|
||||
paper. To learn more, refer to the Wikipedia page linked above.
|
||||
|
||||
## Collector mode
|
||||
|
||||
Beside traditional RPN you can also enter a special mode, called
|
||||
*collector mode* by entering the <kbd>(</kbd> command. The collector
|
||||
mode has its own stack (a sub stack) which is independed of the
|
||||
primary stack. Inside this mode you can use all operators, however
|
||||
they work on *ALL* items on the sub stack.
|
||||
|
||||
So, let's compare. If you had in normal RPN mode the following stack:
|
||||
|
||||
3
|
||||
5
|
||||
6
|
||||
|
||||
and then entering the <kbd>+</kbd> operator, the calculator would pop
|
||||
5 and 6 from the stack, add them and push the result 11 back to the
|
||||
stack.
|
||||
|
||||
However, if you are in collector mode with this stack, then all the
|
||||
items would be added, the sub stack would be cleared and the result 14
|
||||
would be added to the primary stack.
|
||||
|
||||
You will leave the collector mode after an operator has been
|
||||
executed. But you can also just leave the collector mode with the
|
||||
command <kbd>)</kbd> leaving the sub stack intact. That is, upon
|
||||
re-entering collector mode at a later time, you'll find the unaltered
|
||||
sub stack of before.
|
||||
|
||||
## Undo
|
||||
|
||||
Every operation which modifies the stack can be reversed by entering
|
||||
the <kbd>u</kbd> command. There's only one level of undo and no redo.
|
||||
|
||||
## Functions
|
||||
|
||||
You can define functions anytime directly on the cli or in a file called
|
||||
`~/.rpnc`. A function has a name (which must not collide with existing
|
||||
functions and commands) and a body of commands.
|
||||
|
||||
Example:
|
||||
|
||||
f res2vcc 1.22 R1 R2 + R2 / 1 + *
|
||||
|
||||
Which calculates:
|
||||
|
||||
(((R1 + R2) / R2) + 1) * 1.22 = ??
|
||||
|
||||
To use it later, just enter the variables into the stack followed by the
|
||||
function name:
|
||||
|
||||
470
|
||||
220
|
||||
res2vcc
|
||||
=> 2.79
|
||||
|
||||
You can also put the function definition in the config file
|
||||
`~/.rpnc`. Empty lines and lines beginning with `#` will be ignored.
|
||||
|
||||
Another way to define a function is to use perl code directly. The
|
||||
perl code must be a closure string and surrounded by braces. You can
|
||||
access the stack via `@_`. Here's an example:
|
||||
|
||||
f pr { return "1.0 / (" . join(' + ', map { "1.0 / $_"} @_) . ")" }
|
||||
|
||||
This function calculates the parallel resistance of a number of
|
||||
resistors. It adds up all values from the stack. Usage:
|
||||
|
||||
22
|
||||
47
|
||||
330
|
||||
pr
|
||||
=> 41.14
|
||||
|
||||
|
||||
## Using STDIN via a PIPE
|
||||
|
||||
If the commandline includes any operator, commands will be read from
|
||||
STDIN, the result will be printed to STDOUT wihout any decoration and
|
||||
the program will exit. Commands can be separated by whitespace or
|
||||
newline.
|
||||
|
||||
Examples:
|
||||
|
||||
echo "2 2" | rpnc +
|
||||
(echo 2; echo 2) | rpnc +
|
||||
|
||||
Both commands will print 4 to STDOUT.
|
||||
|
||||
|
||||
## Complete list of all supported commands:
|
||||
|
||||
### Stack Management
|
||||
|
||||
* <kbd>s</kbd> show the stack
|
||||
* <kbd>ss</kbd> show the whole stack
|
||||
* <kbd>sc</kbd> clear stack
|
||||
* <kbd>scx</kbd> clear last stack element
|
||||
* <kbd>sr</kbd> reverse the stack
|
||||
* <kbd>srt</kbd> rotate the stack
|
||||
|
||||
## Configuration
|
||||
|
||||
* <kbd>td</kbd> toggle debugging (-d)
|
||||
* <kbd>ts</kbd> toggle display of the stack (-n)
|
||||
|
||||
## Supported mathematical operators:
|
||||
|
||||
* <kbd>+</kbd> add
|
||||
* <kbd>-</kbd> substract
|
||||
* <kbd>/</kbd> divide
|
||||
* <kbd>*</kbd> multiply
|
||||
* <kbd>^</kbd> expotentiate
|
||||
* <kbd>%</kbd> percent
|
||||
* <kbd>%+</kbd> add percent
|
||||
* <kbd>%-</kbd> substract percent
|
||||
* <kbd>%d</kbd> percentual difference
|
||||
* <kbd>&</kbd> bitwise AND
|
||||
* <kbd>|</kbd> bitwise OR
|
||||
* <kbd>x</kbd> bitwise XOR
|
||||
* <kbd>m</kbd> median
|
||||
* <kbd>a</kbd> average
|
||||
* <kbd>v</kbd> pull root (2nd if stack==1)
|
||||
* <kbd>(</kbd> enter collect mode
|
||||
* <kbd>)</kbd> leave collect mode
|
||||
|
||||
## Register Commands
|
||||
|
||||
* <kbd>r</kbd> put element into register
|
||||
* <kbd>rc</kbd> clear register
|
||||
* <kbd>rcx</kbd> clear last register element
|
||||
|
||||
## Various Commands
|
||||
|
||||
* <kbd>u</kbd> undo last operation
|
||||
* <kbd>q</kbd> finish (<kbd>C-d</kbd> works as well)
|
||||
* <kbd>h</kbd> show history of past operations
|
||||
* <kbd>?</kbd> print help
|
||||
|
||||
## Converters
|
||||
|
||||
* <kbd>tl</kbd> gallons to liters
|
||||
* <kbd>tk</kbd> miles to kilometers
|
||||
* <kbd>tm</kbd> yards to meters
|
||||
* <kbd>tc</kbd> inches to centimeters
|
||||
* <kbd>tkb</kbd> bytes to kilobytes
|
||||
* <kbd>tmb</kbd> bytes to megabytes
|
||||
* <kbd>tgb</kbd> bytes to gigabytes
|
||||
* <kbd>ttb</kbd> bytes to terabytes
|
||||
|
||||
## Function Comands
|
||||
|
||||
* <kbd>f NAME CODE</kbd> define a functions (see ab above)
|
||||
* <kbd>fs</kbd> show list of defined functions
|
||||
|
||||
|
||||
## Copyleft
|
||||
|
||||
Copyleft (L) 2019 - Thomas von Dein.
|
||||
Licensed under the terms of the GPL 3.0.
|
||||
679
archived/rpnc
Executable file
679
archived/rpnc
Executable file
@@ -0,0 +1,679 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
use Term::ReadLine;
|
||||
use Data::Dumper;
|
||||
use Getopt::Long;
|
||||
use Data::Dumper;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
my (@stack, @substack, @backup, @subbackup, @hist, @register);
|
||||
my $term = Term::ReadLine->new('rpn calc');
|
||||
my $debug = 0;
|
||||
my $showstack = 1;
|
||||
my $mgt = 0;
|
||||
my $tty = 1;
|
||||
my $VERSION = '1.10';
|
||||
my $sub = 0;
|
||||
my $maxstack = 10;
|
||||
my $maxreg = 5;
|
||||
my $silent = 1;
|
||||
my $op;
|
||||
|
||||
# management commands, always lower case letters or words
|
||||
my %commands = (
|
||||
# stack commands
|
||||
s => sub { $mgt = 1; dumpstack(); $mgt = 0; },
|
||||
sa => sub { $mgt = 1; dumpstack(1); $mgt = 0;},
|
||||
sc => sub { clearstack(); },
|
||||
scx => sub { clearstack(1); dumpstack(); },
|
||||
sr => sub { reversestack(); },
|
||||
srt => sub { rotatestack(); },
|
||||
# collector
|
||||
'(' => sub { $sub = 1 },
|
||||
')' => sub { stack2sub(); },
|
||||
# register stuff
|
||||
r => sub { last_to_reg(); dumpstack(); },
|
||||
rcx => sub { clearreg(1); dumpstack(); },
|
||||
rc => sub { clearreg(); },
|
||||
# main
|
||||
'?' => sub { help(); },
|
||||
u => sub { undo(); dumpstack(); },
|
||||
h => sub { showhist(); },
|
||||
q => sub { exit; },
|
||||
# toggles
|
||||
td => sub { $debug ^= 1; },
|
||||
ts => sub { $showstack ^= 1; },
|
||||
# functions
|
||||
fs => sub { showfuncs(); },
|
||||
);
|
||||
|
||||
# executed 1:1, or aliased
|
||||
my %alias = qw(^ ** x ^ < << > >> + + - - / / * * & & | |);
|
||||
|
||||
# holds user functions
|
||||
my %custom;
|
||||
|
||||
# hand coded functions
|
||||
my %func = (
|
||||
'%' => sub {
|
||||
# X % of Y
|
||||
my ($a, $b) = getlast(2);
|
||||
if (defined $b) {
|
||||
return "($a / 100) * $b";
|
||||
}
|
||||
},
|
||||
|
||||
'%d' => sub {
|
||||
# percentual difference
|
||||
my ($a, $b) = getlast(2);
|
||||
if (defined $b) {
|
||||
return "(($a - $b) / $b) * 100"
|
||||
}
|
||||
},
|
||||
|
||||
'%+' => sub {
|
||||
# Y + (X $ of Y)
|
||||
my ($a, $b) = getlast(2);
|
||||
if (defined $b) {
|
||||
return "$a + (($a / 100) * $b)";
|
||||
}
|
||||
},
|
||||
|
||||
'%-' => sub {
|
||||
# Y - (X $ of Y)
|
||||
my ($a, $b) = getlast(2);
|
||||
if (defined $b) {
|
||||
return "$a - (($a / 100) * $b)";
|
||||
}
|
||||
},
|
||||
|
||||
'v' => sub {
|
||||
# square root
|
||||
my ($a) = getlast(1);
|
||||
if (defined $a) {
|
||||
return "$a ** (1 / 2)";
|
||||
}
|
||||
},
|
||||
|
||||
'm' => sub {
|
||||
# median
|
||||
my @values = getlast(2); # we need 2 or all in sub mode
|
||||
if (scalar @values >= 2) {
|
||||
my $c = $#values;
|
||||
if (scalar @values % 2 == 0) {
|
||||
# even
|
||||
return "((sort qw(@values))[$c / 2] + (sort qw(@values))[($c / 2) + 1]) / 2";
|
||||
}
|
||||
else {
|
||||
# uneven
|
||||
return "(sort qw(@values))[$c / 2]";
|
||||
}
|
||||
}
|
||||
else {
|
||||
print "median only possible with 2 or more values\n";
|
||||
undo();
|
||||
return 0;
|
||||
}
|
||||
},
|
||||
|
||||
'a' => sub {
|
||||
# average
|
||||
my @values = getlast(2); # we need 2 or all in sub mode
|
||||
if (scalar @values > 1) {
|
||||
return "(" . join(' + ', @values) . ") / " . scalar @values;
|
||||
}
|
||||
else {
|
||||
print "average only possible with 2 or more values\n";
|
||||
undo();
|
||||
return 0;
|
||||
}
|
||||
},
|
||||
|
||||
# converters:
|
||||
# gallons to liters
|
||||
'tl' => sub { return convert("* 3.785") },
|
||||
# yards to meters
|
||||
'tm' => sub { return convert("* 91.44") },
|
||||
# miles to kilometers
|
||||
'tk' => sub { return convert("* 1.609") },
|
||||
# inches to cm
|
||||
'tc' => sub { return convert("* 2.54") },
|
||||
# to 'bytes
|
||||
'tkb' => sub { return convert("/ 1000") },
|
||||
'tmb' => sub { return convert("/ 1000 / 1000") },
|
||||
'tgb' => sub { return convert("/ 1000 / 1000 / 1000") },
|
||||
'ttb' => sub { return convert("/ 1000 / 1000 / 1000 / 1000") },
|
||||
);
|
||||
|
||||
# math constants, always upper case letters, usable via eval{}
|
||||
use constant PI => 3.141592653589793;
|
||||
use constant V2 => 1.414213562373095;
|
||||
use constant V3 => 1.732050807568877;
|
||||
|
||||
# handle command line
|
||||
my ($o_h, $o_v, $o_s);
|
||||
Getopt::Long::Configure( qw(no_ignore_case));
|
||||
if (! GetOptions (
|
||||
"version|v" => \$o_v,
|
||||
"help|h" => \$o_h,
|
||||
"debug|d" => \$debug,
|
||||
"nostack|n" => \$o_s
|
||||
) ) {
|
||||
help();
|
||||
exit;
|
||||
}
|
||||
|
||||
if ($o_v) {
|
||||
print "$0 version $VERSION\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
if ($o_h) {
|
||||
help();
|
||||
exit;
|
||||
}
|
||||
|
||||
if ($o_s) {
|
||||
$showstack = 0;
|
||||
}
|
||||
|
||||
# load config, if any
|
||||
if (-s "$ENV{HOME}/.rpnc") {
|
||||
if (open RC, "< $ENV{HOME}/.rpnc") {
|
||||
while (<RC>) {
|
||||
chomp();
|
||||
next if (/^\s*#/ || /^\s*$/);
|
||||
looptokenize($_);
|
||||
}
|
||||
close RC;
|
||||
$silent = 0;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# run in commandline mode?
|
||||
$op = shift;
|
||||
if ($op) {
|
||||
$tty = 0;
|
||||
while (<STDIN>) {
|
||||
chomp;
|
||||
push @stack, split /\s\s*/;
|
||||
}
|
||||
print calc($op);
|
||||
exit;
|
||||
}
|
||||
|
||||
# else: run interactively
|
||||
# main
|
||||
my $OUT = $term->OUT || \*STDOUT;
|
||||
while ( defined ($_ = $term->readline(prompt())) ) {
|
||||
looptokenize($_);
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
|
||||
# converter helper
|
||||
sub convert {
|
||||
my $code = shift;
|
||||
my ($a) = getlast(1);
|
||||
if (defined $a) {
|
||||
return "$a $code";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub looptokenize {
|
||||
# disassemble user input into tokens
|
||||
my $tokens = shift;
|
||||
|
||||
if ($tokens =~ /^f\s/) {
|
||||
# function definition
|
||||
defun($tokens);
|
||||
}
|
||||
else {
|
||||
foreach my $tok (split /\s+/, $tokens) {
|
||||
if ($tok =~ /^-?[A-Z\.\d]+?$/) {
|
||||
# number or register fetch
|
||||
if ($tok =~ /^R(\d+?)/) {
|
||||
# fetch number from register $1 and put it to stack
|
||||
my $r = getreg($1);
|
||||
if ($r) {
|
||||
pushstack($r);
|
||||
}
|
||||
else {
|
||||
print "invalid register index!\n";
|
||||
next;
|
||||
}
|
||||
}
|
||||
else {
|
||||
# put number to stsack
|
||||
pushstack($tok);
|
||||
}
|
||||
dumpstack();
|
||||
}
|
||||
else {
|
||||
# operator or command, execute
|
||||
if (exists $commands{$tok}) {
|
||||
cmd($tok);
|
||||
}
|
||||
else {
|
||||
print calc($tok);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub cmd {
|
||||
my $c = shift;
|
||||
|
||||
if (exists $commands{$c}) {
|
||||
my $sub = $commands{$c};
|
||||
&$sub;
|
||||
}
|
||||
else {
|
||||
print "unknown command '$c'!\n";
|
||||
}
|
||||
}
|
||||
|
||||
sub showhist {
|
||||
foreach my $entry (@hist) {
|
||||
printf "History: %10s = %s\n", $entry->[0], $entry->[1];
|
||||
}
|
||||
}
|
||||
|
||||
sub clearstack {
|
||||
my $one = shift;
|
||||
|
||||
backup();
|
||||
|
||||
if ($sub) {
|
||||
if ($one) {
|
||||
pop @substack;
|
||||
}
|
||||
else {
|
||||
@substack = ();
|
||||
}
|
||||
}
|
||||
else {
|
||||
if ($one) {
|
||||
pop @stack;
|
||||
}
|
||||
else {
|
||||
@stack = ();
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub reversestack {
|
||||
backup();
|
||||
if ($sub) {
|
||||
@substack = reverse @substack;
|
||||
}
|
||||
else {
|
||||
@stack = reverse @stack;
|
||||
}
|
||||
dumpstack();
|
||||
}
|
||||
|
||||
sub rotatestack {
|
||||
backup();
|
||||
if ($sub) {
|
||||
my $f = shift @substack;
|
||||
@substack = (@substack, $f);
|
||||
}
|
||||
else {
|
||||
my $f = shift @stack;
|
||||
@stack = (@stack, $f);
|
||||
}
|
||||
dumpstack();
|
||||
}
|
||||
|
||||
sub pushstack {
|
||||
my $num = shift;
|
||||
if ($num) {
|
||||
if ($num =~ /^\./) {
|
||||
$num = '0' . $num;
|
||||
}
|
||||
if ($sub) {
|
||||
push @substack, $num;
|
||||
}
|
||||
else {
|
||||
push @stack, $num;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub dumpstack {
|
||||
if (! $showstack && !$mgt) {
|
||||
return;
|
||||
}
|
||||
|
||||
my $max = shift;
|
||||
my $x = ' ';
|
||||
my $prefix = 'stack';
|
||||
my @all;
|
||||
|
||||
if ($sub) {
|
||||
@all = @substack;
|
||||
$prefix = 'collectorstack';
|
||||
}
|
||||
else {
|
||||
@all = @stack;
|
||||
}
|
||||
|
||||
my $abs = scalar @all;
|
||||
if (! $max && $abs > $maxstack) {
|
||||
my $min = $max - ($max * 2);
|
||||
@all = @all[$min .. -1];
|
||||
printf "%s [..]\n", $prefix;
|
||||
}
|
||||
|
||||
if (@register) {
|
||||
my $p = 1;
|
||||
foreach my $n (@register) {
|
||||
printf "register R%d: %s\n", $p++, $n;
|
||||
}
|
||||
}
|
||||
print "\n";
|
||||
|
||||
my $p = scalar @all;
|
||||
foreach my $n (@all) {
|
||||
$x = 'X' if($p == 1);
|
||||
printf "%s %s %4d: %s\n", $prefix, $x, $p--, $n;
|
||||
}
|
||||
print "\n";
|
||||
}
|
||||
|
||||
sub undo {
|
||||
if ($sub) {
|
||||
@substack = @subbackup;
|
||||
}
|
||||
else {
|
||||
@stack = @backup;
|
||||
}
|
||||
}
|
||||
|
||||
sub backup {
|
||||
if ($sub) {
|
||||
@subbackup = @substack;
|
||||
}
|
||||
else {
|
||||
@backup = @stack;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub getlast {
|
||||
# return and remove last 1, 2 or all elements of current stack
|
||||
my $request = shift;
|
||||
|
||||
my @all = ();
|
||||
|
||||
backup();
|
||||
|
||||
if ($sub) {
|
||||
# ignore request count
|
||||
@all = @substack;
|
||||
@substack = ();
|
||||
}
|
||||
else {
|
||||
if (@stack) {
|
||||
if (scalar @stack == 1) {
|
||||
if ($request > 1) {
|
||||
print "At least $request variables must be on the stack!\n";
|
||||
}
|
||||
else {
|
||||
@all = pop @stack;
|
||||
}
|
||||
}
|
||||
elsif (scalar @stack >= 2) {
|
||||
@all = splice(@stack, -1 * $request, $request);
|
||||
}
|
||||
}
|
||||
else {
|
||||
print "Please enter one or more numbers to operate on!\n";
|
||||
}
|
||||
}
|
||||
|
||||
return @all;
|
||||
}
|
||||
|
||||
sub getreg {
|
||||
# fetch $n'th element from register
|
||||
my $n = shift;
|
||||
if ($n <= scalar @register) {
|
||||
return $register[$n-1];
|
||||
}
|
||||
else {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
sub last_to_reg {
|
||||
# put last stack element to register
|
||||
my $n;
|
||||
if ($sub) {
|
||||
if (@substack) {
|
||||
$n = $substack[-1];
|
||||
}
|
||||
}
|
||||
else {
|
||||
if (@stack) {
|
||||
$n = $stack[-1];
|
||||
}
|
||||
}
|
||||
|
||||
if ($n) {
|
||||
if (scalar @register == $maxreg) {
|
||||
shift @register;
|
||||
}
|
||||
push @register, $n;
|
||||
}
|
||||
}
|
||||
|
||||
sub clearreg {
|
||||
my $one = shift;
|
||||
|
||||
if ($one) {
|
||||
pop @register;
|
||||
}
|
||||
else {
|
||||
@register = ();
|
||||
}
|
||||
}
|
||||
|
||||
sub stack2sub {
|
||||
if (! $sub && scalar @substack == 0 && scalar @stack > 1) {
|
||||
# not in collector mode, empty substack, move stack to substack, enter collect
|
||||
backup();
|
||||
@substack = @stack;
|
||||
@stack = ();
|
||||
$sub = 1;
|
||||
}
|
||||
else {
|
||||
# leave collector mode
|
||||
$sub = 0;
|
||||
}
|
||||
}
|
||||
|
||||
sub prompt {
|
||||
my $count;
|
||||
my $prompt;
|
||||
|
||||
if ($sub) {
|
||||
$count = scalar @substack;
|
||||
$prompt = '%--(';
|
||||
}
|
||||
else {
|
||||
$count = scalar @stack;
|
||||
$prompt = '%';
|
||||
}
|
||||
|
||||
return sprintf "%3d %s ", $count, $prompt;
|
||||
}
|
||||
|
||||
sub calc {
|
||||
my $op = shift;
|
||||
my $res;
|
||||
my $code;
|
||||
|
||||
if (exists $alias{$op}) {
|
||||
my @last = getlast(2);
|
||||
$op = $alias{$op};
|
||||
$code = join(" $op ", @last);
|
||||
}
|
||||
elsif (exists $func{$op}) {
|
||||
my $sub = $func{$op};
|
||||
$code = &$sub();
|
||||
return unless $code;
|
||||
}
|
||||
else {
|
||||
print "syntax error or unknown command ($op)!\n";
|
||||
undo();
|
||||
return;
|
||||
}
|
||||
|
||||
# execute
|
||||
eval "\$res = $code";
|
||||
|
||||
if ($@) {
|
||||
# error, reset stack
|
||||
print "Syntax error: $@, resetting stack\n";
|
||||
undo();
|
||||
}
|
||||
else {
|
||||
push @stack, $res;
|
||||
$sub = 0;
|
||||
|
||||
if ($debug) {
|
||||
print "DEBUG: $code = $res\n";
|
||||
}
|
||||
|
||||
if ($tty) {
|
||||
dumpstack();
|
||||
push @hist, [$res, $code];
|
||||
return "=> $res\n\n";
|
||||
}
|
||||
else {
|
||||
return "$res\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub defun {
|
||||
# define a function, use N1 .. NN as function arguments
|
||||
my $code = shift;
|
||||
my ($op, $name, @tokens) = split /\s\s*/, $code;
|
||||
|
||||
if ($name !~ /^[a-zA-Z0-9_]+$/) {
|
||||
print "invalid function name (a-z0-9_)!\n";
|
||||
return;
|
||||
}
|
||||
|
||||
if (! exists $custom{$name}) {
|
||||
# no need to check twice and overwriting of custom function must be legal
|
||||
if (grep {$name eq $_} keys %commands) {
|
||||
print "reserved function name (command)!\n";
|
||||
return;
|
||||
}
|
||||
|
||||
if (grep {$name eq $_} keys %func) {
|
||||
print "reserved function name (function)!\n";
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
$custom{$name} = "@tokens";
|
||||
|
||||
if ($custom{$name} =~ /^\{.*\}$/) {
|
||||
# perl code
|
||||
$func{$name} = sub { return eval "@tokens" };
|
||||
}
|
||||
else {
|
||||
# rpnc code
|
||||
$func{$name} = sub {
|
||||
my $max = scalar @_;
|
||||
my @args = reverse(@_);
|
||||
|
||||
# replace N1..NN with actual stack items
|
||||
my @body;
|
||||
foreach my $item (@tokens) {
|
||||
if ($item =~ /^([A-Z])(\d+)$/) {
|
||||
my $letter = $1;
|
||||
my $i = $2;
|
||||
if ($i <= $max) {
|
||||
push @body, $args[$i-1];
|
||||
}
|
||||
else {
|
||||
print "undefined variable ${letter}${i}!\n";
|
||||
push @body, 0;
|
||||
}
|
||||
}
|
||||
else {
|
||||
push @body, $item;
|
||||
}
|
||||
}
|
||||
|
||||
# execute @body
|
||||
looptokenize("@body");
|
||||
};
|
||||
}
|
||||
|
||||
print "function $name() defined.\n" unless $silent;
|
||||
}
|
||||
|
||||
sub showfuncs {
|
||||
foreach my $f (sort keys %custom) {
|
||||
print "Function $f():\n $custom{$f}\n\n";
|
||||
}
|
||||
}
|
||||
|
||||
sub help {
|
||||
print qq~
|
||||
Reverse Polish Notation Calculator, version $VERSION.
|
||||
Copyleft (L) 2019-2020 - Thomas von Dein.
|
||||
Licensed under the terms of the GPL 3.0.
|
||||
|
||||
Commandline: rpn [-d] [<operator>]
|
||||
|
||||
If <operator> is provided, read numbers from STDIN,
|
||||
otherwise runs interactively.
|
||||
|
||||
Configure: Available math operators:
|
||||
td toggle debugging (-d) ( enter collect mode
|
||||
ts toggle display of stack (-n) ) leave collect || stack => collect
|
||||
+ add
|
||||
Stack Management: - substract
|
||||
s show the stack / divide
|
||||
sa show the whole stack * multiply
|
||||
scx clear X (last stack element) ^ expotentiate
|
||||
sc clear stack % percent (%+ add %- substract)
|
||||
sr reverse the stack %d percentual difference
|
||||
srt rotate the stack & bitwise AND
|
||||
| bitwise OR
|
||||
Register Management: x bitwise XOR
|
||||
r put X to register < > bitwise shift left or right
|
||||
R1-9 push value of register to stack v square root
|
||||
rcx clear X (last register element) m median
|
||||
rc clear register a average
|
||||
|
||||
Converters:
|
||||
tl gallons => liters tkb bytes => kb
|
||||
tk miles => kilometers tmb bytes => mb
|
||||
tm yards => meters tgb bytes => gb
|
||||
tc inches => centimeters ttb bytes => tb
|
||||
|
||||
Various Commands: Functions:
|
||||
u undo last operation f <name> op op... (use N1..NN for stack)
|
||||
h show history of past operations fs show list of defined functions
|
||||
q finish (C-d works as well) Using register: enter R + index, e.g. R1
|
||||
? print help Constants: PI V2 V3
|
||||
|
||||
~;
|
||||
}
|
||||
Reference in New Issue
Block a user