menu.pm

   1 # menu for DCT, by Shiar
   2
   3 # 1.006.1 2004-09-15 23:32 - moved @menus from 1.6 main
   4 # 1.009.1 2004-10-11 21:50 - everything related to menus moved here
   5
   6 use strict;
   7 use warnings;
   8 use utf8;
   9
  10 #my %falias = ("\033"=>0);
  11 my %falias = (
  12         "\033"                         =>  0, # esc
  13         "\033\117\120"                 =>  1, # f1
  14         "\033\133\061\061\176"         =>  1, # f1
  15         "\033\133\061\062\176"         =>  2, # f2
  16         "\033\133\061\063\176"         =>  3, # f3
  17         "\033\133\061\064\176"         =>  4, # f4
  18         "\033\117\121"                 =>  2, # f2
  19         "\033\117\122"                 =>  3, # f3
  20         "\033\117\123"                 =>  4, # f4
  21         "\033\133\061\065\176"         =>  5, # f5
  22         "\033\133\061\067\176"         =>  6, # f6
  23         "\033\133\061\070\176"         =>  7, # f7
  24         "\033\133\061\071\176"         =>  8, # f8
  25         "\033\133\062\060\176"         =>  9, # f9
  26         "\033\133\062\061\176"         => 10, # f10
  27         "\033\133\062\063\176"         => 11, # f11/F1
  28         "\033\133\062\064\176"         => 12, # f12/F2
  29         "\033\133\062\065\176"         => 13, # F3
  30         "\033\133\062\066\176"         => 14, # F4
  31         "\033\133\062\070\176"         => 15, # F5
  32         "\033\133\062\071\176"         => 16, # F6
  33         "\033\133\063\061\176"         => 17, # F7
  34         "\033\133\063\062\176"         => 18, # F8
  35         "\033\133\063\063\176"         => 19, # F9
  36         "\033\133\063\064\176"         => 20, # F10
  37         "\033\133\062\063\073\062\176" => 21, # F11
  38         "\033\133\062\064\073\062\176" => 22, # F12
  39 ); # %falias
  40
  41 #my @menus = ([qw(refresh quit)]);
  42 my @menus = (
  43         [qw(refresh math>8 prog> mode>7 unit>11)],
  44         [qw(main>0 log alog ln exp sin cos tan 0 asin acos atan)], #1 math
  45         [qw(main>0 dec bin oct hex logic>3 bit>4)], #2 base
  46         [qw(base>2 and or xor not)], #3 base logic
  47         [qw(base>2 rl sl asr sr rr)], #4 base bit
  48         [qw(base>2 rlb slb srb rrb)], #5 base byte
  49         [qw(main>0 sq sqrt ^ xroot)], #6
  50         [qw(main>0 number_format angle_measure coord_system)], #7 mode
  51         [qw(main>0
  52                 vector> matrix> list> hyperbolic>9 real>10 base>2
  53                 probability> fft> complex> constants>
  54         )], #8 math
  55         [qw(math>8
  56                 sinh cosh tanh asinh acosh atanh
  57                 expm lnp1
  58         )], #9 math hyperbolic
  59         [qw(math>8
  60                 % %ch %t min max mod
  61                 abs sign mant xpon ip fp
  62                 rnd trnc floor ceil r>d d>r
  63         )], #10 math real
  64         [qw(main>0
  65                 tools> length>12 area>13 volume>14 time>15 speed>16
  66                 mass>17 force>18 energy>19 power>20 pressure>21 temperature>22
  67                 electric_current>23 angle>24 light>25 radiation>26 viscosity>27
  68         )], #11 units
  69 #               mm cm m in ft yd km mile mmile lt-yr mil Ang fermi rod fath)],
  70         [qw(unit>11
  71                 _m _cm _mm _yd _ft _in _Mpc _pc _lyr _au _km _mi
  72                 _nmi _miUS _chain _rd _fath _ftUS _Mil _μ _Å _fermi
  73         )], #12 length
  74         [qw(unit>11
  75                 _m^2 _cm^2 _b _yd^2 _ft^2 _in^2
  76                 _km^2 _ha _a _mi^2 _miUS^2 _acre
  77         )], #13 area
  78         [qw(unit>11
  79                 _m^3 _st _cm^3 _yd^3 _ft^3 _in^3
  80                 _l _galUK _galC _gal _qt _pt
  81                 _ml _cu _ozfl _ozUK _tbsp _tsp
  82                 _bbl _bu _pk _fbm
  83         )], #14 volume
  84         [qw(unit>11
  85                 _yr _d _h _min _s _Hz
  86         )], #15 time
  87         [qw(unit>11
  88                 _m/s _cm/s _ft/s _kph _mph _knot
  89                 _c _ga
  90         )], #16 speed
  91         [qw(unit>11
  92                 _kg _g _Lb _oz _slug _lbt
  93                 _ton _tonUS _t _ozt _ct _grain
  94                 _u _mol
  95         )], #17 mass
  96         [qw(unit>11
  97                 _N _dyn _gf _kip _lbf _pdl
  98         )], #18 force
  99         [qw(unit>11
 100                 _J _erg _Kcal _Cal _Btu _ftxlbf
 101                 _therm _MeV _eV
 102         )], #19 energy
 103         [qw(unit>11
 104                 _W _hp
 105         )], #20 power
 106         [qw(unit>11
 107                 _Pa _atm _bar _psi _torr _mmHg
 108                 _inHg _inH2O
 109         )], #21 pressure
 110         [qw(unit>11
 111         )], #22 temperature
 112         [qw(unit>11
 113         )], #23 electric_current
 114         [qw(unit>11
 115         )], #24 angle
 116         [qw(unit>11
 117         )], #25 light
 118         [qw(unit>11
 119         )], #26 radiation
 120         [qw(unit>11
 121         )], #27 viscosity
 122 ); # @menus
 123
 124 #my @menu = [];
 125 my $menumin = 0;
 126
 127 my @menu = @{$menus[0]};
 128
 129 push @{ $hook{init} }, sub {
 130         $set{height}--;  # make space for menubar
 131         $set{menushow} = int($set{width}/(4+$set{width}/20))+1  # menu items to show simultaneously
 132                 unless defined $set{menushow};
 133 }; # init
 134
 135 sub showmenu() {
 136         clrtoeol($set{height}+2, 1);
 137         my $nr = 0;
 138         for (grep exists $menu[$_], $menumin+1..$menumin+$set{menushow}) {
 139                 my $sub = (my $s = $menu[$_]) =~ s/>\d+$//;
 140                 addstr($set{height}+2, $set{width}/$set{menushow}*($nr++), $_);
 141                 attron(A_REVERSE);
 142                 addstr($s);
 143                 attroff(A_REVERSE);
 144                 addch('>') if $sub;
 145         } # display menu txts
 146 } # showmenu
 147
 148 $action{more} = [-1, sub {
 149         $menumin += $set{menushow};
 150         $menumin = 0 if $menumin>=$#menu;
 151         showmenu();
 152 }]; # tab
 153
 154 push @{ $hook{refresh} }, sub {
 155         showmenu();
 156 }; # refresh
 157
 158 unshift @{ $hook{precmd} }, sub {
 159         return unless exists $falias{$_};  # not a function key
 160         return if $_ = $menu[$falias{$_}];  # execute found menu item instead
 161         error("* no such menu entry *");
 162         goto DRAW;
 163 }; # precmd
 164
 165 push @{ $hook{precmd} }, sub {
 166         return unless />(\d+)$/;
 167         @menu = @{ $menus[$1] };  # go to submenu
 168         $menumin = 0;  # reset to first item
 169         showmenu();  # redraw
 170         return 1;
 171 }; # precmd
 172
 173 1;
 174