release 1.09.6
[descalc.git] / menu.pm
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;
+