Hier die Perlversion meines hübschen Stackrechners

Mit "h" bekommt man eine Hilfe, die eigentlich erstmal ausreichen sollte.

Aktuell: Version 0.08 vom 12.Oktober 2000: mit schlauen log/ext-Funktionen!


#!/usr/bin/perl -w

use strict;
use Math::Trig;

my $version   = "0.08";
my $progtitle = " pcalc $version (C)2000 by Tjabo Kloppenburg\n       <Tjabo.Kloppenburg\@gmx.de>\n\n";

my $savefile = $ENV{"HOME"} . "/.calcsave";

my @stack    = ();
my $stackmax = -1;
my @mem    = ();
my @label  = ();
my %defs;

my $winkelmodus = "deg";

my $showdefs = -1;

my $statusline = "";

# Ermitteln der Terminal-Groesse:
my $term_columns = 80;
my $term_lines   = 46;
my $breite = 21;   # Spaltenbreite

sub resize {
  if (open(TERM, "resize |"))  {
    while (<TERM>) {
      my $termline = $_;
      chop($termline);
      chop($termline);
      my @termarray = split(/=/,$termline);
      if ($#termarray == 1) {
        if ($termarray[0] eq "COLUMNS") {
          $term_columns = $termarray[1]+ 0;
        }
        if ($termarray[0] eq "LINES") {
          $term_lines   = $termarray[1]+ 0;
        }
      }
    } #endwhile
  }
  else {
    if (! ((my $termline = $ENV{"COLUMNS"}) eq "")) {
      $term_columns = $termline + 0;
    }
    if (! ((my $termline = $ENV{"LINES"}) eq "")) {
      $term_lines = $termline + 0;
    }
  }

  # Spaltenbreite:
  $breite = int(($term_columns - 18) / 3);
}

resize();

# ---------- Subroutinen: ----------------------------------------

# ------------------------------------------------
# Stackfunktionen:
# ------------------------------------------------

sub mypush { my ($wert) = @_;
  $stackmax++;
  for (my $i = $stackmax; $i >= 1; $i--) {
    $stack[$i] = $stack[$i-1];
  }
  $stack[0] = $wert;
}

sub mypop {
  my $erg = 0;
  if ($stackmax > -1) {
    $erg = $stack[0];
#   print "stack 0 = $erg\n";
    for (my $i = 1; $i <= $stackmax; $i++) {
      $stack[$i-1] = $stack[$i];
    }
    $stackmax--;
  }
  return $erg;
}
# ------------------------------------------------


# ------------------------------------------------
# Ausgabefunktionen:
# ------------------------------------------------

sub rfill{ my ($inhalt,$len,$fillchar) = @_;
  while (length($inhalt) < $len) {
    $inhalt = "$inhalt$fillchar";
  }
  if (length($inhalt) > $len) {
    $inhalt = substr($inhalt,0,$len-1);
  }
  return $inhalt;
}

sub rspace{ my ($inhalt,$len) = @_;
  return rfill($inhalt,$len," ");
}


sub printValue{ my ($value) = @_;
  if (defined($value)) {
    return rspace($value,$breite);
  }
  else {
    return rspace(" ",$breite);
  }
}


sub showstack {

  system("clear");
  print "$progtitle";
  print " STACK:";
  print " " x ($breite-1) . "MEMORY:";
  print " " x ($breite-2) . "LABELS:";
  print "\n";

  for (my $i = 9; $i >= 0; $i--) {
    if ($i != 0) {
      print " a$i : ";
    }
    else {
      print ">a$i : ";
    }

    if ($i <= $stackmax) { print printValue($stack[$i]); }
    else                 { print rspace(" ",$breite); }

    print "m$i : " . printValue($mem[$i]);
    print "l$i : " . printValue($label[$i]);
#    print "  " . printValue($label[$i]);
    print "\n";
  }
  print "\n";
  if ($showdefs == 1) {
    print "Definitionen:\n";
    foreach my $key ( keys %defs ) {
      if (defined($defs{$key})) {
        print "$key = $defs{$key}\n";
      }
    }
  }
  # ----deg----------80x25---------:
  my $outstr = "[$winkelmodus] ";

  $outstr = $outstr . " [Terminal: $term_columns x $term_lines] ";

  print "\n$outstr\n";
  if (length($statusline) > 0) {
    print "STATUS: $statusline\n\n";
  }
  else {
    print "\n\n";
  }
  print "Eingabe (h=Hilfe): ";
  
  $statusline = "";
}

