use strict;
use warnings;
+use utf8;
use Term::ReadKey;
use Curses;
initscr;
-ReadMode 3;
+ReadMode 3; # cbreak mode
+END {
+ ReadMode 0;
+ endwin;
+} # restore terminal on quit
-my $height = $LINES-3 || 4;
-my $width = $COLS || 42;
+my $height = $LINES<3 ? 4 : $LINES-3; # stack depth (lines of stack plus one)
+my $width = $COLS || 42; # limit value precision, stetch menu
-my @val = (0, 0); # val, frac
-my $nopush = 1; # 0=push and reset next; 1=reset next; 2=do nothing
+my %val = qw(i 0 frac 0); # i, frac
my @stack;
my %var;
my @menu;
+my $menumin;
my %set = (
- base => 10,
- numb => 0, # fixed scientific engineering
- card => 1, # degrees radians grades
- coord => 0, # cartesian polar spherical
- complex => 0, # real complex
- menushow => 12,
+ base => 10,
+ numb => 0, # fixed scientific engineering
+ card => 1, # degrees radians grades
+ coord => 0, # cartesian polar spherical
+ complex => 0, # real complex
+ menushow => 6,
); # %set
my @menus = (
- [qw(quit base>1 math>8 mode>7)],
- [qw(main>0 dec bin oct hex logic>3 bit>4)], #1 base
- [qw(main>0 log alog ln exp sin cos tan 0 asin acos atan)], #2 math
- [qw(base>1 and or xor not)], #3 base logic
- [qw(base>1 rl sl asr sr rr)], #4 base bit
- [qw(base>1 rlb slb srb rrb)], #5 base byte
+ [qw(refresh math>8 prog> mode>7 unit>11)],
+ [qw(main>0 log alog ln exp sin cos tan 0 asin acos atan)], #1 math
+ [qw(main>0 dec bin oct hex logic>3 bit>4)], #2 base
+ [qw(base>2 and or xor not)], #3 base logic
+ [qw(base>2 rl sl asr sr rr)], #4 base bit
+ [qw(base>2 rlb slb srb rrb)], #5 base byte
[qw(main>0 sq sqrt ^ xroot)], #6
[qw(main>0 number_format angle_measure coord_system)], #7 mode
[qw(main>0
- vector> matrix> list> hyperbolic>9 real>10 base>1
+ vector> matrix> list> hyperbolic>9 real>10 base>2
probability> fft> complex> constants>
)], #8 math
[qw(math>8
rnd trnc floor ceil r>d d>r
)], #10 math real
[qw(main>0
- tools> length> area> volume> time> speed>
- mass> force> energy> power> pressure> temperature>
- electric_current> angle> light> radiation> viscosity>
+ tools> length>12 area>13 volume>14 time>15 speed>16
+ mass>17 force>18 energy>19 power>20 pressure>21 temperature>22
+ electric_current>23 angle>24 light>25 radiation>26 viscosity>27
)], #11 units
+# mm cm m in ft yd km mile mmile lt-yr mil Ang fermi rod fath)],
+ [qw(unit>11
+ _m _cm _mm _yd _ft _in _Mpc _pc _lyr _au _km _mi
+ _nmi _miUS _chain _rd _fath _ftUS _Mil _μ _Å _fermi
+ )], #12 length
+ [qw(unit>11
+ _m^2 _cm^2 _b _yd^2 _ft^2 _in^2
+ _km^2 _ha _a _mi^2 _miUS^2 _acre
+ )], #13 area
+ [qw(unit>11
+ _m^3 _st _cm^3 _yd^3 _ft^3 _in^3
+ _l _galUK _galC _gal _qt _pt
+ _ml _cu _ozfl _ozUK _tbsp _tsp
+ _bbl _bu _pk _fbm
+ )], #14 volume
+ [qw(unit>11
+ _yr _d _h _min _s _Hz
+ )], #15 time
+ [qw(unit>11
+ _m/s _cm/s _ft/s _kph _mph _knot
+ _c _ga
+ )], #16 speed
+ [qw(unit>11
+ _kg _g _Lb _oz _slug _lbt
+ _ton _tonUS _t _ozt _ct _grain
+ _u _mol
+ )], #17 mass
+ [qw(unit>11
+ _N _dyn _gf _kip _lbf _pdl
+ )], #18 force
+ [qw(unit>11
+ _J _erg _Kcal _Cal _Btu _ftxlbf
+ _therm _MeV _eV
+ )], #19 energy
+ [qw(unit>11
+ _W _hp
+ )], #20 power
+ [qw(unit>11
+ _Pa _atm _bar _psi _torr _mmHg
+ _inHg _inH2O
+ )], #21 pressure
+ [qw(unit>11
+ )], #22 temperature
+ [qw(unit>11
+ )], #23 electric_current
+ [qw(unit>11
+ )], #24 angle
+ [qw(unit>11
+ )], #25 light
+ [qw(unit>11
+ )], #26 radiation
+ [qw(unit>11
+ )], #27 viscosity
+
+
+
); # @menus
@menu = @{$menus[0]};
+$menumin = 0;
my %falias = (
"\033" => 0, # esc
"\033\117\120" => 1, # f1
"\033\133\061\061\176" => 1, # f1
- "\033\117\121" => 2, # f2
"\033\133\061\062\176" => 2, # f2
- "\033\117\122" => 3, # f3
"\033\133\061\063\176" => 3, # f3
- "\033\117\123" => 4, # f4
"\033\133\061\064\176" => 4, # f4
+ "\033\117\121" => 2, # f2
+ "\033\117\122" => 3, # f3
+ "\033\117\123" => 4, # f4
"\033\133\061\065\176" => 5, # f5
"\033\133\061\067\176" => 6, # f6
"\033\133\061\070\176" => 7, # f7
my %alias = (
chr 4 => 'quit', # ^D
- 'q' => 'quit', # quit
- '_' => 'chs', # change sign
- 'e' => 'eex', # exponent
- "\033\133\062\176" => 'swap', # ins
- chr(27).chr(91).chr(51).chr(126) => 'clx', # del
- chr 127 => '<-', # backspace
- chr 8 => '<-', # backspace
+ chr 9 => 'more', # tab
+ '_' => 'chs', # change sign; 48: y
+ 'e' => 'eex', # exponent; 48: z
+# "\033\133\062\176" => 'swap', # ins
+ chr(27).chr(91).chr(51).chr(126) => 'clear', # del
+ chr 127 => 'drop', # backspace
+ chr 8 => 'drop', # backspace
+ chr 13 => ' ', # enter
"\014" => 'refresh', # ^L
- "\033\133\110" => 'refresh', # home
+# "\033\133\110" => 'refresh', # home
+
+# "\033\133\101" => '', # up; 48: k (stack)
+# "\033\133\104" => '', # left; 48: p (picture)
+# "\033\133\102" => '', # down; 48: q (view)
+ "\033\133\103" => 'swap', # right; 48: r (swap)
'&' => 'and',
'|' => 'or',
's' => 'sin',
chr(27).'s' => 'asin',
- 'u' => 'cos',
- chr(27).'u' => 'acos',
+ 'c' => 'cos',
+ chr(27).'c' => 'acos',
't' => 'tan',
chr(27).'t' => 'atan',
'l' => 'log',
chr(27).'l' => 'alog',
'n' => 'ln',
chr(27).'n' => 'exp',
- 'x' => 'xroot',
-
+ 'q' => 'sq',
+ chr(27).'q' => 'sqrt',
+ chr(27).'^' => 'xroot',
); # %alias
+=cut
+HP48 keys:
+ S T U V W X
+ - sin cos tan sqrt ^ 1/x
+ < asin acos atan sq alog exp
+ > [a] ∫ ∑ xroot log ln
+=cut
+
my %action = (
-# 'digit' => [-2, sub {
-# if ($val[1] *= 10) {
-# $val[0] += $_/$val[1];
-# } # fraction
-# else {
-# $val[0] = $val[0]*10+$_;
-# } # integer
-# }],
- 'digit'=> [-2, sub { $val[0] = ($val[1] *= 10) ? $val[0]+$_/$val[1] : $val[0]*10+$_ }],
- '.' => [-2, sub { $val[1] = 1 }], # decimal point
+ 'more' => [0, sub {
+ $menumin += $set{menushow};
+ $menumin = 0 if $menumin>=$#menu;
+ showmenu();
+ }], # tab
+ 'digit'=> [-2, sub { $val{i} = ($val{frac} *= 10) ? $val{i}+$_/$val{frac} : $val{i}*10+$_ }],
+ '.' => [-2, sub { $val{frac} = 1 }], # decimal point
'eex' => [-2, sub {}], # exponent
- 'chs' => [1, sub {$val[0] = -$val[0]}], # negative
-
- '<-' => [-1, sub {
- $val[0] = ($val[1] = int $val[1]/10)
- ? int($val[0]*$val[1])/$val[1] : int $val[0]/10
+ 'chs' => [0, sub {
+ if (defined $val{i}) {
+ $val{i} = -$val{i};
+ } else {
+ $stack[0] = -$stack[0];
+ }
+ }], # negative
+
+ 'drop' => [0, sub {
+ if (defined $val{i}) {
+ $val{i} = ($val{frac} = int $val{frac}/10)
+ ? int($val{i}*$val{frac})/$val{frac} : int $val{i}/10
+ } else {
+ shift @stack;
+ }
}], # backspace
- 'clx' => [0, sub {@stack = (); @val = (0, 0); $nopush = 1}], # clear all
-
- chr 13 => [0, sub {
- unshift @stack, $val[0];
- $nopush = 1;
+ 'clear' => [0, sub {
+ #todo: if (val{i}) delete char after cursor
+ @stack = (); %val = (i=>undef, frac=>0)
+ }], # clear all
+
+ ' ' => [0, sub {
+ unshift @stack, $val{i};
+ %val = (i=>undef, frac=>0);
}], # duplication
- 'swap' => [1, sub {($val[0], $stack[0]) = ($stack[0], $val[0])}], # swap x<->y
-
- '=' => [1, sub {$var{a} = $val[0]}], # copy
- '>' => [1, sub {$var{a} = $val[0]; $val[0] = shift @stack}], # assign
-
- '+' => [2, sub {$val[0] += shift @stack}], # addition
- '-' => [2, sub {$val[0] = shift(@stack) - $val[0]}], # substraction
- '*' => [2, sub {$val[0] *= shift @stack}], # multiplication
- '/' => [2, sub {$val[0] = shift(@stack) / $val[0]}], # division
- 'mod' => [2, sub {$val[0] = shift(@stack) % $val[0]}], # modulo
-
- 'sqrt' => [1, sub {$val[0] = sqrt $val[0]}], # square root
- 'sq' => [1, sub {$val[0] *= $val[0]}], # squared
- '^' => [2, sub {$val[0] = shift(@stack) ** $val[0]}], # exponentiation
- 'xroot'=> [2, sub {$val[0] = shift(@stack) ** (1/$val[0])}], # x-root of y
-
- 'log' => [1, sub {$val[0] = log($val[0]) / log(10)}], # logarithm
- 'alog' => [1, sub {$val[0] = 10 ** $val[0]}], # 10^x
- 'ln' => [1, sub {$val[0] = log $val[0]}], # natural logaritm
- 'lnp1' => [1, sub {$val[0] = log($val[0]+1)}], # ln(x+1)
- 'exp' => [1, sub {$val[0] = exp($val[0])}], # e^x
- 'expm' => [1, sub {$val[0] = exp($val[0])-1}], # exp(x)-1
-
- 'sin' => [1, sub {$val[0] = sin $val[0]}], # sine
- 'asin' => [1, sub {$val[0] = atan2($val[0], sqrt(1 - $val[0]*$val[0]))}], # inverse sine
- 'cos' => [1, sub {$val[0] = cos $val[0]}], # cosine
- 'acos' => [1, sub {$val[0] = atan2(sqrt(1 - $val[0]*$val[0]), $val[0])}], # inverse cosine
- 'tan' => [1, sub {$val[0] = sin($val[0]) / cos($val[0])}], # tangent
+ 'swap' => [1, sub {@stack[0, 1] = @stack[1, 0]}], # swap x<->y
+
+ '=' => [1, sub {$var{a} = $stack[0]}], # copy
+ '>' => [1, sub {$var{a} = shift @stack}], # assign
+
+ '+' => [2, sub {$stack[1] += shift @stack}], # addition
+ '-' => [2, sub {$stack[1] -= shift @stack}], # substraction
+ '*' => [2, sub {$stack[1] *= shift @stack}], # multiplication
+ '/' => [2, sub {$stack[1] /= shift @stack}], # division
+ 'mod' => [2, sub {$stack[1] %= shift @stack}], # modulo
+
+ 'sqrt' => [1, sub {$stack[0] = sqrt $stack[0]}], # square root
+ 'sq' => [1, sub {$stack[0] *= $stack[0]}], # squared
+ '^' => [2, sub {$stack[1] **= shift @stack}], # exponentiation
+ 'xroot'=> [2, sub {$stack[1] **= 1 / shift @stack}], # x-root of y
+
+ 'log' => [1, sub {$stack[0] = log($stack[0]) / log(10)}], # logarithm
+ 'alog' => [1, sub {$stack[0] = 10 ** $stack[0]}], # 10^x
+ 'ln' => [1, sub {$stack[0] = log $stack[0]}], # natural logaritm
+ 'lnp1' => [1, sub {$stack[0] = log($stack[0]+1)}], # ln(x+1)
+ 'exp' => [1, sub {$stack[0] = exp($stack[0])}], # e^x
+ 'expm' => [1, sub {$stack[0] = exp($stack[0])-1}], # exp(x)-1
+
+ 'sin' => [1, sub {$stack[0] = sin $stack[0]}], # sine
+ 'asin' => [1, sub {$stack[0] = atan2($stack[0], sqrt(1 - $stack[0]*$stack[0]))}], # inverse sine
+ 'cos' => [1, sub {$stack[0] = cos $stack[0]}], # cosine
+ 'acos' => [1, sub {$stack[0] = atan2(sqrt(1 - $stack[0]*$stack[0]), $stack[0])}], # inverse cosine
+ 'tan' => [1, sub {$stack[0] = sin($stack[0]) / cos($stack[0])}], # tangent
# 'atan' => [1, sub {}], # arctangent
- '%' => [2, sub {$val[0] /= shift(@stack)}], # percentage
- '%ch' => [2, sub {$val[0] = 100*(shift(@stack)-$val[0])/$val[0]}], # percentage change
- '%t' => [2, sub {$val[0] = 100*$val[0]/shift(@stack)}], # percentage total
+ '%' => [2, sub {$stack[0] /= shift @stack}], # percentage
+ '%ch' => [2, sub {$val{i} = 100*(shift(@stack)-$val{i})/$val{i}}], # percentage change
+ '%t' => [2, sub {$val{i} = 100*$val{i}/shift(@stack)}], # percentage total
- 'and' => [2, sub {$val[0] = shift(@stack) & $val[0]}], # bitwise and
- 'or' => [2, sub {$val[0] = shift(@stack) | $val[0]}], # bitwise or
- 'xor' => [2, sub {$val[0] = shift(@stack) ^ $val[0]}], # bitwise xor
- 'not' => [2, sub {$val[0] = ~$val[0]}], # bitwise not
+ 'and' => [2, sub {$stack[1] &= shift @stack}], # bitwise and
+ 'or' => [2, sub {$stack[1] |= shift @stack}], # bitwise or
+ 'xor' => [2, sub {$stack[1] ^= shift @stack}], # bitwise xor
+ 'not' => [2, sub {$stack[0] = ~$stack[0]}], # bitwise not
- 'abs' => [1, sub {$val[0] = abs $val[0]}], # absolute #todo
- 'sign' => [1, sub {$val[0] = $val[0] <=> 0}], # sign
- 'ip' => [1, sub {$val[0] = int $val[0]}], # integer part
- 'fp' => [1, sub {$val[0] -= int $val[0]}], # fractional part
+ 'abs' => [1, sub {$stack[0] = abs $stack[0]}], # absolute #todo
+ 'sign' => [1, sub {$stack[0] = $stack[0] <=> 0}], # sign
+ 'ip' => [1, sub {$stack[0] = int $stack[0]}], # integer part
+ 'fp' => [1, sub {$stack[0] -= int $stack[0]}], # fractional part
- 'rnd' => [1, sub {local $_ = 10**shift @stack; $val[0] = int(($val[0]+.5)*$_)/$_}], # round
- 'trnc' => [1, sub {local $_ = 10**shift @stack; $val[0] = int($val[0]*$_)/$_}], # truncate
- 'floor'=> [1, sub {$val[0] = int $val[0]}], # floor
- 'ceil' => [1, sub {$val[0] = int $val[0]+.9999}], # ceil
+ 'rnd' => [1, sub {local $_ = 10**shift @stack; $val{i} = int(($val{i}+.5)*$_)/$_}], # round
+ 'trnc' => [1, sub {local $_ = 10**shift @stack; $val{i} = int($val{i}*$_)/$_}], # truncate
+ 'floor'=> [1, sub {$stack[0] = int $stack[0]}], # floor
+ 'ceil' => [1, sub {$stack[0] = int $stack[0]+.9999}], # ceil
'min' => [2, sub {
local $_ = shift @stack;
- $val[0] = $_ if $_<$val[0];
+ $stack[0] = $_ if $_<$stack[0];
}], # minimum
'max' => [2, sub {
local $_ = shift @stack;
- $val[0] = $_ if $_>$val[0];
+ $stack[0] = $_ if $_>$stack[0];
}], # maximum
'dec' => [0, sub {$set{base} = 10}], # decimal
'base36' => [0, sub {$set{base} = 36}], # alphanumerical
); # %action
+my %unit;
+{
+my $i = 0;
+$unit{$_->[0]} = { name=>$_->[0], type=>$i, val=>$_->[1] } for map {$i++; @$_} (
+ [
+ ['m', 1],
+ ['cm', .01],
+ ['mm', .001],
+ ['km', 1000],
+ ['ft', .3048],
+ ['in', .0254],
+ ['yd', .9144],
+ ['mile', 1609.344],
+ ['nmile', 1852],
+ ['lyr', 9.46052840488e+15],
+ ['mil', 2.54e-5],
+ # _m _cm _mm _yd _ft _in _Mpc _pc _lyr _au _km _mi
+ # _nmi _miUS _chain _rd _fath _ftUS _Mil _μ _Å _fermi
+ ], # lengths
+ [
+ ['m^3', 1],
+ ['cm^3', 1e-6],
+ ['ft^3', .028316846592],
+ ['in^3', 1.6387064e-5],
+ ], # volume
+);
+} # create unit table
+
sub showval($$);
sub showval($$) {
my ($val, $base) = @_;
+ return '' unless defined $val;
return $val if $base==10;
my $int = int $val;
sub showmenu() {
clrtoeol($height+2, 1);
- for (grep exists $menu[$_], 1..$set{menushow}) {
+ my $nr = 0;
+ for (grep exists $menu[$_], $menumin+1..$menumin+$set{menushow}) {
my $sub = (my $s = $menu[$_]) =~ s/>\d+$//;
- addstr($height+2, $width/$set{menushow}*($_-1), $_);
+ addstr($height+2, $width/$set{menushow}*($nr++), $_);
attron(A_REVERSE);
addstr($s);
attroff(A_REVERSE);
addstr($height+1, 0, "> ");
while (1) {
- addstr($height+1, 2, showval($val[0], $set{base}));
+ addstr($height+1, 2, showval($val{i}, $set{base}));
+ addstr('_'.$val{unit}{name}) if exists $val{unit};
+ addstr($val{bla}) if exists $val{bla};
clrtoeol;
refresh;
while (defined (my $key = ReadKey -1)) {
$_ .= $key;
} # read additional keys
- } # escape
+ } # escape sequence
exists $alias{$_} and $_ = $alias{$_};
exists $falias{$_} and $_ = $menu[$falias{$_}];
- if (exists $action{$_} or /^\d$/) {
- my ($type, $cmd) = @{ $action{$_} || $action{digit} };
- if ($type==-2) {
- unshift @stack, $val[0] and showstack() unless $nopush;
- @val = (0, 0) if $nopush<2; # replace current
- $nopush = 2;
- } # modify value
- $cmd->();
- $nopush = 0 if $type>0;
- showstack() if $type>=0;
- } # some operation
+ $_ = delete $val{bla} if exists $val{bla} and $_ eq ' ';
- elsif ($_ eq 'quit') {
+ if ($_ eq 'quit') {
last;
} # quit
elsif ($_ eq 'refresh') {
elsif (/>(\d+)$/) {
@menu = @{ $menus[$1] };
+ $menumin = 0;
showmenu();
} # submenu
+ elsif (exists $val{bla} or /^[A-Z]$/) {
+ if (defined $val{i}) {
+ unshift @stack, $val{i};
+ %val = (i=>undef, frac=>0);
+ showstack();
+ }
+ $val{bla} .= lc $_;
+ } # manual command
+
+ elsif (exists $action{$_} or /^\d$/) {
+ my ($type, $cmd) = @{ $action{$_} || $action{digit} };
+ if ($type==-2) {
+ $val{i} = 0 unless defined $val{i};
+ } # modify value
+ if ($type>0 and defined $val{i}) {
+ unshift @stack, $val{i};
+ %val = (i=>undef, frac=>0);
+ } # auto enter
+ $cmd->();
+ showstack() if $type>=0;
+ } # some operation
+
+ elsif ($_ =~ /^_/) {{
+ $_ = $unit{substr $_, 1} or next;
+ if (exists $val{unit} and $val{unit}{type}==$_->{type}) {
+ unshift @stack, $val{i} and showstack() if defined $val{i};
+ $stack[0] *= delete($val{unit})->{val} / $_->{val};
+ %val = (i=>undef, frac=>0);
+ } # convert
+ else {
+ $val{unit} = $_;
+ } # set source unit
+ }} # conversion
+
else {
attron(A_REVERSE);
addstr($height+1, 0, "* error: ".join(' ', map ord, split //, $_)." *");
ReadKey; # wait for confirm
1 while defined (ReadKey -1); # clear key buffer
goto DRAW; # screen messed up
- }
+ } # error
} # input loop
-ReadMode 0;
-endwin;
-
git.shiar.nl / descalc.git / commitdiff