home *** CD-ROM | disk | FTP | other *** search
- /*--------------------------------*
- | File: KEY.c - MLO 900131 V1.00 |
- | These routines will be called |
- | whenever a gadget is hit. |
- *--------------------------------*/
-
- #include "rpn.h"
- #include "proto.h"
- #include "key.h"
- #include <math.h>
-
- static char slate[SLATE_DIM];
- static Boolean Inverse = False;
- static Boolean Hyperbolic = False;
-
- extern double stack[], lastStack[];
- extern double reg[], lastReg[];
- extern double acc[], lastAcc[];
- extern double Convert;
- extern double Pig;
- extern double LastX;
- extern char InBuf[];
- extern Boolean MathError;
- extern struct Window *Wrpn;
- extern struct RastPort *pRP;
- extern int LastCode;
-
- void keypick(
- int code /* Hit gadget identifier */
- )
- {/*--------------------------------------------------*
- | Performs the required action. Every result is |
- | stored in temporary variables, then checked for |
- | errors, then moved to the stack or the registers |
- *--------------------------------------------------*/
-
- double x;
- int i;
- double temp[NACCS];
-
- if (Inverse) {
- if (Hyperbolic) {
- switch (code) {
- case 0: /* Asinh */
- x = log(stack[0] + sqrt(1.0 + stack[0] * stack[0])) / Convert;
- xs(x);
- break;
- case 1: /* Acosh */
- x = log(stack[0] + sqrt(stack[0] * stack[0] - 1.0)) / Convert;
- xs(x);
- break;
- case 2: /* Atanh */
- x = log((1.0 + stack[0]) / (1.0 - stack[0])) / (2.0 * Convert);
- xs(x);
- break;
- default: /* Error */
- DisplayBeep(Wrpn->WScreen);
- break;
- }
- Inverse = Hyperbolic = False;
- } else {
- switch (code) {
- case 0: /* Asin */
- x = asin(stack[0]) / Convert;
- ixs: xs(x);
- ioff: Inverse = False;
- break;
- case 1: /* Acos */
- x = acos(stack[0]) / Convert;
- goto ixs;
- case 2: /* Atan */
- x = atan(stack[0]) / Convert;
- goto ixs;
- case 4: /* Hyp */
- Hyperbolic = True;
- break;
- default: /* Error */
- DisplayBeep(Wrpn->WScreen);
- goto ioff;
- }
- }
- } else if (Hyperbolic) {
- switch (code) {
- case 0: /* Sinh */
- x = sinh(stack[0] * Convert);
- hxs: xs(x);
- hoff: Hyperbolic = False;
- break;
- case 1: /* Cosh */
- x = cosh(stack[0] * Convert);
- goto hxs;
- case 2: /* Tanh */
- x = tanh(stack[0] * Convert);
- goto hxs;
- case 3: /* Inv */
- Inverse = True;
- break;
- default: /* Error */
- DisplayBeep(Wrpn->WScreen);
- goto hoff;
- }
- } else {
- switch (code) {
- case 0: /* Sin */
- x = sin(stack[0] * Convert);
- xs(x);
- break;
- case 1: /* Cos */
- x = cos(stack[0] * Convert);
- xs(x);
- break;
- case 2: /* Tan */
- x = tan(stack[0] * Convert);
- xs(x);
- break;
- case 3: /* Inv */
- Inverse = True;
- break;
- case 4: /* Hyp */
- Hyperbolic = True;
- break;
- case 5: /* 10^X */
- x = pow(10.0, stack[0]);
- xs(x);
- break;
- case 6: /* e^X */
- x = exp(stack[0]);
- xs(x);
- break;
- case 7: /* Log10 */
- x = log10(stack[0]);
- xs(x);
- break;
- case 8: /* Ln */
- x = log(stack[0]);
- xs(x);
- break;
- case 9: /* Y^X */
- x = pow(stack[1], stack[0]);
- goto xys;
- break;
- case 10: /* Sum + */
- temp[0] = acc[0] + 1.0;
- temp[1] = acc[1] + stack[0];
- temp[2] = acc[2] + stack[0] * stack[0];
- temp[3] = acc[3] + stack[1];
- temp[4] = acc[4] + stack[1] * stack[1];
- temp[5] = acc[5] + stack[0] * stack[1];
- sums: if (!MathError) {
- LastX = stack[0];
- for (i=0; i<NACCS; i++) {
- acc[i] = temp[i];
- outAcc(i);
- }
- stack[0] = acc[0];
- outStk();
- code = ENTER_CODE;
- }
- break;
- case 11: /* Sum - */
- temp[0] = acc[0] - 1.0;
- temp[1] = acc[1] - stack[0];
- temp[2] = acc[2] - stack[0] * stack[0];
- temp[3] = acc[3] - stack[1];
- temp[4] = acc[4] - stack[1] * stack[1];
- temp[5] = acc[5] - stack[0] * stack[1];
- goto sums;
- case 12: /* L.R. */
- x = acc[0] * acc[2] - acc[1] * acc[1];
- temp[0] = (acc[3] * acc[2] - acc[1] * acc[5]) / x;
- temp[1] = (acc[0] * acc[5] - acc[1] * acc[3]) / x;
- goto xym;
- case 13: /* x(y) */
- x = acc[0] * acc[2] - acc[1] * acc[1];
- temp[0] = acc[0] * acc[5] - acc[1] * acc[3];
- temp[1] = acc[3] * acc[2] - acc[1] * acc[5];
- x = (x * stack[0] - temp[1]) / temp[0];
- xs(x);
- break;
- case 14: /* y(x) */
- x = acc[0] * acc[2] - acc[1] * acc[1];
- temp[0] = acc[0] * acc[5] - acc[1] * acc[3];
- temp[1] = acc[3] * acc[2] - acc[1] * acc[5];
- x = (temp[0] * stack[0] + temp[1]) / x;
- xs(x);
- break;
- case 15: /* X^2 */
- x = stack[0] * stack[0];
- xs(x);
- break;
- case 16: /* Sqrt */
- x = sqrt(stack[0]);
- xs(x);
- break;
- case 17: /* 1/X */
- x = 1.0 / stack[0];
- xs(x);
- break;
- case 18: /* r */
- x = regCoef();
- if (!MathError) {
- impEnter();
- LastX = stack[0];
- stack[0] = x;
- outStk();
- }
- break;
- case 19: /* Mean */
- temp[0] = acc[1] / acc[0];
- if (acc[0] < 1.1) {
- temp[1] = 0.0;
- } else {
- x = acc[0] * (acc[0] - 1.0);
- temp[1] = sqrt((acc[0] * acc[2] - acc[1] * acc[1]) / x);
- }
- xym: if (!MathError) {
- impEnter();
- LastX = stack[0];
- for (i=NSTM1; i>1; i--) stack[i] = stack[i-1];
- stack[1] = temp[1];
- stack[0] = temp[0];
- outStk();
- }
- break;
- case 20: /* + */
- x = stack[0] + stack[1];
- xys: if (MathError) break;
- LastX = stack[0];
- stack[0] = x;
- for (i=1; i<3; i++) stack[i] = stack[i+1];
- outStk();
- break;
- case 21: /* - */
- x = stack[1] - stack[0];
- goto xys;
- case 22: /* * */
- x = stack[1] * stack[0];
- goto xys;
- case 23: /* / */
- x = stack[1] / stack[0];
- goto xys;
- case 24: /* % */
- x = stack[0] * stack[1] * 0.01;
- xs(x);
- break;
- case 25: /* Pi */
- impEnter();
- stack[0] = Pig;
- outStk();
- break;
- case 26: /* ChSign */
- stack[0] = -stack[0];
- outStk();
- break;
- case 27: /* X <-> Y */
- x = stack[0];
- stack[0] = stack[1];
- stack[1] = x;
- outStk();
- break;
- case 28: /* RLeft */
- x = stack[0];
- for (i=0; i<NSTM1; i++) stack[i] = stack[i+1];
- stack[NSTM1] = x;
- outStk();
- break;
- case 29: /* Enter */
- enter();
- outStk();
- break;
- case 30: /* Input field */
- break;
- }
- }
- LastCode = code;
- }
-
- void enter(void)
- {/*-----------------------*
- | ENTER to be performed |
- *-----------------------*/
-
- int i;
-
- for (i=NSTM1; i; i--) stack[i] = stack[i-1];
- LastCode = ENTER_CODE;
- }
-
- void impEnter(void)
- {/*---------------------------------------------*
- | 'Implicit Enter': enter() is called if last |
- | required operation was not an enter, or a |
- | clear stack, or a clear X, or a Sigma +/- |
- *---------------------------------------------*/
-
- if (LastCode != ENTER_CODE) enter();
- }
-
- void outAcc(
- int n
- )
- {/*-----------------------------------------------*
- | Update of the n-th accumulator register value |
- *-----------------------------------------------*/
-
- SetAPen(pRP, BLACK_PEN);
- if (acc[n] != lastAcc[n]) {
- Move(pRP, ACC_X0, ACC_Y0+n*ACC_DY);
- sprintf(slate, "%14.8lG ", (lastAcc[n] = acc[n]));
- Text(pRP, slate, 15);
- }
- }
-
- void outReg(
- int n
- )
- {/*-----------------------------------*
- | Update of the n-th register value |
- *-----------------------------------*/
-
- if (n < NREGS) {
- SetAPen(pRP, BLUE_PEN);
- if (reg[n] != lastReg[n]) {
- Move(pRP, REG_X0, REG_Y0+n*REG_DY);
- sprintf(slate, "%14.8lG ", (lastReg[n] = reg[n]));
- Text(pRP, slate, 15);
- }
- } else {
- outAcc(n - NREGS);
- }
- }
-
- void outStk(void)
- {/*----------------------------*
- | Update of the stack values |
- *----------------------------*/
-
- int i;
-
- SetAPen(pRP, RED_PEN);
- for (i=NSTM1; i>=0; i--) {
- if (stack[i] != lastStack[i]) {
- Move(pRP, STK_X0, STK_Y0-i*STK_DY);
- sprintf(slate, "%14.8lG ", (lastStack[i] = stack[i]));
- Text(pRP, slate, 15);
- }
- }
- }
-
- double regCoef(void)
- {/*---------------------------*
- | Computation of the linear |
- | correlation coefficient. |
- *---------------------------*/
-
- double x, t0, t1;
-
- x = acc[0] * acc[5] - acc[1] * acc[3];
- t0 = acc[0] * acc[2] - acc[1] * acc[1];
- t1 = acc[0] * acc[4] - acc[3] * acc[3];
- x = x / sqrt(t0 * t1);
- return x;
- }
-
- void xs(
- double x
- )
- {/*----------------------------------*
- | Update of Last X and X registers |
- *----------------------------------*/
-
- if (!MathError) {
- LastX = stack[0];
- stack[0] = x;
- outStk();
- }
- }
-