release 1.08.2
authorShiar <shiar@shiar.org>
Tue, 28 Sep 2004 12:09:55 +0000 (14:09 +0200)
committerShiar <shiar@shiar.org>
Thu, 10 Jul 2008 19:25:31 +0000 (21:25 +0200)
- 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

- all key aliases moved to module DCT::Bindings

DCT/Bindings.pm [new file with mode: 0644]
DCT/Menu.pm [new file with mode: 0644]
dct.pl [moved from sdc.pl with 75% similarity]

diff --git a/DCT/Bindings.pm b/DCT/Bindings.pm
new file mode 100644 (file)
index 0000000..6232b09
--- /dev/null
@@ -0,0 +1,97 @@
+# 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;
+
diff --git a/DCT/Menu.pm b/DCT/Menu.pm
new file mode 100644 (file)
index 0000000..bf9849b
--- /dev/null
@@ -0,0 +1,101 @@
+# 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;
+
diff --git a/sdc.pl b/dct.pl
similarity index 75%
rename from sdc.pl
rename to dct.pl
index f1692ed64619a81fffd4f954fe5ef96ca6052ceb..f3cdcc9d3a9e1d24d41af4b56bd724ed9a955fca 100755 (executable)
--- a/sdc.pl
+++ b/dct.pl
@@ -1,15 +1,24 @@
 #!/usr/bin/perl
 
 #!/usr/bin/perl
 
-### SDC - small desktop calculator ###
+# DCT - desktop calculator thingy
+
 # reverse polish notition calculator using curses
 # by Shiar <shiar.org>
 
 # 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)
 # 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)
 # 1.05 09-10 19:45 - hp48-like drop (backspace but not editing value)
-#                  - argument checking
+#                  - error on insufficient arguments for command
 #                  - command backspacing
 #                  - 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
 # 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 ( )
 #                  - 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 strict;
 use warnings;
@@ -24,7 +40,8 @@ use utf8;
 
 use Term::ReadKey;
 use Curses;
 
 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
 
 initscr;
 ReadMode 3;  # cbreak mode
@@ -33,107 +50,26 @@ END {
        endwin;
 } # restore terminal on quit
 
        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 %val = qw(i 0  frac 0);  # i, frac
 my @stack;
 my %var;
-my @menu;
-my $menumin;
+
 my %set = (
 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
        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
 
 ); # %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 {
 
 my %action = (
        'more' => [-1, sub {
@@ -151,7 +87,16 @@ my %action = (
                %val = (i=>undef, frac=>0);
        }], # duplication
 
                %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
        '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
 
        '='    => [1, sub {$var{a} = $stack[0]}], # copy
        '?'    => [1, sub {$var{a} = shift @stack}], # assign
@@ -189,7 +134,7 @@ my %action = (
        '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
 
        '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
 
        '%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
 
@@ -221,8 +166,6 @@ my %action = (
 
        '!'    => [1, sub {local $_ = $stack[0]; $stack[0] *= $_ while --$_>1}], # factor
        'rand' => [0, sub {unshift @stack, rand}], # random value <1
 
        '!'    => [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;
 ); # %action
 
 my %unit;
@@ -271,11 +214,14 @@ sub showval($$) {
        return '' unless defined $val;
        return $val if $base==10;
 
        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 = '';
        my $int = int $val;
        my $frac = $val-$int;
        my $exp = 0;
 
        my $txt = '';
+
        while ($int>$base**10) {
                $int /= $base;
                $exp++;
        while ($int>$base**10) {
                $int /= $base;
                $exp++;
@@ -287,13 +233,14 @@ sub showval($$) {
        } # integer part
 
        $txt .= '.' if $frac>0;
        } # 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
 
                $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;
        $txt .= 'e'.showval($exp, $base) if $exp;
 
        return $txt;
@@ -301,18 +248,18 @@ sub showval($$) {
 
 sub showstack() {
        for (0..@stack-1) {
 
 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;
        } # show stack
-       clrtoeol($height-$#stack-1, 1);
+       clrtoeol($set{height}-$#stack-1, 1);
 } # showstack
 
 sub showmenu() {
 } # 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+$//;
        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);
                attron(A_REVERSE);
                addstr($s);
                attroff(A_REVERSE);
@@ -325,10 +272,10 @@ DRAW:
 clear;
 showmenu();
 showstack();
 clear;
 showmenu();
 showstack();
-addstr($height+1, 0, "> ");  # prompt
+addstr($set{height}+1, 0, "> ");  # prompt
 
 while (1) {
 
 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;
        addstr('_'.$val{unit}{name}) if exists $val{unit};
        addstr($val{bla}) if exists $val{bla};
        clrtoeol;
@@ -374,6 +321,7 @@ while (1) {
 
        elsif (/^\d$/) {
                $val{i} = 0 unless defined $val{i};
 
        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 '.') {
                $val{i} = ($val{frac} *= 10) ? $val{i}+$_/$val{frac} : $val{i}*10+$_;
        }
        elsif ($_ eq '.') {
@@ -427,7 +375,7 @@ while (1) {
        }} # conversion
 
        else {
        }} # conversion
 
        else {
-               error("* error: ".join(' ', map ord, split //, $_)." *");
+               error("* unrecognised command: ".join(' ', map ord, split //, $_)." *");
                goto DRAW; # screen messed up
        } # error
 } # input loop
                goto DRAW; # screen messed up
        } # error
 } # input loop