DataMuseum.dk

top - download

    Length: 2944 (0xb80)
    Types: TextFile
    Names: »GRUNDTAL.PAS«

└─⟦f983c2ef3⟧ Bits:30004681 Pascal opgaver (Butler)
    └─ ⟦this⟧ »GRUNDTAL.PAS« 

TextFile

PROGRAM grundtal;
  
  CONST
    max = 20;
  
  TYPE
    str30 = STRING(.30.);
    str2 = STRING(.2.);
    str = STRING(.max.);
    
  VAR
    cifre : str;
    fratal, tiltal : str30;
    fragrundtal, tilgrundtal : str2;
    frag, tilg, test, i : INTEGER;
    tal10 : REAL;
    ok : BOOLEAN;
    
  PROCEDURE til10(g : INTEGER; fra : str30; VAR talti : REAL);
    
    VAR
      i, faktor : INTEGER;
    
    BEGIN (* til10 *)
      tal10 := 0.0;
      FOR i := 1 TO LEN(fra) DO
        BEGIN
          IF ORD(fra(.i.)) < ORD('A')
            THEN faktor := ORD(fra(.i.)) - ORD('0')
            ELSE faktor := ORD(fra(.i.)) - ORD('A') + 10;
          talti := talti * g + faktor;
        END;
    END; (* til10 *)
  
  PROCEDURE fra10(g : INTEGER; talti : REAL; VAR til : str30);
  
    VAR
      rest : INTEGER;
      dividend, kvotient : REAL;
      
    BEGIN (* fra10 *)
      kvotient := INT(talti / g + 0.0001);
      rest := ROUND(talti - kvotient * g);
      til := cifre(.rest + 1.);
      WHILE kvotient > 0.1 DO
        BEGIN
          dividend := kvotient;
          kvotient := INT(dividend / g + 0.0001);
          rest := ROUND(dividend  - kvotient * g);
          til := cifre(.rest + 1.) + til;
        END;
    END; (* fra10 *)
  
  BEGIN (* grundtal *)
    cifre := '0123456789';
    FOR i := 11 TO max DO
      cifre := cifre + CHR(ORD('A') - 11 + i);
    WRITE(CLRHOM);
    REPEAT
      REPEAT
        GOTOXY(5, 1);
        WRITE(CLREOL);
        BUFLEN := 2;
        WRITE('Fra hvilket talsystem (2 - ', max, '): ');
        READLN(fragrundtal);
        VAL(fragrundtal, frag, test);
      UNTIL test = 0;
    UNTIL (2 <= frag) AND (frag <= max);
    GOTOXY(5, 3);
    WRITE('Cifrene i ', frag, '-talsystemet: ');
    FOR i := 1 TO frag DO
      WRITE(cifre(.i.), ' ');
    REPEAT
      GOTOXY(5, 7);
      WRITE(CLREOL);
      BUFLEN := 30;
      ok := TRUE;
      WRITE('Hvilket tal skal omformes: ');
      READLN(fratal);
      FOR i := 1 TO LEN(fratal) DO
        IF POS(fratal(.i.), COPY(cifre, 1, frag)) = 0
          THEN ok := FALSE;
    UNTIL ok AND (LEN(fratal) > 0);
    REPEAT
      REPEAT
        GOTOXY(5, 11);
        WRITE(CLREOL);
        BUFLEN := 2;
        WRITE('Til hvilket talsystem (2 - ', max, '): ');
        READLN(tilgrundtal);
        VAL(tilgrundtal, tilg, test);
      UNTIL test = 0;
    UNTIL (2 <= tilg) AND (tilg <= max);
    GOTOXY(5, 13);
    WRITE('Cifrene i ', tilg, '-talsystemet: ');
    FOR i := 1 TO tilg DO
      WRITE(cifre(.i.), ' ');
    GOTOXY(5, 17);
    WRITE(frag, '-talsystemet: ', fratal);
    GOTOXY(5, 19);
    WRITE(tilg, '-talsystemet: ');
    til10(frag, fratal, tal10);
    fra10(tilg, tal10, tiltal);
    WRITELN(tiltal);
    WRITELN;
  END. (* grundtal *)
«eof»