Category : Miscellaneous Language Source Code
Archive   : QTAWKU42.ZIP
Filename : CALCRPNA.EXP

# calcrp - reverse-Polish calculator
#
# Reverse Polish Calculator.
# (C) Copyright 1989, 1990 Terry D. Boldt, All Rights Reserved.
#
# input: expression in reverse polish
# output: value of each expression
#
BEGIN {
month_array[ 1] = "January";
month_array[ 2] = "February";
month_array[ 3] = "March";
month_array[ 4] = "April";
month_array[ 5] = "May";
month_array[ 6] = "June";
month_array[ 7] = "July";
month_array[ 8] = "August";
month_array[ 9] = "September";
month_array[10] = "October";
month_array[11] = "November";
month_array[12] = "December";
week_day[0] = "Sunday";
week_day[1] = "Monday";
week_day[2] = "Tuesday";
week_day[3] = "Wednesday";
week_day[4] = "Thursday";
week_day[5] = "Friday";
week_day[6] = "Saturday";
number = /^({_i}|{_f}({_e})?)$/; # integer & floating point numbers
variable_set = /^[a-zA-Z_][a-zA-Z0-9]*=$/; # variable name set
variable_del = /^[a-zA-Z_][a-zA-Z0-9]*-$/; # variable name delete
vars["pi"] = pi; # built-in variable
vars["e"] = exp(1); # built-in variable
rtd = 180/pi; # constant to convert radians to degrees
cm_inch = 2.54; # centimeters / inch (exact)
km_sm = 1.609344; # kilometers / mile (exact)
Lts_gal = 3.785411784;# Liters / gallon (U.S. liquid)
stderr = "stderr";
prt_ln = "%s\n";
#
# Gregorian/Julian calender flag.
# TRUE == julian
# FALSE == gregorian
#
greg_jul = FALSE;
split(sdate(1),tdate,/\//);
vars["today"] = jdn(tdate[3],tdate[1],tdate[2]);

Yess = /[Yy](es)?/; # Yes string
Nos = /[Nn]o?/; # No string
Yes = /^{_w}*{Yess}{_w}*$/; # Yes answer
No = /^{_w}*{Nos}{_w}*$/; # No answer
Quit = /^{_w}*[Qq](uit)?({_w}+({Yess}|{Nos}))?{_w}*$/; # define regular expression To Quit
Help = /^{_w}*[Hh](elp)?{_w}*$/; # define regular expression for Help
Stat = /^{_w}*[Ss](tat)?{_w}*$/; # define regular expression for Stats
Cls = /^{_w}*[Cc](ls)?{_w}*$/; # define regular expression To Clear Screen

quit_status = TRUE;

copyright;
prompt;
}

GROUP Quit {
if ( NF > 1 ) {
switch ( $2 ) {
case Yes:
quit_status = TRUE;
break;
case No:
quit_status = FALSE;
break;
}
}
exit 2;
}

GROUP Help { help; prompt; next; }

GROUP Stat { stat; prompt; next; }

GROUP Cls { copyright; prompt; next; }

{
local ivar, ntime, dte;

for ( i = 1 ; i <= NF ; i++ ) {
if ( $i ~~ number ) { # find numbers
stack[++top] = $i + 0.0; # force numbers to real by adding 0.0
} else if ( j = mono_operation($i) ) { # built-in mono operator ?
j; # do nothing statement
} else if ( j = binary_operation($i) ) { # built-in binary operator ?
top--;
} else if ( j = tern_operation($i) ) { # built ternary operator ?
top -= 2;
} else if ( $i == "pmonth" ) { # set stack top to current time
dte = caln(today);
three_month(dte[1],dte[2],dte[3]);
} else if ( $i == "now" ) { # set stack top to current time
split(stime(1),ntime,/:/);
stack[++top] = hrs(ntime[1] + 0.0,ntime[2] + 0.0,ntime[3] + 0.0);
} else if ( $i == "deg" ) { # use degrees in trig
DEGREES = TRUE; # set built-in variable
} else if ( $i == "rad" ) { # use radians in trig - start-up default
DEGREES = FALSE; # set built-in variable
} else if ( $i == "greg" ) { # toggle gregorian/julian calender
greg_jul = !greg_jul;
printf("Calender Set: %s.\n",greg_jul ? "Julian" : "Gregorian");
} else if ( $i in vars ) { # defined variable ?
stack[++top] = vars[$i];
} else if ( $i ~~ variable_set && top > 0 ) { # variable definition ?
# NOTE: for single letter variable names,
# substr($i,1,length($i)-1)
# returns a single letter and not a string. The single letter
# is interpreted by the subscripting routine as a numeric
# and gives 'strange' subscripts. To prevent, concatenate
# a null string on substr return to force to a string irregardless
vars[substr($i,1,length($i)-1) ï ""] = stack[top--];
} else if ( $i ~~ variable_del ) { # variable deletion ?
# Again force substr return to a string
ivar = substr($i,1,length($i)-1) ï "";
if ( ivar in vars ) delete vars[ivar];
else printf("error: attempt to delete ivar - non-existent.\n");
} else { # unknown operation
printf("error: cannot evaluate %s\n",$i);
top = 0;
prompt;
next;
}
}
if ( top == 1 && $NF !~ /^=$/ ) {
ostr = addcomma(stack[top--]);
print "\t" ostr;
} else if ( top > 1 ) {
printf("error: too many operands\n");
top = 0;
}
prompt;
}

END {
if ( quit_status ) copyright;
}

# function to find binary operations - needs two numbers
function binary_operation(op) {
local ret = FALSE; # return value - assume no match
local swap;

if ( top > 1 ) switch ( op ) {
case '+': # addition
stack[top-1] += stack[top];
ret = 1;
break;
case '-': # subtraction
stack[top-1] -= stack[top];
ret = 2;
break;
case '*': # multiplication
stack[top-1] *= stack[top];
ret = 3;
break;
case '/': # division
stack[top-1] /= stack[top];
ret = 4;
break;
case '^': # exponentiation
stack[top-1] ^= stack[top];
ret = 5;
break;
case '&': # binary and
stack[top-1] &= stack[top];
ret = 6;
break;
case '|': # binary or
stack[top-1] |= stack[top];
ret = 7;
break;
case '@': # binary xor
stack[top-1] @= stack[top];
ret = 8;
break;
case '%': # modulus
stack[top-1] %= stack[top];
ret = 9;
break;
case ">>": # shift right
stack[top-1] >>= stack[top];
ret = 10;
break;
case "<<": # shift left
stack[top-1] <<= stack[top];
ret = 11;
break;
case "swap": # swap top two stack numbers
swap = stack[top];
stack[top] = stack[top-1];
stack[top-1] = swap;
top++; # compensate for reduction upon return
ret = 12;
break;
case "atan2":
stack[top-1] = atan2(stack[top-1],stack[top]);
ret = 13;
break;
case "calm":
three_month(int(stack[top-1]),int(stack[top]),0);
top--;
ret = 14;
break;
}
return ret;
}

# function to recognize mono operations - require only one number
function mono_operation(fun) {
local ret = FALSE; #return value - assume no match
local stck = FALSE;

if ( top ) switch ( fun ) {
case "sin":
stack[top] = sin(stack[top]);
ret = 100;
break;
case "asin":
stack[top] = asin(stack[top]);
ret = 100;
break;
case "cos":
stack[top] = cos(stack[top]);
ret = 101;
break;
case "acos":
stack[top] = acos(stack[top]);
ret = 101;
break;
case "sinh":
stack[top] = sinh(stack[top]);
ret = 117;
break;
case "cosh":
stack[top] = cosh(stack[top]);
ret = 118;
break;
case "log":
stack[top] = log(stack[top]);
ret = 102;
break;
case "log10":
stack[top] = log10(stack[top]);
ret = 102;
break;
case "int":
stack[top] = int(stack[top]);
ret = 103;
break;
case "exp":
stack[top] = exp(stack[top]);
ret = 104;
break;
case "sqrt":
stack[top] = sqrt(stack[top]);
ret = 105;
break;
case "fract":
stack[top] = fract(stack[top]);
ret = 106;
break;
case "push":
stack[top+1] = stack[top];
top++;
ret = 107;
break;
case "pop":
top--;
ret = 108;
break;
case "=": # display top of stack
printf("\t%d: %s\n",top,addcomma(stack[top]));
ret = 109;
break;
case "=s": # display entire stack
for ( stck in stack ) printf("\t%d: %s\n",stck,addcomma(stack[stck]));
ret = 118;
break;
case '~': # ones complement
stack[top] = ~stack[top];
ret = 110;
break;
case /^\+\/?-$/: # change sign of stack top
case /^-\/?\+$/: # change sign of stack top
stack[top] = -stack[top];
ret = 117;
break;
case "rtd": # convert radians to degrees
stack[top] = stack[top] * rtd;
ret = 111;
break;
case "dtr": # convert degrees to radians
stack[top] = stack[top] / rtd;
ret = 112;
break;
case "cti": # convert centimeters to inches
stack[top] = stack[top] / cm_inch;
ret = 113;
break;
case "itc": # convert inches to centimeters
stack[top] = stack[top] * cm_inch;
ret = 114;
break;
case "ktm": # convert kilometers to miles
stack[top] = stack[top] / km_sm;
ret = 114;
break;
case "mtk": # convert miles to kilometers
stack[top] = stack[top] * km_sm;
ret = 114;
break;
case "ltg": # convert Liters to gallons
stack[top] = stack[top] /Lts_gal;
ret = 114;
break;
case "gtl": # convert gallons to Liters
stack[top] = stack[top] * Lts_gal;
ret = 114;
break;
case "cals": # convert stack top from julian day number to date
# leave result on stack
stck = TRUE;
case "cal": # convert stack top from julian day number to date
ret = (stack[top] + 1) % 7;
stack_date(stack[top]);
printf("\tyr: %2u\n",stack[top-2]);
printf("\tmo: %2u (%s)\n",stack[top-1],month_array[stack[top-1]]);
printf("\tdy: %2u (%s)\n",stack[top],week_day[ret]);
if ( !stck ) top -= 3;
ret = 115;
break;
case "hmss": # convert stack top from hrs to hrs, minutes, seconds
# leave result on stack
stck = TRUE;
case "hms": # convert stack top from hrs to hrs, minutes, seconds
hms(stack[top]);
printf("\thr: %2g",stack[top-2]);
if ( stack[top-2] > 12 ) printf(" (%2u pm)",stack[top-2] - 12);
printf("\n");
printf("\tmn: %2g\n",stack[top-1]);
printf("\tsc: %2g\n",stack[top]);
if ( !stck ) top -= 3;
ret = 116;
break;
case "fdates": # compute date for stack[top] days in future (past)
# leave result on stack
stck = TRUE;
case "fdate": # compute date for stack[top] days in future (past)
ret = fdate(stack[top]);
printf("\tyr: %2u\n",stack[top-2]);
printf("\tmo: %2u (%s)\n",stack[top-1],month_array[stack[top-1]]);
printf("\tdy: %2u (%s)\n",stack[top],week_day[ret]);
if ( !stck ) top -= 3;
ret = 117;
break;
}
return ret;
}

# function to recognize ternary operations - require three numbers
function tern_operation(fun) {
local ret = FALSE; #return value - assume no match

if ( top > 2 ) switch ( fun ) {
case "jdn":
stack[top-2] = jdn(stack[top-2],stack[top-1],stack[top]);
ret = 300;
break;
case "hrs":
stack[top-2] = hrs(stack[top-2],stack[top-1],stack[top]);
ret = 301;
break;
case "dow":
stack[top-2] = day_of_week(stack[top-2],stack[top-1],stack[top]);
ret = 302;
break;
case "calmh":
three_month(int(stack[top-2]),int(stack[top-1]),int(stack[top]));
top--;
ret = 303;
break;
}
return ret;
}

# function to convert year/month/day into julian day number
function jdn(year,month,day) {
local yr;
local pfac = 0.6;
local ljdn;

yr = year + (month - 3.0) / 12.0;
ljdn = int(367.0 * yr + pfac) - (2 * int(yr)) + int(yr/4.0)
+ int(day) + 1721117;
if ( !greg_jul ) ljdn += -int(yr/100.0) + int(yr/400.0) + 2;
return ljdn;
}

# function to convert julian dday number to year/month/day
function caln(cjdn) {
local n, ic, np, npp, mp;
local yr, mo, day;
local dte; # dte[1] == year, dte[2] == month, dte[3] == day

n = int(cjdn) - 1721119;
ic = int((n - 0.2)/36524.25);
if ( greg_jul ) np = n + 2; else np = n + ic - (ic / 4);
yr = int((np - 0.2)/365.25);
npp = np - int(365.25 * yr);
mp = int((npp - 0.5)/30.6);
day = int(npp + 0.5 - 30.6 * mp);
if ( mp <= 9 ) mo = mp + 3;
else {
yr++;
mo = mp - 9;
}
dte[1] = yr;
dte[2] = mo;
dte[3] = day;
return dte; # return date ARRAY
}

# function to set date corresponding to julian day number passed into stack
# stack[top - 2] == year
# stack[top - 1] == month
# stack[top] == day
function stack_date(cjdn) {
local dte;

dte = caln(cjdn);
stack[top] = dte[1]; # year
stack[top + 1] = dte[2]; # month
stack[top + 2] = dte[3]; # day
top += 2;
}

# function to set stack to today + days in future (past)
function fdate(days) {
local fd;
local wkday;

fd = vars["today"] + days;
wkday = (fd + 1) % 7;
stack_date(fd);
return wkday;
}

# function to convert hours, minutes, seconds to fractional hours
function hrs(hrs,min,sec) {
return hrs += min/60 + sec/3600;
}

# functions to convert fractional hours to hrs, min, sec
function hms(hrs) {
local mins = fract(hrs) * 60;
local secs = fract(mins) * 60;

stack[top] = int(hrs);
stack[top+1] = int(mins);
stack[top+2] = secs = secs > 1 ? secs : 0;
if ( secs > 59 ) {
stack[top+1]++;
stack[top+2] = 0;
} else stack[top+2] = int(secs);
top += 2;
}

# function to provide header & copyright information
function copyright() {
cls;
fprintf(stderr,prt_ln,"");
fprintf(stderr,prt_ln,"Reverse Polish Calculator.\n(C) Copyright 1989, 1990 Terry D. Boldt, All Rights Reserved.");
}

# function to provide help - list operators and functions
function help() {
local dummy;

copyright;
fprintf(stderr,prt_ln,"Operators Available:");
fprintf(stderr,prt_ln,"n1 n2 [+ - * /], add subtract multiply divide n1 to n2");
fprintf(stderr,prt_ln,"n1 n2 %%, n1 remainder of n2");
fprintf(stderr,prt_ln,"n1 n2 ^, n1 to n2 power");
fprintf(stderr,prt_ln,"n1 n2 [& | @], n2 bit-wise [ and or xor ] n2");
fprintf(stderr,prt_ln,"n1 n2 [<< >>], n1 shifted [ left right ] n2 bits");
fprintf(stderr,prt_ln,"n1 n2 swap, swap n1/n2 on stack top");
fprintf(stderr,prt_ln,"n1 n2 atan2, arc_tan(n1/n2), -ã to ã");
fprintf(stderr,prt_ln,"n1 ~, one's complement of n1");
fprintf(stderr,prt_ln,"n1 var=, set variable 'var' to n1");
fprintf(stderr,prt_ln,"n1 var-, delete variable 'var'");
fprintf(stderr,prt_ln,"var, display value of variable var");
fprintf(stderr,prt_ln,"deg/rad, assume degrees/radians for trig. functions (rad default)");
fprintf(stderr,prt_ln,"built-in single argument functions:");
fprintf(stderr,prt_ln,"sin asin cos acos sinh cosh log log10 int exp sqrt fract push pop");
fprintf(stderr,prt_ln,"+/-, -/+, +-, -+ change sign of top of stack");
fprintf(stderr,prt_ln,"= display value on top of stack");
fprintf(stderr,prt_ln,"=s display values for entire stack");
fprintf(stderr,prt_ln,"[Qq](uit)? to quit, [Ss](tat)? to display calculator status");
fprintf(stderr,prt_ln,"[Cc](ls)? to clear screen, [Hh](elp)? to display this help");
fprintf(stderr,prt_ln,"\nPress to Continue. [Qq](uit)? to Return to Calculations.");
getline(dummy);
if ( dummy ~~ Quit ) return;
copyright;
fprintf(stderr,prt_ln,"rtd - top of stack converted from radians to degrees");
fprintf(stderr,prt_ln,"dtr - top of stack converted from degrees to radians");
fprintf(stderr,prt_ln,"cti - top of stack converted from cm to inches");
fprintf(stderr,prt_ln,"itc - top of stack converted from inches to cm");
fprintf(stderr,prt_ln,"ktm - top of stack converted from kilometers to miles");
fprintf(stderr,prt_ln,"mtk - top of stack converted from miles to kilometers");
fprintf(stderr,prt_ln,"ltg - top of stack converted from Liters to gallons");
fprintf(stderr,prt_ln,"gtl - top of stack converted from gallons to Liters");
fprintf(stderr,prt_ln,"jdn - compute julian day number from date (yr mo day jdn)");
fprintf(stderr,prt_ln,"cal - compute date from julian day number");
fprintf(stderr,prt_ln,"calm - display calender 3 month calender centered on month (year month)");
fprintf(stderr,prt_ln,"calmh - display highlighted 3 month calender centered on month (year month day)");
fprintf(stderr,prt_ln,"pmonth - display highlighted 3 month calender centered on current month");
fprintf(stderr,prt_ln,"dow - compute day of week, Sunday == 0 (yr mo day dow)");
fprintf(stderr,prt_ln,"now - sets top of stack to current time");
fprintf(stderr,prt_ln,"greg - toggle between Gregorian (default) and Julian calenders");
fprintf(stderr,prt_ln,"hrs - compute hours from hour, minute, second (hr min sec hrs)");
fprintf(stderr,prt_ln,"hms - compute hour, minute, second from hours");
fprintf(stderr,prt_ln,"fdate - compute date days in future (past)");
fprintf(stderr,prt_ln,"For cal/hms/fdate/ functions, append 's' to leave result on stack");
}

# function to display calculator status
function stat() {
local j;

copyright;
fprintf(stderr,"Calculator Status:\n");
fprintf(stderr,"Calender Set: %s.\n",greg_jul ? "Julian" : "Gregorian");
fprintf(stderr,"Assume %s for Trig. Functions\n",DEGREES ? "Degrees" : "Radians");
fprintf(stderr,"Defined variables:\n");
for ( j in vars ) {
ostr = addcomma(vars[j]);
fprintf(stderr,"%s == %s\n",j,ostr);
}
}

# function to add commas to numbers
function addcomma(x) {
local num;
local spat;
local bnum = /{_d}{3,3}([,.]|$)/;

if ( x < 0 ) return "-" addcomma(-x);
num = sprintf("%.14g",x); # num is dddddd.dd
spat = num ~~ /\./ ? /{_d}{4,4}[.,]/ : /{_d}{4,4}(,|$)/;
while ( num ~~ spat ) sub(bnum,",&",num);
return num;
}

function prompt() {
printf("<>");
}

# function to clear screen and home cursor
function cls() {
# clear screen and home cursor string
local num_lines = 25;

while ( num_lines-- ) print "";
}

# function to compute day of week 0 == Sunday, 6 == Saturday
function day_of_week(yr,month,day) {
return (jdn(yr,month,day) + 1) % 7;
}

# function to display monthly calender for year/month passed
function month_cal(yr,month,day) {
local t1i = jdn(yr,month,1);
local t2i, i, j;
local nmnth = month + 1, nyr = yr;

if ( nmnth == 13 ) { nmnth = 1; nyr++; }
t2i = jdn(nyr,nmnth,1) - t1i;
t1i = (t1i + 1) % 7;
print month_array[month],yr;
print hdr_line;
for ( i = 1 , j = 7 ; i <= t2i ; ) {
if ( t1i ) {
t1i--;
printf(" ");
} else {
if ( i == day ) printf("\x01b[1;32;40m");
printf("%3u",i);
if ( i == day ) printf("\x01b[0;37;44m");
i++;
}
if ( i <= t2i && !--j ) {
print "";
j = 7;
}
}
print "";
}

# function to display 3 month calender
function three_month(yr,mn,dy) {
local lyr = yr, lmn = mn, nyr = yr, nmn = mn;

if ( --lmn < 1 ) { lmn = 12; lyr--;}
if ( ++nmn > 12 ) { nmn = 1; nyr++;}
month_cal(lyr,lmn,0);
month_cal(yr,mn,dy);
month_cal(nyr,nmn,0);
}