home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.6 / ffcollection-1-6-1993-02.iso / ff_disks / 121-150 / ff_130 / hp / hp_math.include < prev    next >
Text File  |  1988-03-13  |  15KB  |  482 lines
  1. /*----------------------------------------*/
  2. /*                                        */
  3. /*     Filename:  hp_math.include         */
  4. /*                                        */
  5. /*     Contains C source code for         */
  6. /*     routines ProcessFloat,             */
  7. /*     ProcessComplex, ProcessInteger,    */
  8. /*     matherr, StoreRegister,            */
  9. /*     RecallRegister, SelectStoreReg     */
  10. /*     and CheckStack.                    */
  11. /*                                        */
  12. /*----------------------------------------*/
  13. ProcessFloat()
  14. {
  15.   double temp;
  16.                                     
  17.   if ( inkey == 52 ) {
  18.     if ( entry_in_progress == FALSE ) {
  19.          t = z;
  20.          z = y;
  21.          y = x;                 }
  22.     return(0);       }
  23.  
  24.  
  25.   /* The binary operators that remove y and replace x */
  26.   if ( (inkey ==  4) || (inkey ==  8) || (inkey ==12) ||
  27.        (inkey == 51) || (inkey == 39) )    {
  28.     if ( inkey ==  4 ) x = y * pow( x, -1.0 );
  29.     if ( inkey ==  8 ) x = y*x;
  30.     if ( inkey == 12 ) x = y-x;
  31.     if ( inkey == 51 ) x = y+x;
  32.  
  33.     if ( inkey == 39 ) x = pow( y, x );
  34.     if ( error_occurred ) return(0);   /* leave the stack alone */
  35.     y = z;
  36.     z = t;
  37.     t = 0.0;
  38.     return(0);                        }
  39.  
  40.     /*  Polar to rectangular   */
  41.     if ( inkey == 44 )          {
  42.           temp = y * angfac;
  43.           y = x * sin( temp );
  44.           x = x * cos( temp );
  45.           return(0);  }
  46.  
  47.     /*  Rectangular to polar   */
  48.     if ( inkey == 45 )          {
  49.           temp = y;
  50.           y = atan2( y, x ) / angfac;
  51.           x = sqrt( x*x + temp*temp );
  52.           return(0);                 }
  53.  
  54.  
  55.     if ( inkey == 28 ) x =  sin( x   * angfac );
  56.     if ( inkey == 29 ) x =  cos( x   * angfac );
  57.     if ( inkey == 30 ) x =  tan( x   * angfac );
  58.     if ( inkey == 34 ) x = asin( x ) / angfac  ;
  59.     if ( inkey == 35 ) x = acos( x ) / angfac  ;
  60.     if ( inkey == 36 ) x = atan( x ) / angfac  ;
  61.  
  62.  
  63.     /* Use math library functions where possible to get friendly errors */
  64.     if ( inkey == 53 ) x = -x;
  65.     if ( inkey == 33 ) x = pow( x, -1.0 ); 
  66.     if ( inkey == 37 ) x = pow( x,  2.0 );
  67.     if ( inkey == 38 ) x = sqrt( x );
  68.     if ( inkey == 40 ) x = log10( x );
  69.     if ( inkey == 41 ) x = log( x ) / log ( 2.0 );
  70.     if ( inkey == 42 ) x = log( x );
  71.     if ( inkey == 46 ) x = pow( 10.0, x );
  72.     if ( inkey == 47 ) x = pow(  2.0, x );
  73.     if ( inkey == 48 ) x = exp( x );
  74.  
  75.     if ( inkey == 43 ) {
  76.         t = z;
  77.         z = y;
  78.         y = x;
  79.         x = PI;        }
  80.  
  81.  
  82.     /* If we've already encountered an error, nevermind. . . */
  83.     if ( error_occurred ) return(0);
  84.  
  85.     /* Force over(under)flow if number cannot be displayed   */
  86.     if (  abs(x) > 9.99999999999E99 ) x = pow( 10.0,  10000.0 );
  87.     if ( (abs(x) < 1.0000000000E-99) && (abs(x) > 0.0) )
  88.         x = pow( 10.0, -10000.0 );
  89.  
  90. }
  91. /*--------------------------------------------------------*/
  92. ProcessComplex()
  93. {
  94.   double temp, temp2, r, theta, lnr, coeff, coshx, sinhx, a,b,c,d, xy;
  95.                                     
  96.   if ( inkey == 52 ) {
  97.     if ( entry_in_progress == FALSE ) {
  98.          t = z;
  99.          z = y;
  100.          y = x;                 }
  101.     return(0);       }
  102.  
  103.   /*   Note that in all the following computations, x represents the     */
  104.   /*   imaginary part of the argument, while y is the real part.  This   */
  105.   /*   notation is contrary to that used in analysis, where the roles    */
  106.   /*   of x and y are precisely reversed.  This arises since it is more  */
  107.   /*   natural to enter the real part of a number first, which causes    */
  108.   /*   it to end up in the y-register.  Just think backwards.  I know    */
  109.   /*   I certainly do.                                                   */
  110.  
  111.  
  112.   /* The binary operators that remove t,z and replace y,x */
  113.   if ( (inkey ==  4) || (inkey ==  8) || (inkey ==12) ||
  114.        (inkey == 51) || (inkey == 39) )    {
  115.     if ( inkey ==  4 ) { temp = pow( y*y + x*x , -1.0 );
  116.                          temp2 = y;
  117.                          y = (y*t     + x*z) * temp;
  118.                          x = (temp2*z - x*t) * temp; }
  119.     if ( inkey ==  8 ) { temp = y;
  120.                          y = y*t - x*z;
  121.                          x = x*t + temp*z; }
  122.     if ( inkey == 12 ) { x = z-x;
  123.                          y = t-y; }
  124.     if ( inkey == 51 ) { x = z+x;
  125.                          y = t+y; }
  126.  
  127.     /*   y to the x     */
  128.     if ( inkey == 39 ) { r = sqrt(t*t + z*z);
  129.                          theta = atan2( z, t );
  130.                          lnr = log(r);
  131.                          coeff = exp( y*lnr - x*theta );
  132.                          temp = y;
  133.                          y = coeff * cos( x*lnr +    y*theta );
  134.                          x = coeff * sin( x*lnr + temp*theta ); }
  135.     t = 0.0;
  136.     z = 0.0;
  137.     return(0);                        }
  138.  
  139.     /*  Polar to rectangular   */
  140.     if ( inkey == 44 )          {
  141.           temp = y * angfac;
  142.           y = x * sin( temp );
  143.           x = x * cos( temp );
  144.           return(0);  }
  145.  
  146.     /*  Rectangular to polar   */
  147.     if ( inkey == 45 )          {
  148.           temp = y;
  149.           y = atan2( y, x ) / angfac;
  150.           x = sqrt( x*x + temp*temp );
  151.           return(0);                 }
  152.  
  153.  
  154.     if ( ( inkey > 27) && (inkey < 31) ) {
  155.       coshx = cosh( x * angfac );
  156.       sinhx = sinh( x * angfac );
  157.       if (error_occurred) return(0);
  158.  
  159.       /*   sine   */
  160.       if ( inkey == 28 ) { x =  cos(y*angfac) * sinhx;
  161.                            y =  sin(y*angfac) * coshx; }
  162.       /*   cosine  */
  163.       if ( inkey == 29 ) { x = -sin(y*angfac) * sinhx;
  164.                            y =  cos(y*angfac) * coshx; }
  165.       /*   tangent  */
  166.       if ( inkey == 30 ) { x =  sin(y*angfac);
  167.                            y =  cos(y*angfac);
  168.                            a =  x * coshx;
  169.                            b =  y * sinhx;
  170.                            c =  y * coshx;
  171.                            d = -x * sinhx;
  172.                            temp = pow( c*c + d*d , -1.0 );
  173.                            if ( error_occurred ) return(0);
  174.                            y = (a*c + b*d) * temp;
  175.                            x = (b*c - a*d) * temp; }   }
  176.  
  177.     /*  arcsine   */
  178.     if ( inkey == 34 ) { xy = x*y;
  179.                          temp = 1.0 - y*y + x*x;
  180.                          r = sqrt( temp*temp + 4.0*xy*xy );
  181.                          theta = atan2( -2.0*xy, temp );
  182.                          if (theta < 0.0) theta = theta + 2.0 * PI;
  183.                          r = sqrt( r );
  184.                          theta = theta / 2.0;
  185.                          b = r * sin( theta ) + y;
  186.                          a = r * cos( theta ) - x;
  187.                          x = -log( sqrt( a*a + b*b ) ) / angfac;
  188.                          y =  atan2( b, a );
  189.                          if ( y < 0.0 ) y = y + 2.0 * PI;
  190.                          y /= angfac; }
  191.  
  192.     /*  arccosine  */
  193.     if ( inkey == 35 ) { xy = x*y;
  194.                          temp = 1.0 - y*y + x*x;
  195.                          r = sqrt( temp*temp + 4.0*xy*xy );
  196.                          theta = atan2( -2.0*xy, temp );
  197.                          if (theta < 0.0) theta = theta + 2.0 * PI;
  198.                          r = sqrt( r );
  199.                          theta = theta / 2.0;
  200.                          a =  r * cos( theta ) + x;
  201.                          b = -r * sin( theta ) + y;
  202.                          x = -log( sqrt( a*a + b*b ) ) / angfac;
  203.                          y =  atan2( a, b );
  204.                          if ( y < 0.0 ) y = y + 2.0 * PI;
  205.                          y /= angfac; }
  206.  
  207.     /*  arctangent  */
  208.     if ( inkey == 36 ) { d = (1.0-x)*(1.0-x) + y*y;
  209.                          a = (-x*x - y*y + 1.0) / d;
  210.                          b = (-2.0 * y) / d;
  211.                          r = sqrt( a*a + b*b );
  212.                          theta = atan2( b, a );
  213.                          y = -theta / 2.0 / angfac;
  214.                          x = log(r) / 2.0 / angfac; }
  215.  
  216.  
  217.     if ( inkey == 53 ) { x = -x;
  218.                          y = -y; }
  219.     /*    1/x      */
  220.     if ( inkey == 33 ) { r = pow( x*x + y*y, -1.0 );
  221.                          y =  r*y;
  222.                          x = -r*x; }
  223.     /*    x squared   */
  224.     if ( inkey == 37 ) { r = y;
  225.                          y = y*y - x*x;
  226.                          x = 2.0*x*r; }
  227.     /*    sqrt(x)     */
  228.     if ( inkey == 38 ) { theta = atan2( x, y ) / 2.0;
  229.                          r = sqrt( sqrt( x*x + y*y ) );
  230.                          x = r * sin( theta );
  231.                          y = r * cos( theta );  }
  232.  
  233.     /*   logarithms   */
  234.     if ((inkey > 39) && (inkey < 43)) {
  235.       theta = atan2( x, y );
  236.       r = sqrt( x*x + y*y );
  237.       if ( inkey == 40 ) a = log( 10.0 );
  238.       if ( inkey == 41 ) a = log(  2.0 );
  239.       if ( inkey == 42 ) a = 1.0;
  240.       x = theta  / a;
  241.       y = log(r) / a;
  242.       }
  243.  
  244.     /*  exponentials  */
  245.     if ((inkey > 45) && (inkey < 49)) {
  246.       if ( inkey == 46 ) a = log( 10.0 );
  247.       if ( inkey == 47 ) a = log(  2.0 );
  248.       if ( inkey == 48 ) a = 1.0;
  249.       r = exp( y * a );
  250.       y = r * cos( x * a );
  251.       x = r * sin( x * a );
  252.       }
  253.  
  254.     if ( inkey == 43 ) {
  255.         t = z;
  256.         z = y;
  257.         y = x;
  258.         x = PI;        }
  259.  
  260.  
  261.     /* If we've already encountered an error, nevermind. . . */
  262.     if ( error_occurred ) return(0);
  263.  
  264.     /* Force over(under)flow if number cannot be displayed   */
  265.     if (  abs(x) > 9.99999999999E99 ) x = pow( 10.0,  10000.0 );
  266.     if ( (abs(x) < 1.0000000000E-99) && (abs(x) > 0.0) )
  267.         x = pow( 10.0, -10000.0 );
  268.  
  269.     /* Force over(under)flow if number cannot be displayed   */
  270.     if (  abs(y) > 9.99999999999E99 ) y = pow( 10.0,  10000.0 );
  271.     if ( (abs(y) < 1.0000000000E-99) && (abs(y) > 0.0) )
  272.         y = pow( 10.0, -10000.0 );
  273. }
  274. /*--------------------------------------------------------*/
  275. ProcessInteger()
  276. {
  277.   x = ix;
  278.   y = iy;
  279.   z = iz;
  280.   t = it;
  281.  
  282.   ProcessFloat();
  283.  
  284.   /*  Truncate toward zero after slight rounding:        */
  285.   ix = ( x > 0.0 )  ?  x + TRUNC_MARGIN : x - TRUNC_MARGIN;
  286.   iy = ( y > 0.0 )  ?  y + TRUNC_MARGIN : y - TRUNC_MARGIN;
  287.   iz = ( z > 0.0 )  ?  z + TRUNC_MARGIN : z - TRUNC_MARGIN;
  288.   it = ( t > 0.0 )  ?  t + TRUNC_MARGIN : t - TRUNC_MARGIN;
  289.  
  290.  
  291. }
  292. /*-------------------------------------------------------*/
  293. matherr( exc )
  294. struct exception *exc;
  295. {
  296.   if (error_occurred) return(0);
  297.   error_occurred = TRUE;
  298.  
  299.   DrawDisplay();
  300.  
  301.   Move( rp, 250, 55 );
  302.   Text( rp, errstring[ exc->type ], 14 );
  303.  
  304.   Acknowledge:
  305.   WaitPort( hp_window -> UserPort );
  306.  
  307.   if ( GadgetPoked() )        {
  308.     CloseWindow( hp_window );
  309.     CloseScreen( hp_screen );
  310.     if ( print_on )         {
  311.       fputs("\33#1", printer );    /* restore default setting */
  312.       fclose( printer );    }
  313.     exit();                   }
  314.  
  315.   if ( message -> Code != SELECTDOWN ) goto Acknowledge;
  316.  
  317.   DrawDisplay();
  318.  
  319.   /*  Zero out appropriate stack elements  */
  320.   if ( base < BINARY )   {
  321.     x = 0.0;
  322.     if ( base == COMPLEX ) y = 0.0;
  323.     DisplayFloatXY();    }
  324.   else                   {
  325.     ix = 0;
  326.     DisplayIntXY();      }
  327.  
  328. }
  329. /*------------------------------------------------------*/
  330. StoreRegister()
  331. {
  332.   if ( entry_in_progress ) {
  333.        entry_in_progress = FALSE;
  334.        PushX();            }
  335.  
  336.   Move( rp, start_display[ base ], 59 );
  337.   Text( rp, "                                ", display_length[ base ] );
  338.   Move( rp, start_display[ base ], 59 );
  339.   Text( rp, "  STO  _ ", 9 );
  340.  
  341.   SelectStoreReg();
  342.  
  343.   if ( base < BINARY )  {
  344.     registers[reg] = x;
  345.     DisplayFloatXY();   }
  346.   else                  {
  347.     iregisters[reg] = ix;
  348.     DisplayIntXY();     }
  349.  
  350. }
  351. /*-----------------------------------------------------------*/
  352. RecallRegister()
  353. {
  354.   if ( entry_in_progress ) {
  355.        entry_in_progress = FALSE;
  356.        PushX();            }
  357.  
  358.   Move( rp, start_display[ base ], 59 );
  359.   Text( rp, "                                ", display_length[ base ] );
  360.   Move( rp, start_display[ base ], 59 );
  361.   Text( rp, "  RCL  _ ", 9 );
  362.  
  363.   SelectStoreReg();
  364.  
  365.   if ( base < BINARY )  {
  366.     t = z;
  367.     z = y;
  368.     y = x;
  369.     x = registers[reg];
  370.     DisplayFloatXY();   }
  371.   else                  {
  372.     it = iz;
  373.     iz = iy;
  374.     iy = ix;
  375.     ix = iregisters[reg];
  376.     DisplayIntXY();     }
  377.  
  378. }
  379. /*-----------------------------------------------------------*/
  380. SelectStoreReg()
  381. {
  382.   int k;
  383.  
  384.   Sleep:
  385.   WaitPort( hp_window -> UserPort );
  386.  
  387.   if ( GadgetPoked() )        {
  388.     CloseWindow( hp_window );
  389.     CloseScreen( hp_screen );
  390.     if ( print_on )       {
  391.       fputs("\33#1", printer );    /* restore default setting */
  392.       fclose( printer );  }
  393.     exit();                   }
  394.  
  395.   if ( message -> Code != SELECTDOWN )  goto Sleep;
  396.  
  397.   regcode = KeyCode();
  398.  
  399.   if ( (regcode > 18) && (regcode < 49)  )  goto Sleep;
  400.   if (  regcode > 49)                       goto Sleep;
  401.   if ( (regcode == 0) || (regcode ==  4) ||
  402.        (regcode == 8) || (regcode == 12  )) goto Sleep;
  403.  
  404.   
  405.   Move( rp, start_display[ base ] + 39, 59 );
  406.   Text( rp, opcode[ regcode ], 5 );
  407.  
  408.   for ( k = 1; k < 7000; k++) xmin = 5;
  409.  
  410.   if ( regcode ==  1 ) reg = 7;
  411.   if ( regcode ==  2 ) reg = 8;
  412.   if ( regcode ==  3 ) reg = 9;
  413.   if ( regcode ==  5 ) reg = 4;
  414.   if ( regcode ==  6 ) reg = 5;
  415.   if ( regcode ==  7 ) reg = 6;
  416.   if ( regcode ==  9 ) reg = 1;
  417.   if ( regcode == 10 ) reg = 2;
  418.   if ( regcode == 11 ) reg = 3;
  419.   if ( (regcode > 12) && (regcode <19) ) reg = regcode - 3;
  420.   if ( regcode == 49 ) reg = 0;
  421.  
  422. }
  423. /*-----------------------------------------------------*/
  424. CheckStack()
  425. {
  426.   double t_float;
  427.   int    t_int;
  428.  
  429.   if ( inkey < 56 ) return(0);
  430.  
  431.   /*     RCLz     */
  432.   if ( inkey == 56 ) {  it = iz;
  433.                         iz = iy;
  434.                         iy = ix;
  435.                         ix = it;   /* was iz a moment ago */
  436.                         t  =  z;
  437.                         z  =  y;
  438.                         y  =  x;
  439.                         x  =  t;   }
  440.  
  441.   /*     RCLt     */
  442.   if ( inkey == 57 ) {  t_int =  it;
  443.                         it    =  iz;
  444.                         iz    =  iy;
  445.                         iy    =  ix;
  446.                         ix    =  t_int;
  447.                         t_float = t;
  448.                         t       = z;
  449.                         z       = y;
  450.                         y       = x;
  451.                         x       = t_float; }
  452.  
  453.   /*      LastX            */
  454.   if ( inkey == 58 )     {
  455.       tempbase = base;
  456.       base = lastbase;
  457.       PushX();
  458.       base = tempbase;   }
  459.  
  460.   /*      x <> y           */
  461.   if ( inkey == 59 ) {  t_int   =      ix;
  462.                         ix      =      iy;
  463.                         iy      =   t_int;
  464.                         t_float =       x;
  465.                         x       =       y;
  466.                         y       = t_float;   }
  467.   
  468.  
  469.   if ( (inkey == 60) && ( entry_in_progress == FALSE ) ) {
  470.      x  =   y;
  471.      y  =   z;
  472.      z  =   t;
  473.      t  = 0.0;
  474.      ix =  iy;
  475.      iy =  iz;
  476.      iz =  it;
  477.      it =   0;  }
  478.  
  479. }
  480.  
  481.  
  482.