#/usr/local/bin/perl

require 'date.pl';

$command = '';
print " Date Calculator version 1.0\n";
print "    (type `h' for help)\n";
print "> ";

while(<stdin>) {
       ($command) = /^\s*(\w+)\s*$/;
       last if (index("quit",$command) == 0);
       if (/^\s*(\d+)\s+(\d+)\s+(\d+)\s*$/) {                  # quit
               $j = &jday($1,$2,$3);
               push(@stack,$j);
               next;
       }
       elsif (/^\s*(\w+)\s+(\d+)(\s+(\d+)?)\s*$/) {    # mmm dd yy
               # assumes this year if year is missing
               $j = &jday(&monthnum($1),$2,$4);
               push(@stack,$j);
               next;
       }
       elsif (/^\s*([-]?\d+)\s*$/) {                                   # [-]n
               push(@stack,$1);
               next;
       }
       elsif (index("clear",$command)==0) {                    # clear
               @stack = ();
               next;
       }
       elsif (index("duplicate",$command)==0) {                # duplicate
               push(@stack,$stack[$#stack]);
               next;
       }
       elsif (index("exchange",$command)==0 ||
              $command eq 'x') {                                               # exchange
               $x = pop(@stack);
               $y = pop(@stack);
               push(@stack,$x);
               push(@stack,$y);
               next;
       }
       elsif (index("print",$command)==0) {                    # print
               do print($stack[$#stack]);
               next;
       }
       elsif (index("today",$command)==0) {                    # today
               push(@stack,&today());
               do print($stack[$#stack]);
               next;
       }
       elsif (/^\s*[+]\s*$/) {                                                 # add
               $y = pop(@stack);
               $x = pop(@stack);
               if (&is_jday($x) && &is_jday($y)) {
                       print stderr "** cannot add two dates\n";
                       push(@stack,$x);
                       push(@stack,$y);
                       next;
               }
               $r = $x + $y;
               push(@stack,$r);
               do print($r);
               next;
       }
       elsif (m:^\s*([\-*/%])\s*$:) {                                  # (-) (*) (/) and (%)
               $y = pop(@stack);
               $x = pop(@stack);
               $r = eval "$x $+ $y";
               warn "** evaluation error $@\n" if $@ ne "";
               push(@stack,$r);
               do print($r);
               next;
       }
       elsif (index("Print",$command)==0) {                            # dump
               do dump();
               next;
       }
       elsif (index("help",$command)==0) {                                     # help
               print <<EOD ;
Commands:

       mmm dd          Push date for current year onto stack
       mmm dd yyyy     Push date onto stack
       n or -n         Push positive/negative constant or interval onto stack
       + - * / %       Add, subtract, multiply, divide, modulo
       expr            Push result of Perl expression onto stack
       <d>uplicate     Push a duplicate of the top value onto the stack
       <c>lear         Clear stack
       <p>rint         Print last value on stack
       <P>rint         Print all stack values
       <t>oday         Put today's date on the stack
       e<x>change      Exchange top two values of stack
       <q>uit          Exit the program

Note:   expressions are scanned for embedded dates of the form `1991/Jan/2',
       `Jan 1, 1991' or just `Jan 1'.  These dates are translated to Julian
       Day numbers before the expression is evaluated.  Also, the tokens
       `today', `tomorrow' and `yesterday' are replaced with their
       respective Julian Day numbers.  If the expression does something
       stupid with Julian Day numbers (like add them) you get silly
       results.
EOD
               next;
       }
       else {
               chop;
               # replace yyyy/mmm/dd dates with Julian day number
                 s|(\d{1,4})\W?(\w\w\w)\W?(\d\d?)|&jday(&monthnum($2),$3,$1)|ge;
               # replace mmm dd yyyy dates with Julian day number
                 s|(\w\w\w)[\W\s](\d\d?)[,]?[\W\s](\d{1,4})|&jday(&monthnum($1),$2,$3)|ge;
               # replace mmm dd dates with Julian day number (for this year)
                 s|(\w\w\w)[\W\s](\d\d?)|&jday(&monthnum($1),$2)|ge;
               # replace 'today' with todays jday
                 s|\b(today)\b|&today()|ge;
               # replace 'tomorrow' with tomorrows jday
                 s|\b(tomorrow)\b|&tomorrow()|ge;
               # replace 'yesterday' with yesterdays jday
                 s|\b(yesterday)\b|&yesterday()|ge;
               print $_,"\n";
               push(@stack,eval($_));
               do print($stack[$#stack]);
               next;
       }
#       else { warn "** invalid command - try \"help\"\n" unless ($_ eq "\n"); }
} continue {
       print "> ";
       $command = "";
}

sub print #(value)
{
       if (&is_jday($_[0])) {
               ($m,$d,$y,$wd) = &jdate($_[0]);
               $month = &monthname($m,3);
               $wkday = &weekday($wd);
               print "= $wkday $month $d, $y (JD = $_[0])\n";
       } else {
               if ($_[0] > 365 || $_[0] < -365) {
                       $years = int($_[0] / 365.25);
                       $days = $_[0] - int($years * 365.25);
                       print "= $_[0] days  ($years years, $days days)\n\n";
               } else {
                       print "= $_[0] days\n\n";
               }
       }
}

sub dump
{
       for ($i = 0; $i <= $#stack; $i++) {
               print "stack[",$i,"] ";
               do print($stack[$i]);
       }
}

You are viewing proxied material from ftp.icm.edu.pl. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.