DataMuseum.dk

Presents historical artifacts from the history of:

CP/M

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about CP/M

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦0897b0d4b⟧ TextFile

    Length: 1920 (0x780)
    Types: TextFile
    Names: »TRECIFRE.PAS«

Derivation

└─⟦08ea08c61⟧ Bits:30003924 PolyPascal programmer
    └─ ⟦this⟧ »TRECIFRE.PAS« 

TextFile

PROGRAM trecifre;
  
  VAR
    tal : REAL;
    felter : INTEGER;
  
  PROCEDURE trecif(tal : REAL; felter : INTEGER);
  
    VAR
      decimaler, hel, mellemrum, space, i : INTEGER;
      heldel, decdel : REAL;
      decimalstreng : STRING(.2.);
      helstreng : STRING(.16.);
      fortegn : BOOLEAN;
    
    BEGIN (* trecif *)
      IF tal < 0
        THEN fortegn := TRUE
        ELSE fortegn := FALSE;
      tal := ABS(tal);
      tal := INT(tal * 100 + 0.5) / 100;
      heldel := INT(tal);
      decdel := tal - heldel;
      decimaler := TRUNC(decdel *100 + 0.5);
      IF decimaler >= 10
        THEN STR(decimaler : 2, decimalstreng)
        ELSE
          BEGIN
            STR(decimaler : 1, decimalstreng);
            decimalstreng := '0' + decimalstreng;
          END;
      IF heldel > 0
        THEN hel := TRUNC(LN(heldel) / LN(10)) + 1
        ELSE hel := 1;
      STR(heldel: 16, helstreng);
      IF hel > 1
        THEN helstreng := COPY(helstreng, 1, 1) + COPY(helstreng, 3, hel - 1)
        ELSE helstreng := COPY(helstreng, 1, 1);
      mellemrum := (hel - 1) DIV 3;
      space := felter - hel - mellemrum -3;
      IF fortegn
        THEN space :=space - 1;
      IF space < 0
        THEN space := 0;
      FOR i := 1 TO space DO
        WRITE(' ');
      IF fortegn
        THEN WRITE('-');
      FOR i := 1 TO hel DO
        BEGIN
          WRITE(COPY(helstreng, i, 1));
          IF ((hel - i) MOD 3 = 0) AND (i < hel)
            THEN WRITE(' ');
        END;
      WRITE('.');
      WRITE(decimalstreng);
    END; (* trecif *)
  
  BEGIN (* trecifre *)
    WRITE(CLRHOM);
    REPEAT
      WRITELN;
      WRITE('Indtast et tal (CTRL C stopper): '); READLN(tal);
      WRITE('Indtast feltbredden: '); READLN(felter);
      trecif(tal, felter);
    UNTIL FALSE;
  END. (* trecifre *)
«eof»