# ------------------------------------------------

sub showhelp {
  system("clear");
  print "$progtitle\n";

  print " ENTERING VALUES:  num (enter), num[+-*/] (enter)\n";
  print "\n";
  print " STORING VALUES:\n";
  print "   s4         : stores value on stack to store #4\n";
  print "   m4         : puts value from store #4 on  stack\n";
  print "   l4 text    : sets label of store #4\n";
  print "   a4         : put stack value 4 on stack\n";
  print "\n";
  print " MISC FUNCTIONS & OPERATORS:\n";
  print "  defs        : show/hide variables\n";
  print "  resize      : redraw calculator after resizing terminal window\n";
  print "  ^           : power function, 2 3 ^  = 8 (x hoch y)\n";
  print "  w           :       36 w = 6 (Wurzel)\n";
  print "  xw          :       function: 8 3 xw = 2 (x.te Wurzel aus y)\n";
  print "  log<zahl>,logx,log :  Logartithmus zur Basis <zahl> bzw. Stackelement. 8 2 logx = 3 = log2(8).\n";
  print "  exp<zahl>,expx,exp :  3 exp4 = 4^3.  expx: 3 2 expx = 2^3.  2 exp = e^2 = nat.Exponent.\n";
  print "  i           : 1/x\n";
  print "\n";
  print " ARCUS FUNCTIONS:\n";
  print "  sin,asin    : calculate sinus or inverse of sinus\n";
  print "  deg,rad     : toggle trigenometric mode\n";
  print "\n";
  print " ENTER";
  my $enter = <STDIN>;
}

# ------------------------------------------------


# ------------------------------------------------
# Arithmetische Funktionen:
# ------------------------------------------------

sub myplus{ 
  if ($stackmax >= 1) {
    my $b = mypop();
    my $a = mypop();
    mypush($a + $b);
  }
}
sub myminus{ 
  if ($stackmax >= 1) {
    my $b = mypop();
    my $a = mypop();
    mypush($a - $b);
  }
}

sub mydurch{
  if ($stackmax >= 1) {
    my $b = mypop();
    my $a = mypop();
    print "a = $a, b = $b\n";
    if ($b == 0) { mypush($a);
                   mypush($b);
                   $statusline = ": Division durch Null!" }
    else         { mypush($a / $b); }
  }
}

sub mymulti{
  if ($stackmax >= 1) {
    my $b = mypop();
    my $a = mypop();
    mypush($a * $b);
  }
}

