+++ /dev/null
-# ncurses output for DCT, by Shiar
-
-# 1.12.0 200410312200 - define main loop (get input from Term::ReadKey)
-# 1.11.0 200410152225 - uses class in filename instead of $set{display} check
-# 1.10.0 200410140120 - all output functions seperated from main
-
-use strict;
-use warnings;
-
-use Curses;
-use Term::ReadKey;
-
-push @{$hook{init}}, sub {
- 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;
-}; # 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
-
-$hook{main} = sub {
- while (1) {
- draw();
-
- my $key = ReadKey; # wait for user input
- if ($key eq chr 27) {
- $key .= $_ while defined ($_ = ReadKey(-1)); # read additional keys
- } # escape sequence
-
- onkey($key);
- } # input loop
-}; # main
-
-return {
- author => "Shiar",
- title => "curses output",
- version => "1.12",
-};
-
# s-lang output for DCT, by Shiar
+# 1.13.0 200411042100 - menu i/o functions
+# - refresh hook renamed to showall
# 1.12.0 200411032145 - define main loop
# - use slang key reading functions
-# 1.11.0 200410291300 -
+# 1.11.0 200410291300 - basic output using Term::Slang (ported from Curses)
use strict;
use warnings;
use Term::Slang qw(:all);
+use vars qw(%falias $path);
+require $path."termcommon.pm";
+
push @{$hook{init}}, sub {
SLtt_get_terminfo and exit;
SLang_init_tty(-1, 0, 1);
SLsmg_init_smg;
+ SLtt_set_color(1, 0, 'black', 'lightgray');
END { SLsmg_reset_smg; SLang_reset_tty; } # shutdown display system
# where are $SLtt_Screen_Rows and $SLtt_Screen_Cols?
($set{height}, $set{width}) = SLtt_get_screen_size;
- $set{height} -= 2;
+ $set{height} -= 3;
+ $set{menushow} = int($set{width}/(4+$set{width}/20))+1; # menu items to show simultaneously
}; # init
push @{$hook{showerror}}, sub {
SLsmg_erase_eol;
}; # showstack
-push @{$hook{refresh}}, sub {
+push @{$hook{showmenu}}, sub {
+ SLsmg_gotorc($set{height}+2, 1);
+ SLsmg_erase_eol;
+ my $nr = -1;
+ for (grep exists $menu[0][$_], $menu[0][0]+1..$menu[0][0]+$set{menushow}) {
+ $nr++;
+ next unless defined $menu[0][$_];
+ my $sub = (my $s = $menu[0][$_]) =~ s/>[\w ]+$//;
+ SLsmg_gotorc($set{height}+2, $set{width}/$set{menushow}*$nr);
+ SLsmg_write_string($_);
+ SLsmg_reverse_video; # reverse
+ SLsmg_write_string($s);
+ SLsmg_normal_video;
+ SLsmg_write_string('>') if $sub; # indicate submenu
+ } # display menu txts
+}; # showmenu
+
+$action{more} = [-1, sub {
+ $menu[0][0] += $set{menushow};
+ $menu[0][0] = 0 if $menu[0][0] > @{$menu[0]};
+ $_->() for @{$hook{showmenu}};
+}]; # tab
+
+unshift @{$hook{precmd}}, sub {
+ exists $falias{$_} or return; # handle function key
+ if ($falias{$_}==0) {
+ shift @menu if @menu>1; # remove current submenu
+ redraw(menu=>1);
+ return 1;
+ } # escape (go to parent)
+ $_ = $menu[0][$falias{$_}] and return; # execute found menu item instead
+ error("no such menu entry");
+ return 1;
+}; # precmd
+
+push @{$hook{showall}}, sub {
SLsmg_cls;
SLsmg_gotorc($set{height}+1, 0);
SLsmg_write_string("> "); # prompt
-}; # refresh
+}; # showall
push @{$hook{showentry}}, sub {
SLsmg_gotorc($set{height}+1, 2);
return {
author => "Shiar",
title => "slang output",
- version => "1.12",
+ version => "1.13",
};
--- /dev/null
+# ncurses output for DCT, by Shiar
+
+# 1.13.0 200411042100 - hook to display and handle menu
+# - submenus are named instead of numbered
+# - refresh hook renamed to showall
+# 1.12.0 200410312200 - define main loop (get input from Term::ReadKey)
+# 1.11.0 200410152225 - uses class in filename instead of $set{display} check
+# 1.10.0 200410140120 - all output functions seperated from main
+
+use strict;
+use warnings;
+
+use Curses;
+use Term::ReadKey;
+
+use vars qw(%falias $path);
+require $path."termcommon.pm";
+
+sub setsize () {
+ $set{height} = $LINES-3 if $LINES>=3;
+ $set{width} = $COLS if $COLS;
+ $set{menushow} = int($set{width}/(4+$set{width}/20))+1; # menu items to show simultaneously
+} # setsize
+
+push @{$hook{init}}, sub {
+ initscr;
+ ReadMode 3; # cbreak mode
+
+ END {
+ ReadMode 0;
+ endwin;
+ } # restore terminal on quit
+
+ $SIG{WINCH} = sub {
+ endwin;
+ refresh; # setup for new screen size
+ setsize(); # adjust for new sizes
+ redraw(all=>1); # queue complete refresh
+ draw(); # redraw rightnow
+ };
+
+ setsize();
+}; # 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{showmenu}}, sub {
+ clrtoeol($set{height}+2, 1);
+ my $nr = -1;
+ for (grep exists $menu[0][$_], $menu[0][0]+1..$menu[0][0]+$set{menushow}) {
+ $nr++;
+ next unless defined $menu[0][$_];
+ my $sub = (my $s = $menu[0][$_]) =~ s/>\w+$//;
+ 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 {
+ $menu[0][0] += $set{menushow};
+ $menu[0][0] = 0 if $menu[0][0] > @{$menu[0]};
+ $_->() for @{$hook{showmenu}};
+}]; # tab
+
+unshift @{$hook{precmd}}, sub {
+ exists $falias{$_} or return; # handle function key
+ if ($falias{$_}==0) {
+ shift @menu if @menu>1; # remove current submenu
+ redraw(menu=>1);
+ return 1;
+ } # escape (go to parent)
+ $_ = $menu[0][$falias{$_}] and return; # execute found menu item instead
+ error("no such menu entry");
+ return 1;
+}; # precmd (menu item selection)
+
+push @{$hook{showall}}, sub {
+ clear;
+ addstr($set{height}+1, 0, "> "); # prompt
+}; # showall
+
+push @{$hook{showentry}}, sub {
+ addstr($set{height}+1, 2, $_[0]);
+ clrtoeol;
+ refresh;
+}; # showentry
+
+$hook{main} = sub {
+ while (1) {
+ draw();
+
+ my $key = ReadKey; # wait for user input
+ if ($key eq chr 27) {
+ $key .= $_ while defined ($_ = ReadKey(-1)); # read additional keys
+ } # escape sequence
+
+ onkey($key);
+ } # input loop
+}; # main
+
+return {
+ author => "Shiar",
+ title => "curses output",
+ version => "1.13",
+};
+
push @{$hook{init}}, sub {
ReadMode 3; # cbreak mode
-# print "\ec"; # reset (clear screen, go home)
# print "\e[4mDCT $::VERSION\e[24m "; # print intro (underlined)
END {
ReadMode 0;
print "\n> "; # prompt
}; # showstack
+push @{$hook{showmenu}}, sub {
+ my $nr = -1;
+ for (grep exists $menu[0][$_], $menu[0][0]+1..$menu[0][0]+$set{menushow}) {
+ $nr++;
+ next unless defined $menu[0][$_];
+ my $sub = (my $s = $menu[0][$_]) =~ s/>[\w ]+$//;
+ print " $_:$s";
+ print ">" if $sub; # indicate submenu
+ } # display menu txts
+ print "\n> ";
+}; # showmenu
+
+push @{$hook{showall}}, sub {
+# print "\ec"; # reset (clear screen, go home)
+}; # showall
+
push @{$hook{showentry}}, sub {
print "\e[3G\e[K", $_[0]; # cursor to column #3; erase line
}; # showentry
# clrtoeol($set{height}-@stack, 1);
}; # showstack
-push @{$hook{refresh}}, sub {
+push @{$hook{showall}}, sub {
# clear;
# addstr($set{height}+1, 0, "> "); # prompt
$main->Label(-text=>"> ")->pack;
-}; # refresh
+}; # showall
push @{$hook{showentry}}, sub {
$main->Label(-text=>$_[0])->pack;
# clrtoeol($set{height}-@stack, 1);
}; # showstack
-push @{$hook{refresh}}, sub {
+push @{$hook{showall}}, sub {
# clear;
# addstr($set{height}+1, 0, "> "); # prompt
$main->Label(-text=>"> ")->pack;
-}; # refresh
+}; # showall
push @{$hook{showentry}}, sub {
$main->Label(-text=>$_[0])->pack;
+++ /dev/null
-# key bindings for DCT, by Shiar
-
-# 1.09.3 200410142200 - enter sent as chr 10 on non-curses terminals
-# 1.09.2 200410120145 - alt+backspace and ^W for (hard) drop
-# 1.09.1 200410112145 - function keys moved to menu.pm
-# 1.08.2 200409270049 - single key alias to chs: \ (often close to _)
-# 1.08.1 200409270040 - moved from 1.8 main
-
-use strict;
-use warnings;
-
-%alias = (
- chr 4 => "quit", # ^D
- chr 9 => "more", # tab
- "\014" => "refresh", # ^L
-# "\033\133\110" => "refresh", # home
- '_' => "chs", # easy to remember, difficult to type
- '\\' => "chs", # single key
-# 'y' => "chs", # redundant hp48 compatibility
-# 'z' => "eex", # redundant hp48 compatibility
- "\033\133\062\176" => "eex", # ins
- "\033\133\063\176" => "clear", # del
- "\177" => "back", # backspace
- "\010" => "back", # backspace
- "\033\010" => "drop", # alt+backspace
- "\033\177" => "drop", # alt+backspace
- "\027" => "drop", # ^W
- chr 10 => "enter", # enter (terminal)
- chr 13 => "enter", # enter (curses)
- ' ' => "enter", # space
- '=' => "sto", #
-
- "\033\133\101" => "stack", # up - 48: k (stack)
- "\033\133\104" => "undo", # left - 48: p (picture)
-# "\033\133\102" => '', # down - 48: q (view)
- "\033\133\103" => "swap", # right - 48: r (swap)
-
- '&' => "and",
- '|' => "or",
- '#' => "xor",
- '~' => "not",
- '(' => "sl",
- ')' => "sr",
-
- "s" => "sin",
- "\033s" => "asin",
- "o" => "cos", # or u?
- "\033o" => "acos",
- "t" => "tan",
- "\033t" => "atan",
- "l" => "log",
- "\033l" => "alog",
- "n" => "ln",
- "\033n" => "exp",
- "q" => "sq",
- "\033q" => "sqrt",
- "x" => "^",
- "\033x" => "xroot",
- "\033^" => "xroot", # for consistency
- "v" => "inv",
-); # %alias
-
-return {
- author => "Shiar",
- title => "default key bindings",
- version => "1.9.3",
-};
-
+++ /dev/null
-# menu for DCT, by Shiar
-
-# 1.11.0 200410282200 - display-specific code in evals
-# 1.10.4 200410151900 - remove explicit call to redraw on error
-# 1.10.3 200410150030 - add quit at F10 in main menu (after running other modules)
-# - don't show undefined menu entries (skippable)
-# 1.10.2 200410122345 - addmenu() function to add submenus
-# 1.10.1 200410122210 - @menus global; unit+math items added in those modules
-# 1.09.1 200410112150 - everything related to menus moved here
-# 1.06.1 200409152332 - moved @menus from 1.6 main
-
-#todo: merge basics back into main; i/o functions in display modules
-# (menu can also be disabled at this level, without too high cost)
-#todo: always remember parent menus (so no need to store back-item (0)
-# and ability to show higher levels)
-#todo: also store menu hash (to add additional items to a specific submenu)
-
-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 = [];
-our @menu;
-our $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
-
-my %show = (
- curses => q{
- 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
- },
- stdout => q{
- my $nr = -1;
- for (grep exists $menu[$_], $menumin+1..$menumin+$set{menushow}) {
- $nr++;
- next unless defined $menu[$_];
- my $sub = (my $s = $menu[$_]) =~ s/>\d+$//;
- print " $_:$s";
- print ">" if $sub; # indicate submenu
- } # display menu txts
- print "\n> ";
- },
-);
-
-sub showmenu() {
- eval $_ if local $_ = $show{$::modules{disp}{name}};
-} # 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");
- return 1;
-}; # 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.11",
-};
-
--- /dev/null
+# improved stack functionality for DCT, by Shiar
+
+# 1.13.0 200411042045 - added swap and stack from main
+# - renamed to "stack"
+# - stack cycle would crash with undefined stack
+# 1.10.1 200410150045 - set initial value to prevent crash when no undos set
+# 1.10.0 200410150000 - single-level undo from main
+
+use strict;
+use warnings;
+
+my $undo = []; # stack backup
+my $stackpos = 0; # position of stack browser
+
+push @{$hook{preaction}}, sub {
+ if ($_[0] >= 0) {
+ $undo = [@stack]; # backup stack
+ $stackpos = 0; # reset position of stack navigation
+ } # stack-modifying operations (type>=0)
+}; # preaction
+
+$action{undo} = [-1, sub { ($undo, @stack) = ([@stack], @$undo) }]; # undo/redo
+
+$action{swap} = [ 2, sub { reverse @_ }]; # swap x<->y
+
+$action{stack} = [-2, sub {
+ $stackpos %= @stack if @stack; # cycle
+ $val{i} = $stack[$stackpos++];
+}]; # stack
+
+return {
+ author => "Shiar",
+ title => "stack functions",
+ version => "1.13",
+};
+
+++ /dev/null
-# key bindings for DCT, by Shiar
-
-# 1.10.1 200410150045 - set initial value to prevent crash when no undos set
-# 1.10.0 200410150000 - single-level undo from main
-
-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.1",
-};
-
# math for DCT, by Shiar
+# 1.13.0 20041104 - new addmenu() call
# 1.10.4 200410282330 - trig functions from basic menu
# 1.10.3 200410152245 - rnd, atan, pi
# - trigonometry functions seperated
# 'utpf' => [3], # F distribution
); # newaction
-addmenu(["main", 0], "math",
+addmenu("main", "math",
[qw(basic sq sqrt ^ xroot log alog ln exp)],
# [qw(vector)],
# [qw(matrix)],
# [qw(fft)],
# [qw(complex)],
# [qw(constants)],
-) if defined &addmenu; # addmenu
+); # addmenu
return {
author => "Shiar",
title => "basic math",
- version => "1.10.4",
+ version => "1.13",
};
# trigonometry for DCT, by Shiar
+# 1.13.0 20041104 - new addmenu() call
# 1.11.2 200411032120 - check for menu module before addmenu()
# 1.11.1 200410282330 - cardial mode setting; rad/deg to switch to radians/degrees
# - convert from/to radians for trig commands if rad mode set
$stack[0] *= 360/$pi if $_[1] =~ /^a(?:sin|cos|tan)h?$/;
}; # postaction
-addmenu(["main", 0], "trig", #todo: in math, not in main
+addmenu("math", "trig",
qw(sin cos tan asin acos atan),
qw(sinh cosh tanh asinh acosh atanh),
qw(expm lnp1),
-) if defined &addmenu;
+); # addmenu
return {
author => "Shiar",
title => "trigonometry",
- version => "1.11.2",
+ version => "1.13",
};
# unit convertor for DCT, by Shiar
+# 1.14.0 200501261830 - units can have different offsets, so we can convert ^C/^F
+# 1.13.1 200501071420 - added cd/dvd sizes to data storage
+# 1.13.0 200411042100 - changed calls addmenu() and redraw()
# 1.11.0 200410291000 - use redraw()
# 1.10.5 200410151900 - data storage units (8 total, including LOC)
# 1.10.4 200410132300 - hp49 units for mass
use warnings;
use utf8;
-my $menugroup = addmenu(["main", 0], "unit") if defined &addmenu;
+addmenu("main", "unit");
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;
+ addmenu("unit", $title, map "_$_->[0]", @$_);
$unit{$_->[0]} = {
type=>$i, name=>$_->[0], val=>$_->[1], desc=>$_->[2], diff=>$_->[3]
} for @$_;
['bit', 1/8, "bit/octet"],
['Mbit', 1024**2/8, "megabit"],
['LOC', 19e12, 'Library of Congress'], # est. 17-20TB
+ ['CD', 735e6, 'max CD-ROM data'],
+ ['DVD', 47e8, 'max DVD-ROM data'],
],
); # units table
$_ = $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] += $val{unit}{diff} if $val{unit}{diff};
$stack[0] *= delete($val{unit})->{val} / $_->{val};
- redraw(1);
+ $stack[0] -= $_->{diff} if $_->{diff};
+ redraw(stack=>1);
undef %val;
} # convert
else {
return {
author => "Shiar",
title => "unit convertor",
- version => "1.11",
+ version => "1.14",
};
+200412131608 1.13.1 / 1.12.2
+ - menu names can have space characters in them
+200411042130 1.13.0
+ - menu structure back in main, menu i/o in display modules
+ - item position is (re)stored seperately for each submenu
+ - menus are named, not numbered
+ - objects to be redrawn specified seperately; redraw() takes hash
+
200411032300 1.12.1
- commandline arguments with leading - will skip modules of that name/group
- use readdir instead of glob (quite a bit faster)
20040618 1.01
- start (curses, some basic commands)
+
+# menu for DCT, by Shiar
+
+# 1.11.0 200410282200 - display-specific code in evals
+# 1.10.4 200410151900 - remove explicit call to redraw on error
+# 1.10.3 200410150030 - add quit at F10 in main menu (after running other modules)
+# - don't show undefined menu entries (skippable)
+# 1.10.2 200410122345 - addmenu() function to add submenus
+# 1.10.1 200410122210 - @menus global; unit+math items added in those modules
+# 1.09.1 200410112150 - everything related to menus moved here
+# 1.06.1 200409152332 - moved @menus from 1.6 main
#!/usr/bin/perl
-# DCT - desktop calculator thingy
+# descalc - desktop calculator
# simple modular reverse polish notition calculator
# by Shiar <shiar.org>
use Data::Dumper;
-our $VERSION = "1.12.1";
+our $VERSION = "1.14";
-use vars qw(@stack %val %set %alias %action %hook);
+
+use vars qw(@stack %val %set %alias %action %hook @menu);
%set = (
base => 10, # decimal; set using commands bin/oct/dec/hex/base
"back" => [ 1, sub { () }], # drop essentially
"clear" => [ 0, sub { @stack = (); undef %val; () }], # clear all
- "swap" => [ 2, sub { reverse @_ }], # swap x<->y
- "stack" => [-2, sub {
- my $stackpos if 0;
- $stackpos = 0 unless $stackpos; # initialize
- $stackpos %= @stack; # cycle
- $val{i} = $stack[$stackpos++];
- }], # stack
-
"version" => [-2, sub {
error("Desktop Calculator Thingy $VERSION by Shiar"); ()
}], # version
); # %action
+%hook = map {$_=>[]} qw(
+ showerror showall showmenu showstack showentry
+ postentry precmd postcmd preaction postaction init
+);
+
+my %redraw = (all=>1); # set flag to refresh whole screen
+
+my %menus = (
+ main => [qw(0 prog> mode>mode)], # main
+ mode => [qw(0 number_format angle_measure coord_system)], #1 mode
+); # %menus
+
+@menu = ($menus{main}); # current menu tree
-my $redraw = 2; # set flag to refresh whole screen
-sub redraw($) {
- # queue a redraw of level $_[0]
- $redraw = $_[0] if $_[0]>$redraw;
+sub redraw(%) {
+ my %obj = @_;
+ while (my ($obj, $level) = each %obj) {
+ $redraw{$obj} = $level;# if $level>$redraw{$obj};
+ } # queue redraw of given objects
} # redraw
sub error($) {
$_->($_[0]) for @{$hook{showerror}};
- redraw(2);
+ redraw(all=>1);
} # error
+sub addmenu {
+ my ($parent, $menuname) = (shift, shift);
+ $menus{$menuname} = [0]; # create new menu
+ push @{$menus{$parent}}, "$menuname>$menuname"; # link from parent
+ ref $_ ? addmenu($menuname, @$_) : push @{$menus{$menuname}}, $_
+ for @_; # add menu items (which can be sub-submenus)
+ return $menuname;
+} # addmenu
+
sub showval;
sub showval {
my ($val, $base, $baseexp) = @_;
return '' unless defined $val;
- return $val if $base==10;
+ return $val if $base==10; # perl can do the decimal values (much faster)
- my $txt = '';
+ $_ = ''; # string to output
my $sign = $val<0 and $val = abs $val;
my $int = int $val;
my $frac = $val-$int;
while ($int>=1) {
my $char = $int%$base;
- $txt = ($char<10 ? $char : chr($char+55)) . $txt;
+ $_ = ($char<10 ? $char : chr($char+55)) . $_; # add digit [0-9A-Z]
$int /= $base;
} # integer part
- $txt .= '.' if $frac>0;
- for (my $i = 0; length $txt<$set{width}-2 && $frac>0; $i++) {
+ $_ .= '.' if $frac>0;
+ for (my $i = 0; length $_<$set{width}-2 && $frac>0; $i++) {
$frac *= $base;
my $char = int $frac;
$frac -= $char;
- $txt .= $char<10 ? $char : chr($char+55);
+ $_ .= $char<10 ? $char : chr($char+55);
} # fraction part
- $txt = "-".$txt if $sign;
- $txt .= 'e'.showval($exp, $base) if $exp;
+ $_ = '-'.$_ if $sign;
+ $_ .= 'e'.showval($exp, $base) if $exp;
- return $txt;
+ return $_;
} # showval
sub draw {
- if ($redraw) {
- if ($redraw>1) {
- $_->() for @{$hook{refresh}};
- }
- $_->() for @{$hook{showstack}};
- $redraw = 0;
- } # do necessary redrawing
+ if (%redraw) {
+ my @obj = qw(all menu stack); # all possible redraw hooks
+ @obj = grep $redraw{$_}, @obj # keep stuff specified in %redraw
+ unless $redraw{all}; # all keeps everything
+ $_->() for map @{$hook{"show$_"}}, @obj; # call show$obj hooks
+ %redraw = ();
+ } # do necessary redrawing (queued by &redraw)
{
my $entry = showval($val{i}, $set{base}, $val{ex});
- $entry .= $_->() for @{$hook{postentry}};
- $entry .= $val{alpha} if exists $val{alpha};
+ $entry .= $_->() for @{$hook{postentry}}; # additional text after val
+ $entry .= $val{alpha} if exists $val{alpha}; # manual command
$_->($entry) for @{$hook{showentry}};
} # show entry
} # draw
sub onkey($) {
- my $key = shift;
- $_ = exists $alias{$key} ? $alias{$key} : $key; # command (alias maps keys to commands)
- $_ eq "enter" and exists $val{alpha} and $_ = delete $val{alpha}; # use manual command
+ my $key = shift; # key pressed
+ # command to run into $_ (alias maps keys to commands)
+ $_ = exists $alias{$key} ? $alias{$key} : $key;
+ # manual command entered - make that the new command
+ $_ eq "enter" and exists $val{alpha} and $_ = delete $val{alpha};
for my $cmd (@{$hook{precmd}}) {
$cmd->() and return; # command was handled by function if returns true
exit if $_ eq "quit"; # break out of loop
if ($_ eq "refresh") {
- redraw(2);
+ redraw(all=>1);
} # refresh
elsif (/^\033?[A-Z]$/ or exists $val{alpha}) {
if (defined $val{i}) {
unshift @stack, $val{i};
undef %val;
- redraw(1);
+ redraw(stack=>1);
} # enter present value
if ($_ eq "back") {
$_ = -$_ if $val{i}<0; # substract from negative value
$val{i} = ($val{frac} and $val{frac} *= 10)
? $val{i}+$_/$val{frac} # add digit to fraction
- : defined $val{ex} ? $val{ex} = $val{ex}*$set{base}+$_ # digit to exponent
- : $val{i}*$set{base}+$_; # add digit to integer part
+ : defined $val{ex}
+ ? $val{ex} = $val{ex}*$set{base}+$_ # digit to exponent
+ : $val{i}*$set{base}+$_; # add digit to integer part
} # digit
elsif ($_ eq '.') {
$val{i} = 0 unless defined $val{i};
: int $val{i}/$set{base} # backspace digit in integer part
} # backspace
+ elsif (/>([\w ]+)$/) {
+ unshift @menu, $menus{$1}; # go to submenu
+ redraw(menu=>1);
+ } # goto submenu
+
elsif (exists $action{$_}) {
my ($action, $type, $cmd) = ($_, @{$action{$_}});
- unshift @stack, $action{enter}[1]->() if $type>0 and defined $val{i}; # auto enter
+ unshift @stack, $action{enter}[1]->()
+ if $type>0 and defined $val{i}; # auto enter
if ($type>0 and $type>@stack) {
error("insufficient stack arguments for operation");
$type<0 ? $cmd->() : unshift @stack, $cmd->(splice @stack, 0, $type);
$_->($type, $action) for @{$hook{postaction}};
- redraw(1) if $type>=-1; # redraw stack
+ redraw(stack=>1) if $type>=-1; # redraw stack
} # some operation
else {
- error(
- "unrecognised command: " # show string or character codes
- . (m/^\w*$/ ? qq{"$_"} : join ' ', map ord, split //, $_)
- );
+ $_ = m/^\w*$/ ? qq{"$_"} : join ' ', map ord, split //, $_;
+ error("unrecognised command: $_"); # show string or character codes
} # error
} # onkey
-our %modules;
+our %modules; # loaded modules
{
my %modskip;
$modskip{substr $_, 1}++ for grep /^-/, @ARGV;
- opendir my $moddir, ".";
+
+ require Cwd;
+ our $path = Cwd::abs_path($0); # resolve symlinks first
+ $path = substr($path, 0, rindex($path, '/')+1) || './';
+ # or just use FindBin
+ opendir my($moddir), $path;
for my $module (sort readdir $moddir) { # glob "*.pm"
$module =~ /^\d{2}_([a-z0-9-]+)(?:_(\w+))?\.pm$/ or next;
# files named 00_class_name.pm; ($1, $2) = (class, name)
next if exists $modskip{$1} or $2 && exists $modskip{$2};
next if defined $modules{$1}; # no such module already loaded
- defined ($_ = do $module) # return value means no errors
+
+# defined ($_ = do $module) # return value means no errors
+# ? (ref $_ and $modules{$1} = $_, $modules{$1}{name} = $2 || "")
+# : print STDERR $@, "error loading $module\n\n";
+ defined($_ = eval {do $path.$module}) # return value means no errors
? (ref $_ and $modules{$1} = $_, $modules{$1}{name} = $2 || "")
- : print STDERR $@, "error loading $module\n\n";
+ : print STDERR $@, "error loading $path$module\n";
} # load modules
closedir $moddir;
} # find external modules
-printf STDERR "DCT %s by Shiar (%s)\n", $VERSION, join "; ",
+printf STDERR "descalc %s by Shiar (%s)\n", $VERSION, join "; ",
map join(" ", grep $_, $_, $modules{$_}{name}, $modules{$_}{version}),
keys %modules;
$_->() for @{$hook{init}};
+$menus{main}[10] = "quit";
-$hook{main}->();
+$hook{main}->(); #todo: error if nothing loaded
--- /dev/null
+# key bindings for DCT, by Shiar
+
+# - function keys moved back here
+# - module not auto loaded by dct, but by specific display modules
+# 1.09.3 200410142200 - enter sent as chr 10 on non-curses terminals
+# 1.09.2 200410120145 - alt+backspace and ^W for (hard) drop
+# 1.09.1 200410112145 - function keys moved to menu.pm
+# 1.08.2 200409270049 - single key alias to chs: \ (often close to _)
+# 1.08.1 200409270040 - moved from 1.8 main
+
+use strict;
+use warnings;
+
+%alias = (
+ chr 4 => "quit", # ^D
+ chr 9 => "more", # tab
+ "\014" => "refresh", # ^L
+# "\033\133\110" => "refresh", # home
+ "\033\133\062\176" => "eex", # ins
+ "\033\133\063\176" => "clear", # del
+ "\177" => "back", # backspace
+ "\010" => "back", # backspace
+ "\033\010" => "drop", # alt+backspace
+ "\033\177" => "drop", # alt+backspace
+ "\027" => "drop", # ^W
+ chr 10 => "enter", # enter (terminal)
+ chr 13 => "enter", # enter (curses)
+ ' ' => "enter", # space
+ "\033\133\101" => "stack", # up - 48: k (stack)
+ "\033\133\104" => "undo", # left - 48: p (picture)
+# "\033\133\102" => '', # down - 48: q (view)
+ "\033\133\103" => "swap", # right - 48: r (swap)
+
+ '=' => "sto", #
+ '_' => "chs", # easy to remember, difficult to type
+ '\\' => "chs", # single key
+# 'y' => "chs", # redundant hp48 compatibility
+# 'z' => "eex", # redundant hp48 compatibility
+
+ '&' => "and",
+ '|' => "or",
+ '#' => "xor",
+ '~' => "not",
+ '(' => "sl",
+ ')' => "sr",
+
+ "s" => "sin",
+ "\033s" => "asin",
+ "o" => "cos", # or u?
+ "\033o" => "acos",
+ "t" => "tan",
+ "\033t" => "atan",
+ "l" => "log",
+ "\033l" => "alog",
+ "n" => "ln",
+ "\033n" => "exp",
+ "q" => "sq",
+ "\033q" => "sqrt",
+ "x" => "^",
+ "\033x" => "xroot",
+ "\033^" => "xroot", # for consistency
+ "v" => "inv",
+); # %alias
+
+%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
+
+1;
+
git.shiar.nl / descalc.git / commitdiff