home *** CD-ROM | disk | FTP | other *** search
- # 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 <Enter> to Continue. [Qq](uit)?<Enter> 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);
- }
-