DataMuseum.dk

top - download

    Length: 5056 (0x13c0)
    Notes: Mikados TextFile, Mikados_K
    Names: »PSCT6«

└─⟦ca21ef4c0⟧ Bits:30005311 Extended Pascal System Disc v. 04.07.1980 (SPC/1)
    └─ ⟦this⟧ »PSCT6« 

Text

PROGRAM FORMATTEST;
  (* EXAMPLE OF AN ADVANCED FORMATTING ROUTINE FOR MIKADOS  *)
  (* PASCAL E EXTENDED PRECISION REALS                      *)
  (* APPLICATION NOTE - RM/800103 - NOT COPYRIGHTED         *)
VAR TEST: STRING;
 
PROCEDURE FORMAT( BINARY: REAL; VAR ASCII: STRING );
CONST FILLER = '*'; (*CHANGE TO ' ' IF LEADING *'S NOT REQUIRED*)
VAR I,J: INTEGER;
    FINISHED: BOOLEAN;
 
PROCEDURE BCDTOASCII( BINARY: REAL; VAR ASCII: STRING );
    (* CONVERTS THE EXTENDED PRECISION BINARY REAL IN 'BINARY' *)
    (* INTO AN ASCII STRING IN 'ASCII'. THE RESULTING FORMAT   *)
    (* OF 'ASCII' IS:                                          *)
    (*  POS. X (1<=X<=13) DIGIT OF WEIGHT 10^(11-X) IN BASE 10 *)
    (*                    REPRESENTATION OF 'BINARY'           *)
    (*  POS. 14           SIGN ('+' OR '-')                    *)
    (*  POS. 15-16        EXPONENT                             *)
    (*                                                         *)
    (* THE ROUTINE CAN ONLY BE USED WITH PASCAL E AND DEPENDS  *)
    (* ON THE INTERNAL REPRESENTATION OF EXTENDED PRECISION    *)
    (* NUMBERS                                                 *)
 
TYPE BYTE = 0..255;
     EQUIVALENCER = RECORD  (*VERY DIRTY TRICK*)
                      CASE BOOLEAN OF
                         TRUE:  (INN: REAL);
                         FALSE: (OUT: PACKED ARRAY(1..8) OF BYTE)
                    END;
VAR I,J,INDEX,EXPONENT: INTEGER;
    BCD: BYTE;
    CONVERT: EQUIVALENCER;
BEGIN
  ASCII := '0000000000000+00';
  IF BINARY>=0.0 THEN BINARY:=BINARY+0.005 ELSE BINARY:=BINARY-0.005;
  CONVERT.INN := BINARY;
  IF CONVERT.OUT(1) >= 128 THEN ASCII(14) := '-';
  EXPONENT := CONVERT.OUT(8) - 128;
  IF EXPONENT > 11 THEN ASCII := '????????????????'
  ELSE
    BEGIN
    FOR I:=EXPONENT DOWNTO -1 DO
      BEGIN
      J := EXPONENT - I + 3;
      BCD := CONVERT.OUT(J DIV 2);
      INDEX := 12 - I;
      IF J MOD 2 = 1 THEN ASCII(INDEX):=CHR(BCD MOD 16 + ORD('0'))
                     ELSE ASCII(INDEX):=CHR(BCD DIV 16 + ORD('0'));
      END;
    BCD := CONVERT.OUT(8);
    ASCII(15) := CHR( BCD DIV 10 + ORD('0') );
    ASCII(16) := CHR( BCD MOD 10 + ORD('0') );
    END;
END (*BCD TO ASCII*);
 
BEGIN  (*FORMAT BINARY NUMBER INTO PRETTY ASCII STRING *)
       (*TRAILING SIGN, DECIMAL COMMA, POSITIONAL DOTS *)
       (*FILLER CHARACTERS OPTIONAL                    *)
  BCDTOASCII( BINARY, ASCII );
  ASCII := CONCAT( ASCII, '  ' );
  I := 1;
  WHILE (ASCII(I)='0') AND (I<11) DO
    BEGIN
    ASCII(I) := FILLER;
    I := I + 1
    END;
  ASCII(18) := ASCII(14);
  ASCII(17) := ASCII(13);
  ASCII(16) := ASCII(12);
  FINISHED := FALSE;
  I := 15;
  FOR J := 11 DOWNTO 2 DO
    BEGIN
    IF (J+1) MOD 3 = 0 THEN
      BEGIN
      IF FINISHED THEN ASCII(I) := FILLER ELSE ASCII(I) := '.';
      I := I - 1;
      END;
    IF FINISHED THEN ASCII(I) := FILLER ELSE ASCII(I) := ASCII(J);
    FINISHED := FINISHED OR (ASCII(J-1)=FILLER);
    I := I - 1;
    END;
  ASCII(15) := ',';
END  (*FORMAT*);
 
BEGIN (* MAIN PROGRAM *)
FORMAT(         1.23, TEST );WRITELN(LIST,         1.23:25:2,TEST:20);
FORMAT(  -123456.777, TEST );WRITELN(LIST,  -123456.777:25:2,TEST:20);
FORMAT( 4445556667.9, TEST );WRITELN(LIST, 4445556667.9:25:2,TEST:20);
FORMAT(        -0.05, TEST );WRITELN(LIST,        -0.05:25:2,TEST:20);
FORMAT(         1E11, TEST );WRITELN(LIST,          1E11:25 ,TEST:20);
FORMAT(        1E-11, TEST );WRITELN(LIST,         1E-11:25 ,TEST:20);
END (*MAIN PROGRAM*).