mirror of
https://codeberg.org/scip/rpnc.git
synced 2025-12-18 13:01:08 +01:00
fixed x, added checks, enhanced doc
This commit is contained in:
33
rpnc
33
rpnc
@@ -106,6 +106,7 @@ my %func = (
|
||||
return 0;
|
||||
}
|
||||
},
|
||||
|
||||
'%d' => sub {
|
||||
# percentual difference
|
||||
if (scalar @_ == 2) {
|
||||
@@ -118,6 +119,7 @@ my %func = (
|
||||
return 0;
|
||||
}
|
||||
},
|
||||
|
||||
'%+' => sub {
|
||||
# Y + (X $ of Y)
|
||||
if (scalar @_ == 2) {
|
||||
@@ -130,6 +132,7 @@ my %func = (
|
||||
return 0;
|
||||
}
|
||||
},
|
||||
|
||||
'%-' => sub {
|
||||
# Y - (X $ of Y)
|
||||
if (scalar @_ == 2) {
|
||||
@@ -142,6 +145,7 @@ my %func = (
|
||||
return 0;
|
||||
}
|
||||
},
|
||||
|
||||
'v' => sub {
|
||||
if (scalar @_ == 2) {
|
||||
my ($a, $b) = @_;
|
||||
@@ -152,11 +156,13 @@ my %func = (
|
||||
return "$a ** (1 / 2)";
|
||||
}
|
||||
},
|
||||
|
||||
'pr' => sub {
|
||||
# parallel resistance, maybe add ~/.rpncrc support
|
||||
# where to add such custom functions...
|
||||
return "1 / (" . join(' + ', map { "1 / $_"} @_) . ")";
|
||||
},
|
||||
|
||||
'm' => sub {
|
||||
# median
|
||||
if (scalar @_ >= 2) {
|
||||
@@ -175,10 +181,12 @@ my %func = (
|
||||
undo(); return 0;
|
||||
}
|
||||
},
|
||||
|
||||
'a' => sub {
|
||||
# average
|
||||
return "(" . join(' + ', @_) . ") / " . scalar @_;
|
||||
},
|
||||
|
||||
# converters:
|
||||
# gallons to liters
|
||||
'tl' => sub { return $_[-1] * 3.785 },
|
||||
@@ -193,6 +201,9 @@ my %func = (
|
||||
'tmb' => sub { return $_[-1] / 1000 / 1000},
|
||||
'tgb' => sub { return $_[-1] / 1000 / 1000 / 1000 },
|
||||
'ttb' => sub { return $_[-1] / 1000 / 1000 / 1000 / 1000 },
|
||||
|
||||
# alias
|
||||
'x' => sub { return join "^", @_ },
|
||||
);
|
||||
|
||||
# math constants, always upper case letters, usable via eval{}
|
||||
@@ -540,6 +551,21 @@ sub defun {
|
||||
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 (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";
|
||||
|
||||
$func{$name} = sub {
|
||||
@@ -549,13 +575,14 @@ sub defun {
|
||||
# replace N1..NN with actual args
|
||||
my @body;
|
||||
foreach my $item (@tokens) {
|
||||
if ($item =~ /^N(\d+)$/) {
|
||||
my $i = $1;
|
||||
if ($item =~ /^([A-Z])(\d+)$/) {
|
||||
my $letter = $1;
|
||||
my $i = $2;
|
||||
if ($i <= $max) {
|
||||
push @body, $args[$i-1];
|
||||
}
|
||||
else {
|
||||
print "undefined variable N$i!\n";
|
||||
print "undefined variable ${letter}${i}!\n";
|
||||
push @body, 0;
|
||||
}
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user