# ncurses output for DCT, by Shiar
-# 1.10.1 200410140120 - all output functions seperated from main
+# 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;
-return 0 if $set{display};
-$set{display} = "curses";
-
push @{$hook{init}}, sub {
initscr;
END { endwin; } # restore terminal on quit
return {
author => "Shiar",
title => "curses output",
- version => "1.10.1",
+ version => "1.11",
};
--- /dev/null
+# s-lang output for DCT, by Shiar
+
+# 1.11.0 200410291300 -
+
+use strict;
+use warnings;
+
+use Term::Slang qw(:common :screen :term :CONSTANTS);
+
+push @{$hook{init}}, sub {
+ SLtt_get_terminfo and exit;
+ SLang_init_tty(-1, 0, 1);
+ SLsmg_init_smg;
+
+ 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;
+}; # init
+
+push @{$hook{showerror}}, sub {
+ my $error = shift;
+ SLsmg_draw_box(0, 0, 3, length($error)+4);
+ SLsmg_gotorc(1, 1);
+ SLsmg_write_string(" $error ");
+ SLsmg_refresh;
+
+ ReadKey; # wait for confirm
+ 1 while defined ReadKey(-1); # clear key buffer
+}; # showerror
+
+push @{$hook{showstack}}, sub {
+ for (0..@stack-1) {
+ SLsmg_gotorc($set{height}-$_, 1);
+ SLsmg_write_string("$_: ".showval($stack[$_], $set{base})); # prompt
+ SLsmg_erase_eol;
+ } # show stack
+ SLsmg_gotorc($set{height}-@stack, 1);
+ SLsmg_erase_eol;
+}; # showstack
+
+push @{$hook{refresh}}, sub {
+ SLsmg_cls;
+ SLsmg_gotorc($set{height}+1, 0);
+ SLsmg_write_string("> "); # prompt
+}; # refresh
+
+push @{$hook{showentry}}, sub {
+ SLsmg_gotorc($set{height}+1, 2);
+ SLsmg_write_string($_[0]);
+ SLsmg_erase_eol;
+ SLsmg_refresh;
+}; # showentry
+
+return {
+ author => "Shiar",
+ title => "slang output",
+ version => "1.11",
+};
+
# 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)
+# 1.11.0 200410152225 - class in file name, so check is not needed anymore
+# 1.10.1 200410142200 - startup message omitted (now shown by main)
+# 1.10.0 200410140120 - never clear screen (just let it scroll)
+# - try to get width/height from environment vars
+# - use escape sequences for clear/reposition/invert
+# - print everything to STDOUT
use strict;
use warnings;
-return 0 if $set{display};
-$set{display} = "stdout";
+#return 0 if $set{display};
+#$set{display} = "stdout";
push @{$hook{init}}, sub {
# print "\ec"; # reset (clear screen, go home)
return {
author => "Shiar",
title => "console output",
- version => "1.10.4",
+ version => "1.11",
};
# key bindings for DCT, by Shiar
-# 1.08.1 200409270040 - moved from 1.8 main
-# .2 200409270049 - single key alias to chs: \ (often close to _)
+# 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
-# .2 200410120145 - alt+backspace and ^W for (hard) drop
-# .3 200410142200 - enter sent as chr 10 on non-curses terminals
+# 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;
# 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.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
-# .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)
+# 1.09.1 200410112150 - everything related to menus moved here
+# 1.06.1 200409152332 - moved @menus from 1.6 main
use strict;
use warnings;
} # addmenu
#my @menu = [];
-my @menu;
-my $menumin = 0;
+our @menu;
+our $menumin = 0;
push @{$hook{init}}, sub {
$menus[0][10] = "quit";
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() {
- 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
+ eval $_ if local $_ = $show{$::modules{disp}{name}};
} # showmenu
$action{more} = [-1, sub {
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;
+ error("no such menu entry");
+ return 1;
}; # precmd
push @{$hook{precmd}}, sub {
return {
author => "Shiar",
title => "menu",
- version => "1.10.4",
+ version => "1.11",
};
--- /dev/null
+use strict;
+use warnings;
+
+# 1.10.0 200410151900 - actions sto/?/rcl to copy/assign/recall variable
+
+my %var;
+
+# "sto" => [ 1, sub { $var{a} = $_[0] }], # copy
+# '?' => [ 1, sub { $var{a} = $_[0] }], # assign
+$action{sto} = [ 1, sub { $var{a} = $_[0] }]; # copy
+$action{rcl} = [ 0, sub { $var{a} }]; # recall
+
+return {
+ author => "Shiar",
+ title => "user variables",
+ version => "1.10",
+};
+
# 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
+# 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;
return {
author => "Shiar",
title => "simple undo",
- version => "1.10.2",
+ version => "1.10.1",
};
# math for DCT, by Shiar
-# 1.09.1 200410022255 - moved from 1.9 main
+# 1.10.4 200410282330 - trig functions from basic menu
+# 1.10.3 200410152245 - rnd, atan, pi
+# - trigonometry functions seperated
+# 1.10.2 200410132050 - probability functions: comb, perm, rdz
+# 1.10.1 200410112340 - adds menu items via addmenu() call
# 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
+# 1.09.1 200410022255 - moved from 1.9 main
+
+#todo: check for errors, eg division by zero
use strict;
use warnings;
use utf8;
-my %newaction = (
+%action = (
+ %action,
+
'+' => [2, sub { $_[1] + $_[0] }], # addition
'-' => [2, sub { $_[1] - $_[0] }], # substraction
'*' => [2, sub { $_[1] * $_[0] }], # multiplication
'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
- 'acos' => [1, sub { atan2(sqrt(1 - $_[0]*$_[0]), $_[0]) }], # inverse cosine
- 'tan' => [1, sub { sin($_[0]) / cos($_[0]) }], # tangent
-# 'atan' => [1, sub { }], # arctangent
-
- 'sinh' => [1, sub { (exp($_[0]) - exp(-$_[0])) / 2 }], # hyperbolic sine
- 'cosh' => [1, sub { (exp($_[0]) + exp(-$_[0])) / 2 }], # hyperbolic cosine
- 'tanh' => [1, sub { (exp($_[0]) - exp(-$_[0])) / (exp($_[0]) + exp(-$_[0])) }], # hyperbolic tangent (sinh/cosh)
- 'asinh'=> [1, sub { log(sqrt($_[0]**2+1) + $_[0]) }], # inverse hyperbolic sine
- 'acosh'=> [1, sub { log(sqrt($_[0]**2-1) + $_[0]) }], # inverse hyperbolic cosine
- 'atanh'=> [1, sub { log((1+$_[0]) / (1-$_[0])) / 2 }], # inverse hyperbolic tangent
-
# binary
'and' => [2, sub { $_[1] & $_[0] }], # bitwise and
'or' => [2, sub { $_[1] | $_[0] }], # bitwise or
# '%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
+ 'abs' => [1, sub { abs $_[0] }], # absolute
'sign' => [1, sub { $_[0] <=> 0 }], # sign
'ip' => [1, sub { int $_[0] }], # integer part
'fp' => [1, sub { $_[0] - int $_[0] }], # fractional part
-# 'rnd' => [1, sub { local $_ = 10**$_[0]; $val{i} = int(($val{i}+.5)*$_)/$_ }], # round
+ 'rnd' => [1, sub { sprintf "%.0f", $_[0] }], # round
# 'trnc' => [1, sub { local $_ = 10**$_[0]; $val{i} = int($val{i}*$_)/$_ }], # truncate
'floor'=> [1, sub { int $_[0] }], # floor
'ceil' => [1, sub { int $_[0]+.9999 }], # ceil
# 'utpf' => [3], # F distribution
); # newaction
-#while (my ($cmd, $val) = each %newaction) {$action{$cmd} = $val}
-$action{$_} = $newaction{$_} for keys %newaction;
-
addmenu(["main", 0], "math",
- [qw(basic log alog ln exp sin cos tan asin acos atan sq sqrt ^ xroot)],
+ [qw(basic sq sqrt ^ xroot log alog ln exp)],
# [qw(vector)],
# [qw(matrix)],
# [qw(list)],
- [qw(hyperbolic sinh cosh tanh asinh acosh atanh expm lnp1)],
+# [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)],
return {
author => "Shiar",
title => "basic math",
- version => "1.10.2",
+ version => "1.10.4",
};
--- /dev/null
+# trigonometry for DCT, by Shiar
+
+# 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
+# 1.11.0 200410152320 - a?(sin|cos|tan)h? actions from math; links in main submenu trig
+
+use strict;
+use warnings;
+
+my $pi = atan2(1, 1) * 4;
+
+$set{card} = 1; # degrees radians grades
+
+%action = (
+ %action,
+
+ 'pi' => [0, sub { $pi }], # pi constant
+
+ 'deg' => [-1, sub { $set{card} = 1 }], # set degrees
+ 'rad' => [-1, sub { $set{card} = 2 }], # set radians
+
+ # trigonometric
+ 'sin' => [1, sub { sin $_[0] }], # sine
+ 'asin' => [1, sub { atan2($_[0], sqrt(1 - $_[0]*$_[0])) }], # inverse sine
+ 'cos' => [1, sub { cos $_[0] }], # cosine
+ 'acos' => [1, sub { atan2(sqrt(1 - $_[0]*$_[0]), $_[0]) }], # inverse cosine
+ 'tan' => [1, sub { sin($_[0]) / cos($_[0]) }], # tangent
+ 'atan' => [1, sub { atan2($_[0], 1) }], # arctangent
+
+ # hyperbolic
+ 'sinh' => [1, sub { (exp($_[0]) - exp(-$_[0])) / 2 }], # hyperbolic sine
+ 'cosh' => [1, sub { (exp($_[0]) + exp(-$_[0])) / 2 }], # hyperbolic cosine
+ 'tanh' => [1, sub { (exp($_[0]) - exp(-$_[0])) / (exp($_[0]) + exp(-$_[0])) }], # hyperbolic tangent (sinh/cosh)
+ 'asinh'=> [1, sub { log(sqrt($_[0]**2+1) + $_[0]) }], # inverse hyperbolic sine
+ 'acosh'=> [1, sub { log(sqrt($_[0]**2-1) + $_[0]) }], # inverse hyperbolic cosine
+ 'atanh'=> [1, sub { log((1+$_[0]) / (1-$_[0])) / 2 }], # inverse hyperbolic tangent
+); # action
+
+push @{$hook{preaction}}, sub {
+ return unless $set{card}==2;
+ # convert user input from radians if necessary
+ $stack[0] /= 360/$pi if $_[1] =~ /^(?:sin|cos|tan)h?$/;
+}; # preaction
+push @{$hook{postaction}}, sub {
+ return unless $set{card}==2;
+ # convert command output to radians if necessary
+ $stack[0] *= 360/$pi if $_[1] =~ /^a(?:sin|cos|tan)h?$/;
+}; # postaction
+
+addmenu(["main", 0], "trig", #todo: in math, not in main
+ qw(sin cos tan asin acos atan),
+ qw(sinh cosh tanh asinh acosh atanh),
+ qw(expm lnp1),
+);
+
+return {
+ author => "Shiar",
+ title => "trigonometry",
+ version => "1.11.1",
+};
+
# 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.11.0 200410291000 - use redraw()
+# 1.10.5 200410151900 - data storage units (8 total, including LOC)
+# 1.10.4 200410132300 - hp49 units for mass
+# 1.10.3 200410130000 - fix error when run without menu module
+# 1.10.2 200410122200 - adds submenus with all units
# 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
+# 1.09.2 200410112205 - all code moved here as well
+# 1.09.1 200410022305 - moved %unit specs from 1.9 main
use strict;
use warnings;
# [], # light
# [], # radiation
# [], # viscosity
+
+ [
+ "data storage", # memory
+ ['B', 1, "byte"],
+ ['kB', 1024, "kilobyte"],
+ ['MB', 1024**2, "megabyte"],
+ ['GB', 1024**3, "gigabyte"],
+ ['TB', 1024**4, "terabyte"],
+ ['bit', 1/8, "bit/octet"],
+ ['Mbit', 1024**2/8, "megabit"],
+ ['LOC', 19e12, 'Library of Congress'], # est. 17-20TB
+ ],
); # units table
push @{$hook{precmd}}, sub {
# $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();
+ redraw(1);
undef %val;
} # convert
else {
return {
author => "Shiar",
title => "unit convertor",
- version => "1.10.4",
+ version => "1.11",
};
--- /dev/null
+200410291000 1.11.2
+ - global redraw() to queue a stack/screen refresh
+200410282330 1.11.1
+ - postaction hook after running commands
+ - give command name as parameter to pre/postaction hooks
+200410152225 1.11.0
+ - modules filenames can contain class; only loads first of any class
+
+200410151900 1.10.7
+ - main changelog moved to seperate CHANGES file
+ - user variables to module; our %var removed
+ - redraw inside main loop; automatically called after error
+ - when showing values with exponent, also adjust fraction
+200410150015 1.10.6
+ - invalid commands shown as strings instead of character codes
+200410150000 1.10.5
+ - only first module run of multiple with the same name
+ - preaction hook; undo functionality moved to module
+200410142145 1.10.4
+ - display welcome at startup, also showing version and modules
+ - allow modules to not load but without error
+200410132200 1.10.3
+ - digits added/removed to/from integer part in correct number base
+200410130020 1.10.2
+ - altered stack not redrawn after undo
+200410120245 1.10.1
+ - fixed backspace with undef fraction
+
+200410120213 1.09.6
+ - $val{frac} default undefined instead of 0
+200410120150 1.09.5
+ - normal drop command (alt+bs) removes input/stack value at once
+ - backspace becomes "back" (soft drop, like old "drop")
+200410112205 1.09.4
+ - unit conversion out of main program (entirely into unitconv.pm)
+200410112150 1.09.3
+ - all menu related functions moved to menu.pm
+200410112130 1.09.2
+ - hooks allowing for extra code at reload, showentry, and precmd
+200409291215 1.09.1
+ - number of menu items depends on screen width
+200409270057 1.09.0
+ - all key aliases moved to module DCT::Bindings
+
+200409262210 1.08
+ - stack command (cursor up) cycles through values in stack
+ - fixed %
+ - second undo redoes
+ - negative numbers displayed correctly in different bases
+ - additional digits were not correctly applied to negative values
+
+200409242350 1.07
+ - new commands: sr/sr, shortkeys ( )
+ - enter on no value repeats last val on stack
+ - action undo: last stack alteration can be undone
+ - numeric modifiers hardcoded instead of in action hash
+
+200409152310 1.06
+ - x and v shortkeys
+ - new commands: a?(sin|cos|tan)h, inv, !, rand
+ - menu contents in module
+
+200409101945 1.05
+ - q for sq(rt) (formerly quit, now only ^D/quit)
+ - some unit conversion (mostly lengths) from menu
+ - command backspacing
+ - error on insufficient arguments for command
+ - hp48-like drop (backspace but not editing value)
+ 200409092200
+ - overhaul in stack handling
+
+200408041445 1.04
+ - ^L redraws screen
+ - manual command input using capital letters
+ - error dialog (don't mess up screen)
+
+20040625 1.03
+ - can enter fractions (.) and negative values (_)
+ - values displayable in arbitrary base
+
+20040620 1.02
+ - backspace to undo last digit
+ - function keys select command/submenu from (sub)menu
+
+20040618 1.01
+ - start (curses, some basic commands)
+
use Data::Dumper;
use Term::ReadKey;
-our $VERSION = "1.10.6";
+our $VERSION = "1.11.2";
-use vars qw(@stack %val %var %set %alias %action %hook);
+use vars qw(@stack %val %set %alias %action %hook);
+my $redraw = 2; # set flag to refresh whole screen
%set = (
base => 10, # decimal; set using commands bin/oct/dec/hex/base
- numb => 0, # fixed scientific engineering
- card => 1, # degrees radians grades
- coord => 0, # cartesian polar spherical
- complex => 0, # real complex
+# numb => 0, # fixed scientific engineering
+# coord => 0, # cartesian polar spherical
+# complex => 0, # real complex
height => 4, # stack depth (lines of stack plus one)
width => 42, # limit value precision, stetch menu
"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}++];
+ my $stackpos if 0;
+ $stackpos = 0 unless $stackpos; # initialize
+ $stackpos %= @stack; # cycle
+ $val{i} = $stack[$stackpos++];
}], # stack
- "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 redraw($) {
+ # queue a redraw of level $_[0]
+ $redraw = $_[0] if $_[0]>$redraw;
+} # redraw
+
sub error($) {
$_->($_[0]) for @{$hook{showerror}};
+ redraw(2);
} # error
-sub showval($$);
-sub showval($$) {
- my ($val, $base) = @_;
+sub showval;
+sub showval {
+ my ($val, $base, $baseexp) = @_;
return '' unless defined $val;
return $val if $base==10;
- my $sign = $val<0;
- $val = abs $val;
- my $int = int $val;
- my $frac = $val-$int;
- my $exp = 0;
-
my $txt = '';
+ my $sign = $val<0 and $val = abs $val;
+ my $int = int $val;
+
+ my $exp = $val{ex} || 0;
while ($int>$base**10) {
$int /= $base;
$exp++;
} # exponent part
+ my $frac = $val-$int;
while ($int>=1) {
my $char = $int%$base;
- $txt = ($char<10 ? $char : chr($char+55)).$txt;
+ $txt = ($char<10 ? $char : chr($char+55)) . $txt;
$int /= $base;
} # integer part
-
$txt .= '.' if $frac>0;
for (my $i = 0; length $txt<$set{width}-2 && $frac>0; $i++) {
$frac *= $base;
return $txt;
} # showval
-sub showstack() {
- $_->() for @{$hook{showstack}};
-} # showstack
-
-my %modules;
+our %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
+ next unless $module =~ /^\d{2}_([a-z0-9-]+)(?:_(\w+))?\.pm$/; # filename 00_class_name.pm
+ next if defined $modules{$1}; # no such module already loaded
+# next if $1 eq "disp" and $2 eq "curses";
+ defined ($_ = do $module) # return value means no errors
+ ? (ref $_ and $modules{$1} = $_, $modules{$1}{name} = $2 || "")
: print STDERR $@, "error loading $module\n\n";
} # load modules
-printf STDERR "DCT %s by Shiar (%s)\n", $VERSION,
- join "; ", map {"$_ $modules{$_}{version}"} keys %modules;
+printf STDERR "DCT %s by Shiar (%s)\n", $VERSION, join "; ",
+ map join(" ", grep $_, $_, $modules{$_}{name}, $modules{$_}{version}), keys %modules;
ReadMode 3; # cbreak mode
END { ReadMode 0; } # restore terminal on quit
$_->() for @{$hook{init}};
-my $redraw = 1;
LOOP: while (1) {
if ($redraw) {
- $_->() for @{$hook{refresh}};
- showstack();
+ if ($redraw>1) {
+ $_->() for @{$hook{refresh}};
+ }
+ $_->() for @{$hook{showstack}};
$redraw = 0;
} # refresh
{
- my $entry = showval($val{i}, $set{base});
- $entry .= $_ for map $_->(), @{$hook{postentry}};
+ my $entry = showval($val{i}, $set{base}, $val{ex});
+ $entry .= $_->() for @{$hook{postentry}};
$entry .= $val{alpha} if exists $val{alpha};
$_->($entry) for @{$hook{showentry}};
} # show entry
- my $key = ReadKey;
+ my $key = ReadKey; # wait for user input
if ($key eq chr 27) {
$key .= $_ while defined ($_ = ReadKey(-1)); # read additional keys
} # escape sequence
- $_ = $alias{$key} || $key; #if exists $alias{$key}; # command shortkeys
+ $_ = exists $alias{$key} ? $alias{$key} : $key; # command (alias maps keys to commands)
$_ = delete $val{alpha} if $_ eq "enter" and exists $val{alpha}; # use manual command
for my $cmd (@{$hook{precmd}}) {
- next LOOP if $cmd->();
+ $cmd->() and next LOOP; # command was handled by function if returns true
} # precmd functions
- last if $_ eq 'quit';
+ last if $_ eq 'quit'; # break out of loop
if ($_ eq 'refresh') {
- $redraw++;
+ redraw(2);
} # refresh
elsif (/^\033?[A-Z]$/ or exists $val{alpha}) {
if (defined $val{i}) {
unshift @stack, $val{i};
undef %val;
- showstack();
+ redraw(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
} # digit
elsif ($_ eq '.') {
} # decimal point
elsif ($_ eq "eex") {
$val{i} = 1 unless defined $val{i};
- #todo
+ $val{ex} = 0;
} # exponent
elsif ($_ eq "chs" and defined $val{i}) {
$val{i} = -$val{i};
} # backspace
elsif (exists $action{$_}) {
- my ($type, $cmd) = @{$action{$_}};
+ my ($action, $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");
- $redraw++;
next;
} # insufficient arguments
- $_->($type) for @{$hook{preaction}};
-
+ $_->($type, $action) 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);
+ $_->($type, $action) for @{$hook{postaction}};
- showstack() if $type>=-1;
+ redraw(1) if $type>=-1; # redraw stack
} # some operation
else {
"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 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
git.shiar.nl / descalc.git / commitdiff