mirror of
https://codeberg.org/scip/rpnc.git
synced 2025-12-17 04:21:01 +01:00
realease 1.00
- renamed commandline tool to rpnc - added better README - added collector mode - added V command - added R command
This commit is contained in:
30
README
30
README
@@ -1,30 +0,0 @@
|
|||||||
|
|
||||||
Reverse Polish Notation Calculator, version 1.00.
|
|
||||||
Copyleft (L) 2019 - 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.
|
|
||||||
|
|
||||||
Available commands:
|
|
||||||
c clear stack
|
|
||||||
s show the stack
|
|
||||||
d toggle debugging (current setting: 0)
|
|
||||||
r reverse the stack (w/ reg if stack==1)
|
|
||||||
u undo last operation
|
|
||||||
q finish
|
|
||||||
? print help
|
|
||||||
|
|
||||||
Available operators:
|
|
||||||
+ add
|
|
||||||
- substract
|
|
||||||
/ divide
|
|
||||||
* multiply
|
|
||||||
^ expotentiate
|
|
||||||
% percent
|
|
||||||
& bitwise AND
|
|
||||||
| bitwise OR
|
|
||||||
x bitwise XOR
|
|
||||||
|
|
||||||
182
README.md
Normal file
182
README.md
Normal file
@@ -0,0 +1,182 @@
|
|||||||
|
## Reverse Polish Notation Calculator for the commandline
|
||||||
|
|
||||||
|
This is a small commandline calculator which takes its input in
|
||||||
|
[https://en.wikipedia.org/wiki/Reverse_Polish_notation](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.
|
||||||
|
|
||||||
|
## 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:
|
||||||
|
|
||||||
|
* <kbd>c</kbd> clear stack
|
||||||
|
* <kbd>s</kbd> show the stack
|
||||||
|
* <kbd>d</kbd> toggle debugging (current setting: 0)
|
||||||
|
* <kbd>r</kbd> reverse the stack
|
||||||
|
* <kbd>R</kbd> rotate the stack
|
||||||
|
* <kbd>(</kbd> enter collect mode
|
||||||
|
* <kbd>)</kbd> leave collect mode
|
||||||
|
* <kbd>u</kbd> undo last operation
|
||||||
|
* <kbd>q</kbd> finish (<kbd>C-d</kbd> works as well)
|
||||||
|
* <kbd>?</kbd> print help
|
||||||
|
|
||||||
|
## Supported mathematical operators:
|
||||||
|
|
||||||
|
* <kbd>+</kbd> add
|
||||||
|
* <kbd>-</kbd> substract
|
||||||
|
* <kbd>/</kbd> divide
|
||||||
|
* <kbd>*</kbd> multiply
|
||||||
|
* <kbd>^</kbd> expotentiate
|
||||||
|
* <kbd>%</kbd> percent
|
||||||
|
* <kbd>&</kbd> bitwise AND
|
||||||
|
* <kbd>|</kbd> bitwise OR
|
||||||
|
* <kbd>x</kbd> bitwise XOR
|
||||||
|
* <kbd>V</kbd> pull root (2nd if stack==1)
|
||||||
|
|
||||||
|
## Copyleft
|
||||||
|
|
||||||
|
Copyleft (L) 2019 - Thomas von Dein.
|
||||||
|
Licensed under the terms of the GPL 3.0.
|
||||||
252
rpn
252
rpn
@@ -1,252 +0,0 @@
|
|||||||
#!/usr/bin/perl
|
|
||||||
|
|
||||||
use Term::ReadLine;
|
|
||||||
use Data::Dumper;
|
|
||||||
|
|
||||||
use strict;
|
|
||||||
use warnings;
|
|
||||||
|
|
||||||
my (@stack, @register, @rbackup, @sbackup);
|
|
||||||
my $prompt = "% ";
|
|
||||||
my $term = Term::ReadLine->new('rpn calc');
|
|
||||||
my $debug = 0;
|
|
||||||
my $tty = 1;
|
|
||||||
my $VERSION = '1.00';
|
|
||||||
my $op;
|
|
||||||
|
|
||||||
my ($arg1, $arg2) = @ARGV;
|
|
||||||
if ($arg1 eq '-d') {
|
|
||||||
$debug = 1;
|
|
||||||
$op = $arg2;
|
|
||||||
}
|
|
||||||
elsif ($arg1 eq '-h') {
|
|
||||||
help();
|
|
||||||
exit;
|
|
||||||
}
|
|
||||||
elsif ($arg1) {
|
|
||||||
$op = $arg1;
|
|
||||||
}
|
|
||||||
|
|
||||||
if ($op) {
|
|
||||||
$tty = 0;
|
|
||||||
while (<STDIN>) {
|
|
||||||
chomp;
|
|
||||||
push @stack, split /\s\s*/;
|
|
||||||
}
|
|
||||||
print calc($op);
|
|
||||||
exit;
|
|
||||||
}
|
|
||||||
|
|
||||||
my %commands = (
|
|
||||||
q => sub { exit; },
|
|
||||||
'?' => sub { help(); },
|
|
||||||
s => sub { dumpstack(); },
|
|
||||||
c => sub { @stack = @register = (); },
|
|
||||||
d => sub {
|
|
||||||
if ($debug) {
|
|
||||||
$debug = 0;
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
$debug = 1;
|
|
||||||
}
|
|
||||||
},
|
|
||||||
u => sub { undo(); dumpstack(); },
|
|
||||||
r => sub {
|
|
||||||
backup();
|
|
||||||
if (scalar @stack == 1 && @register) {
|
|
||||||
@register = @stack;
|
|
||||||
@stack = @rbackup; # == @register
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
@stack = reverse(@stack);
|
|
||||||
}
|
|
||||||
dumpstack();
|
|
||||||
}
|
|
||||||
);
|
|
||||||
|
|
||||||
my $OUT = $term->OUT || \*STDOUT;
|
|
||||||
while ( defined ($_ = $term->readline($prompt)) ) {
|
|
||||||
if (/^-?[\.\d]+?$/) {
|
|
||||||
# number
|
|
||||||
pushstack($_);
|
|
||||||
dumpstack();
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
if (/^[a-z\?]+?$/) {
|
|
||||||
cmd($_);
|
|
||||||
}
|
|
||||||
elsif (/^[<>x\%\|\&\^+\-\*\/]$/) {
|
|
||||||
# calc
|
|
||||||
print calc($_);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
sub cmd {
|
|
||||||
my $c = shift;
|
|
||||||
|
|
||||||
if (exists $commands{$_}) {
|
|
||||||
my $sub = $commands{$_};
|
|
||||||
&$sub;
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
print "unknown command!\n";
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
sub pushstack {
|
|
||||||
my $num = shift;
|
|
||||||
if ($num) {
|
|
||||||
if ($num =~ /^\./) {
|
|
||||||
$num = '0' . $num;
|
|
||||||
}
|
|
||||||
push @stack, $num;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
sub dumpstack {
|
|
||||||
my $p = 1;
|
|
||||||
foreach my $n (@register) {
|
|
||||||
printf "r %04d - %s\n", $p++, $n;
|
|
||||||
}
|
|
||||||
foreach my $n (@stack) {
|
|
||||||
printf "s %04d - %s\n", $p++, $n;
|
|
||||||
}
|
|
||||||
print "\n";
|
|
||||||
}
|
|
||||||
|
|
||||||
sub calc {
|
|
||||||
my $op = shift;
|
|
||||||
my $res;
|
|
||||||
my $code;
|
|
||||||
|
|
||||||
my @last = getlast();
|
|
||||||
|
|
||||||
if (@last) {
|
|
||||||
# map operators
|
|
||||||
if ($op eq '^') {
|
|
||||||
$op = '**';
|
|
||||||
}
|
|
||||||
elsif ($op eq 'x') {
|
|
||||||
$op = '^';
|
|
||||||
}
|
|
||||||
elsif ($op eq '<') {
|
|
||||||
$op = '<<';
|
|
||||||
}
|
|
||||||
elsif ($op eq '>') {
|
|
||||||
$op = '>>';
|
|
||||||
}
|
|
||||||
|
|
||||||
# direct ops
|
|
||||||
if ($op eq '%') {
|
|
||||||
if (scalar @last == 2) {
|
|
||||||
my ($a, $b) = @last;
|
|
||||||
$code = "\$res = ($a / 100) * $b";
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
print "percent only possible with 2 values\n";
|
|
||||||
undo();
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
# rpn op
|
|
||||||
$code = "\$res = " . join(" $op ", @last);
|
|
||||||
}
|
|
||||||
|
|
||||||
# execute
|
|
||||||
eval $code;
|
|
||||||
|
|
||||||
if ($@) {
|
|
||||||
# error, reset stack
|
|
||||||
die $@;
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
push @register, $res;
|
|
||||||
if ($debug) {
|
|
||||||
print "DEBUG: $code\n";
|
|
||||||
}
|
|
||||||
if ($tty) {
|
|
||||||
return "=> $res\n\n";
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
return "$res\n";
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
sub undo {
|
|
||||||
@stack = @sbackup, @register = @rbackup;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub backup {
|
|
||||||
@sbackup = @stack;
|
|
||||||
@rbackup = @register;
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
sub getlast {
|
|
||||||
my @all = ();
|
|
||||||
|
|
||||||
if (@stack) {
|
|
||||||
if (scalar @stack == 1 && @register) {
|
|
||||||
@all = (@register, @stack);
|
|
||||||
@register = @stack = ();
|
|
||||||
}
|
|
||||||
elsif (scalar @stack == 1) {
|
|
||||||
return ();
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
@all = @stack;
|
|
||||||
@stack = ();
|
|
||||||
}
|
|
||||||
|
|
||||||
return @all;
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
if (@register) {
|
|
||||||
@all = @register;
|
|
||||||
@register = ();
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
return @all;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub help {
|
|
||||||
print qq~
|
|
||||||
Reverse Polish Notation Calculator, version $VERSION.
|
|
||||||
Copyleft (L) 2019 - 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.
|
|
||||||
|
|
||||||
Available commands:
|
|
||||||
c clear stack
|
|
||||||
s show the stack
|
|
||||||
d toggle debugging (current setting: $debug)
|
|
||||||
r reverse the stack (w/ reg if stack==1)
|
|
||||||
u undo last operation
|
|
||||||
q finish
|
|
||||||
? print help
|
|
||||||
|
|
||||||
Available operators:
|
|
||||||
+ add
|
|
||||||
- substract
|
|
||||||
/ divide
|
|
||||||
* multiply
|
|
||||||
^ expotentiate
|
|
||||||
% percent
|
|
||||||
& bitwise AND
|
|
||||||
| bitwise OR
|
|
||||||
x bitwise XOR
|
|
||||||
|
|
||||||
~;
|
|
||||||
}
|
|
||||||
350
rpnc
Executable file
350
rpnc
Executable file
@@ -0,0 +1,350 @@
|
|||||||
|
#!/usr/bin/perl
|
||||||
|
|
||||||
|
use Term::ReadLine;
|
||||||
|
use Data::Dumper;
|
||||||
|
use Getopt::Long;
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
|
||||||
|
my (@stack, @substack, @backup, @subbackup);
|
||||||
|
my $term = Term::ReadLine->new('rpn calc');
|
||||||
|
my $debug = 0;
|
||||||
|
my $showstack = 1;
|
||||||
|
my $tty = 1;
|
||||||
|
my $VERSION = '1.00';
|
||||||
|
my $sub = 0;
|
||||||
|
my $op;
|
||||||
|
|
||||||
|
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;
|
||||||
|
}
|
||||||
|
|
||||||
|
$op = shift;
|
||||||
|
|
||||||
|
if ($op) {
|
||||||
|
$tty = 0;
|
||||||
|
while (<STDIN>) {
|
||||||
|
chomp;
|
||||||
|
push @stack, split /\s\s*/;
|
||||||
|
}
|
||||||
|
print calc($op);
|
||||||
|
exit;
|
||||||
|
}
|
||||||
|
|
||||||
|
my %commands = (
|
||||||
|
q => sub { exit; },
|
||||||
|
'?' => sub { help(); },
|
||||||
|
s => sub { dumpstack(); },
|
||||||
|
c => sub { clearstack(); },
|
||||||
|
d => sub {
|
||||||
|
if ($debug) {
|
||||||
|
$debug = 0;
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
$debug = 1;
|
||||||
|
}
|
||||||
|
},
|
||||||
|
u => sub { undo(); dumpstack(); },
|
||||||
|
r => sub { reversestack(); },
|
||||||
|
R => sub { rotatestack(); },
|
||||||
|
'(' => sub { $sub = 1 },
|
||||||
|
')' => sub { $sub = 0 },
|
||||||
|
);
|
||||||
|
|
||||||
|
my $OUT = $term->OUT || \*STDOUT;
|
||||||
|
while ( defined ($_ = $term->readline(prompt())) ) {
|
||||||
|
foreach my $tok (split /\s+/) {
|
||||||
|
if ($tok =~ /^-?[\.\d]+?$/) {
|
||||||
|
# number
|
||||||
|
pushstack($tok);
|
||||||
|
dumpstack();
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
if ($tok =~ /^[\(\)csdrRuq\?]+?$/) {
|
||||||
|
cmd($tok);
|
||||||
|
}
|
||||||
|
elsif ($tok =~ /^[V<>x\%\|\&\^+\-\*\/]$/) {
|
||||||
|
print calc($tok);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub cmd {
|
||||||
|
my $c = shift;
|
||||||
|
|
||||||
|
if (exists $commands{$c}) {
|
||||||
|
my $sub = $commands{$c};
|
||||||
|
&$sub;
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
print "unknown command '$c'!\n";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub clearstack {
|
||||||
|
if ($sub) {
|
||||||
|
@substack = ();
|
||||||
|
}
|
||||||
|
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 {
|
||||||
|
return unless $showstack;
|
||||||
|
|
||||||
|
my $prefix = 'stack';
|
||||||
|
my @all;
|
||||||
|
|
||||||
|
if ($sub) {
|
||||||
|
@all = @substack;
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
@all = @stack;
|
||||||
|
}
|
||||||
|
|
||||||
|
my $p = scalar @all;
|
||||||
|
|
||||||
|
foreach my $n (@all) {
|
||||||
|
printf "%s %4d: %s\n", $prefix, $p--, $n;
|
||||||
|
}
|
||||||
|
|
||||||
|
print "\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
sub undo {
|
||||||
|
if ($sub) {
|
||||||
|
@substack = @subbackup;
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
@stack = @backup;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub backup {
|
||||||
|
if ($sub) {
|
||||||
|
@subbackup = @substack;
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
@backup = @stack;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
sub getlast {
|
||||||
|
my @all = ();
|
||||||
|
|
||||||
|
backup();
|
||||||
|
|
||||||
|
if ($sub) {
|
||||||
|
@all = @substack;
|
||||||
|
@substack = ();
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
if (@stack) {
|
||||||
|
if (scalar @stack == 1) {
|
||||||
|
@all = pop @stack;
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
@all = reverse (pop @stack, pop @stack);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
return @all;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub prompt {
|
||||||
|
my $count;
|
||||||
|
my $prompt;
|
||||||
|
|
||||||
|
if ($sub) {
|
||||||
|
$count = scalar @substack;
|
||||||
|
$prompt = '%--(';
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
$count = scalar @stack;
|
||||||
|
$prompt = '%';
|
||||||
|
}
|
||||||
|
|
||||||
|
return sprintf "%2d %s ", $count, $prompt;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub calc {
|
||||||
|
my $op = shift;
|
||||||
|
my $res;
|
||||||
|
my $code;
|
||||||
|
|
||||||
|
my @last = getlast();
|
||||||
|
|
||||||
|
if (@last) {
|
||||||
|
# map operators
|
||||||
|
if ($op eq '^') {
|
||||||
|
$op = '**';
|
||||||
|
}
|
||||||
|
elsif ($op eq 'x') {
|
||||||
|
$op = '^';
|
||||||
|
}
|
||||||
|
elsif ($op eq '<') {
|
||||||
|
$op = '<<';
|
||||||
|
}
|
||||||
|
elsif ($op eq '>') {
|
||||||
|
$op = '>>';
|
||||||
|
}
|
||||||
|
|
||||||
|
# direct and special ops
|
||||||
|
if ($op eq '%') {
|
||||||
|
if (scalar @last == 2) {
|
||||||
|
my ($a, $b) = @last;
|
||||||
|
$code = "($a / 100) * $b";
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
print "percent only possible with 2 values\n";
|
||||||
|
undo();
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
elsif ($op eq 'V') {
|
||||||
|
if (scalar @last == 2) {
|
||||||
|
my ($a, $b) = @last;
|
||||||
|
$code = "$a ** (1 / $b)";
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
my $a = pop @last;
|
||||||
|
$code = "$a ** (1 / 2)";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
# rpn op
|
||||||
|
$code = join(" $op ", @last);
|
||||||
|
}
|
||||||
|
|
||||||
|
# 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();
|
||||||
|
return "=> $res\n\n";
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
return "$res\n";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
sub help {
|
||||||
|
print qq~
|
||||||
|
Reverse Polish Notation Calculator, version $VERSION.
|
||||||
|
Copyleft (L) 2019 - 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.
|
||||||
|
|
||||||
|
Available commands:
|
||||||
|
c clear stack
|
||||||
|
s show the stack
|
||||||
|
d toggle debugging (current setting: $debug)
|
||||||
|
r reverse the stack
|
||||||
|
R rotate the stack
|
||||||
|
( enter collect mode
|
||||||
|
) leave collect mode
|
||||||
|
u undo last operation
|
||||||
|
q finish (C-d works as well)
|
||||||
|
? print help
|
||||||
|
|
||||||
|
Available operators:
|
||||||
|
+ add
|
||||||
|
- substract
|
||||||
|
/ divide
|
||||||
|
* multiply
|
||||||
|
^ expotentiate
|
||||||
|
% percent
|
||||||
|
& bitwise AND
|
||||||
|
| bitwise OR
|
||||||
|
x bitwise XOR
|
||||||
|
V pull root (2nd if stack==1)
|
||||||
|
|
||||||
|
~;
|
||||||
|
}
|
||||||
Reference in New Issue
Block a user