--- /dev/null
+# key bindings for DCT, by Shiar
+
+# 1.08.1 2004-09-27 00:40 - moved from 1.8 main
+# 1.08.2 2004-09-27 00:49 - single key alias to chs: \ (often close to _)
+
+package DCT::Bindings;
+
+use strict;
+use utf8;
+
+use vars qw($VERSION @ISA @EXPORT);
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(%falias %alias);
+
+$VERSION = 1.008.001;
+
+our %falias = (
+ "\033" => 0, # esc
+ "\033\117\120" => 1, # f1
+ "\033\133\061\061\176" => 1, # f1
+ "\033\133\061\062\176" => 2, # f2
+ "\033\133\061\063\176" => 3, # f3
+ "\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
+ "\033\133\061\071\176" => 8, # f8
+ "\033\133\062\060\176" => 9, # f9
+ "\033\133\062\061\176" => 10, # f10
+ "\033\133\062\063\176" => 11, # f11/F1
+ "\033\133\062\064\176" => 12, # f12/F2
+ "\033\133\062\065\176" => 13, # F3
+ "\033\133\062\066\176" => 14, # F4
+ "\033\133\062\070\176" => 15, # F5
+ "\033\133\062\071\176" => 16, # F6
+ "\033\133\063\061\176" => 17, # F7
+ "\033\133\063\062\176" => 18, # F8
+ "\033\133\063\063\176" => 19, # F9
+ "\033\133\063\064\176" => 20, # F10
+ "\033\133\062\063\073\062\176" => 21, # F11
+ "\033\133\062\064\073\062\176" => 22, # F12
+); # %falias
+
+our %alias = (
+ chr 4 => 'quit', # ^D
+ chr 9 => 'more', # tab
+ "\014" => 'refresh', # ^L
+# "\033\133\110" => 'refresh', # home
+ '_' => 'chs', # easy to remember, difficult to type
+ '\\' => 'chs', # single key
+# 'y' => 'chs', # redundant hp48 compatibility
+# 'z' => 'eex', # redundant hp48 compatibility
+ "\033\133\062\176" => 'eex', # ins
+ "\033\133\063\176" => "clear", # del
+ chr 127 => 'drop', # backspace
+ chr 8 => 'drop', # backspace
+ chr 13 => 'enter', # enter
+ ' ' => 'enter', # space
+ '=' => 'sto', #
+
+ "\033\133\101" => 'stack', # up - 48: k (stack)
+ "\033\133\104" => 'undo', # left - 48: p (picture)
+# "\033\133\102" => '', # down - 48: q (view)
+ "\033\133\103" => 'swap', # right - 48: r (swap)
+
+ '&' => 'and',
+ '|' => 'or',
+ '#' => 'xor',
+ '~' => 'not',
+ '(' => 'sl',
+ ')' => 'sr',
+
+ "s" => "sin",
+ "\033s" => "asin",
+ "c" => "cos", #todo: u? o?
+ "\033c" => "acos",
+ "t" => "tan",
+ "\033t" => "atan",
+ "l" => "log",
+ "\033l" => "alog",
+ "n" => "ln",
+ "\033n" => "exp",
+ "q" => "sq",
+ "\033q" => "sqrt",
+ "x" => "^",
+ "\033x" => "xroot",
+ "\033^" => "xroot",
+ "v" => "inv",
+); # %alias
+
+1;
+
--- /dev/null
+# menu for DCT, by Shiar
+
+# 2004-09-15 23:32 - moved from 1.6 main
+
+package DCT::Menu;
+
+use strict;
+use utf8;
+
+use vars qw($VERSION @ISA @EXPORT);
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(@menus);
+
+$VERSION = 1.006.002;
+
+our @menus = (
+ [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>2
+ probability> fft> complex> constants>
+ )], #8 math
+ [qw(math>8
+ sinh cosh tanh asinh acosh atanh
+ expm lnp1
+ )], #9 math hyperbolic
+ [qw(math>8
+ % %ch %t min max mod
+ abs sign mant xpon ip fp
+ rnd trnc floor ceil r>d d>r
+ )], #10 math real
+ [qw(main>0
+ 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
+
+1;
+
#!/usr/bin/perl
-### SDC - small desktop calculator ###
+# DCT - desktop calculator thingy
+
# reverse polish notition calculator using curses
# by Shiar <shiar.org>
-# 1.01 06-18 - start
-# 1.03 06-25 -
+# 1.01 06-18 - start (curses, some basic commands)
+# 1.02 06-20 - function keys select command/submenu from (sub)menu
+# - backspace to undo last digit
+# 1.03 06-25 - values displayable in arbitrary base
+# - can enter fractions (.) and negative values (_)
# 1.04 08-04 14:45 - error dialog (don't mess up screen)
+# - manual command input using capital letters
+# - ^L redraws screen
+# pre 09-09 22:00 - overhaul in stack handling
# 1.05 09-10 19:45 - hp48-like drop (backspace but not editing value)
-# - argument checking
+# - error on insufficient arguments for command
# - command backspacing
+# - some unit conversion (mostly lengths) from menu
+# - q for sq(rt) (formerly quit, now only ^D/quit)
# 1.06 09-15 23:10 - menu contents in module
# - new commands: a?(sin|cos|tan)h, inv, !, rand
# - x and v shortkeys
# - action undo: last stack alteration can be undone
# - enter on no value repeats last val on stack
# - new commands: sr/sr, shortkeys ( )
+# 1.08 09-26 22:10 - additional digits were not correctly applied to negative values
+# - negative numbers displayed correctly in different bases
+# - second undo redoes
+# - fixed %
+# - stack command (cursor up) cycles through values in stack
+# 09-27 00:57 - all key aliases moved to module DCT::Bindings
+our $VERSION = 1.008;
use strict;
use warnings;
use Term::ReadKey;
use Curses;
-use SDC::Menu 1.006;
+use DCT::Menu 1.006;
+use DCT::Bindings 1.008;
initscr;
ReadMode 3; # cbreak mode
endwin;
} # restore terminal on quit
-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 = qw(i 0 frac 0); # i, frac
my @stack;
my %var;
-my @menu;
-my $menumin;
+
my %set = (
- base => 10,
+ base => 10, # decimal; set using commands bin/oct/dec/hex/base
numb => 0, # fixed scientific engineering
card => 1, # degrees radians grades
coord => 0, # cartesian polar spherical
complex => 0, # real complex
- menushow => 12,
+
+ height => $LINES<3 ? 4 : $LINES-3, # stack depth (lines of stack plus one)
+ width => $COLS || 42, # limit value precision, stetch menu
+ menushow => 12, # menu items to show simultaneously
); # %set
-@menu = @{$menus[0]};
-$menumin = 0;
-
-my %falias = (
- "\033" => 0, # esc
- "\033\117\120" => 1, # f1
- "\033\133\061\061\176" => 1, # f1
- "\033\133\061\062\176" => 2, # f2
- "\033\133\061\063\176" => 3, # f3
- "\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
- "\033\133\061\071\176" => 8, # f8
- "\033\133\062\060\176" => 9, # f9
- "\033\133\062\061\176" => 10, # f10
- "\033\133\062\063\176" => 11, # f11/F1
- "\033\133\062\064\176" => 12, # f12/F2
- "\033\133\062\065\176" => 13, # F3
- "\033\133\062\066\176" => 14, # F4
- "\033\133\062\070\176" => 15, # F5
- "\033\133\062\071\176" => 16, # F6
- "\033\133\063\061\176" => 17, # F7
- "\033\133\063\062\176" => 18, # F8
- "\033\133\063\063\176" => 19, # F9
- "\033\133\063\064\176" => 20, # F10
- "\033\133\062\063\073\062\176" => 21, # F11
- "\033\133\062\064\073\062\176" => 22, # F12
-); # %falias
-
-my %alias = (
- chr 4 => 'quit', # ^D
- chr 9 => 'more', # tab
- '_' => 'chs', # change sign; 48: y
- 'e' => 'eex', # exponent; 48: z
- "\033\133\062\176" => 'eex', # ins
- "\033\133\063\176" => "clear", # del
- chr 127 => 'drop', # backspace
- chr 8 => 'drop', # backspace
- chr 13 => 'enter', # enter
- ' ' => 'enter', # space
- "\014" => 'refresh', # ^L
-# "\033\133\110" => 'refresh', # home
-
-# "\033\133\101" => '', # up; 48: k (stack)
- "\033\133\104" => 'undo', # left; 48: p (picture)
-# "\033\133\102" => '', # down; 48: q (view)
- "\033\133\103" => 'swap', # right; 48: r (swap)
-
- '&' => 'and',
- '|' => 'or',
- '#' => 'xor',
- '~' => 'not',
- '(' => 'sl',
- ')' => 'sr',
-
- "s" => "sin",
- "\033s" => "asin",
- "c" => "cos",
- "\033c" => "acos",
- "t" => "tan",
- "\033t" => "atan",
- "l" => "log",
- "\033l" => "alog",
- "n" => "ln",
- "\033n" => "exp",
- "q" => "sq",
- "\033q" => "sqrt",
- "x" => "^",
- "\033x" => "xroot",
- "\033^" => "xroot",
- "v" => "inv",
-); # %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
+#%alias = (' '=>'enter', "\004"=>'quit', 'q'=>'quit') unless %alias; # rudimentary defaults
+
+my @menu = @{$menus[0]};
+my $menumin = 0;
my %action = (
'more' => [-1, sub {
%val = (i=>undef, frac=>0);
}], # duplication
+# 'undo' => [0, sub {@stack = @{ $var{undo} }}], # undo
+ 'undo' => [0, sub {($var{undo}, @stack) = ([@stack], @{ $var{undo} }) }], # undo
'swap' => [1, sub {@stack[0, 1] = @stack[1, 0]}], # swap x<->y
+ 'stack'=> [0, sub {
+ $var{stackpos} = 0 unless $var{stackpos}; # initialize
+ $var{stackpos} %= @stack; # cycle
+ $val{i} = $stack[$var{stackpos}++];
+ }], # stack
+
+ 'version' => [0, sub{error("Desktop Calculator Thingy $VERSION by Shiar")}], # version
'=' => [1, sub {$var{a} = $stack[0]}], # copy
'?' => [1, sub {$var{a} = shift @stack}], # assign
'acosh'=> [1, sub {$stack[0] = log( sqrt($stack[0]**2-1)+$stack[0] )}], # inverse hyperbolic cosine
'atanh'=> [1, sub {$stack[0] = log( (1+$stack[0]) / (1-$stack[0]) )/2}], # inverse hyperbolic tangent
- '%' => [2, sub {$stack[0] /= shift @stack}], # percentage
+ '%' => [2, sub {$stack[0] = shift(@stack)/$stack[0]}], # 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
'!' => [1, sub {local $_ = $stack[0]; $stack[0] *= $_ while --$_>1}], # factor
'rand' => [0, sub {unshift @stack, rand}], # random value <1
-
- 'undo' => [0, sub {@stack = @{ $var{undo} }}], # undo
); # %action
my %unit;
return '' unless defined $val;
return $val if $base==10;
+ my $sign = $val<0;
+ $val = abs $val;
my $int = int $val;
my $frac = $val-$int;
my $exp = 0;
my $txt = '';
+
while ($int>$base**10) {
$int /= $base;
$exp++;
} # integer part
$txt .= '.' if $frac>0;
- for (my $i = 0; length $txt<$width-2 && $frac>0; $i++) {
+ for (my $i = 0; length $txt<$set{width}-2 && $frac>0; $i++) {
$frac *= $base;
my $char = int $frac;
$frac -= $char;
$txt .= $char<10 ? $char : chr($char+55);
} # fraction part
+ $txt = "-".$txt if $sign;
$txt .= 'e'.showval($exp, $base) if $exp;
return $txt;
sub showstack() {
for (0..@stack-1) {
- addstr($height-$_, 1, "$_: ".showval($stack[$_], $set{base}));
+ addstr($set{height}-$_, 1, "$_: ".showval($stack[$_], $set{base}));
clrtoeol;
} # show stack
- clrtoeol($height-$#stack-1, 1);
+ clrtoeol($set{height}-$#stack-1, 1);
} # showstack
sub showmenu() {
- clrtoeol($height+2, 1);
+ clrtoeol($set{height}+2, 1);
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}*($nr++), $_);
+ addstr($set{height}+2, $set{width}/$set{menushow}*($nr++), $_);
attron(A_REVERSE);
addstr($s);
attroff(A_REVERSE);
clear;
showmenu();
showstack();
-addstr($height+1, 0, "> "); # prompt
+addstr($set{height}+1, 0, "> "); # prompt
while (1) {
- addstr($height+1, 2, showval($val{i}, $set{base}));
+ addstr($set{height}+1, 2, showval($val{i}, $set{base}));
addstr('_'.$val{unit}{name}) if exists $val{unit};
addstr($val{bla}) if exists $val{bla};
clrtoeol;
elsif (/^\d$/) {
$val{i} = 0 unless defined $val{i};
+ $_ = -$_ if $val{i}<0;
$val{i} = ($val{frac} *= 10) ? $val{i}+$_/$val{frac} : $val{i}*10+$_;
}
elsif ($_ eq '.') {
}} # conversion
else {
- error("* error: ".join(' ', map ord, split //, $_)." *");
+ error("* unrecognised command: ".join(' ', map ord, split //, $_)." *");
goto DRAW; # screen messed up
} # error
} # input loop