DataMuseum.dk

top - download

    Length: 5248 (0x1480)
    Types: TextFile
    Names: »LIFE.PAS«

└─⟦09235ab48⟧ Bits:30003065 Demoprogrammer K-Z til Pascal bog
    └─ ⟦this⟧ »LIFE.PAS« 

TextFile

PROGRAM life;

  TYPE
    tavle = ARRAY(.0 .. 18, 0 .. 18.) OF CHAR;
  
  VAR
    glgen, nygen : tavle;
    ch : CHAR;
    generation : INTEGER;
    
  PROCEDURE init;
  
    TYPE
      str2 = STRING(.2.);
    
    VAR
      plac : str2;
      x, y : INTEGER;
      ch : CHAR;
      
    BEGIN (* init *)
      FOR x := 0 TO 18 DO
        FOR y := 0 TO 18 DO
          nygen(.x, y.) := ' ';
      WRITE(CLRHOM);
      GOTOXY(12, 1); WRITE('NY GENERATION');
      GOTOXY(2, 3);
      FOR ch := 'a' TO 'q' DO
        WRITE(ch, ' ');
      GOTOXY(2, 21);
      FOR ch := 'a' TO 'q' DO
        WRITE(ch, ' ');
      FOR ch := 'A' TO 'Q' DO
        BEGIN
          GOTOXY(0, ORD(ch) - 61); WRITE(ch);
          GOTOXY(36, ORD(ch) - 61); WRITE(ch);
        END;
      GOTOXY(45, 5); WRITE('En organismes placering angives');
      GOTOXY(45, 6); WRITE('f.eks. således: <fK>');
      GOTOXY(45, 8); WRITE('I. Indsæt organisme');
      GOTOXY(45, 9); WRITE('S. Slet organisme');
      GOTOXY(45, 10); WRITE('A. Afslut indtastning');
      GOTOXY(45, 12); WRITE('Ønske: < >');
      GOTOXY(45, 14); WRITE('Placering: <  >');
      REPEAT
        GOTOXY(53, 12); WRITE(' ', CHR(8));
        REPEAT
          READ(KBD, ch);
        UNTIL ch IN (.'I', 'i', 'S', 's', 'A', 'a'.);
        WRITELN(ch);
        IF ch IN (.'I', 'i', 'S', 's'.)
          THEN
            BEGIN
              REPEAT
                GOTOXY(57, 14); WRITE('  ', CHR(8), CHR(8));
                BUFLEN := 2;
                READ(plac);
              UNTIL (plac(.1.) IN (.'a' .. 'q'.)) AND
                    (plac(.2.) IN (.'A' .. 'Q'.));
              GOTOXY((ORD(plac(.1.)) - 96) * 2, ORD(plac(.2.)) - 61);
              IF ch IN (.'I', 'i'.)
                THEN
                  BEGIN
                    WRITE('*');
                    nygen(.ORD(plac(.1.)) - 96, ORD(plac(.2.)) - 64.) := '*';
                  END
                ELSE
                  BEGIN
                    WRITE(' ');
                    nygen(.ORD(plac(.1.)) - 96, ORD(plac(.2.)) - 64.) := ' ';
                  END;
            END;
      UNTIL ch IN (.'A', 'a'.);
      GOTOXY(54, 1); WRITE('GL GENERATION');
      FOR y := 5 TO 14 DO
        BEGIN
          GOTOXY(45, y); WRITE(CLREOL);
        END;
      GOTOXY(44, 3);
      FOR ch := 'a' TO 'q' DO
        WRITE(ch, ' ');
      GOTOXY(44, 21);
      FOR ch := 'a' TO 'q' DO
        WRITE(ch, ' ');
      FOR ch := 'A' TO 'Q' DO
        BEGIN
          GOTOXY(42, ORD(ch) - 61); WRITE(ch);
          GOTOXY(78, ORD(ch) - 61); WRITE(ch);
        END;
      generation := 1;
    END; (* init *)
  
  PROCEDURE nygeneration;
    
    VAR
      x, y, antal : INTEGER;
    
    FUNCTION nabo(x, y : INTEGER) : INTEGER;
    
      VAR
        i, j, antal : INTEGER;
      
      BEGIN (* nabo *)
        antal := 0;
        FOR i := x -1 TO x + 1 DO
          IF glgen(.i, y - 1.) = '*'
            THEN antal := antal + 1;
        FOR i := x-1 TO x + 1 DO
          IF glgen(.i, y + 1.) = '*'
            THEN antal := antal + 1;
        IF glgen(.x - 1, y.) = '*'
          THEN antal := antal + 1;
        IF glgen(.x + 1, y.) = '*'
          THEN antal := antal + 1;
        nabo := antal;
      END; (* nabo *)
    
    PROCEDURE tegnbane(nr : INTEGER);
    
      VAR
        i, j : INTEGER;
      
      BEGIN (* tegnbane *)
        FOR i := 1 TO 17 DO
          FOR j := 1 TO 17 DO
            IF nr = 1
              THEN
                BEGIN
                  GOTOXY(2 * i, j + 3); WRITE(nygen(.i, j.));
                END
              ELSE
                BEGIN
                  GOTOXY(2 * i + 42, j + 3); WRITE(nygen(.i, j.));
                END;
      END; (* tegnbane *)
    
    BEGIN (* nygeneration *)
      glgen := nygen;
      tegnbane(2);
      FOR x := 1 TO 17 DO
        FOR y := 1 TO 17 DO
          BEGIN
            antal := nabo(x,y);
            CASE antal OF
              4, 5, 6, 7, 8 : nygen(.x, y.) := ' ';
              0, 1, 2, 3, 4 : BEGIN
                                IF (glgen(.x, y.) = ' ') AND (antal = 3)
                                  THEN nygen(.x, y.) := '*';
                                IF (glgen(.x, y.) = '*') AND ((antal = 0)
                                   OR (antal = 1) OR (antal = 4))
                                  THEN nygen(.x, y.) := ' ';
                              END;
            END;
          END;
      GOTOXY(26,23); WRITE(generation);
      tegnbane(1);
    END; (* nygeneration *)
    
  BEGIN (* life *)
    init;
    GOTOXY(11,23); WRITE('Generation nr. 1');
    GOTOXY(47, 23); WRITE('En generation mere (j/n): ');
    REPEAT
      REPEAT
        GOTOXY(73, 23); WRITE(' ', CHR(8));
        READ(KBD, ch);
      UNTIL ch IN (.'J', 'j', 'N', 'n'.);
      WRITE(ch);
      IF ch IN (.'J', 'j'.)
        THEN
          BEGIN
            generation := generation + 1;
            nygeneration;
          END;
    UNTIL ch IN (.'N', 'n'.);
    WRITELN;
  END. (* life *)
«eof»