Jeu de la vie


Contenu du snippet

Le célèbre jeu de la vie de Conway.

Possibilité d'initialiser aléatoirement, manuellement, ou avec un "Gliter Gun".

Attention c'est en vieux Turbo Pascal old school (Prépa oblige...) !

Source / Exemple :


PROGRAM jeu_de_la_vie;   {by FHR}

USES Crt;

TYPE matrice = ARRAY [1..40,1..40]  OF WORD;

VAR t,tab1,tab2:matrice;
    s:CHAR;
    nbretours:WORD;
    bol:BOOLEAN;

PROCEDURE Affiche (tab:matrice);
VAR i,j:WORD;
BEGIN
     FOR i:=1 TO 40 DO
     BEGIN
          FOR j:=1 TO 40 DO BEGIN
              IF tab[i,j]=1 THEN Write('X')
              ELSE Write('-');

          END;
          Writeln;
     END;
END;

PROCEDURE Aleat (VAR tab:matrice);
VAR i,j:WORD;
BEGIN
     Randomize;
     FOR i:=1 TO 40 DO
     BEGIN
          FOR j:=1 TO 40 DO tab[i,j]:=Random(2);
          Writeln;
     END;
END;

PROCEDURE Tabnul (VAR tab:matrice);
VAR i,j:WORD;
BEGIN
     Randomize;
     FOR i:=1 TO 40 DO
     BEGIN
          FOR j:=1 TO 40 DO tab[i,j]:=0;
          Writeln;
     END;
END;

PROCEDURE Glitergun (VAR tab:matrice); {genere un gliter gun}
BEGIN
     Tabnul(Tab);
     Tab[20,3]:=1;Tab[20,4]:=1;Tab[21,3]:=1;Tab[21,4]:=1;Tab[20,13]:=1;
     Tab[21,13]:=1;Tab[22,13]:=1;Tab[19,14]:=1;Tab[23,14]:=1;Tab[18,15]:=1;
     Tab[24,15]:=1;Tab[18,16]:=1;Tab[24,16]:=1;Tab[21,17]:=1;Tab[19,18]:=1;
     Tab[23,18]:=1;Tab[20,19]:=1;Tab[21,19]:=1;Tab[22,19]:=1;Tab[21,20]:=1;
     Tab[18,23]:=1;Tab[19,23]:=1;Tab[20,23]:=1;Tab[18,24]:=1;Tab[19,24]:=1;
     Tab[20,24]:=1;Tab[17,25]:=1;Tab[21,25]:=1;Tab[16,27]:=1;Tab[17,27]:=1;
     Tab[21,27]:=1;Tab[22,27]:=1;Tab[18,37]:=1;Tab[19,37]:=1;Tab[18,38]:=1;
     Tab[19,38]:=1;
END;

PROCEDURE Remplissage (VAR tab:matrice);
VAR i,j:WORD;s:CHAR;
BEGIN
     s:='o';
     Tabnul(tab);
     REPEAT
           Affiche(tab);
           Writeln('Coordonn‚es de la cellule vivante :');
           Writeln('Ligne (1..40) ?');
           Readln(i);

           Writeln('Colonne (1..40) ?');
           Readln(j);
           tab[i,j]:=1;

           Writeln('Continuer ?');
           Readln(s);
     UNTIL s<>'o';
     Clrscr;
END;

FUNCTION Compte(i,j:WORD;tabl:matrice):WORD; {compte le nombre de cellules voisines}
BEGIN
     IF (i<>1) AND (i<>40) AND (j<>1) AND (j<>40) THEN  {cellule sympa}
        Compte:=tabl[i-1,j-1] + tabl[i-1,j] + tabl[i-1,j+1]
               +tabl[i,j-1]   +          + tabl[i,j+1]
               +tabl[i+1,j-1] + tabl[i+1,j] + tabl[i+1,j+1];

     IF i=1 THEN
     BEGIN
          IF j=1 THEN Compte:=tabl[1,2]+tabl[2,2]+tabl[2,1];
          IF j=40 THEN Compte:=tabl[1,39]+tabl[2,39]+tabl[2,40];
          IF (j<>1) AND (j<>40) THEN Compte:=tabl[1,j-1]+tabl[1,j+1]+tabl[2,j-1]+tabl[2,j]+tabl[2,j+1];
     END;

     IF i=40 THEN
     BEGIN
          IF j=1 THEN Compte:=tabl[39,1]+tabl[39,2]+tabl[40,2];
          IF j=40 THEN Compte:=tabl[39,40]+tabl[39,39]+tabl[40,39];
          IF (j<>1) AND (j<>40) THEN Compte:=tabl[40,j-1]+tabl[40,j+1]+tabl[39,j-1]+tabl[39,j]+tabl[39,j+1];
     END;

     IF (j=1) AND ((i<>1) AND (i<>40)) THEN Compte:=tabl[i-1,1]+tabl[i+1,1]+tabl[i-1,2]+tabl[i,2]+tabl[i+1,2];

     IF (j=40) AND ((i<>1) AND (i<>40)) THEN Compte:=tabl[i-1,40]+tabl[i+1,40]+tabl[i-1,39]+tabl[i,39]+tabl[i+1,39];

END;

PROCEDURE Evoluer(VAR tab:matrice);
VAR i,j,k:WORD;buff:matrice;
BEGIN
    FOR i:=1 TO 40 DO
    BEGIN
        FOR j:=1 TO 40 DO
        BEGIN
            k:=compte(i,j,tab);
            IF tab[i,j]=1 THEN
                IF (k=2) OR (k=3) THEN buff[i,j]:=1
                ELSE buff[i,j]:=0
            ELSE
                IF k=3 THEN buff[i,j]:=1
                ELSE buff[i,j]:=0;
        END;
    END;

    tab:=buff;

END;

FUNCTION Comp(t1,t2:matrice):BOOLEAN;
VAR i,j:WORD;bol:BOOLEAN;
BEGIN
     i:=1;
     bol:=TRUE;
     WHILE (bol<>FALSE) AND (i<=40) DO
     BEGIN
         FOR j:=1 TO 40 DO
             IF t1[i,j]<>t2[i,j] THEN bol:=FALSE;
         i:=i+1;
     END;
     Comp:=bol;
END;

BEGIN
     bol:=FALSE;
     Clrscr;

     REPEAT
          nbretours:=0;
          Write('Remplissage aleatoire (a), manuel (m) ou gliter gun (g) (boucle infinie !) ?');
          Readln(s);
          IF s='g' THEN Glitergun(t)
          ELSE IF s='m' THEN Remplissage(t)
               ELSE Aleat(t);

          REPEAT
                Clrscr;
                Writeln('Etape',nbretours);
                Writeln;
                Affiche(t);
                tab1:=t;
                nbretours:=nbretours+1;
                Evoluer(t);
                tab2:=t;
                bol:=Comp(tab1,tab2);
                Evoluer(tab2);
                bol:= bol OR Comp(tab1,tab2);

           UNTIL bol=TRUE;
           writeln('Fin.');
           writeln('Encore ?');
           readln(s);

     UNTIL s<>'o';
     readln;
END.

Conclusion :


A priori pas de mise à jour prévue. Néanmoins on implanter des initialisations célèbres (planeur, canon...) facilement.

Rq : je n'ai pas d'idée précise du niveau ou de la catégorie...

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.