sub OperationAusfuehren { my ($op) = @_;
  if    ($op eq "+") {
    myplus();
  }
  elsif ($op eq "-") {
    myminus();
  }
  elsif ($op eq "*") {
    mymulti();
 } 
  elsif ($op eq "/") {
    mydurch();
 } 
  elsif ($op eq "i") {
    if ($stackmax >= 0) {
      my $a = mypop();
      if ($a != 0) {
        mypush(1/$a);
      }
      else {
        $statusline = "ERROR: Invertierung von Null ist nicht moeglich...";
        mypush($a);
      }
    }
  }
  elsif ($op eq "sin") {
    if ($stackmax >= 0) {
      my $a = mypop();
      if ($winkelmodus eq "deg") {
        $a = deg2rad($a);
      }
      mypush(sin($a));
    }
  }
  elsif ($op eq "asin") {
    if ($stackmax >= 0) {
      my $a = mypop();
      my $b = asin($a);

      if ($winkelmodus eq "deg") {
        $b = rad2deg($b);
      }
      mypush($b);
    }
  }

  # cosinus:
  elsif ($op eq "cos") {
    if ($stackmax >= 0) {
      my $a = mypop();
      if ($winkelmodus eq "deg") {
        $a = deg2rad($a);
      }
      mypush(cos($a));
    }
  }
  elsif ($op eq "acos") {
    if ($stackmax >= 0) {
      my $a = mypop();
      my $b = acos($a);

      if ($winkelmodus eq "deg") {
        $b = rad2deg($b);
      }
      mypush($b);
    }
  }
  elsif ($op eq "xhochy") {
# x hoch y:
    if ($stackmax >= 1) {
      my $exponent = mypop() + 0;
      my $basis    = mypop() + 0;

      if (log($basis) == 0) {
         $statusline = "Error: log( $basis ) not defined!";
         mypush($basis);
         mypush($exponent);
      } else {
         mypush( exp( $exponent * log($basis)) );
      }
    }
    else {
         $statusline = "Error: not enough data on stack!";
    }
  }
  elsif ($op eq "wurzel") {
    if ($stackmax >= 0) {
        my $zahl = mypop() + 0;
        mypush(sqrt($zahl));
    }
    else {
        $statusline = "Error: not enough data on stack!";
    }
  }
    
  elsif ($op eq "xtewurzelausy") {
    if ($stackmax >= 0) {
      my $exponent = mypop() + 0;
      my $basis    = mypop() + 0;

      if (log($basis) == 0) {
         $statusline = "Error: log( $basis ) not defined!";
         mypush($basis);
         mypush($exponent);
      }
      elsif ($exponent == 0) {
         $statusline = "Error: exponent $exponent not allowed!";
         mypush($basis);
         mypush($exponent);
      }
      else {
         $exponent = 1 / $exponent;
         mypush( exp( $exponent * log($basis)) );
      }
    }
    else {
         $statusline = "Error: not enough data on stack!";
    }
  }

  elsif ($op eq "log") {
     if ($stackmax >= 0) {
        my $command = mypop();

        if ($command =~ /^log([0-9]+)$/) {
            # log2, log5 log10 usw:
            if (defined($1)) {

                my $basis = $1 + 0;
                if ($stackmax >= 0) {
                  my $vonzahl = mypop() + 0;
                  mypush(log($vonzahl) / log($basis));
                }
                else {
                  $statusline = "Error: not enough data on stack!";
                }
            }
            else {
                $statusline = "Error: unbekannter Fehler 28426 :-)!";
            }
        }
        elsif ($command =~ /^logx$/) {
            if ($stackmax >= 1) {
                my $basis = mypop() + 0;
                my $zahl  = mypop() + 0;
                mypush(log($zahl)/log($basis));
            }
            else {
                $statusline = "Error: not enough data on stack!";
            }
        }
        elsif ($command =~ /^log$/) {
            if ($stackmax >= 0) {
                my $zahl = mypop() + 0;
                mypush(log($zahl));
            }
            else {
                $statusline = "Error: not enough data on stack!";
            }
        }
        else {
            $statusline = "Error: unbekanntes LOG-Kommando!";
        }

     }
     else {
       $statusline = "STACK-Fehler!!! Operand liegt nicht auf Stack!";
     }
  }

  elsif ($op eq "exponent") {
     if ($stackmax >= 0) {
        my $command = mypop();

        if ($command =~ /^exp([0-9]+)$/) {
            # exp2, exp5 exp10 usw:
            if (defined($1)) {

                my $basis    = $1 + 0;
                
                # x hoch y:
                if ($stackmax >= 0) {
                    my $exponent = mypop() + 0;
                    mypush( exp( $exponent * log($basis)) );
                }
                else {
                    $statusline = "Error: not enough data on stack!";
                }
            }
        }
        elsif ($command =~ /^expx$/) {
            if ($stackmax >= 1) {
                my $basis    = mypop() + 0;
                my $exponent = mypop() + 0;
                mypush( exp( $exponent * log($basis)) );
            }
            else {
                $statusline = "Error: not enough data on stack!";
            }
        }
        elsif ($command =~ /^exp$/) {
            if ($stackmax >= 0) {
                my $zahl = mypop() + 0;
                mypush(exp($zahl));
            }
            else {
                $statusline = "Error: not enough data on stack!";
            }
        }
        else {
            $statusline = "Error: unbekanntes EXP-Kommando!";
        }

     }
     else {
       $statusline = "STACK-Fehler!!! Operand liegt nicht auf Stack!";
     }
  }


  else {
         $statusline = "Programmierfehler: unbekannter Operator $op !!! (Zeile 353)";
  }

} 

