home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 026.lha / HP-10C / display.mod < prev    next >
Encoding:
Modula Implementation  |  1987-04-02  |  5.1 KB  |  166 lines
  1. IMPLEMENTATION MODULE CalcDisplay;
  2.  
  3. (* 
  4.  
  5.  
  6.    Created: Duncan Prindle,  September 1, 1986
  7.  
  8.    Modified: Perhaps
  9.  
  10. *)
  11.  
  12. FROM CalcFunctions IMPORT ErrorType, X, SAME, NDeci;
  13.  
  14. FROM Conversions   IMPORT ConvertToString;
  15. FROM Intuition     IMPORT IntuitionTextPtr, IntuitionText, PrintIText,
  16.                           WindowPtr;
  17. FROM MathLib0      IMPORT log, power;
  18. FROM M2Conversions IMPORT ConvertReal;
  19. FROM SYSTEM        IMPORT  ADDRESS, ADR, BYTE, NULL, WORD;
  20.  
  21.  
  22.  
  23. VAR
  24.   Display    : ARRAY[0..18] OF CHAR;
  25.   DISPLAY    : IntuitionText;
  26.   Cexp       : LONGCARD;    Emask : LONGBITSET;     Eshift : LONGCARD;
  27.   LDisp      : LONGCARD;    Mmask : LONGBITSET;     Mshift : LONGCARD;
  28.   HiddenBit  : LONGCARD;
  29.   Shifts     : ARRAY[0..23] OF LONGCARD;
  30.  
  31. PROCEDURE DisplayX( error : ErrorType;
  32.                     wp    : WindowPtr  ) ;
  33.  
  34.  
  35. VAR NDecimal : INTEGER;
  36.  
  37.  
  38. BEGIN
  39.  
  40.  (* Delete Old Display  *)
  41.     WITH DISPLAY DO
  42.       FrontPen  := BYTE (0);   BackPen   := BYTE (0);
  43.       DrawMode  := BYTE (0);
  44.       LeftEdge  := 5;          TopEdge  := 3;
  45.       ITextFont := NULL;       NextText  := NULL;
  46.       IText     := ADR( Display );
  47.     END;
  48.    PrintIText( wp^.RPort^, DISPLAY, 8, 15 );
  49.  
  50.  
  51. (* Print out any error messages *)
  52.  CASE error OF
  53.    DivideByZero  : Display := "Divide by 0 ?";   |
  54.    NegSqrt       : Display := "SQRT: X < 0 ?";   |
  55.    NegLog        : Display := "Log:  X < 0 ?";   |
  56.    NegLn         : Display := "Ln:   X < 0 ?";   |
  57.    AsinTooBig    : Display := "ASIN: X > 1 ?";   |
  58.    XTooBigForSIN : Display := "X Too Big 4 sin"; |
  59.    AcosTooBig    : Display := "ACOS: X > 1 ?";   |
  60.    XTooBigForCOS : Display := "X Too Big 4 cos"; |
  61.    XTooBigForTAN : Display := "X Too Big 4 tan"; |
  62.    piOver2       : Display := "X Close to pi/2"; |
  63.    OverFlow      : Display := "Result Too Big";  |
  64.    NoError :
  65.  (* No Error. Create character string containing desired format *)
  66.     CASE display OF
  67.        BINARY    : IntDisp(  2 );                             |
  68.        OCTAL     : IntDisp(  8 );                             |
  69.        HEX       : IntDisp( 16 );                             |
  70.        DECIMAL   : IF SAME
  71.                       THEN IF (X = 1.0) & (NDeci = 0)
  72.                               THEN Display := "             1.";
  73.                             ELSIF (X = -1.0) & (NDeci = 0)
  74.                               THEN Display := "            -1.";
  75.                             ELSE   ConvertReal( X, 15, NDeci, Display );
  76.                            END;
  77.                       ELSE ConvertReal( X, 15, NDecDigits, Display );
  78.                    END;                                       |
  79.        SCIENTIFIC: ConvertReal( X, 15, NSciDigits, Display );
  80.                    Display[11] := ' '
  81.     END;
  82.                                                  |
  83.     ELSE  Display := " ? ERROR ?";
  84.  END;
  85.  
  86.  (* Now display new number *)
  87.     WITH DISPLAY DO
  88.       FrontPen  := BYTE (2);   BackPen   := BYTE (0);
  89.       DrawMode  := BYTE (0);
  90.       LeftEdge  := 5;           TopEdge  := 3;
  91.       ITextFont := NULL;       NextText  := NULL;
  92.       IText     := ADR( Display );
  93.     END;
  94.    PrintIText( wp^.RPort^, DISPLAY, 8, 15 );
  95.  
  96. END DisplayX;
  97.  
  98.  
  99. PROCEDURE IntDisp( Base : CARDINAL );
  100. VAR neg   : BOOLEAN;
  101.     done  : BOOLEAN;
  102.     I     : INTEGER;
  103.     ILast : INTEGER;
  104.     DispL : ARRAY[0..33] OF CHAR;
  105.  
  106.    PROCEDURE Shift( VAR items : ARRAY OF WORD ) : LONGCARD;
  107.  
  108.    BEGIN
  109.      RETURN Shifts[ INTEGER( items[1] ) ];
  110.    END Shift;
  111.  
  112. BEGIN
  113.     neg   := X < 0.0;
  114.    (* We turn a REAL into a LONGCARD.
  115.        This procedure will give us up to 24 bits *)
  116.     Cexp := LONGCARD( LONGBITSET( X ) * Emask ) DIV Eshift;;
  117.     IF Cexp < 126
  118.        THEN LDisp := 0;
  119.      ELSIF Cexp > 150
  120.        THEN Display := "24 BIT OverFlow";
  121.             RETURN;
  122.      ELSE   Cexp := 150 - Cexp;
  123.             Mshift := Shift( Cexp );
  124.             LDisp := ( LONGCARD( LONGBITSET( X ) * Mmask ) + HiddenBit )
  125.                                       DIV Mshift;
  126.     END;
  127.  
  128.     ConvertToString( LDisp, Base, neg, DispL, done);
  129.     IF ~done
  130.        THEN Display := "Display Error";
  131.        ELSE
  132.     (* Copy from DispL to Display, justifying to right of Display *)
  133.             I := 0; ILast := 0;
  134.             WHILE (DispL[I] # ' ') & ( I < 15 ) DO
  135.                INC(I);
  136.                ILast := I;
  137.             END;
  138.             FOR I := 0 TO ILast DO
  139.                Display[I+15-ILast] := DispL[I];
  140.             END;
  141.     END;
  142.  
  143. END IntDisp;
  144.  
  145.  
  146.  
  147. BEGIN
  148.  
  149.   display    := DECIMAL;
  150.   NDecDigits := 3;
  151.   NSciDigits := 3;
  152.   Emask      := LONGBITSET{23..30};
  153.   Eshift     := 8388608;
  154.   HiddenBit  := 8388608;
  155.   Mmask      := LONGBITSET{1..22};
  156.   Shifts[ 0]  :=       1;  Shifts[ 1]  :=       2;  Shifts[ 2]  :=       4;
  157.   Shifts[ 3]  :=       8;  Shifts[ 4]  :=      16;  Shifts[ 5]  :=      32;
  158.   Shifts[ 6]  :=      64;  Shifts[ 7]  :=     128;  Shifts[ 8]  :=     256;
  159.   Shifts[ 9]  :=     512;  Shifts[10]  :=    1024;  Shifts[11]  :=    2048;
  160.   Shifts[12]  :=    4096;  Shifts[13]  :=    8192;  Shifts[14]  :=   16384;
  161.   Shifts[15]  :=   32764;  Shifts[16]  :=   65528;  Shifts[17]  :=  131072;
  162.   Shifts[18]  :=  262144;  Shifts[19]  :=  524288;  Shifts[20]  := 1048576;
  163.   Shifts[21]  := 2097152;  Shifts[22]  := 4194304;  Shifts[23]  := 8388608;
  164.  
  165. END CalcDisplay.
  166.