home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / qtawk / calcrp.exp < prev    next >
Text File  |  1990-11-09  |  21KB  |  628 lines
  1. # calcrp - reverse-Polish calculator
  2. #
  3. # Reverse Polish Calculator.
  4. # (C) Copyright 1989, 1990 Terry D. Boldt, All Rights Reserved.
  5. #
  6. # input: expression in reverse polish
  7. # output: value of each expression
  8. #
  9. BEGIN {
  10.     month_array[ 1] = "January";
  11.     month_array[ 2] = "February";
  12.     month_array[ 3] = "March";
  13.     month_array[ 4] = "April";
  14.     month_array[ 5] = "May";
  15.     month_array[ 6] = "June";
  16.     month_array[ 7] = "July";
  17.     month_array[ 8] = "August";
  18.     month_array[ 9] = "September";
  19.     month_array[10] = "October";
  20.     month_array[11] = "November";
  21.     month_array[12] = "December";
  22.  
  23.     week_day[0] = "Sunday";
  24.     week_day[1] = "Monday";
  25.     week_day[2] = "Tuesday";
  26.     week_day[3] = "Wednesday";
  27.     week_day[4] = "Thursday";
  28.     week_day[5] = "Friday";
  29.     week_day[6] = "Saturday";
  30.  
  31.     hdr_line = "  S  M  T  W  T  F  S";
  32.  
  33.     number = /^({_i}|{_f}({_e})?)$/;    # integer & floating point numbers
  34.  
  35.     v_name = /[a-zA-Z_][a-zA-Z0-9_]*/;    # variable name set
  36.  
  37.     variable_set  = /^{v_name}=$/;  # variable name set
  38.     variable_del  = /^{v_name}-$/;  # variable name delete
  39.  
  40.     vars["pi"] = pi;    # built-in variable
  41.     vars["e"] = exp(1); # built-in variable
  42.  
  43.     rtd = 180/pi;    # constant to convert radians to degrees
  44.     cm_inch = 2.54;    # centimeters / inch (exact)
  45.     km_sm = 1.609344;    # kilometers / mile  (exact)
  46.     Lts_gal = 3.785411784;# Liters / gallon (U.S. liquid)
  47.  
  48.     stderr = "stderr";
  49.  
  50.     prt_ln = "%s\n";
  51. #
  52. # Gregorian/Julian calender flag.
  53. #   TRUE == julian
  54. #   FALSE == gregorian
  55. #
  56.     greg_jul = FALSE;
  57.     split(sdate(1),tdate,/\//);
  58.     today = vars["today"] = jdn(tdate[3],tdate[1],tdate[2]);
  59.  
  60.     Yess = /[Yy](es)?/;           # Yes string
  61.     Nos  = /[Nn]o?/;              # No  string
  62.     Yes  = /^{_w}*{Yess}{_w}*$/;      # Yes answer
  63.     No     = /^{_w}*{Nos}{_w}*$/;       # No  answer
  64.     Quit = /^{_w}*[Qq](uit)?({_w}+({Yess}|{Nos}))?{_w}*$/;  # define regular expression To  Quit
  65.     Help = /^{_w}*[Hh](elp)?{_w}*$/;    # define regular expression for Help
  66.     Stat = /^{_w}*[Ss](tat)?{_w}*$/;    # define regular expression for Stats
  67.     Cls  = /^{_w}*[Cc](ls)?{_w}*$/;    # define regular expression To Clear Screen
  68.  
  69.     quit_status = TRUE;
  70.  
  71.     copyright;
  72.     prompt;
  73. }
  74.  
  75. GROUP Quit {
  76.     if ( NF > 1 ) {
  77.     switch ( $2 ) {
  78.         case Yes:
  79.         quit_status = TRUE;
  80.         break;
  81.         case No:
  82.         quit_status = FALSE;
  83.         break;
  84.     }
  85.     }
  86.     exit 2;
  87. }
  88.  
  89. GROUP Help { help; prompt; next; }
  90.  
  91. GROUP Stat { stat; prompt; next; }
  92.  
  93. GROUP Cls  { copyright; prompt; next; }
  94.  
  95.     {
  96.     local ivar, ntime, dte;
  97.  
  98.     for ( i = 1 ; i <= NF ; i++ ) {
  99.     if ( $i ~~ number ) {    # find numbers
  100.         stack[++top] = $i + 0.0; # force numbers to real by adding 0.0
  101.       } else if ( j = mono_operation($i) ) {   # built-in mono operator ?
  102.         j;    # do nothing statement
  103.       } else if ( j = binary_operation($i) ) { # built-in binary operator ?
  104.         top--;
  105.       } else if ( j = tern_operation($i) ) { # built ternary operator ?
  106.         top -= 2;
  107.       } else if ( $i == "pmonth" ) { # set stack top to current time
  108.         dte = caln(today);
  109.         three_month(dte[1],dte[2],dte[3]);
  110.       } else if ( $i == "now" ) { # set stack top to current time
  111.         split(stime(1),ntime,/:/);
  112.         stack[++top] = hrs(ntime[1] + 0.0,ntime[2] + 0.0,ntime[3] + 0.0);
  113.       } else if ( $i == "deg" ) { # use degrees in trig
  114.         DEGREES = TRUE;   # set built-in variable
  115.       } else if ( $i == "rad" ) { # use radians in trig - start-up default
  116.         DEGREES = FALSE;  # set built-in variable
  117.       } else if ( $i == "greg" ) { # toggle gregorian/julian calender
  118.         greg_jul = !greg_jul;
  119.         printf("Calender Set: %s.\n",greg_jul ? "Julian" : "Gregorian");
  120.       } else if ( $i in vars ) { # defined variable ?
  121.         stack[++top] = vars[$i];
  122.       } else if ( $i ~~ variable_set && top > 0 ) { # variable definition ?
  123.         # NOTE: for single letter variable names,
  124.         # substr($i,1,length($i)-1)
  125.         # returns a single letter and not a string. The single letter
  126.         # is interpreted by the subscripting routine as a numeric
  127.         # and gives 'strange' subscripts. To prevent, concatenate
  128.         # a null string on substr return to force to a string irregardless
  129.         vars[substr($i,1,length($i)-1) ∩ ""] = stack[top--];
  130.       } else if ( $i ~~ variable_del ) { # variable deletion ?
  131.         # Again force substr return to a string
  132.         ivar = substr($i,1,length($i)-1) ∩ "";
  133.         if ( ivar in vars ) delete vars[ivar];
  134.           else printf("error: attempt to delete ivar - non-existent.\n");
  135.       } else { # unknown operation
  136.         printf("error: cannot evaluate: %s\n",$i);
  137.         top = 0;
  138.         prompt;
  139.         next;
  140.     }
  141.     }
  142.     if ( top == 1 && $NF !~ /^=$/ ) {
  143.     ostr = addcomma(stack[top--]);
  144.     print "\t" ∩ ostr;
  145.       } else if ( top > 1 ) {
  146.     printf("error: too many operands\n");
  147.     top = 0;
  148.     }
  149.     prompt;
  150. }
  151.  
  152. END {
  153.     if ( quit_status ) copyright;
  154. }
  155.  
  156. # function to find binary operations - needs two numbers
  157. function binary_operation(op) {
  158.     local ret = FALSE;    # return value - assume no match
  159.     local swap;
  160.  
  161.     if ( top > 1 ) switch ( op ) {
  162.     case '+':   # addition
  163.         stack[top-1] += stack[top];
  164.         ret = 1;
  165.         break;
  166.     case '-':   # subtraction
  167.         stack[top-1] -= stack[top];
  168.         ret = 2;
  169.         break;
  170.     case '*':   # multiplication
  171.         stack[top-1] *= stack[top];
  172.         ret = 3;
  173.         break;
  174.     case '/':   # division
  175.         stack[top-1] /= stack[top];
  176.         ret = 4;
  177.         break;
  178.     case '^':   # exponentiation
  179.         stack[top-1] ^= stack[top];
  180.         ret = 5;
  181.         break;
  182.     case '&':   # binary and
  183.         stack[top-1] &= stack[top];
  184.         ret = 6;
  185.         break;
  186.     case '|':   # binary or
  187.         stack[top-1] |= stack[top];
  188.         ret = 7;
  189.         break;
  190.     case '@':   # binary xor
  191.         stack[top-1] @= stack[top];
  192.         ret = 8;
  193.         break;
  194.     case '%':   # modulus
  195.         stack[top-1] %= stack[top];
  196.         ret = 9;
  197.         break;
  198.     case ">>":   # shift right
  199.         stack[top-1] >>= stack[top];
  200.         ret = 10;
  201.         break;
  202.     case "<<":   # shift left
  203.         stack[top-1] <<= stack[top];
  204.         ret = 11;
  205.         break;
  206.     case "swap": # swap top two stack numbers
  207.         swap = stack[top];
  208.         stack[top] = stack[top-1];
  209.         stack[top-1] = swap;
  210.         top++;  # compensate for reduction upon return
  211.         ret = 12;
  212.         break;
  213.     case "atan2":
  214.         stack[top-1] = atan2(stack[top-1],stack[top]);
  215.         ret = 13;
  216.         break;
  217.     case "calm":
  218.         three_month(int(stack[top-1]),int(stack[top]),0);
  219.         top--;
  220.         ret = 14;
  221.         break;
  222.     }
  223.     return ret;
  224. }
  225.  
  226. # function to recognize mono operations - require only one number
  227. function mono_operation(fun) {
  228.     local ret = FALSE;    #return value - assume no match
  229.     local stck = FALSE;
  230.     local ntime;
  231.  
  232.     if ( top ) switch ( fun ) {
  233.     case "sin":
  234.         stack[top] = sin(stack[top]);
  235.         ret = 100;
  236.         break;
  237.     case "asin":
  238.         stack[top] = asin(stack[top]);
  239.         ret = 100;
  240.         break;
  241.     case "cos":
  242.         stack[top] = cos(stack[top]);
  243.         ret = 101;
  244.         break;
  245.     case "acos":
  246.         stack[top] = acos(stack[top]);
  247.         ret = 100;
  248.         break;
  249.     case "sinh":
  250.         stack[top] = sinh(stack[top]);
  251.         ret = 117;
  252.         break;
  253.     case "cosh":
  254.         stack[top] = cosh(stack[top]);
  255.         ret = 118;
  256.         break;
  257.     case "log":
  258.         stack[top] = log(stack[top]);
  259.         ret = 102;
  260.         break;
  261.     case "log10":
  262.         stack[top] = log10(stack[top]);
  263.         ret = 102;
  264.         break;
  265.     case "int":
  266.         stack[top] = int(stack[top]);
  267.         ret = 103;
  268.         break;
  269.     case "exp":
  270.         stack[top] = exp(stack[top]);
  271.         ret = 104;
  272.         break;
  273.     case "sqrt":
  274.         stack[top] = sqrt(stack[top]);
  275.         ret = 105;
  276.         break;
  277.     case "fract":
  278.         stack[top] = fract(stack[top]);
  279.         ret = 106;
  280.         break;
  281.     case "push":
  282.         stack[top+1] = stack[top];
  283.         top++;
  284.         ret = 107;
  285.         break;
  286.     case "pop":
  287.         top--;
  288.         ret = 108;
  289.         break;
  290.     case "=": # display top of stack
  291.         printf("\t%d: %s\n",top,addcomma(stack[top]));
  292.         ret = 109;
  293.         break;
  294.     case "=s": # display entire stack
  295.         for ( stck in stack ) printf("\t%d: %s\n",stck,addcomma(stack[stck]));
  296.         ret = 118;
  297.         break;
  298.     case '~':   # ones complement
  299.         stack[top] = ~stack[top];
  300.         ret = 110;
  301.         break;
  302.     case /^\+\/?-$/:   # change sign of stack top
  303.     case /^-\/?\+$/:   # change sign of stack top
  304.         stack[top] = -stack[top];
  305.         ret = 117;
  306.         break;
  307.     case "rtd": # convert radians to degrees
  308.         stack[top] = stack[top] * rtd;
  309.         ret = 111;
  310.         break;
  311.     case "dtr": # convert degrees to radians
  312.         stack[top] = stack[top] / rtd;
  313.         ret = 112;
  314.         break;
  315.     case "cti": # convert centimeters to inches
  316.         stack[top] = stack[top] / cm_inch;
  317.         ret = 113;
  318.         break;
  319.     case "itc": # convert inches to centimeters
  320.         stack[top] = stack[top] * cm_inch;
  321.         ret = 114;
  322.         break;
  323.     case "ktm": # convert kilometers to miles
  324.         stack[top] = stack[top] / km_sm;
  325.         ret = 114;
  326.         break;
  327.     case "mtk": # convert miles to kilometers
  328.         stack[top] = stack[top] * km_sm;
  329.         ret = 114;
  330.         break;
  331.     case "ltg": # convert Liters to gallons
  332.         stack[top] = stack[top] /Lts_gal;
  333.         ret = 114;
  334.         break;
  335.     case "gtl": # convert gallons to Liters
  336.         stack[top] = stack[top] * Lts_gal;
  337.         ret = 114;
  338.         break;
  339.     case "cals": # convert stack top from julian day number to date
  340.              # leave result on stack
  341.         stck = TRUE;
  342.     case "cal":  # convert stack top from julian day number to date
  343.         ret = (stack[top] + 1) % 7;
  344.         stack_date(stack[top]);
  345.         printf("\tyr: %2u\n",stack[top-2]);
  346.         printf("\tmo: %2u (%s)\n",stack[top-1],month_array[stack[top-1]]);
  347.         printf("\tdy: %2u (%s)\n",stack[top],week_day[ret]);
  348.         if ( !stck ) top -= 3;
  349.         ret = 115;
  350.         break;
  351.     case "hmss": # convert stack top from hrs to hrs, minutes, seconds
  352.              # leave result on stack
  353.         stck = TRUE;
  354.     case "hms":  # convert stack top from hrs to hrs, minutes, seconds
  355.         hms(stack[top]);
  356.         printf("\thr: %2g",stack[top-2]);
  357.         if ( stack[top-2] > 12 ) printf(" (%2u pm)",stack[top-2] - 12);
  358.         printf("\n");
  359.         printf("\tmn: %2g\n",stack[top-1]);
  360.         printf("\tsc: %2g\n",stack[top]);
  361.         if ( !stck ) top -= 3;
  362.         ret = 116;
  363.         break;
  364.     case "fdates": # compute date for stack[top] days in future (past)
  365.                # leave result on stack
  366.         stck = TRUE;
  367.     case "fdate":  # compute date for stack[top] days in future (past)
  368.         ret = fdate(stack[top]);
  369.         printf("\tyr: %2u\n",stack[top-2]);
  370.         printf("\tmo: %2u (%s)\n",stack[top-1],month_array[stack[top-1]]);
  371.         printf("\tdy: %2u (%s)\n",stack[top],week_day[ret]);
  372.         if ( !stck ) top -= 3;
  373.         ret = 117;
  374.         break;
  375.     }
  376.     return ret;
  377. }
  378.  
  379. # function to recognize ternary operations - require three numbers
  380. function tern_operation(fun) {
  381.     local ret = FALSE;    #return value - assume no match
  382.  
  383.     if ( top > 2 ) switch ( fun ) {
  384.     case "jdn":
  385.         stack[top-2] = jdn(stack[top-2],stack[top-1],stack[top]);
  386.         ret = 300;
  387.         break;
  388.     case "hrs":
  389.         stack[top-2] = hrs(stack[top-2],stack[top-1],stack[top]);
  390.         ret = 301;
  391.         break;
  392.     case "dow":
  393.         stack[top-2] = day_of_week(stack[top-2],stack[top-1],stack[top]);
  394.         ret = 302;
  395.         break;
  396.     case "calmh":
  397.         three_month(int(stack[top-2]),int(stack[top-1]),int(stack[top]));
  398.         top--;
  399.         ret = 303;
  400.         break;
  401.     }
  402.     return ret;
  403. }
  404.  
  405. # function to convert year/month/day into julian day number
  406. function jdn(year,month,day) {
  407.     local yr;
  408.     local pfac = 0.6;
  409.     local ljdn;
  410.  
  411.     yr = year + (month - 3.0) / 12.0;
  412.     ljdn = int(367.0 * yr + pfac) - (2 * int(yr)) + int(yr/4.0)
  413.        + int(day) + 1721117;
  414.     if ( !greg_jul ) ljdn += -int(yr/100.0) + int(yr/400.0) + 2;
  415.     return ljdn;
  416. }
  417.  
  418. #  function to convert julian dday number to year/month/day
  419. function caln(cjdn) {
  420.     local n, ic, np, npp, mp;
  421.     local yr, mo, day;
  422.     local dte; # dte[1] == year, dte[2] == month, dte[3] == day
  423.  
  424.     n = int(cjdn) - 1721119;
  425.     ic = int((n - 0.2)/36524.25);
  426.     if ( greg_jul ) np = n + 2; else np = n + ic - (ic / 4);
  427.     yr = int((np - 0.2)/365.25);
  428.     npp = np - int(365.25 * yr);
  429.     mp = int((npp - 0.5)/30.6);
  430.     day = int(npp + 0.5 - 30.6 * mp);
  431.     if ( mp <= 9 ) mo = mp + 3;
  432.       else {
  433.     yr++;
  434.     mo = mp - 9;
  435.     }
  436.     dte[1] = yr;
  437.     dte[2] = mo;
  438.     dte[3] = day;
  439.     return dte; # return date ARRAY
  440. }
  441.  
  442. # function to set date corresponding to julian day number passed into stack
  443. # stack[top - 2] == year
  444. # stack[top - 1] == month
  445. # stack[top]     == day
  446. function stack_date(cjdn) {
  447.     local dte;
  448.  
  449.     dte = caln(cjdn);
  450.     stack[top]       = dte[1]; # year
  451.     stack[++top]   = dte[2]; # month
  452.     stack[++top]   = dte[3]; # day
  453. }
  454.  
  455. # function to set stack to today + days in future (past)
  456. function fdate(days) {
  457.     local fd;
  458.     local wkday;
  459.  
  460.     fd = vars["today"] + days;
  461.     wkday = (fd + 1) % 7;
  462.     stack_date(fd);
  463.     return wkday;
  464. }
  465.  
  466. # function to convert hours, minutes, seconds to fractional hours
  467. function hrs(hrs,min,sec) {
  468.     return hrs += min/60.0 + sec/3600.0;
  469. }
  470.  
  471. # functions to convert fractional hours to hrs, min, sec
  472. function hms(hrs) {
  473.     local mins = fract(hrs) * 60;
  474.     local secs = fract(mins) * 60;
  475.  
  476.     stack[top] = int(hrs);
  477.     stack[top+1] = int(mins);
  478.     stack[top+2] = secs = secs > 1 ? secs : 0;
  479.     if ( secs > 59 ) {
  480.     stack[top+1]++;
  481.     stack[top+2] = 0;
  482.     } else stack[top+2] = int(secs);
  483.     top += 2;
  484. }
  485.  
  486. # function to provide header & copyright information
  487. function copyright() {
  488.     cls;
  489.     fprintf(stderr,prt_ln,"\nReverse Polish Calculator.\n\x01b[1;32;40m(C) Copyright 1989, 1990 Terry D. Boldt, All Rights Reserved.\x01b[0;37;44m");
  490. }
  491.  
  492. # function to provide help - list operators and functions
  493. function help() {
  494.     local dummy;
  495.  
  496.     copyright;
  497.     fprintf(stderr,prt_ln,"Operators Available:");
  498.     fprintf(stderr,prt_ln,"n1 n2 [\x01b[1;32;40m+ - * /\x01b[0;37;44m], add subtract multiply divide n1 to n2");
  499.     fprintf(stderr,prt_ln,"n1 n2 \x01b[1;32;40m%%\x01b[0;37;44m, n1 remainder of n2");
  500.     fprintf(stderr,prt_ln,"n1 n2 \x01b[1;32;40m^\x01b[0;37;44m, n1 to n2 power");
  501.     fprintf(stderr,prt_ln,"n1 n2 [\x01b[1;32;40m& | @\x01b[0;37;44m], n2 bit-wise [ and or xor ] n2");
  502.     fprintf(stderr,prt_ln,"n1 n2 [\x01b[1;32;40m<< >>\x01b[0;37;44m], n1 shifted [ left right ] n2 bits");
  503.     fprintf(stderr,prt_ln,"n1 n2 \x01b[1;32;40mswap\x01b[0;37;44m, swap n1/n2 on stack top");
  504.     fprintf(stderr,prt_ln,"n1 n2 \x01b[1;32;40matan2\x01b[0;37;44m, arc_tan(n1/n2), -π to π");
  505.     fprintf(stderr,prt_ln,"n1 \x01b[1;32;40m~\x01b[0;37;44m, one's complement of n1");
  506.     fprintf(stderr,prt_ln,"n1 \x01b[1;32;40mvar=\x01b[0;37;44m, set variable 'var' to n1");
  507.     fprintf(stderr,prt_ln,"n1 \x01b[1;32;40mvar-\x01b[0;37;44m, delete variable 'var'");
  508.     fprintf(stderr,prt_ln,"\x01b[1;32;40mvar\x01b[0;37;44m, display value of variable var");
  509.     fprintf(stderr,prt_ln,"\x01b[1;32;40mdeg/rad\x01b[0;37;44m, assume degrees/radians for trig. functions (rad default)");
  510.     fprintf(stderr,prt_ln,"built-in single argument functions:");
  511.     fprintf(stderr,prt_ln,"sin asin cos acos sinh cosh log log10 int exp sqrt fract push pop");
  512.     fprintf(stderr,prt_ln,"\x01b[1;32;40m+/-, -/+, +-, -+\x01b[0;37;44m  change sign of top of stack");
  513.     fprintf(stderr,prt_ln,"\x01b[1;32;40m=\x01b[0;37;44m display value on top of stack");
  514.     fprintf(stderr,prt_ln,"\x01b[1;32;40m=s\x01b[0;37;44m display values for entire stack");
  515.     fprintf(stderr,prt_ln,"\x01b[1;32;40m[Qq](uit)?\x01b[0;37;44m to quit, \x01b[1;32;40m[Ss](tat)?\x01b[0;37;44m to display calculator status");
  516.     fprintf(stderr,prt_ln,"\x01b[1;32;40m[Cc](ls)?\x01b[0;37;44m to clear screen, \x01b[1;32;40m[Hh](elp)?\x01b[0;37;44m to display this help");
  517.     fprintf(stderr,prt_ln,"\nPress \x01b[1;32;40m<Enter>\x01b[0;37;44m to Continue. \x01b[1;32;40m[Qq](uit)?<Enter>\x01b[0;37;44m to Return to Calculations.");
  518.     getline(dummy);
  519.     if ( dummy ~~ Quit ) return;
  520.     copyright;
  521.     fprintf(stderr,prt_ln,"\x01b[1;32;40mrtd\x01b[0;37;44m   - top of stack converted from radians to degrees");
  522.     fprintf(stderr,prt_ln,"\x01b[1;32;40mdtr\x01b[0;37;44m   - top of stack converted from degrees to radians");
  523.     fprintf(stderr,prt_ln,"\x01b[1;32;40mcti\x01b[0;37;44m   - top of stack converted from cm to inches");
  524.     fprintf(stderr,prt_ln,"\x01b[1;32;40mitc\x01b[0;37;44m   - top of stack converted from inches to cm");
  525.     fprintf(stderr,prt_ln,"\x01b[1;32;40mktm\x01b[0;37;44m   - top of stack converted from kilometers to miles");
  526.     fprintf(stderr,prt_ln,"\x01b[1;32;40mmtk\x01b[0;37;44m   - top of stack converted from miles to kilometers");
  527.     fprintf(stderr,prt_ln,"\x01b[1;32;40mltg\x01b[0;37;44m   - top of stack converted from Liters to gallons");
  528.     fprintf(stderr,prt_ln,"\x01b[1;32;40mgtl\x01b[0;37;44m   - top of stack converted from gallons to Liters");
  529.     fprintf(stderr,prt_ln,"\x01b[1;32;40mjdn\x01b[0;37;44m   - compute julian day number from date (yr mo day jdn)");
  530.     fprintf(stderr,prt_ln,"\x01b[1;32;40mcal\x01b[0;37;44m   - compute date from julian day number");
  531.     fprintf(stderr,prt_ln,"\x01b[1;32;40mcalm\x01b[0;37;44m  - display calender 3 month calender centered on month (year month)");
  532.     fprintf(stderr,prt_ln,"\x01b[1;32;40mcalmh\x01b[0;37;44m - display highlighted 3 month calender centered on month (year month day)");
  533.     fprintf(stderr,prt_ln,"\x01b[1;32;40mpmonth\x01b[0;37;44m - display highlighted 3 month calender centered on current month");
  534.     fprintf(stderr,prt_ln,"\x01b[1;32;40mdow\x01b[0;37;44m   - compute day of week, Sunday == 0 (yr mo day -> dow)");
  535.     fprintf(stderr,prt_ln,"\x01b[1;32;40mnow\x01b[0;37;44m   - sets top of stack to current time");
  536.     fprintf(stderr,prt_ln,"\x01b[1;32;40mgreg\x01b[0;37;44m  - toggle between Gregorian (default) and Julian calenders");
  537.     fprintf(stderr,prt_ln,"\x01b[1;32;40mhrs\x01b[0;37;44m   - compute hours from hour, minute, second (hr min sec hrs)");
  538.     fprintf(stderr,prt_ln,"\x01b[1;32;40mhms\x01b[0;37;44m   - compute hour, minute, second from hours");
  539.     fprintf(stderr,prt_ln,"\x01b[1;32;40mfdate\x01b[0;37;44m - compute date days in future (past)");
  540.     fprintf(stderr,prt_ln,"For cal/hms/fdate/ functions, append 's' to leave result on stack");
  541. }
  542.  
  543. # function to display calculator status
  544. function stat() {
  545.     local j;
  546.  
  547.     copyright;
  548.     fprintf(stderr,"Calculator Status:\n");
  549.     fprintf(stderr,"Calender Set: \x01b[1;32;40m%s\x01b[0;37;44m.\n",greg_jul ? "Julian" : "Gregorian");
  550.     fprintf(stderr,"Assume \x01b[1;32;40m%s\x01b[0;37;44m for Trig. Functions\n",DEGREES ? "Degrees" : "Radians");
  551.     fprintf(stderr,"Defined variables:\n");
  552.     for ( j in vars ) {
  553.     ostr = addcomma(vars[j]);
  554.     fprintf(stderr,"\x01b[1;32;40m%s\x01b[0;37;44m == %s\n",j,ostr);
  555.     }
  556. }
  557.  
  558. # function to add commas to numbers
  559. function addcomma(x) {
  560.     local num;
  561.     local spat;
  562.     local bnum = /{_d}{3,3}([,.]|$)/;
  563.  
  564.     if ( x < 0 ) return "-" ∩ addcomma(-x);
  565.     num = sprintf("%.14g",x);        # num is dddddd.dd
  566.     spat = num ~~ /\./ ? /{_d}{4,4}[.,]/ : /{_d}{4,4}(,|$)/;
  567.     while ( num ~~ spat ) sub(bnum,",&",num);
  568.     return num;
  569. }
  570.  
  571. function prompt() {
  572.     printf("<>");
  573. }
  574.  
  575. # function to clear screen and home cursor
  576. # NOTE: MUST have ANSI.SYS device driver installed to work
  577. function cls() {
  578.       # clear screen and home cursor string
  579.     local _cls_ = "\x01b[2J";
  580.  
  581.     fprintf(stderr,_cls_);
  582. }
  583.  
  584. # function to compute day of week 0 == Sunday, 6 == Saturday
  585. function day_of_week(yr,month,day) {
  586.     return (jdn(yr,month,day) + 1) % 7;
  587. }
  588.  
  589. # function to display monthly calender for year/month passed
  590. function month_cal(yr,month,day) {
  591.     local t1i = jdn(yr,month,1);
  592.     local t2i, i, j;
  593.     local nmnth = month + 1, nyr = yr;
  594.  
  595.     if ( nmnth == 13 ) { nmnth = 1; nyr++; }
  596.     t2i = jdn(nyr,nmnth,1) - t1i;
  597.     t1i = (t1i + 1) % 7;
  598.     print month_array[month],yr;
  599.     print hdr_line;
  600.     for ( i = 1 , j = 7 ; i <= t2i ; ) {
  601.     if ( t1i ) {
  602.         t1i--;
  603.         printf("   ");
  604.       } else {
  605.         if ( i == day ) printf("\x01b[1;32;40m");
  606.         printf("%3u",i);
  607.         if ( i == day ) printf("\x01b[0;37;44m");
  608.         i++;
  609.     }
  610.     if ( i <= t2i && !--j ) {
  611.         print "";
  612.         j = 7;
  613.     }
  614.     }
  615.     print "";
  616. }
  617.  
  618. # function to display 3 month calender
  619. function three_month(yr,mn,dy) {
  620.     local lyr = yr, lmn = mn, nyr = yr, nmn = mn;
  621.  
  622.     if ( --lmn < 1 ) { lmn = 12; lyr--;}
  623.     if ( ++nmn > 12 ) { nmn = 1; nyr++;}
  624.     month_cal(lyr,lmn,0);
  625.     month_cal(yr,mn,dy);
  626.     month_cal(nyr,nmn,0);
  627. }
  628.