# ------------------------------------------------------

sub mydrop {
  mypop();
}

# -------------------------------------------------------

sub CreateSavefile{
   print "Saving all values to $savefile.\n";

   if (open(SAVEFILE, ">$savefile")) {

     print SAVEFILE "stackmax = $stackmax\n";

     for (my $i = $stackmax; $i >= 0; $i--) {
       print SAVEFILE "a$i = $stack[$i]\n";
     }
     for (my $i = 9; $i >= 0; $i--) {
       if (defined($mem[$i])) { print SAVEFILE "m$i = $mem[$i]\n"; }
       if (defined($label[$i])) {  print SAVEFILE "l$i = $label[$i]\n"; }
     }
     foreach my $key (keys %defs) {
       if (defined($defs{$key})) { print SAVEFILE "def $key = $defs{$key}\n"; }
     }
     print SAVEFILE "showdefs = $showdefs\n";
     close(SAVEFILE);
   }
   else {
     print "Konnte Savefile $savefile nicht schreiben! :-(\n";
   }
}

sub LeseSavefile {
  if (open(SAVEFILE, "<$savefile")) {
     while (<SAVEFILE>) {
   
       if ($_ =~ /^stackmax\ =\ ([-]{0,1}[0-9]+)$/) {
         $stackmax = $1;
       }
       if ($_ =~ /^a([0-9]{1,2})\ =\ (.*)$/) {
         $stack[$1] = $2;
       }
       elsif ($_ =~ /^m([0-9]{1,2})\ =\ (.*)$/) {
         $mem[$1] = $2;
       }
       elsif ($_ =~ /^l([0-9]{1,2})\ =\ (.*)$/) {
         $label[$1] = $2;
       }
       elsif ($_ =~ /^def ([a-zA-Z]+)\ =\ (.*)$/) {
         $defs{$1} = $2;
       }
       elsif ($_ =~ /^showdefs\ =\ (.*)$/) {
         $showdefs = $1;
       }
     
     }
     close(SAVEFILE);
  }
  else {
    $statusline = ": Kein Savefile $savefile gefunden.";
  }
}

# ======================================================
#  H a u p t p r o g r a m m :

$stackmax = -1;

# Einlesen des Savefiles:
LeseSavefile();

my $eingabe;

