Jeu de la vie

Soyez le premier à donner votre avis sur cette source.

Snippet vu 11 074 fois - Téléchargée 29 fois


Commenter

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

Ajouter un commentaire

Commentaires

Signaler
Bombela
Messages postés
225
Date d'inscription
mardi 4 mars 2003
Statut
Membre
Dernière intervention
30 juillet 2008
 -
T'aurais pu mettre des boucles pour remplir ton tableau...

Et ben dis donc, en prépa on est obligé de faire du Turbo Pascal !
Y connaisse pas le 32 bits en PMode ? Nan parce que là quand même, c'est abuser... Je connais bien le Turbo Pascal, et Delphi, et avec quelque petite fonction, on peux faire un prog Delphi en mode console qui fonctionne visuelement comme sous DOS, mais en 32 bits et avec plus de contrôle et de fiabilitée ! Oui parce que l'émulation du DOS c'est pas le top ! A moins que vous programmiez sous DOS !! Arrrrrg ! Même mes prog DOS (Programme système oblige) je les fais sous Win !
@+
Signaler
croustibat82
Messages postés
79
Date d'inscription
jeudi 6 novembre 2003
Statut
Membre
Dernière intervention
29 juin 2004
 -
bon je suis sous delphi 6 personnal edition et j'arrive pas a le faire marcher, je dois faire kwa? je sais je suis un newb mais bon wala kwa... si kkun pouvait m'aider :'(
S'inscrire maintenant

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.

Du même auteur (fhr)