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

⟦075514987⟧ TextFile

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

Derivation

└─⟦09235ab48⟧ Bits:30003065 Demoprogrammer K-Z til Pascal bog
    └─ ⟦this⟧ »TRECIFRE.PAS« 
└─⟦092727b26⟧ Bits:30005927 Demoprogrammer til Pascal bog (Jet-80)
    └─ ⟦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 (^C stopper): '); READLN(tal);
      WRITE('Indtast feltlængden: '); READLN(felter);
      trecif(tal, felter);
    UNTIL FALSE;
  END. (* trecifre *)
«eof»