From 7d9af85556b0e64c70e3641764b7b49a306723f3 Mon Sep 17 00:00:00 2001 From: Shiar Date: Fri, 15 Oct 2004 00:58:33 +0200 Subject: [PATCH] release 1.10.6 - fixed backspace with undef fraction - altered stack not redrawn after undo - digits added/removed to/from integer part in correct number base - allow modules to not load but without error - display welcome at startup, also showing version and modules - preaction hook; undo functionality moved to module - only first module run of multiple with the same name - invalid commands shown as strings instead of character codes --- 05_curses.pm | 56 ++++++++ 08_stdout.pm | 44 +++++++ bindings.pm => 12_bindings.pm | 25 ++-- 15_menu.pm | 126 ++++++++++++++++++ 28_undo.pm | 22 ++++ math.pm => 31_math.pm | 70 ++++++++-- 35_unitconv.pm | 209 +++++++++++++++++++++++++++++ dct.pl | 241 +++++++++++++++++----------------- math.pm.old | 83 ------------ menu.pm | 174 ------------------------ unitconv.pm | 62 --------- 11 files changed, 651 insertions(+), 461 deletions(-) create mode 100644 05_curses.pm create mode 100644 08_stdout.pm rename bindings.pm => 12_bindings.pm (73%) create mode 100644 15_menu.pm create mode 100644 28_undo.pm rename math.pm => 31_math.pm (66%) create mode 100644 35_unitconv.pm delete mode 100644 math.pm.old delete mode 100644 menu.pm delete mode 100644 unitconv.pm diff --git a/05_curses.pm b/05_curses.pm new file mode 100644 index 0000000..73e0d01 --- /dev/null +++ b/05_curses.pm @@ -0,0 +1,56 @@ +# ncurses output for DCT, by Shiar + +# 1.10.1 200410140120 - all output functions seperated from main + +use strict; +use warnings; + +use Curses; + +return 0 if $set{display}; +$set{display} = "curses"; + +push @{$hook{init}}, sub { + initscr; + END { endwin; } # restore terminal on quit + + $set{height} = $LINES-2 if $LINES>=3; + $set{width} = $COLS if $COLS; +}; # init + +push @{$hook{showerror}}, sub { + attron(A_REVERSE); + addstr(0, 0, shift); + attroff(A_REVERSE); + clrtoeol; + refresh; + + ReadKey; # wait for confirm + 1 while defined ReadKey(-1); # clear key buffer +}; # showerror + +push @{$hook{showstack}}, sub { + for (0..@stack-1) { + addstr($set{height}-$_, 1, "$_: ".showval($stack[$_], $set{base})); + clrtoeol; + } # show stack + clrtoeol($set{height}-@stack, 1); +}; # showstack + +push @{$hook{refresh}}, sub { + clear; + addstr($set{height}+1, 0, "> "); # prompt +}; # refresh + +push @{$hook{showentry}}, sub { + addstr($set{height}+1, 2, $_[0]); + clrtoeol; + refresh; +}; # showentry + +return { + author => "Shiar", + title => "curses output", + version => "1.10.1", +}; + diff --git a/08_stdout.pm b/08_stdout.pm new file mode 100644 index 0000000..ededf36 --- /dev/null +++ b/08_stdout.pm @@ -0,0 +1,44 @@ +# console output for DCT, by Shiar + +# 1.10.1 200410140120 - print everything to STDOUT +# .2 - use escape sequences for clear/reposition/invert +# .3 - try to get width/height from environment vars +# .4 - never clear screen (just let it scroll) +# .5 200410142200 - startup message omitted (now shown by main) + +use strict; +use warnings; + +return 0 if $set{display}; +$set{display} = "stdout"; + +push @{$hook{init}}, sub { +# print "\ec"; # reset (clear screen, go home) +# print "\e[4mDCT $::VERSION\e[24m "; # print intro (underlined) + END { print "\n"; } + + $set{height} = $ENV{LINES}-2 if $ENV{LINES} and $ENV{LINES}>=3; + $set{width} = $ENV{COLUMNS} if $ENV{COLUMNS}; +}; # init + +push @{$hook{showerror}}, sub { + print "\n\a\e[7m$_[0]\e[27m"; # bell and reverse video +}; # showerror + +push @{$hook{showstack}}, sub { + for (reverse 0..@stack-1) { + print "\n$_: ", showval($stack[$_], $set{base}); + } # show stack + print "\n> "; # prompt +}; # showstack + +push @{$hook{showentry}}, sub { + print "\e[3G\e[K", $_[0]; # cursor to column #3; erase line +}; # showentry + +return { + author => "Shiar", + title => "console output", + version => "1.10.4", +}; + diff --git a/bindings.pm b/12_bindings.pm similarity index 73% rename from bindings.pm rename to 12_bindings.pm index 374a57d..9ea8a4f 100644 --- a/bindings.pm +++ b/12_bindings.pm @@ -1,13 +1,13 @@ # 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 +# 1.08.1 200409270040 - moved from 1.8 main +# .2 200409270049 - single key alias to chs: \ (often close to _) +# 1.09.1 200410112145 - function keys moved to menu.pm +# .2 200410120145 - alt+backspace and ^W for (hard) drop +# .3 200410142200 - enter sent as chr 10 on non-curses terminals use strict; use warnings; -use utf8; %alias = ( chr 4 => "quit", # ^D @@ -25,7 +25,8 @@ use utf8; "\033\010" => "drop", # alt+backspace "\033\177" => "drop", # alt+backspace "\027" => "drop", # ^W - chr 13 => "enter", # enter + chr 10 => "enter", # enter (terminal) + chr 13 => "enter", # enter (curses) ' ' => "enter", # space '=' => "sto", # @@ -43,8 +44,8 @@ use utf8; "s" => "sin", "\033s" => "asin", - "c" => "cos", #todo: u? o? - "\033c" => "acos", + "o" => "cos", # or u? + "\033o" => "acos", "t" => "tan", "\033t" => "atan", "l" => "log", @@ -55,9 +56,13 @@ use utf8; "\033q" => "sqrt", "x" => "^", "\033x" => "xroot", - "\033^" => "xroot", + "\033^" => "xroot", # for consistency "v" => "inv", ); # %alias -1; +return { + author => "Shiar", + title => "default key bindings", + version => "1.9.3", +}; diff --git a/15_menu.pm b/15_menu.pm new file mode 100644 index 0000000..c75f442 --- /dev/null +++ b/15_menu.pm @@ -0,0 +1,126 @@ +# menu for DCT, by Shiar + +# 1.06.1 200409152332 - moved @menus from 1.6 main +# 1.09.1 200410112150 - everything related to menus moved here +# 1.10.1 200410122210 - @menus global; unit+math items added in those modules +# .2 200410122345 - addmenu() function to add submenus +# .3 200410150030 - don't show undefined menu entries (skippable) +# .4 200410150030 - add quit at F10 in main menu (after running other modules) + +use strict; +use warnings; + +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 + "\033\061" => 1, # alt+1 + "\033\062" => 2, # alt+2 + "\033\063" => 3, # alt+3 + "\033\064" => 4, # alt+4 + "\033\065" => 5, # alt+5 + "\033\066" => 6, # alt+6 + "\033\067" => 7, # alt+7 + "\033\070" => 8, # alt+8 + "\033\071" => 9, # alt+9 + "\033\060" => 10, # alt+0 +); # %falias + +#our @menus = ([qw(refresh quit)]); +our @menus = ( + [qw(refresh prog> mode>1)], # main + [qw(main>0 number_format angle_measure coord_system)], #1 mode +); # @menus + +sub addmenu { + my $parent = shift; + push @menus, ["$parent->[0]>$parent->[1]"]; # create new menu + my $menuthis = $#menus; + push @{$menus[$parent->[1]]}, shift(@_).">$menuthis"; # link from parent + ref $_ ? addmenu([$_->[0], $menuthis], @$_) # add subsubmenu + : push @{$menus[$menuthis]}, $_ for @_; # add menu items + return $menuthis; +} # addmenu + +#my @menu = []; +my @menu; +my $menumin = 0; + +push @{$hook{init}}, sub { + $menus[0][10] = "quit"; + @menu = @{$menus[0]}; + $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 = -1; + for (grep exists $menu[$_], $menumin+1..$menumin+$set{menushow}) { + $nr++; + next unless defined $menu[$_]; + 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; # indicate submenu + } # 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 + +return { + author => "Shiar", + title => "menu", + version => "1.10.4", +}; + diff --git a/28_undo.pm b/28_undo.pm new file mode 100644 index 0000000..8a80fc7 --- /dev/null +++ b/28_undo.pm @@ -0,0 +1,22 @@ +# key bindings for DCT, by Shiar + +# 1.10.1 200410150000 - single-level undo from main +# .2 200410150045 - set initial value to prevent crash when no undos set + +use strict; +use warnings; + +my $undo = []; + +push @{$hook{preaction}}, sub { + $undo = [@stack] if $_[0]>=0; # type>=0 for stack-modifying operations +}; # preaction + +$action{undo} = [-1, sub { ($undo, @stack) = ([@stack], @$undo) }]; # undo/redo + +return { + author => "Shiar", + title => "simple undo", + version => "1.10.2", +}; + diff --git a/math.pm b/31_math.pm similarity index 66% rename from math.pm rename to 31_math.pm index b83ce16..dd4d7d8 100644 --- a/math.pm +++ b/31_math.pm @@ -1,8 +1,10 @@ -# menu for DCT, by Shiar +# math 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 +# 1.09.1 200410022255 - moved from 1.9 main +# 1.09.2 200410112050 - functions don't handle stack themselves, +# but behave like real functions +# 1.10.1 200410112340 - adds menu items via addmenu() call +# .2 200410132050 - probability functions: comb, perm, rdz use strict; use warnings; @@ -21,6 +23,7 @@ my %newaction = ( '^' => [2, sub { $_[1] ** $_[0] }], # exponentiation 'xroot'=> [2, sub { $_[1] ** (1/$_[0]) }], # x-root of y + # logarithmic 'log' => [1, sub { log($_[0]) / log(10) }], # logarithm 'alog' => [1, sub { 10 ** $_[0] }], # 10^x 'ln' => [1, sub { log $_[0] }], # natural logaritm @@ -28,6 +31,7 @@ my %newaction = ( 'exp' => [1, sub { exp $_[0] }], # e^x 'expm' => [1, sub { exp($_[0]) - 1 }], # exp(x)-1 + # hyperbolic 'sin' => [1, sub { sin $_[0] }], # sine 'asin' => [1, sub { atan2($_[0], sqrt(1 - $_[0]*$_[0])) }], # inverse sine 'cos' => [1, sub { cos $_[0] }], # cosine @@ -42,10 +46,7 @@ my %newaction = ( '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 - + # binary 'and' => [2, sub { $_[1] & $_[0] }], # bitwise and 'or' => [2, sub { $_[1] | $_[0] }], # bitwise or 'xor' => [2, sub { $_[1] ^ $_[0] }], # bitwise xor @@ -53,6 +54,11 @@ my %newaction = ( 'sl' => [1, sub { $_[0] * 2 }], # shift left 'sr' => [1, sub { $_[0] / 2 }], # shift right + # unclassified + '%' => [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 + 'abs' => [1, sub { abs $_[0] }], # absolute #todo 'sign' => [1, sub { $_[0] <=> 0 }], # sign 'ip' => [1, sub { int $_[0] }], # integer part @@ -66,21 +72,59 @@ my %newaction = ( 'min' => [2, sub { $_[1]<$_[0] ? $_[1] : $_[0] }], # minimum 'max' => [2, sub { $_[1]>$_[0] ? $_[1] : $_[0] }], # maximum + # number base '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 + # probability + 'comb' => [2, sub { + my $res = 1; + $res *= $_ for $_[1]-$_[0]+1..$_[1]; # (n-r+1)..(n-2)(n-1)n + $res /= $_ for 2..$_[0]; # / r! + $res; # n!/(r!(n-r)!) + }], # combinations + 'perm' => [2, sub { + my $res = 1; + $res *= $_ for $_[1]-$_[0]+1..$_[1]; # (n-r+1)..(n-2)(n-1)n + $res; # n!/(n-r)! + }], # permutations '!' => [1, sub { my $res = $_[0]; $res *= $_ for 2..$res-1; $res }], # factor 'rand' => [0, sub { rand }], # random value <1 + 'rdz' => [1, sub { srand $_[0]; () }], # seed randomizer +# 'ndist'=> [3], # normal distribution +# 'utpn' => [3], # normal distribution +# 'utpt' => [1], # student-t distribution +# 'utpc' => [2], # chi-square (χ²) distribution +# 'utpf' => [3], # F distribution ); # newaction -#while (my ($cmd, $val) = each %newaction) { -# $action{$cmd} = $val; -#} - +#while (my ($cmd, $val) = each %newaction) {$action{$cmd} = $val} $action{$_} = $newaction{$_} for keys %newaction; -1; +addmenu(["main", 0], "math", + [qw(basic log alog ln exp sin cos tan asin acos atan sq sqrt ^ xroot)], +# [qw(vector)], +# [qw(matrix)], +# [qw(list)], + [qw(hyperbolic sinh cosh tanh asinh acosh atanh expm lnp1)], + [qw(real % %ch %t min max mod abs sign mant xpon ip fp rnd trnc floor ceil r>d d>r)], + [qw(base dec bin oct hex), + [qw(logic and or xor not)], + [qw(bit rl sl asr sr rr)], +# [qw(byte rlb slb srb rrb)], + ], # base + [qw(probability comb perm ! rand rdz)], # utpc utpf utpn utpt ndist)], +# [qw(fft)], +# [qw(complex)], +# [qw(constants)], +) if defined &addmenu; # addmenu + +return { + author => "Shiar", + title => "basic math", + version => "1.10.2", +}; diff --git a/35_unitconv.pm b/35_unitconv.pm new file mode 100644 index 0000000..1374ccf --- /dev/null +++ b/35_unitconv.pm @@ -0,0 +1,209 @@ +# unit convertor for DCT, by Shiar + +# 1.09.1 200410022305 - moved %unit specs from 1.9 main +# 1.09.2 200410112205 - all code moved here as well +# 1.10.1 200410122030 - hp49 units for area, volume, time, speed, force, energy, power +# .2 2200 - adds submenus with all units +# .3 10130000 - fix error when run without menu module +# .4 10132300 - hp49 units for mass + +use strict; +use warnings; +use utf8; + +my $menugroup = addmenu(["main", 0], "unit") if defined &addmenu; + +my %unit; # unit table (build below) +my $i = 0; # unit group counter (temporary) +do { + $i++; # next group + my $title = shift @$_; # first element is group title, no unit + addmenu(["unit", $menugroup], $title, map "_$_->[0]", @$_) if defined &addmenu; + $unit{$_->[0]} = { + type=>$i, name=>$_->[0], val=>$_->[1], desc=>$_->[2], diff=>$_->[3] + } for @$_; +} for ( + [ + "length", + ['m', 1, "metre"], + ['cm', .01, "centimeter"], + ['mm', .001, "millimeter"], + ['yd', .0254*36, "yard"], + ['ft', .0254*12, "feet"], + ['in', .0254, "inch"], + ['Mpc', 3.085_677_581_3*10**22, "Mega parsec"], + ['pc', 3.085_677_581_3*10**16, "parsec"], # 180*60*60/pi au + ['lyr', 299_792_458*86_400*365.25, "light-year"], # c0*(seconds/year) - 9.46052840488e+15 + ['au', 149_597_870.691*30, "astronomical unit"], + ['km', 1000, "kilometer"], + ['mi', .0254*12*5280, "international mile"], + ['nmi', 1852, "nautical mile"], + ['miUS', 1200/3937*5280, "US statute mile"], + ['chain', .0254*12*66, "Gunter's chain"], + ['rd', .0254*198, "rod/pole/perch"], + ['fath', .0254*72, "fathom"], + ['ftUS', 1200/3937, "survey foot"], + ['Mil', 2.54e-5, "Mil/thou"], + ['μ', 1e-6, "micron"], # μm + ['Å', 1e-10, "ångström"], # .1nm + ['fermi', 1e-15, "fermi"], # 1fm +# ['a0', .291_772_083*10**-11*19e-20, "atomic unit of length"], +# ['ell', .0254*45, "ell"], +# ['rope', .0254*12*20, "rope"], +# TI86 order: mm cm m in ft yd km mile mmile lt-yr mil Ang fermi rod fath + ], # lengths + [ + "area", + ['m²', 1, "square metre"], + ['cm²', .01**2, "square centimetre"], + ['b', 1e-28, "barn"], + ['yd²', (.0254*36)**2, "square yard"], + ['ft²', (.0254*12)**2, "square feet"], + ['in²', (.0254)**2, "square inch"], + ['km²', 1_000_000, "square kilometre"], + ['ha', 10_000, "hectare"], + ['a', 100, "are"], + ['mi²', (.0254*12*5280)**2, "square mile"], + ['miUS²', (1200/3937*5280)**2, "square statute mile"], + ['acre', (.0254*12*66)**2*10, "acre"], +# ['chain²', (.0254*12*66)**2, "square Gunter's chain"], +# ['ba', .0254**2*12, "board"], + ], # area + [ + "volume", #todo + ['m³', 1, "cubic metre"], +# ['st', 0, "stere"], + ['cm³', 1e-6, "cubic centimetre"], + ['yd³', (.0254*36)**3, "cubic yard"], + ['ft³', (.0254*12)**3, "cubic feet"], + ['in³', (.0254)**3, "cubic inch"], + ['l', 100, "litre"], + ['galUK', .045_460_9, "Imperial gallon"], + ['galC', 0, "Canadian gallon"], + ['gal', 0, "US gallon"], + ['qt', 0, "quart"], + ['pt', 0, "pint"], + ['ml', 100e6, "mililitre"], + ['cu', 0, "US cup"], + ['ozfl', 0, "US fluid ounce"], + ['ozUK', 0, "UK fluid ounce"], + ['tbsp', 0, "tablespoon"], + ['tsp', 0, "teaspoon"], + ['bbl', 0, "barrel"], + ['bu', 0, "bushel"], + ['pk', 0, "peck"], + ['fbm', 0, "board foot"], + ], # volume + [ + "time", + ['yr', 365.2425*86_400, "year (Gregorian)"], + ['d', 86_400, "day"], + ['h', 3_600, "hour"], + ['min', 60, "minute"], + ['s', 1, "second"], +# ['Hz', 1, "hertz"], + ['week', 604_800, "week"], # new +# ['au', 2.418_884_254e-17, "atomic unit of time"], # a[0]/(α*c) + ], # time + [ + "speed", + ['m/s', 1, "meter per second"], + ['cm/s', 100, "centimeter per second"], + ['ft/s', 8.466_667e-5, "feet per second"], + ['kph', 2.777_778e-1, "kilometer per hour"], + ['mph', .447_04, "mile per hour"], +# ['mph', .447_041, "statute mile per hour"], + ['knot', .514_444, "nautical miles per hour"], + ['c', 2.997_924_58e8, "speed of light in vacuum"], +# ['ga', 0, "acceleration of gravity"], + ], # speed + [ + "mass", + ['kg', 1, "kilogram"], + ['g', 1e-3, "gram"], + ['Lb', .453_592_37, "avoirdupois pound"], + ['oz', 28.349_523_125, "ounce"], + ['slug', 14.593_903, "slug"], + ['lbt', .373_241_721_6, "Troy pound"], + ['ton', 907.184_74, "short ton"], + ['tonUK', 1016.046_908_8, "long ton"], + ['t', 1000, "tonne (metric ton)"], + ['ozt', .031_103_476_8, "Troy ounce"], + ['ct', 64.798_91e-6*19/6, "carat"], # 3+1/6 gr +# ['kt', 200e-6, "metric carat"], # new + ['grain', 64.798_91e-6, "grain"], + ['u', 1.660_538_73e-27 * 13e-35, "unified atomic mass"], +# ['mol', 0, "mole"], # mole = g/u + ], # mass + [ + "force", + ['N', 1, "newton"], # kg*m/s² + ['dyn', 1e-5, "dyne"], + ['gf', 9_806.65, "gram-force"], + ['kip', 4.448_221_615_260_500_0, "kilopound-force"], + ['lbf', 4.448_221_615_260_5, "pound-force"], + ['pdl', .138_254_954_376, "poundal"], # lb*ft/s² + ['kgf', 9.806_65, "kilogram-force/grave"], + ], # force + [ + "energy", + ['J', 1, "joule"], # N*m + ['erg', 1e-7, "erg"], # g*cm²/s² + ['Kcal', 4_186.8, "kilocalorie"], + ['Cal', 4.186_8, "calorie"], + ['Btu', 1_055.055_852_62, "International table btu"], + ['ft*lbf', 1.355_817_948_331_400_4, "foot-pound"], + ['therm', 105_505_585.262, "EEC therm"], + ['MeV', 1/6.241_509_629_152_65e12, "mega electron-volt"], + ['eV', 1/6.241_509_629_152_65e18, "electron-volt"], + ], # energy + [ + "power", + ['W', 1, "watt"], + ['hp', 735.498_75, "horse power"], + ], # power +# [ +# "pressure", +# ], # pressure + [ + "temperature", #todo + ['°C', 1, "degree Celsius", 273.15], + ['°F', 5/9, "degree Fahrenheit", 459.67], + ['K', 1, "Kelvin"], + ['°R', 5/9, "degree Rankine"], + ], # temperature +# [], # electric current +# [], # angle +# [], # light +# [], # radiation +# [], # viscosity +); # units table + +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] -= $_->{diff} if $_->{diff}; +# $stack[0] += $val{unit}{diff}*$val{unit}{val}/$_->{val} if $val{unit}{diff}; + $stack[0] *= delete($val{unit})->{val} / $_->{val}; + showstack(); + undef %val; + } # convert + else { + $val{unit} = $_; + } # set source unit + return 1; + }} # conversion +}; # precmd + +push @{$hook{postentry}}, sub { + exists $val{unit} && '_'.$val{unit}{name}; +}; # showentry + +return { + author => "Shiar", + title => "unit convertor", + version => "1.10.4", +}; + diff --git a/dct.pl b/dct.pl index a671e52..b11ca57 100755 --- a/dct.pl +++ b/dct.pl @@ -2,17 +2,17 @@ # DCT - desktop calculator thingy -# reverse polish notition calculator using curses +# simple modular reverse polish notition calculator # by Shiar -our $VERSION = 1.009; - use strict; use warnings; use utf8; +use Data::Dumper; use Term::ReadKey; -use Curses; + +our $VERSION = "1.10.6"; use vars qw(@stack %val %var %set %alias %action %hook); @@ -27,47 +27,39 @@ use vars qw(@stack %val %var %set %alias %action %hook); width => 42, # limit value precision, stetch menu ); # %set -%alias = (' '=>'enter', "\004"=>'quit', 'q'=>'quit'); # rudimentary default key bindings +%alias = (' '=>"enter", "\004"=>"quit"); # rudimentary default key bindings %action = ( - "chs" => [1, sub { -$_[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 - - "enter" => [0, sub { + "enter" => [ 0, sub { local $_ = defined $val{i} ? $val{i} : $stack[0]; undef %val; return defined $_ ? $_ : (); }], # duplication - "swap" => [2, sub { reverse @_ }], # swap x<->y - "undo" => [-1, sub { - ($var{undo}, @stack) = ([@stack], @{ $var{undo} }); - }], # undo/redo - "stack" => [-1, sub { + "chs" => [ 1, sub { -$_[0] }], # negative + + "drop" => [ 1, sub { defined $val{i} ? '' : () }], # drop + "back" => [ 1, sub { () }], # drop essentially + "clear" => [ 0, sub { @stack = (); undef %val; () }], # clear all + + "swap" => [ 2, sub { reverse @_ }], # swap x<->y + "stack" => [-2, sub { $var{stackpos} = 0 unless $var{stackpos}; # initialize $var{stackpos} %= @stack; # cycle $val{i} = $stack[$var{stackpos}++]; }], # stack - "version" => [-1, sub { error("Desktop Calculator Thingy $VERSION by Shiar"); () }], # version + "sto" => [ 1, sub { $var{a} = $_[0] }], # copy + '?' => [ 1, sub { $var{a} = $_[0] }], # assign - "sto" => [1, sub { $var{a} = $_[0] }], # copy - '?' => [1, sub { $var{a} = $_[0] }], # assign + "version" => [-2, sub { + error("Desktop Calculator Thingy $VERSION by Shiar"); () + }], # version ); # %action sub error($) { - attron(A_REVERSE); - addstr(0, 0, shift); - attroff(A_REVERSE); - clrtoeol; - refresh; - - ReadKey; # wait for confirm - 1 while defined ReadKey(-1); # clear key buffer + $_->($_[0]) for @{$hook{showerror}}; } # error sub showval($$); @@ -110,46 +102,41 @@ sub showval($$) { } # showval sub showstack() { - for (0..@stack-1) { - addstr($set{height}-$_, 1, "$_: ".showval($stack[$_], $set{base})); - clrtoeol; - } # show stack - clrtoeol($set{height}-@stack, 1); + $_->() for @{$hook{showstack}}; } # showstack -my @modules; -eval 'require $_' ? push @modules, $_ -: print STDERR "error loading $_\n".(join "", map "\t$_\n", split /\n/, $@) - for glob "*.pm"; +my %modules; +for my $module (sort glob "*.pm") { + next unless $module =~ /^\d{2}_(\w+)\.pm$/; # filename 00_name.pm + next if defined $modules{$1}; # such module already loaded + defined ($_ = do $module) + ? (ref $_ and $modules{$1} = $_) # return value means no errors + : print STDERR $@, "error loading $module\n\n"; +} # load modules + +printf STDERR "DCT %s by Shiar (%s)\n", $VERSION, + join "; ", map {"$_ $modules{$_}{version}"} keys %modules; -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; -$_->() for @{ $hook{refresh} }; -showstack(); -addstr($set{height}+1, 0, "> "); # prompt - -LOOP: -while (1) { - addstr($set{height}+1, 2, showval($val{i}, $set{base})); - for my $cmd (@{ $hook{showentry} }) { - addstr($_) if $_ = $cmd->(); - } # showentry functions - addstr($val{alpha}) if exists $val{alpha}; - clrtoeol; - refresh; +END { ReadMode 0; } # restore terminal on quit + +$_->() for @{$hook{init}}; +my $redraw = 1; + +LOOP: while (1) { + if ($redraw) { + $_->() for @{$hook{refresh}}; + showstack(); + $redraw = 0; + } # refresh + + { + my $entry = showval($val{i}, $set{base}); + $entry .= $_ for map $_->(), @{$hook{postentry}}; + $entry .= $val{alpha} if exists $val{alpha}; + $_->($entry) for @{$hook{showentry}}; + } # show entry my $key = ReadKey; if ($key eq chr 27) { @@ -158,14 +145,17 @@ while (1) { $_ = $alias{$key} || $key; #if exists $alias{$key}; # command shortkeys $_ = delete $val{alpha} if $_ eq "enter" and exists $val{alpha}; # use manual command - for my $cmd (@{ $hook{precmd} }) { + for my $cmd (@{$hook{precmd}}) { next LOOP if $cmd->(); } # precmd functions last if $_ eq 'quit'; - goto DRAW if $_ eq 'refresh'; - if (exists $val{alpha} or /^\033?[A-Z]$/) { + if ($_ eq 'refresh') { + $redraw++; + } # refresh + + elsif (/^\033?[A-Z]$/ or exists $val{alpha}) { if (defined $val{i}) { unshift @stack, $val{i}; undef %val; @@ -183,11 +173,13 @@ while (1) { } # add character } # manual command entry - elsif (/^\d$/) { + elsif (/^[\da-f]$/) { + m/^[a-z]$/ and $_ = ord($_)-87; # digit>9 $val{i} = 0 unless defined $val{i}; $_ = -$_ if $val{i}<0; # substract from negative value - $val{i} = ($val{frac} and $val{frac} *= 10) ? $val{i}+$_/$val{frac} - : $val{i}*10+$_; + $val{i} = ($val{frac} and $val{frac} *= 10) + ? $val{i}+$_/$val{frac} # add digit to fraction + : $val{i}*$set{base}+$_; # add digit to integer part } # digit elsif ($_ eq '.') { $val{i} = 0 unless defined $val{i}; @@ -201,69 +193,80 @@ while (1) { $val{i} = -$val{i}; } # change sign 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 + $val{i} = ($val{frac} and $val{frac} = int $val{frac}/10) + ? int($val{i}*$val{frac})/$val{frac} # backspace fraction digit + : int $val{i}/$set{base} # backspace digit in integer part } # backspace elsif (exists $action{$_}) { - my ($type, $cmd) = @{ $action{$_} }; - unshift @stack, $action{enter}[1]->() - if $type>0 and defined $val{i}; # auto enter + my ($type, $cmd) = @{$action{$_}}; + 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"); - goto DRAW; + $redraw++; + next; } # insufficient arguments - if ($type>=0) { - $var{undo} = [@stack]; # if $_ ne 'undo'; - unshift @stack, $cmd->(splice @stack, 0, $type); - showstack(); - } # stack-modifying operation - else { - $cmd->(); - } # harmless + $_->($type) for @{$hook{preaction}}; + + # put return value(s) of stack-modifying operations (type>=0) at stack + $type<0 ? $cmd->() : unshift @stack, $cmd->(splice @stack, 0, $type); + + showstack() if $type>=-1; } # some operation else { - error("unrecognised command: ".join(' ', map ord, split //, $_)); - goto DRAW; # screen messed up + error( + "unrecognised command: " # show string or character codes + . (m/^\w*$/ ? qq{"$_"} : join ' ', map ord, split //, $_) + ); + $redraw++; # 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 +1.01 040618 - start (curses, some basic commands) +1.02 040620 - function keys select command/submenu from (sub)menu + - backspace to undo last digit +1.03 040625 - values displayable in arbitrary base + - can enter fractions (.) and negative values (_) +1.04 0408041445 - error dialog (don't mess up screen) + - manual command input using capital letters + - ^L redraws screen + 0409092200 - overhaul in stack handling +1.05 0409101945 - 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 0409152310 - menu contents in module + - new commands: a?(sin|cos|tan)h, inv, !, rand + - x and v shortkeys +1.07 0409242350 - 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 0409262210 - 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 0409270057 - all key aliases moved to module DCT::Bindings + 0409291215 - number of menu items depends on screen width + 0410112130 - hooks allowing for extra code at reload, showentry, and precmd + 2150 - all menu related functions moved to menu.pm + 2205 - unit conversion out of main program (entirely into unitconv.pm) + 0410120150 - backspace becomes "back" (soft drop, like old "drop") + - normal drop command (alt+bs) removes input/stack value at once + 0213 - $val{frac} default undefined instead of 0 +1.10 0410120245 - fixed backspace with undef fraction + 0410130020 - altered stack not redrawn after undo + 0410132200 - digits added/removed to/from integer part in correct number base + 0410142145 - allow modules to not load but without error + - display welcome at startup, also showing version and modules + 0410150000 - preaction hook; undo functionality moved to module + - only first module run of multiple with the same name + 0015 - invalid commands shown as strings instead of character codes =cut diff --git a/math.pm.old b/math.pm.old deleted file mode 100644 index e71c5d0..0000000 --- a/math.pm.old +++ /dev/null @@ -1,83 +0,0 @@ -# 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 deleted file mode 100644 index 2733db8..0000000 --- a/menu.pm +++ /dev/null @@ -1,174 +0,0 @@ -# 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 deleted file mode 100644 index 494aaa1..0000000 --- a/unitconv.pm +++ /dev/null @@ -1,62 +0,0 @@ -# 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; - -- 2.30.0