+++ /dev/null
-#!/usr/bin/perl
-
-# DCT - desktop calculator thingy
-
-# simple modular reverse polish notition calculator
-# by Shiar <shiar.org>
-
-use strict;
-use warnings;
-use utf8;
-
-use Data::Dumper;
-
-our $VERSION = "1.12.1";
-
-use vars qw(@stack %val %set %alias %action %hook);
-
-%set = (
- base => 10, # decimal; set using commands bin/oct/dec/hex/base
-# numb => 0, # fixed scientific engineering
-
- height => 4, # stack depth (lines of stack plus one)
- width => 42, # limit value precision, stetch menu
-); # %set
-
-%alias = (' '=>"enter", "\004"=>"quit"); # rudimentary default key bindings
-
-%action = (
- "enter" => [ 0, sub {
- local $_ = defined $val{i} ? $val{i} : $stack[0];
- undef %val;
- return defined $_ ? $_ : ();
- }], # duplication
-
- "chs" => [ 1, sub { -$_[0] }], # negative
-
- "drop" => [ 1, sub { defined $val{i} ? '' : () }], # drop
- "back" => [ 1, sub { () }], # drop essentially
- "clear" => [ 0, sub { @stack = (); undef %val; () }], # clear all
-
- "swap" => [ 2, sub { reverse @_ }], # swap x<->y
- "stack" => [-2, sub {
- 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
-
-
-my $redraw = 2; # set flag to refresh whole screen
-
-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, $baseexp) = @_;
- return '' unless defined $val;
- return $val if $base==10;
-
- 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;
- $int /= $base;
- } # integer part
- $txt .= '.' if $frac>0;
- for (my $i = 0; length $txt<$set{width}-2 && $frac>0; $i++) {
- $frac *= $base;
- my $char = int $frac;
- $frac -= $char;
- $txt .= $char<10 ? $char : chr($char+55);
- } # fraction part
-
- $txt = "-".$txt if $sign;
- $txt .= 'e'.showval($exp, $base) if $exp;
-
- return $txt;
-} # showval
-
-
-sub draw {
- if ($redraw) {
- if ($redraw>1) {
- $_->() for @{$hook{refresh}};
- }
- $_->() for @{$hook{showstack}};
- $redraw = 0;
- } # do necessary redrawing
-
- {
- 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
-} # 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
-
- for my $cmd (@{$hook{precmd}}) {
- $cmd->() and return; # command was handled by function if returns true
- } # precmd functions
-
- exit if $_ eq "quit"; # break out of loop
-
- if ($_ eq "refresh") {
- redraw(2);
- } # refresh
-
- elsif (/^\033?[A-Z]$/ or exists $val{alpha}) {
- if (defined $val{i}) {
- unshift @stack, $val{i};
- undef %val;
- redraw(1);
- } # enter present value
-
- if ($_ eq "back") {
- $val{alpha} = substr $val{alpha}, 0, -1 or delete $val{alpha};
- } # backspace
- elsif ($_ eq "drop") {
- delete $val{alpha};
- } # drop
- else {
- $val{alpha} .= $key =~ /^\033(.)/ ? uc $1 : lc $key;
- } # add character
- } # manual command entry
-
- elsif (/^[\da-f]$/) {
- m/^[a-z]$/ and $_ = ord($_)-87; # digit>9
- $val{i} = 0 unless defined $val{i};
- $_ = -$_ if $val{i}<0; # substract from negative value
- $val{i} = ($val{frac} and $val{frac} *= 10)
- ? $val{i}+$_/$val{frac} # 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 '.') {
- $val{i} = 0 unless defined $val{i};
- $val{frac} = 1;
- } # decimal point
- elsif ($_ eq "eex") {
- $val{i} = 1 unless defined $val{i};
- $val{ex} = 0;
- } # exponent
- elsif ($_ eq "chs" and defined $val{i}) {
- $val{i} = -$val{i};
- } # change sign
- elsif ($_ eq "back" and defined $val{i}) {
- $val{i} = ($val{frac} and $val{frac} = int $val{frac}/10)
- ? int($val{i}*$val{frac})/$val{frac} # backspace fraction digit
- : int $val{i}/$set{base} # backspace digit in integer part
- } # backspace
-
- elsif (exists $action{$_}) {
- my ($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");
- next;
- } # insufficient arguments
-
- $_->($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}};
-
- redraw(1) if $type>=-1; # redraw stack
- } # some operation
-
- else {
- error(
- "unrecognised command: " # show string or character codes
- . (m/^\w*$/ ? qq{"$_"} : join ' ', map ord, split //, $_)
- );
- } # error
-} # onkey
-
-
-our %modules;
-{
- my %modskip;
- $modskip{substr $_, 1}++ for grep /^-/, @ARGV;
- opendir my $moddir, ".";
- 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
- ? (ref $_ and $modules{$1} = $_, $modules{$1}{name} = $2 || "")
- : print STDERR $@, "error loading $module\n\n";
- } # load modules
- closedir $moddir;
-} # find external modules
-
-printf STDERR "DCT %s by Shiar (%s)\n", $VERSION, join "; ",
- map join(" ", grep $_, $_, $modules{$_}{name}, $modules{$_}{version}),
- keys %modules;
-
-
-$_->() for @{$hook{init}};
-
-$hook{main}->();
-
git.shiar.nl / descalc.git / blobdiff