From: Shiar <shiar@shiar.org>
Date: Wed, 23 Jun 2004 22:06:20 +0000 (+0200)
Subject: release 1.03
X-Git-Url: http://git.shiar.net/descalc.git/commitdiff_plain/375edfcd40c9aae752068931a7831a1dae3d0d7e

release 1.03

Oldest snapshot I could find.

Curses interface, some basic commands and menu.

This version adds fraction and negative input, and preliminary base
conversion.
---

375edfcd40c9aae752068931a7831a1dae3d0d7e
diff --git a/sdc.pl b/sdc.pl
new file mode 100644
index 0000000..09541a0
--- /dev/null
+++ b/sdc.pl
@@ -0,0 +1,247 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Term::ReadKey;
+use Curses;
+
+initscr;
+ReadMode 3;
+
+my $height = $LINES-3;
+my $width = 42; #COLS
+
+my @stack;
+my @val;
+my $nopush; # 0=push and reset next; 1=reset next; 2=do nothing
+my $base = 10;
+my @menu;
+
+INIT: {
+
+@stack = ();
+@val = (0, 0); # val, frac
+$nopush = 1;
+
+sub showval($$) {
+	my ($val, $base) = @_;
+	return $val if $base==10;
+
+	my $int = int $val;
+	my $frac = $val-$int;
+
+	my $txt = '';
+	while ($int>=1) {
+		my $char = $int%$base;
+		$txt = ($char<10 ? $char : chr($char+55)).$txt;
+		$int /= $base;
+	}
+
+	$txt .= '.' if $frac>0;
+	for (my $i = 0; length $txt<$width-2 && $frac>0; $i++) {
+		$frac *= $base;
+		my $char = int $frac;
+		$frac -= $char;
+		$txt .= $char<10 ? $char : chr($char+55);
+	}
+
+	return $txt;
+} # showval
+
+sub showstack() {
+	for (0..@stack-1) {
+		addstr($height-$_, 1, "$_: ".showval($stack[$_], $base));
+		clrtoeol;
+	} # show stack
+	clrtoeol($height-$#stack-1, 1);
+} # showstack
+
+sub showmenu($) {
+	my @menus = ([qw(xroot log alog)], [qw(dec bin oct hex)]);
+	@menu = @{$menus[shift]};
+	attron(A_REVERSE);
+	addstr($height+2, $width/6*$_+1, join " ", $menu[$_]) for grep exists $menu[$_], 0..5;
+	attroff(A_REVERSE);
+	clrtoeol;
+	addstr($height+2, $width/6*$_, $_+1) for grep exists $menu[$_], 0..5;
+} # showmenu
+
+my %falias = (
+	chr(27).chr(79).chr(80)                  =>  0, # F1
+	chr(27).chr(79).chr(81)                  =>  1, # F2
+	chr(27).chr(79).chr(82)                  =>  2, # F3
+	chr(27).chr(79).chr(83)                  =>  3, # F4
+	chr(27).chr(91).chr(49).chr(53).chr(126) =>  4, # F5
+	chr(27).chr(91).chr(49).chr(55).chr(126) =>  5, # F6
+	chr(27).chr(91).chr(49).chr(56).chr(126) =>  6, # F7
+	chr(27).chr(91).chr(49).chr(57).chr(126) =>  7, # F8
+	chr(27).chr(91).chr(50).chr(48).chr(126) =>  8, # F9
+	chr(27).chr(91).chr(50).chr(49).chr(126) =>  9, # F10
+	chr(27).chr(91).chr(50).chr(51).chr(126) => 10, # F11
+	chr(27).chr(91).chr(50).chr(52).chr(126) => 10, # F12
+); # %falias
+
+my %alias = (
+	q     => chr 4,   # quit
+	s     => 'sin',
+	c     => 'cos',
+	t     => 'tan',
+	l     => 'log',
+	x     => 'xroot',
+	chr 8 => chr 127, # backspace
+); # %alias
+
+my %action = (
+	chr 13 => sub {
+		unshift @stack, $stack[0];
+		$nopush = 1;
+	}, # duplication
+
+	'+' => sub {
+		$stack[1] += shift @stack;
+	}, # addition
+	'-' => sub {
+		$stack[1] -= shift @stack;
+	}, # substraction
+	'*' => sub {
+		$stack[1] *= shift @stack;
+	}, # multiplication
+	'/' => sub {
+		$stack[1] /= shift @stack;
+	}, # division
+	'%' => sub {
+		$stack[1] %= shift @stack;
+	}, # modulus
+
+	'^' => sub {
+		$stack[1] **= shift @stack;
+	}, # exponentiation
+	'xroot' => sub {
+		$stack[1] **= 1/shift @stack;
+	}, # x-root of y
+
+	'&' => sub {
+		$stack[1] &= shift @stack;
+	}, # bitwise and
+	'|' => sub {
+		$stack[1] |= shift @stack;
+	}, # bitwise or
+	'#' => sub {
+		$stack[1] ^= shift @stack;
+	}, # bitwise xor
+	'~' => sub {
+		unshift @stack, ~(shift @stack);
+	}, # bitwise not
+
+	'log' => sub {
+		unshift @stack, log shift @stack;
+	}, # logarithm
+	'alog' => sub {
+		unshift @stack, 10 ** shift @stack;
+	}, # 10^x
+
+	'sin' => sub {
+		unshift @stack, sin shift @stack;
+	}, # sine
+	'cos' => sub {
+		unshift @stack, cos shift @stack;
+	}, # cosine
+	'tan' => sub {
+		local $_ = shift @stack;
+		unshift @stack, sin($_) / cos($_);
+	}, # tangent
+
+	'abs' => sub {
+		unshift @stack, abs shift @stack;
+	}, # absolute
+	'_' => sub {
+		unshift @stack, -shift @stack;
+	}, # negative
+	'min' => sub {
+		local $_ = shift @stack;
+		$stack[1] = $_ if $_<$stack[1];
+	}, # minimum
+
+	'dec' => sub {
+		$base = 10;
+	}, # decimal
+	'bin' => sub {
+		$base = 2;
+	}, # binary
+	'oct' => sub {
+		$base = 8;
+	}, # octal
+	'hex' => sub {
+		$base = 16;
+	}, # hexadecimal
+	'base36' => sub {
+		$base = 36;
+	}, # alphanumerical
+); # %action
+
+clear;
+showmenu(0);
+addstr($height+1, 0, "> ");
+
+while (1) {
+	addstr($height+1, 2, showval($val[0], $base));
+	clrtoeol;
+	refresh;
+
+	$_ = ReadKey;
+	if ($_ eq chr 27) {
+		while (defined (my $key = ReadKey -1)) {
+			$_ .= $key;
+		} # read additional keys
+	} # escape
+
+	exists $alias{$_}  and $_ = $alias{$_};
+	exists $falias{$_} and $_ = $menu[$falias{$_}];
+
+	if ($_ eq chr 4) {
+		last INIT;
+	} # ^D
+	elsif ($_ eq chr 27) {
+		redo INIT;
+	} # escape
+
+	elsif (/^[\d.]$/) {
+		unshift @stack, $val[0] and showstack() unless $nopush;
+		@val = (0, 0) if $nopush<2; # replace current
+		$nopush = 2;
+		if ($_ eq '.') {
+			$val[1] = 1;
+		} # dot
+		elsif ($val[1] *= 10) {
+			$val[0] += $_/$val[1];
+		} # fraction
+		else {
+			$val[0] = $val[0]*10+$_;
+		} # integer
+	} # number
+	elsif ($_ eq chr 127) {
+		if ($val[1] = int $val[1]/10) {
+			$val[0] = int($val[0]*$val[1])/$val[1];
+		} else {
+			$val[0] = int $val[0]/10
+		}
+	} # backspace
+
+	elsif (exists $action{$_}) {
+		unshift @stack, $val[0];
+		$nopush = 0;
+		$action{$_}();
+		$val[0] = shift @stack;
+		showstack();
+	} # some operation
+
+	else {
+		print "\n* error: ", join(' ', map ord, split //, $_), "\n";
+	}
+} # input loop
+}
+
+ReadMode 0;
+endwin;
+