From: Shiar Date: Wed, 9 Feb 2005 13:32:40 +0000 (+0100) Subject: release 1.14pre0 X-Git-Url: http://git.shiar.net/descalc.git/commitdiff_plain/090ac304afe801cb3e72ced0941ff2a874a98cc9 release 1.14pre0 - objects to be redrawn specified seperately; redraw() takes hash - menus are named, not numbered - item position is (re)stored seperately for each submenu - menu structure back in main, menu i/o in display modules - menu names can have space characters in them --- diff --git a/03_disp_curses.pm b/03_disp_curses.pm deleted file mode 100644 index 8f94960..0000000 --- a/03_disp_curses.pm +++ /dev/null @@ -1,74 +0,0 @@ -# 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", -}; - diff --git a/04_disp_slang.pm b/03_disp_slang.pm similarity index 52% rename from 04_disp_slang.pm rename to 03_disp_slang.pm index 90dccf6..6d8c62d 100644 --- a/04_disp_slang.pm +++ b/03_disp_slang.pm @@ -1,24 +1,31 @@ # 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 { @@ -42,11 +49,46 @@ push @{$hook{showstack}}, 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); @@ -71,6 +113,6 @@ $hook{main} = sub { return { author => "Shiar", title => "slang output", - version => "1.12", + version => "1.13", }; diff --git a/04_disp_curses.pm b/04_disp_curses.pm new file mode 100644 index 0000000..be3da3c --- /dev/null +++ b/04_disp_curses.pm @@ -0,0 +1,126 @@ +# 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", +}; + diff --git a/05_disp_stdout.pm b/05_disp_stdout.pm index 07be1da..9e0d22d 100644 --- a/05_disp_stdout.pm +++ b/05_disp_stdout.pm @@ -16,7 +16,6 @@ use Term::ReadKey; 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; @@ -38,6 +37,22 @@ push @{$hook{showstack}}, sub { 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 diff --git a/08_disp_tk.pm b/08_disp_tk.pm index 918b77f..f7d4e27 100644 --- a/08_disp_tk.pm +++ b/08_disp_tk.pm @@ -57,11 +57,11 @@ print $_; # 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; diff --git a/09_disp_qt.pm b/09_disp_qt.pm index e055729..1ee134f 100644 --- a/09_disp_qt.pm +++ b/09_disp_qt.pm @@ -58,11 +58,11 @@ print $_; # 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; diff --git a/12_bindings.pm b/12_bindings.pm deleted file mode 100644 index 0488176..0000000 --- a/12_bindings.pm +++ /dev/null @@ -1,68 +0,0 @@ -# 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", -}; - diff --git a/15_menu.pm b/15_menu.pm deleted file mode 100644 index 9ae8c03..0000000 --- a/15_menu.pm +++ /dev/null @@ -1,151 +0,0 @@ -# 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", -}; - diff --git a/28_stack.pm b/28_stack.pm new file mode 100644 index 0000000..6922747 --- /dev/null +++ b/28_stack.pm @@ -0,0 +1,36 @@ +# 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", +}; + diff --git a/28_undo.pm b/28_undo.pm deleted file mode 100644 index ba39c7f..0000000 --- a/28_undo.pm +++ /dev/null @@ -1,22 +0,0 @@ -# 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", -}; - diff --git a/32_math.pm b/32_math.pm index 96447e1..5fc029a 100644 --- a/32_math.pm +++ b/32_math.pm @@ -1,5 +1,6 @@ # 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 @@ -93,7 +94,7 @@ use utf8; # '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)], @@ -109,11 +110,11 @@ addmenu(["main", 0], "math", # [qw(fft)], # [qw(complex)], # [qw(constants)], -) if defined &addmenu; # addmenu +); # addmenu return { author => "Shiar", title => "basic math", - version => "1.10.4", + version => "1.13", }; diff --git a/33_trig.pm b/33_trig.pm index fbfd46a..8efd1f0 100644 --- a/33_trig.pm +++ b/33_trig.pm @@ -1,5 +1,6 @@ # 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 @@ -48,15 +49,15 @@ push @{$hook{postaction}}, sub { $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", }; diff --git a/35_unitconv.pm b/35_unitconv.pm index 3cf2540..2cb181f 100644 --- a/35_unitconv.pm +++ b/35_unitconv.pm @@ -1,5 +1,8 @@ # 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 @@ -13,14 +16,14 @@ use strict; 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 @$_; @@ -190,6 +193,8 @@ do { ['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 @@ -198,10 +203,10 @@ push @{$hook{precmd}}, sub { $_ = $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 { @@ -218,6 +223,6 @@ push @{$hook{postentry}}, sub { return { author => "Shiar", title => "unit convertor", - version => "1.11", + version => "1.14", }; diff --git a/CHANGES b/CHANGES index 396d657..4be4db9 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,11 @@ +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) @@ -91,3 +99,14 @@ 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 diff --git a/dct.pl b/descalc.pl similarity index 56% rename from dct.pl rename to descalc.pl index d871555..e3366e7 100755 --- a/dct.pl +++ b/descalc.pl @@ -1,6 +1,6 @@ #!/usr/bin/perl -# DCT - desktop calculator thingy +# descalc - desktop calculator # simple modular reverse polish notition calculator # by Shiar @@ -11,9 +11,10 @@ use utf8; 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 @@ -38,39 +39,54 @@ use vars qw(@stack %val %set %alias %action %hook); "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; @@ -84,45 +100,47 @@ sub showval { 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 @@ -131,14 +149,14 @@ sub onkey($) { 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") { @@ -158,8 +176,9 @@ sub onkey($) { $_ = -$_ 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}; @@ -178,9 +197,15 @@ sub onkey($) { : 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"); @@ -192,41 +217,49 @@ sub onkey($) { $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 diff --git a/termcommon.pm b/termcommon.pm new file mode 100644 index 0000000..245535d --- /dev/null +++ b/termcommon.pm @@ -0,0 +1,106 @@ +# 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; +