showstack();
while ($eingabe = <STDIN>) {
 
 chomp($eingabe);
 $eingabe =~ s/,/\./g;

 
 if ($eingabe eq "q") {     # aka QUIT
   # Beenden des Programms: SaveFile schreiben:
   CreateSavefile();
   exit 0;
 }
 elsif ($eingabe =~ /^h$/) {
   showhelp();
 }

 # ----------------------------------------------------------
 #  Erkennen von Zahlenwerten, mit optionalem Operator dahinter:
 # ----------------------------------------------------------

 elsif ($eingabe =~ /^([-]{0,1}[0-9\.]+)([-+\/\*]*)$/) {
   if (defined($1)) {
     mypush($1);
   }
   if (defined($2)) {
     for (my $i = 0; $i < length($2); $i++) {
       OperationAusfuehren(substr($2,$i,1));
     }
   }
 }
 
 # ----------------------------------------------------------
 #  Erkennen von einzelnen Operatoren:
 # ----------------------------------------------------------

 elsif ($eingabe =~ /^([-+\/\*i]{1})$/) {
   if (defined($1)) {
     for (my $i = 0; $i < length($1); $i++) {
       OperationAusfuehren(substr($1,$i,1));
     }
   }
 }
 elsif ($eingabe =~ /^sin$/) {
   OperationAusfuehren("sin");
 }
 elsif ($eingabe =~ /^asin$/) {
   OperationAusfuehren("asin");
 }
 elsif ($eingabe =~ /^cos$/) {
   OperationAusfuehren("cos");
 }
 elsif ($eingabe =~ /^acos$/) {
   OperationAusfuehren("acos");
 }

 elsif ($eingabe =~ /^\^$/) {
   OperationAusfuehren("xhochy");
 }
 elsif ($eingabe =~ /^xw$/) {
   OperationAusfuehren("xtewurzelausy");
 }
 elsif ($eingabe =~ /^w$/) {
   OperationAusfuehren("wurzel");
 }

 elsif ($eingabe =~ /^log(.*)$/) {
   mypush($eingabe);           # Neuer Trick: Befehl auf Stack legen :-)
   OperationAusfuehren("log");
 }
 elsif ($eingabe =~ /^exp(.*)$/) {
   mypush($eingabe);           # Neuer Trick: Befehl auf Stack legen :-)
   OperationAusfuehren("exponent");
 }

 # ----------------------------------------------------------
 #                 drop, clear und clear all, und swap:
 # ----------------------------------------------------------

 elsif ($eingabe =~ /^d$/) {
   mydrop();
 }
 elsif ($eingabe =~ /^c$/) {
   while($stackmax > -1) {
     mydrop();
   }
 }
 elsif ($eingabe =~ /^ca$/) {
   while($stackmax > -1) {
     mydrop();
   }
   for( my $i=0; $i <= 9; $i++) {
     $mem[$i]   = undef;
     $label[$i] = undef; 
   }
 }
 elsif ($eingabe =~ /^s$/) {
   if ($stackmax >= 1) {
     my $a = mypop();
     my $b = mypop();
     mypush($a);
     mypush($b);
   }
   else {
     $statusline = ": Nicht genug Stackelemente!";
   }
 }

 # ----------------------------------------------------------
 #                 Speicherfunktionen:
 # ----------------------------------------------------------
 # Speicher schreiben:
 
 elsif ($eingabe =~ /^s([0-9]+)$/) {
   if ($stackmax > -1) {
     my $a = mypop();
     mypush($a);
     if (($1 > 0) && ($1 <= 9)) {
       $mem[$1] = $a;
     }
   }
 }
 
 
 # Speicher auslesen (m0..9)

 elsif ($eingabe =~ /^m([0-9]+)$/) {
   if (($1 > 0) && ($1 <= 9)) {
     my $a = $mem[$1];
     if (defined($a)) {
       mypush($a);
     }
     else {
       mypush(0);
     }
   }
 }
 # ----------------------------------------------------------
 
 # Auslesen von Stack-Elementen:
 
 elsif ($eingabe =~ /^a([0-9]+)$/) {
   if (($1 > 0) && ($1 <= $stackmax)) {
     my $a = $stack[$1];
     mypush($a);
   }
 }
 
 
 # Label setzen:
 
 elsif ($eingabe =~ /^l([0-9]+)\ *(.*)$/) {
   if (($1 > 0) && ($1 <= 9)) {
     $label[$1] = $2;
   }
 }
 
 
 # ENTER:
 
 elsif ($eingabe =~ /^$/) {
   if ($stackmax >= 0) {
     my $a = mypop();
     mypush($a);
     mypush($a);
   }
 }

 # Schaltervariablen:
 # Variablen zeigen:
 elsif ($eingabe =~ /^rad$/) {
   $winkelmodus = "rad";
 }
 elsif ($eingabe =~ /^deg$/) {
   $winkelmodus = "deg";
 }


 elsif ($eingabe =~ /^resize$/) {
   resize();
   showstack();
 }

 
 # ----------------------------------------------------------
 #                 Variablen definieren usw.:
 # ----------------------------------------------------------
 # Definieren von Variablen:
 
 elsif ($eingabe =~ /^def\ (.+)$/) {
   if ($stackmax > -1) {
     my $a = mypop();
     mypush($a);
     $defs{$1} = $a;
   }
 }
 
 
 # Variablen löschen:
 
 elsif ($eingabe =~ /^undef\ (.+)$/) {
   if (defined($defs{$1})) {
     $defs{$1} = undef;
   }
 }
 
 # Variablen zeigen:
 elsif ($eingabe =~ /^defs$/) {
   $showdefs = - $showdefs;
 }

 
 # Variablen auslesen:
 
 elsif ($eingabe =~ /^([a-zA-Z]+)$/) {
   if (defined($defs{$1})) {
     mypush($defs{$1});
   }
   else {
     $statusline = "Unbekannter Befehl: $eingabe";
   }
 }

 # ----------------------------------------------------------

 showstack();

}