mirror of
https://codeberg.org/scip/rpnc.git
synced 2025-12-17 20:41:01 +01:00
niceties
This commit is contained in:
109
rpnc
109
rpnc
@@ -21,44 +21,6 @@ my $maxreg = 5;
|
|||||||
my $silent = 1;
|
my $silent = 1;
|
||||||
my $op;
|
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;
|
|
||||||
}
|
|
||||||
|
|
||||||
# management commands, always lower case letters or words
|
# management commands, always lower case letters or words
|
||||||
my %commands = (
|
my %commands = (
|
||||||
# stack commands
|
# stack commands
|
||||||
@@ -93,15 +55,6 @@ my %alias = qw(^ ** x ^ < << > >> + + - - / / * * & & | |);
|
|||||||
# holds user functions
|
# holds user functions
|
||||||
my %custom;
|
my %custom;
|
||||||
|
|
||||||
# converter helper
|
|
||||||
sub convert {
|
|
||||||
my $code = shift;
|
|
||||||
my ($a) = getlast(1);
|
|
||||||
if (defined $a) {
|
|
||||||
return "$a $code";
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
# hand coded functions
|
# hand coded functions
|
||||||
my %func = (
|
my %func = (
|
||||||
'%' => sub {
|
'%' => sub {
|
||||||
@@ -199,6 +152,33 @@ use constant PI => 3.141592653589793;
|
|||||||
use constant V2 => 1.414213562373095;
|
use constant V2 => 1.414213562373095;
|
||||||
use constant V3 => 1.732050807568877;
|
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
|
# load config, if any
|
||||||
if (-s "$ENV{HOME}/.rpnc") {
|
if (-s "$ENV{HOME}/.rpnc") {
|
||||||
if (open RC, "< $ENV{HOME}/.rpnc") {
|
if (open RC, "< $ENV{HOME}/.rpnc") {
|
||||||
@@ -212,6 +192,20 @@ if (-s "$ENV{HOME}/.rpnc") {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
# 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
|
# main
|
||||||
my $OUT = $term->OUT || \*STDOUT;
|
my $OUT = $term->OUT || \*STDOUT;
|
||||||
while ( defined ($_ = $term->readline(prompt())) ) {
|
while ( defined ($_ = $term->readline(prompt())) ) {
|
||||||
@@ -222,18 +216,30 @@ while ( defined ($_ = $term->readline(prompt())) ) {
|
|||||||
1;
|
1;
|
||||||
|
|
||||||
|
|
||||||
|
# converter helper
|
||||||
|
sub convert {
|
||||||
|
my $code = shift;
|
||||||
|
my ($a) = getlast(1);
|
||||||
|
if (defined $a) {
|
||||||
|
return "$a $code";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
sub looptokenize {
|
sub looptokenize {
|
||||||
# does the actual business
|
# disassemble user input into tokens
|
||||||
my $tokens = shift;
|
my $tokens = shift;
|
||||||
|
|
||||||
if ($tokens =~ /^f\s/) {
|
if ($tokens =~ /^f\s/) {
|
||||||
|
# function definition
|
||||||
defun($tokens);
|
defun($tokens);
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
foreach my $tok (split /\s+/, $tokens) {
|
foreach my $tok (split /\s+/, $tokens) {
|
||||||
if ($tok =~ /^-?[A-Z\.\d]+?$/) {
|
if ($tok =~ /^-?[A-Z\.\d]+?$/) {
|
||||||
# number
|
# number or register fetch
|
||||||
if ($tok =~ /^R(\d+?)/) {
|
if ($tok =~ /^R(\d+?)/) {
|
||||||
|
# fetch number from register $1 and put it to stack
|
||||||
my $r = getreg($1);
|
my $r = getreg($1);
|
||||||
if ($r) {
|
if ($r) {
|
||||||
pushstack($r);
|
pushstack($r);
|
||||||
@@ -244,11 +250,13 @@ sub looptokenize {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
|
# put number to stsack
|
||||||
pushstack($tok);
|
pushstack($tok);
|
||||||
}
|
}
|
||||||
dumpstack();
|
dumpstack();
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
|
# operator or command, execute
|
||||||
if (exists $commands{$tok}) {
|
if (exists $commands{$tok}) {
|
||||||
cmd($tok);
|
cmd($tok);
|
||||||
}
|
}
|
||||||
@@ -436,6 +444,7 @@ sub getlast {
|
|||||||
}
|
}
|
||||||
|
|
||||||
sub getreg {
|
sub getreg {
|
||||||
|
# fetch $n'th element from register
|
||||||
my $n = shift;
|
my $n = shift;
|
||||||
if ($n <= scalar @register) {
|
if ($n <= scalar @register) {
|
||||||
return $register[$n-1];
|
return $register[$n-1];
|
||||||
@@ -446,6 +455,7 @@ sub getreg {
|
|||||||
}
|
}
|
||||||
|
|
||||||
sub last_to_reg {
|
sub last_to_reg {
|
||||||
|
# put last stack element to register
|
||||||
my $n;
|
my $n;
|
||||||
if ($sub) {
|
if ($sub) {
|
||||||
if (@substack) {
|
if (@substack) {
|
||||||
@@ -512,7 +522,6 @@ sub calc {
|
|||||||
my $res;
|
my $res;
|
||||||
my $code;
|
my $code;
|
||||||
|
|
||||||
|
|
||||||
if (exists $alias{$op}) {
|
if (exists $alias{$op}) {
|
||||||
my @last = getlast(2);
|
my @last = getlast(2);
|
||||||
$op = $alias{$op};
|
$op = $alias{$op};
|
||||||
|
|||||||
Reference in New Issue
Block a user