release 1.09.6
authorShiar <shiar@shiar.org>
Tue, 12 Oct 2004 00:35:37 +0000 (02:35 +0200)
committerShiar <shiar@shiar.org>
Thu, 10 Jul 2008 19:25:31 +0000 (21:25 +0200)
- all key aliases moved to module DCT::Bindings
- number of menu items depends on screen width
- hooks allowing for extra code at reload, showentry, and precmd
- all menu related functions moved to menu.pm
- unit conversion out of main program (entirely into unitconv.pm)
- backspace becomes "back" (soft drop, like old "drop")
- normal drop command (alt+bs) removes input/stack value at once
- $val{frac} default undefined instead of 0

DCT/Bindings.pm [deleted file]
DCT/Menu.pm [deleted file]
bindings.pm [new file with mode: 0644]
dct.pl
math.pm [new file with mode: 0644]
math.pm.old [new file with mode: 0644]
menu.pm [new file with mode: 0644]
unitconv.pm [new file with mode: 0644]

diff --git a/DCT/Bindings.pm b/DCT/Bindings.pm
deleted file mode 100644 (file)
index 6232b09..0000000
+++ /dev/null
@@ -1,97 +0,0 @@
-# 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
deleted file mode 100644 (file)
index bf9849b..0000000
+++ /dev/null
@@ -1,101 +0,0 @@
-# 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/bindings.pm b/bindings.pm
new file mode 100644 (file)
index 0000000..374a57d
--- /dev/null
@@ -0,0 +1,63 @@
+# 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 _)
+# 1.09.1 2004-10-11 21:45 - function keys moved to menu.pm
+# 1.09.2      10-12 01:45 - alt+backspace and ^W for (hard) drop
+
+use strict;
+use warnings;
+use utf8;
+
+%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
+           "\177"         => "back",    # backspace
+           "\010"         => "back",    # backspace
+       "\033\010"         => "drop",    # alt+backspace
+       "\033\177"         => "drop",    # alt+backspace
+           "\027"         => "drop",    # ^W
+       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.pl b/dct.pl
index f3cdcc9d3a9e1d24d41af4b56bd724ed9a955fca..a671e52787a1dc635ad3d075c61f00535c119f4f 100755 (executable)
--- a/dct.pl
+++ b/dct.pl
@@ -5,34 +5,7 @@
 # reverse polish notition calculator using curses
 # by Shiar <shiar.org>
 
-# 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)
-#                  - 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
-# 1.07 09-24 23:50 - numeric modifiers hardcoded instead of in action hash
-#                  - 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;
+our $VERSION = 1.009;
 
 use strict;
 use warnings;
@@ -40,161 +13,50 @@ use utf8;
 
 use Term::ReadKey;
 use Curses;
-use DCT::Menu 1.006;
-use DCT::Bindings 1.008;
 
-initscr;
-ReadMode 3;  # cbreak mode
-END {
-       ReadMode 0;
-       endwin;
-} # restore terminal on quit
-
-my %val = qw(i 0  frac 0);  # i, frac
-my @stack;
-my %var;
+use vars qw(@stack %val %var %set %alias %action %hook);
 
