home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 17 / CD_ASCQ_17_101194.iso / dos / prg / vidal / pascal / test.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-07-21  |  2.8 KB  |  115 lines
  1.  program jdlavie;
  2.  uses crt;
  3.  const test:array[0..17] of byte=(0,0,0,1,0,0,0,0,0,0,0,1,1,0,0,0,0,0);
  4.  nbl=24;
  5.  nbc=80;
  6.  bidulle=4;
  7.  truc=4;
  8.  type
  9.  tableau=ARRAY[1..nbc+2,1..nbl+2] of byte;
  10.  tust=array[0..17] of byte;
  11.  var t1,t2:tableau;
  12.      i,j,gene: integer;
  13.      tabtest: tust;
  14.      s: byte;
  15.      meilleur:tust;
  16.      dc,dcm: integer;
  17.      score,score1: integer;
  18.  
  19.  PROCEDURE init(var t1,t2:TABLEAU);
  20.  BEGIN
  21.    randomize;
  22.    gene:=9;
  23.    score:=0;
  24.    for i:=0 to 17 do  tabtest[i]:=test[i];
  25.    for i:=1 to nbl+2 do
  26.    for j:=1 to nbc+2 do BEGIN
  27.           t2[j,i]:=0;
  28.           t1[j,i]:=0;
  29.           END;
  30.    for i:=2 to 40 do t1[i,10]:=1;
  31.    for i:=2 to 40 do t1[i,15]:=1;
  32.    for i:=2 to 40 do t1[i,5]:=1;
  33.    for i:=2 to 40 do t1[i,6]:=1;
  34.    for i:=2 to 40 do t1[i,7]:=1;
  35.    for i:=3 to 17 do t1[4,i]:=1;
  36.    END;
  37.  
  38.    PROCEDURE MUTANT(var tab:tust);
  39.    var t:tust;
  40.        i,b,x:integer;
  41.    BEGIN
  42.           b:=0;
  43.           for i:=0 to 17 do tab[i]:=0;
  44.            repeat
  45.             i:=random(15)+1;
  46.             if tab[i]<>1 then BEGIN
  47.                                        b:=b+1;
  48.                                        tab[i]:=1;
  49.                             END;
  50.           until b=bidulle;
  51.  
  52.         END;
  53.  
  54.    PROCEDURE transfert(var t1,t2: TABLEAU);
  55.    BEGIN
  56.      for i:=2 to nbl+1 do
  57.      for j:=2 to nbc+1 do BEGIN
  58.        s:=t1[j,i]*9;
  59.        s:=s+t1[j-1,i-1]+t1[j,i-1]+t1[j+1,i-1]+t1[j-1,i]+t1[j+1,i];
  60.        s:=s++t1[j-1,i+1]+t1[j,i+1]+t1[j+1,i+1];
  61.        t2[j,i]:=tabtest[s];
  62.              END;
  63.        for i:=2 to nbl+1 do
  64.          for j:=2 to nbc+1 do t1[j,i]:=t2[j,i];
  65.      END;
  66.  
  67.      PROCEDURE affichage;
  68.      BEGIN
  69.        score:=0;
  70.        GOTOXY(1,1);
  71.        for i:=2 to nbl+1 do
  72.          for j:=2 to nbc+1 do  BEGIN
  73.           case t1[j,i] of
  74.            1:  BEGIN score:=score+1; write('o');END;
  75.            0: write(' ');
  76.           end;
  77.        end;
  78.     write('regle:');
  79.     dc:=score-score1;
  80.     for i:=0 to 17 do write(tabtest[i]);
  81.     write(' ',dc,'  ');
  82.     for i:=0 to 17 do write(meilleur[i]);
  83.     write(' ',dcm,'        ');
  84.    END;
  85.  
  86.   procedure enmarche;
  87.   BEGIN
  88.   init(t1,t2);
  89.     affichage;
  90.     score1:=score;
  91.     REPEAT
  92.       transfert(t1,t2);
  93.       affichage;
  94.       gene:=gene+1;
  95.       if (gene mod 10)=0 then
  96.                BEGIN
  97.                 gene:=gene-10;
  98.                 mutant(tabtest);
  99.                 {gotoxy(2,23);write(dc);}if dcm<dc then BEGIN
  100.                                                       meilleur:=tabtest;
  101.                                                       dcm:=dc;
  102.                                                       END;
  103.                END;
  104.     UNTIL (score=0) or (keypressed);
  105.   END;
  106.  
  107.     BEGIN
  108.     dcm:=0;
  109.     clrscr;
  110.     repeat
  111.     enmarche;
  112.     until keypressed;
  113.     END.
  114.  
  115.