--- /dev/null
+# 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",
+};
+
--- /dev/null
+# 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",
+};
+
# 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
"\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", #
"s" => "sin",
"\033s" => "asin",
- "c" => "cos", #todo: u? o?
- "\033c" => "acos",
+ "o" => "cos", # or u?
+ "\033o" => "acos",
"t" => "tan",
"\033t" => "atan",
"l" => "log",
"\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",
+};
--- /dev/null
+# 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",
+};
+
--- /dev/null
+# 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",
+};
+
-# 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;
'^' => [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
'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
'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
'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
'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",
+};
--- /dev/null
+# 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",
+};
+
# DCT - desktop calculator thingy
-# reverse polish notition calculator using curses
+# simple modular reverse polish notition calculator
# by Shiar <shiar.org>
-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);
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($$);
} # 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) {
$_ = $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;
} # 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};
$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
+++ /dev/null
-# 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;
-
+++ /dev/null
-# 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;
-
+++ /dev/null
-# 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;
-
git.shiar.nl / descalc.git / commitdiff