-my %set = (
+%set = (
        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
 
-       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
+       height   =>  4,  # stack depth (lines of stack plus one)
+       width    => 42,  # limit value precision, stetch menu
 ); # %set
 
-#%alias = (' '=>'enter', "\004"=>'quit', 'q'=>'quit') unless %alias;  # rudimentary defaults
+%alias = (' '=>'enter', "\004"=>'quit', 'q'=>'quit');  # rudimentary default key bindings
 
-my @menu = @{$menus[0]};
-my $menumin = 0;
+%action = (
+       "chs"   => [1, sub { -$_[0] }], # negative
 
-my %action = (
-       'more' => [-1, sub {
-               $menumin += $set{menushow};
-               $menumin = 0 if $menumin>=$#menu;
-               showmenu();
-       }], # tab
-       'chs'  => [0, sub {$stack[0] = -$stack[0]}], # negative
+       "drop"  => [1, sub { defined $val{i} ? '' : () }], # drop
+       "back"  => [1, sub { () }], # drop essentially
+       "clear" => [0, sub { @stack = (); undef %val; () }], # clear all  #todo: if (val{i}) delete char after cursor
 
-       'drop' => [0, sub {shift @stack}], # backspace
-       'clear'=> [0, sub {@stack = (); %val = (i=>undef, frac=>0) }], # clear all #todo: if (val{i}) delete char after cursor
-
-       'enter'=> [0, sub {
-               unshift @stack, defined $val{i} ? $val{i} : $stack[0];
-               %val = (i=>undef, frac=>0);
+       "enter" => [0, sub {
+               local $_ = defined $val{i} ? $val{i} : $stack[0];
+               undef %val;
+               return defined $_ ? $_ : ();
        }], # 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 {
+       "swap"  => [2, sub { reverse @_ }], # swap x<->y
+       "undo"  => [-1, sub {
+               ($var{undo}, @stack) = ([@stack], @{ $var{undo} });
+       }], # undo/redo
+       "stack" => [-1, 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
-
-       '+'    => [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
-
-       'inv'  => [1, sub {$stack[0] = 1 / $stack[0]}], # 1/x
-       '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
-
-       'sinh' => [1, sub {$stack[0] = ( exp($stack[0]) - exp(-$stack[0]) )/2}], # hyperbolic sine
-       'cosh' => [1, sub {$stack[0] = ( exp($stack[0]) + exp(-$stack[0]) )/2}], # hyperbolic cosine
-       'tanh' => [1, sub {$stack[0] = ( exp($stack[0]) - exp(-$stack[0]) )/( exp($stack[0]) + exp(-$stack[0]) )}], # hyperbolic tangent (sinh/cosh)
-       'asinh'=> [1, sub {$stack[0] = log( sqrt($stack[0]**2+1)+$stack[0] )}], # inverse hyperbolic sine
-       '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)/$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
-
-       '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
-       'sl'   => [1, sub {$stack[0] *= 2}], # shift left
-       'sr'   => [1, sub {$stack[0] /= 2}], # shift right
-
-       '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{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; $stack[0] = $_ if $_<$stack[0] }], # minimum
-       'max'  => [2, sub {local $_ = shift @stack; $stack[0] = $_ if $_>$stack[0] }], # maximum
-
-       'dec'  => [0, sub {$set{base} = 10}], # decimal
-       'bin'  => [0, sub {$set{base} = 2}], # binary
-       'oct'  => [0, sub {$set{base} = 8}], # octal
-       'hex'  => [0, sub {$set{base} = 16}], # hexadecimal
-       'base' => [1, sub {$set{base} = shift @stack}], # alphanumerical
-
-       '!'    => [1, sub {local $_ = $stack[0]; $stack[0] *= $_ while --$_>1}], # factor
-       'rand' => [0, sub {unshift @stack, rand}], # random value <1
-); # %action
+       "version" => [-1, sub { error("Desktop Calculator Thingy $VERSION by Shiar"); () }], # version
 
-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
+       "sto"   => [1, sub { $var{a} = $_[0] }], # copy
+       '?'     => [1, sub { $var{a} = $_[0] }], # assign
+); # %action
 
 
 sub error($) {
@@ -205,7 +67,7 @@ sub error($) {
        refresh;
 
        ReadKey; # wait for confirm
-       1 while defined (ReadKey -1); # clear key buffer
+       1 while defined ReadKey(-1); # clear key buffer
 } # error
 
 sub showval($$);
@@ -226,6 +88,7 @@ sub showval($$) {
                $int /= $base;
                $exp++;
        } # exponent part
+
        while ($int>=1) {
                my $char = $int%$base;
                $txt = ($char<10 ? $char : chr($char+55)).$txt;
@@ -251,132 +114,156 @@ sub showstack() {
                addstr($set{height}-$_, 1, "$_: ".showval($stack[$_], $set{base}));
                clrtoeol;
        } # show stack
-       clrtoeol($set{height}-$#stack-1, 1);
+       clrtoeol($set{height}-@stack, 1);
 } # showstack
 
-sub showmenu() {
-       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($set{height}+2, $set{width}/$set{menushow}*($nr++), $_);
-               attron(A_REVERSE);
-               addstr($s);
-               attroff(A_REVERSE);
-               addch('>') if $sub;
-       } # display menu txts
-} # showmenu
+
+my @modules;
+eval 'require $_' ? push @modules, $_
+: print STDERR "error loading $_\n".(join "", map "\t$_\n", split /\n/, $@)
+       for glob "*.pm";
+
+initscr;
+ReadMode 3;  # cbreak mode
+END {
+       ReadMode 0;
+       endwin;
+} # restore terminal on quit
+
+$set{height} = $LINES-2 if $LINES>=3;
+$set{width} = $COLS if $COLS;
+$_->() for @{ $hook{init} };
 
 
 DRAW:
 clear;
-showmenu();
+$_->() for @{ $hook{refresh} };
 showstack();
 addstr($set{height}+1, 0, "> ");  # prompt
 
+LOOP:
 while (1) {
        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};
+       for my $cmd (@{ $hook{showentry} }) {
+               addstr($_) if $_ = $cmd->();
+       } # showentry functions
+       addstr($val{alpha}) if exists $val{alpha};
        clrtoeol;
        refresh;
 
-       $_ = ReadKey;
-       if ($_ eq chr 27) {
-               while (defined (my $key = ReadKey -1)) {
-                       $_ .= $key;
-               } # read additional keys
+       my $key = ReadKey;
+       if ($key eq chr 27) {
+               $key .= $_ while defined ($_ = ReadKey(-1));  # read additional keys
        } # escape sequence
+       $_ = $alias{$key} || $key; #if exists $alias{$key};  # command shortkeys
+       $_ = delete $val{alpha} if $_ eq "enter" and exists $val{alpha};  # use manual command
 
-       exists $alias{$_}  and $_ = $alias{$_};  # command shortkeys
-       if (exists $falias{$_}) {
-               unless ($_ = $menu[$falias{$_}]) {
-                       error("* no such menu entry *");
-                       goto DRAW;
-               }
-       } # function key
-
-       $_ = delete $val{bla} if exists $val{bla} and $_ eq 'enter';
+       for my $cmd (@{ $hook{precmd} }) {
+               next LOOP if $cmd->();
+       } # precmd functions
 
-       if ($_ eq 'quit') {
-               last;
-       } # quit
-       elsif ($_ eq 'refresh') {
-               goto DRAW;
-       } # refresh
+       last if $_ eq 'quit';
+       goto DRAW if $_ eq 'refresh';
 
-       elsif (exists $val{bla} or /^[A-Z]$/) {
+       if (exists $val{alpha} or /^\033?[A-Z]$/) {
                if (defined $val{i}) {
                        unshift @stack, $val{i};
-                       %val = (i=>undef, frac=>0);
+                       undef %val;
                        showstack();
                } # enter present value
-               if ($_ eq "drop") {
-                       $val{bla} = substr $val{bla}, 0, -1 or delete $val{bla};
+
+               if ($_ eq "back") {
+                       $val{alpha} = substr $val{alpha}, 0, -1 or delete $val{alpha};
                } # backspace
+               elsif ($_ eq "drop") {
+                       delete $val{alpha};
+               } # drop
                else {
-                       $val{bla} .= lc $_;
+                       $val{alpha} .= $key =~ /^\033(.)/ ? uc $1 : lc $key;
                } # add character
-       } # manual command
+       } # manual command entry
 
        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+$_;
-       }
+               $_ = -$_ if $val{i}<0;  # substract from negative value
+               $val{i} = ($val{frac} and $val{frac} *= 10) ? $val{i}+$_/$val{frac}
+                       : $val{i}*10+$_;
+       } # digit
        elsif ($_ eq '.') {
                $val{i} = 0 unless defined $val{i};
                $val{frac} = 1;
        } # decimal point
-       elsif ($_ eq 'eex') {
+       elsif ($_ eq "eex") {
                $val{i} = 1 unless defined $val{i};
                #todo
        } # exponent
-       elsif ($_ eq 'chs' and defined $val{i}) {
+       elsif ($_ eq "chs" and defined $val{i}) {
                $val{i} = -$val{i};
        } # change sign
-       elsif ($_ eq 'drop' and defined $val{i}) {
+       elsif ($_ eq "back" and defined $val{i}) {
                $val{i} = ($val{frac} = int $val{frac}/10)
                        ? int($val{i}*$val{frac})/$val{frac} : int $val{i}/10
        } # backspace
 
-       elsif (exists $action{$_} or /^\d$/) {
+       elsif (exists $action{$_}) {
                my ($type, $cmd) = @{ $action{$_} };
-               if ($type>0 and defined $val{i}) {
-                       unshift @stack, $val{i};
-                       %val = (i=>undef, frac=>0);
-               } # auto enter
+               unshift @stack, $action{enter}[1]->()
+                       if $type>0 and defined $val{i};  # auto enter
                if ($type>0 and $type>@stack) {
-                       error("* insufficient stack arguments for operation *");
+                       error("insufficient stack arguments for operation");
                        goto DRAW;
                } # insufficient arguments
-               $var{undo} = [@stack] if $type>=0 and $_ ne 'undo';
-               $cmd->();
-               showstack() if $type>=0;
-       } # some operation
 
-       elsif (/>(\d+)$/) {
-               @menu = @{ $menus[$1] };
-               $menumin = 0;
-               showmenu();
-       } # submenu
-
-       elsif ($_ =~ /^_/) {{
-               $_ = $unit{substr $_, 1} or next;
-               if (exists $val{unit} and $val{unit}{type}==$_->{type}) {
-                       unshift @stack, $val{i} if defined $val{i};
-                       $stack[0] *= delete($val{unit})->{val} / $_->{val};
+               if ($type>=0) {
+                       $var{undo} = [@stack]; # if $_ ne 'undo';
+                       unshift @stack, $cmd->(splice @stack, 0, $type);
                        showstack();
-                       %val = (i=>undef, frac=>0);
-               } # convert
+               } # stack-modifying operation
                else {
-                       $val{unit} = $_;
-               } # set source unit
-       }} # conversion
+                       $cmd->();
+               } # harmless
+       } # some operation
 
        else {
-               error("* unrecognised command: ".join(' ', map ord, split //, $_)." *");
+               error("unrecognised command: ".join(' ', map ord, split //, $_));
                goto DRAW; # screen messed up
        } # error
 } # input loop
 
+=cut
+VERSION HISTORY
+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)
+                 - 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
+1.07 09-24 23:50 - numeric modifiers hardcoded instead of in action hash
+                 - 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
+1.09 09-27 00:57 - all key aliases moved to module DCT::Bindings
+     09-29 12:15 - number of menu items depends on screen width
+     10-11 21:30 - hooks allowing for extra code at reload, showentry, and precmd
+           21:50 - all menu related functions moved to menu.pm
+           22:05 - unit conversion out of main program (entirely into unitconv.pm)
+     10-12 01:50 - backspace becomes "back" (soft drop, like old "drop")
+                 - normal drop command (alt+bs) removes input/stack value at once
+           02:13 - $val{frac} default undefined instead of 0
+=cut
diff --git a/math.pm b/math.pm
new file mode 100644 (file)
index 0000000..b83ce16
--- /dev/null
+++ b/math.pm
@@ -0,0 +1,86 @@
+# menu for DCT, by Shiar
+
+# 1.09.1 2004-10-02 22:55 - moved from 1.9 main
+# 1.09.2 2004-10-11 20:50 - functions don't handle stack themselves,
+#                           but behave like real functions
+
+use strict;
+use warnings;
+use utf8;
+
+my %newaction = (
+       '+'    => [2, sub { $_[1] + $_[0] }], # addition
+       '-'    => [2, sub { $_[1] - $_[0] }], # substraction
+       '*'    => [2, sub { $_[1] * $_[0] }], # multiplication
+       '/'    => [2, sub { $_[1] / $_[0] }], # division
+       'mod'  => [2, sub { $_[1] % $_[0] }], # modulo
+
+       'inv'  => [1, sub { 1 / $_[0] }], # 1/x
+       'sqrt' => [1, sub { sqrt $_[0] }], # square root
+       'sq'   => [1, sub { $_[0] * $_[0] }], # squared
+       '^'    => [2, sub { $_[1] ** $_[0] }], # exponentiation
+       'xroot'=> [2, sub { $_[1] ** (1/$_[0]) }], # x-root of y
+
+       'log'  => [1, sub { log($_[0]) / log(10) }], # logarithm
+       'alog' => [1, sub { 10 ** $_[0] }], # 10^x
+       'ln'   => [1, sub { log $_[0] }], # natural logaritm
+       'lnp1' => [1, sub { log($_[0] + 1) }], # ln(x+1)
+       'exp'  => [1, sub { exp $_[0] }], # e^x
+       'expm' => [1, sub { exp($_[0]) - 1 }], # exp(x)-1
+
+       'sin'  => [1, sub { sin $_[0] }], # sine
+       'asin' => [1, sub { atan2($_[0], sqrt(1 - $_[0]*$_[0])) }], # inverse sine
+       'cos'  => [1, sub { cos $_[0] }], # cosine
+       'acos' => [1, sub { atan2(sqrt(1 - $_[0]*$_[0]), $_[0]) }], # inverse cosine
+       'tan'  => [1, sub { sin($_[0]) / cos($_[0]) }], # tangent
+#      'atan' => [1, sub { }], # arctangent
+
+       'sinh' => [1, sub { (exp($_[0]) - exp(-$_[0])) / 2 }], # hyperbolic sine
+       'cosh' => [1, sub { (exp($_[0]) + exp(-$_[0])) / 2 }], # hyperbolic cosine
+       'tanh' => [1, sub { (exp($_[0]) - exp(-$_[0])) / (exp($_[0]) + exp(-$_[0])) }], # hyperbolic tangent (sinh/cosh)
+       'asinh'=> [1, sub { log(sqrt($_[0]**2+1) + $_[0]) }], # inverse hyperbolic sine
+       'acosh'=> [1, sub { log(sqrt($_[0]**2-1) + $_[0]) }], # inverse hyperbolic cosine
+       'atanh'=> [1, sub { log((1+$_[0]) / (1-$_[0])) / 2 }], # inverse hyperbolic tangent
+
+       '%'    => [2, sub { $_[0] / $_[1] }], # percentage
+#      '%ch'  => [2, sub { $val{i} = 100*(shift(@_)-$val{i})/$val{i} }], # percentage change
+#      '%t'   => [2, sub { $val{i} = 100*$val{i}/shift(@_) }], # percentage total
+
+       'and'  => [2, sub { $_[1] & $_[0] }], # bitwise and
+       'or'   => [2, sub { $_[1] | $_[0] }], # bitwise or
+       'xor'  => [2, sub { $_[1] ^ $_[0] }], # bitwise xor
+       'not'  => [2, sub { ~$_[0] }], # bitwise not
+       'sl'   => [1, sub { $_[0] * 2 }], # shift left
+       'sr'   => [1, sub { $_[0] / 2 }], # shift right
+
+       'abs'  => [1, sub { abs $_[0] }], # absolute #todo
+       'sign' => [1, sub { $_[0] <=> 0 }], # sign
+       'ip'   => [1, sub { int $_[0] }], # integer part
+       'fp'   => [1, sub { $_[0] - int $_[0] }], # fractional part
+
+#      'rnd'  => [1, sub { local $_ = 10**$_[0]; $val{i} = int(($val{i}+.5)*$_)/$_ }], # round
+#      'trnc' => [1, sub { local $_ = 10**$_[0]; $val{i} = int($val{i}*$_)/$_ }], # truncate
+       'floor'=> [1, sub { int $_[0] }], # floor
+       'ceil' => [1, sub { int $_[0]+.9999 }], # ceil
+
+       'min'  => [2, sub { $_[1]<$_[0] ? $_[1] : $_[0] }], # minimum
+       'max'  => [2, sub { $_[1]>$_[0] ? $_[1] : $_[0] }], # maximum
+
+       'dec'  => [-1, sub { $::set{base} = 10; () }], # decimal
+       'bin'  => [-1, sub { $::set{base} = 2; () }], # binary
+       'oct'  => [-1, sub { $::set{base} = 8; () }], # octal
+       'hex'  => [-1, sub { $::set{base} = 16; () }], # hexadecimal
+       'base' => [1, sub { $::set{base} = $_[0]; () }], # alphanumerical
+
+       '!'    => [1, sub { my $res = $_[0]; $res *= $_ for 2..$res-1; $res }], # factor
+       'rand' => [0, sub { rand }], # random value <1
+); # newaction
+
+#while (my ($cmd, $val) = each %newaction) {
+#      $action{$cmd} = $val;
+#}
+
+$action{$_} = $newaction{$_} for keys %newaction;
+
+1;
+
diff --git a/math.pm.old b/math.pm.old
new file mode 100644 (file)
index 0000000..e71c5d0
--- /dev/null
@@ -0,0 +1,83 @@
+# menu for DCT, by Shiar
+
+# 2004-10-02 22:55 - moved from 1.9 main
+
+use strict;
+use utf8;
+
+my %newaction = (
+       '+'    => [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
+
+       'inv'  => [1, sub {$stack[0] = 1 / $stack[0]}], # 1/x
+       '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
+
+       'sinh' => [1, sub {$stack[0] = ( exp($stack[0]) - exp(-$stack[0]) )/2}], # hyperbolic sine
+       'cosh' => [1, sub {$stack[0] = ( exp($stack[0]) + exp(-$stack[0]) )/2}], # hyperbolic cosine
+       'tanh' => [1, sub {$stack[0] = ( exp($stack[0]) - exp(-$stack[0]) )/( exp($stack[0]) + exp(-$stack[0]) )}], # hyperbolic tangent (sinh/cosh)
+       'asinh'=> [1, sub {$stack[0] = log( sqrt($stack[0]**2+1)+$stack[0] )}], # inverse hyperbolic sine
+       '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)/$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
+
+       '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
+       'sl'   => [1, sub {$stack[0] *= 2}], # shift left
+       'sr'   => [1, sub {$stack[0] /= 2}], # shift right
+
+       '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{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; $stack[0] = $_ if $_<$stack[0] }], # minimum
+       'max'  => [2, sub {local $_ = shift @stack; $stack[0] = $_ if $_>$stack[0] }], # maximum
+
+       'dec'  => [0, sub {$set{base} = 10}], # decimal
+       'bin'  => [0, sub {$set{base} = 2}], # binary
+       'oct'  => [0, sub {$set{base} = 8}], # octal
+       'hex'  => [0, sub {$set{base} = 16}], # hexadecimal
+       'base' => [1, sub {$set{base} = shift @stack}], # alphanumerical
+
+       '!'    => [1, sub {local $_ = $stack[0]; $stack[0] *= $_ while --$_>1}], # factor
+       'rand' => [0, sub {unshift @stack, rand}], # random value <1
+); # newaction
+
+#while (my ($cmd, $val) = each %newaction) {
+#      $action{$cmd} = $val;
+#}
+#%action = %newaction;
+$action{$_} = $newaction{$_} for keys %newaction;
+
+1;
+
diff --git a/menu.pm b/menu.pm
new file mode 100644 (file)
index 0000000..2733db8
--- /dev/null
+++ b/menu.pm
@@ -0,0 +1,174 @@
+# menu for DCT, by Shiar
+
+# 1.006.1 2004-09-15 23:32 - moved @menus from 1.6 main
+# 1.009.1 2004-10-11 21:50 - everything related to menus moved here
+
+use strict;
+use warnings;
+use utf8;
+
+#my %falias = ("\033"=>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 @menus = ([qw(refresh quit)]);
+my @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
+
+#my @menu = [];
+my $menumin = 0;
+
+my @menu = @{$menus[0]};
+
+push @{ $hook{init} }, sub {
+       $set{height}--;  # make space for menubar
+       $set{menushow} = int($set{width}/(4+$set{width}/20))+1  # menu items to show simultaneously
+               unless defined $set{menushow};
+}; # init
+
+sub showmenu() {
+       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($set{height}+2, $set{width}/$set{menushow}*($nr++), $_);
+               attron(A_REVERSE);
+               addstr($s);
+               attroff(A_REVERSE);
+               addch('>') if $sub;
+       } # display menu txts
+} # showmenu
+
+$action{more} = [-1, sub {
+       $menumin += $set{menushow};
+       $menumin = 0 if $menumin>=$#menu;
+       showmenu();
+}]; # tab
+
+push @{ $hook{refresh} }, sub {
+       showmenu();
+}; # refresh
+
+unshift @{ $hook{precmd} }, sub {
+       return unless exists $falias{$_};  # not a function key
+       return if $_ = $menu[$falias{$_}];  # execute found menu item instead
+       error("* no such menu entry *");
+       goto DRAW;
+}; # precmd
+
+push @{ $hook{precmd} }, sub {
+       return unless />(\d+)$/;
+       @menu = @{ $menus[$1] };  # go to submenu
+       $menumin = 0;  # reset to first item
+       showmenu();  # redraw
+       return 1;
+}; # precmd
+
+1;
+
diff --git a/unitconv.pm b/unitconv.pm
new file mode 100644 (file)
index 0000000..494aaa1
--- /dev/null
@@ -0,0 +1,62 @@
+# unit convertor for DCT, by Shiar
+
+# 1.09.1 2004-10-02 23:05 - moved %unit specs from 1.9 main
+# 1.09.2 2004-10-11 22:05 - all code moved here as well
+
+use strict;
+use utf8;
+
+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
+
+$action{_m} = [0, sub {print "test\n"}];
+
+push @{ $hook{precmd} }, sub {
+       if ($_ =~ /^_/) {{
+               $_ = $unit{substr $_, 1} or next;
+               if (exists $val{unit} and $val{unit}{type}==$_->{type}) {
+                       unshift @stack, $val{i} if defined $val{i};
+                       $stack[0] *= delete($val{unit})->{val} / $_->{val};
+                       showstack();
+                       %val = (i=>undef, frac=>0);
+               } # convert
+               else {
+                       $val{unit} = $_;
+               } # set source unit
+               return 1;
+       }} # conversion
+}; # precmd
+
+push @{ $hook{showentry} }, sub {
+       exists $val{unit} && '_'.$val{unit}{name};
+}; # showentry
+
+1;
+