[Flash Pascal] Architecture d'un jeu incluant une intelligence artificielle

[Roland Chastain]

Bonjour !

Voici une première version du jeu. Il manque toujours l'animation, la présentation est pauvre mais ça a l'air de fonctionner.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
 
program Quatre;
 
(* Puissance 4 *)
 
uses
  Couleurs, Flash8;
 
{$FRAME_WIDTH 300}
{$FRAME_HEIGHT 300}
{$BACKGROUND $F5F5F5}
{$FRAME_RATE 10}
 
const
  neant = 0;
  blanc = 1;
  noir = -1;
 
type
  tGrille = array[0..6, 0..5] of integer;
 
  tBouton = class(MovieClip)
              numero: integer;
              constructor create(z: integer);
              procedure onRelease; override;
              procedure onEnterFrame; override;
            end;
 
var
  g: tGrille;
{ procedure initialise; }
{ procedure dessine; }
{ function ajoute(var aG: tGrille; const aX: integer): boolean; }
{ function score(const aG: tGrille): integer; }
{ function quatre_en_ligne: boolean; }
{ function grille_pleine: boolean; }
{ procedure fin_de_partie; }
{ procedure copie(const cG: tGrille; var vG: tGrille); }
{ function meilleurCoup: integer; }
  boutons: array[0..6] of tBouton;
  pause: integer;
 
procedure initialise;
var
  x, y: integer;
begin
  for x := 0 to 6 do for y := 0 to 5 do g[x,y] := neant;
  pause := 0;
end;
 
procedure dessine;
var
  x, y, xs, ys, c: integer;
begin
  with _root do
  begin
    lineStyle(2, Blue);
    for y := 0 to 5 do for x := 0 to 6 do
    begin
      xs := 10 + 40 * x;
      ys := 10 + 40 * (5 - y);
      moveTo(xs, ys);
      case g[x, y] of
        noir : c := Red;
        neant: c := Snow;
        blanc: c := Tangerine;
      end;
      beginFill(c);
      lineTo(xs + 40, ys + 00);
      lineTo(xs + 40, ys + 40);
      lineTo(xs + 00, ys + 40);
      lineTo(xs + 00, ys + 00);
    end;
  end;
end;
 
function ajoute(var aG: tGrille; const aX: integer): boolean;
var
  x, y, c: integer;
begin
  //
  c := 0;
  for x := 0 to 6 do for y := 0 to 5 do if aG[x,y] <> neant then inc(c);
  if c mod 2 = 0 then c := blanc else c := noir;
  //
  if aG[aX, 5] = neant then
  begin
    result := true;
    y := 5;
    while (y > 0) and (aG[aX, y-1] = neant) do dec(y);
    aG[aX, y] := c;
  end else
    result := false;
end;
 
const
  coord: array[0..11, 0..1] of integer = ((0,3),
                                          (0,4),
                                          (0,5),
                                          (1,5),
                                          (2,5),
                                          (3,5),
                                          (6,3),
                                          (6,4),
                                          (6,5),
                                          (5,5),
                                          (4,5),
                                          (3,5));
 
function score(const aG: tGrille): integer;
var
  n, nmax, i, x, y, c: integer;
begin
  //
  nmax := 0;
  //
  c := 0;
  for x := 0 to 6 do for y := 0 to 5 do if aG[x,y] <> neant then inc(c);
  if c mod 2 = 0 then c := noir else c := blanc;
  //
  for i := 0 to 5 do
  begin
    x := coord[i, 0];
    y := coord[i, 1];
    n := 0;
    while (x>=0) and (x<=6) and (y>=0) and (y<=5) do
    begin
      if aG[x, y] = c then inc(n) else n := 0;
      if n > nmax then nmax := n;
      inc(x);
      dec(y);
    end;
  end;
  //
  for i := 6 to 11 do
  begin
    x := coord[i, 0];
    y := coord[i, 1];
    n := 0;
    while (x>=0) and (x<=6) and (y>=0) and (y<=5) do
    begin
      if aG[x, y] = c then inc(n) else n := 0;
      if n > nmax then nmax := n;
      dec(x);
      dec(y);
    end;
  end;
  //
  for x := 0 to 6 do
  begin
    n := 0;
    for y := 5 downTo 0 do
    begin
      if aG[x, y] = c then inc(n) else n := 0;
      if n > nmax then nmax := n;
    end;
  end;
  //
  for y := 5 downTo 0 do
  begin
    n := 0;
    for x := 0 to 6 do
    begin
      if aG[x, y] = c then inc(n) else n := 0;
      if n > nmax then nmax := n;
    end;
  end;
  //
  result := nmax;
  //
end;
 
function quatre_en_ligne: boolean;
begin
  if score(g) >= 4 then result := true else result := false;
end;
 
function grille_pleine: boolean;
var
  x, y, c: integer;
begin
  c := 0;
  for x := 0 to 6 do for y := 0 to 5 do if g[x, y] <> neant then inc(c);
  if c = 7 * 6 then result := true else result := false;
end;
 
procedure fin_de_partie;
begin
  //initialise;
  //dessine;
  pause := 1;
end;
 
procedure copie(const cG: tGrille; var vG: tGrille);
var
  x, y: integer;
begin
  for x := 0 to 6 do for y := 0 to 5 do vG[x, y] := cG[x, y];
end;
 
function meilleurCoup: integer;
var
  g1, g2: tGrille;
  x1, x2: integer;
  note: array[0..6] of double;
  notemax: double;
  max_adv: integer;
  sg1: integer;
  sg2: array[0..6] of integer;
begin
  //
  notemax := - 100;
  //
  for x1 := 0 to 6 do
  begin
    //
    note[x1] := 0;
    //
    copie(g, g1);
    //
    if not ajoute(g1, x1) then dec(note[x1], 1000);
    //
    sg1 := score(g1);
    //
    if sg1 >= 4 then inc(note[x1], 100) else inc(note[x1], sg1);
    //
    max_adv := 0;
    //
    for x2 := 0 to 6 do
    begin
      //
      copie(g1, g2);
      //
      ajoute(g2, x2);
      //
      sg2[x2] := score(g2);
      //
      if sg2[x2] > max_adv then max_adv := sg2[x2];
      //
    end;
    //
    if max_adv >= 4 then dec(note[x1], 100) else
    begin
      for x2 := 0 to 6 do
      begin
        if sg2[x2] = max_adv then dec(note[x1], max_adv);
      end;
    end;
    //
    if (x1>1) and (x1<5) then inc(note[x1]);
    //
    if note[x1] > notemax then notemax := note[x1];
    //
  end;
  //
  x1 := 0;
  while note[x1] < notemax do inc(x1);
  //
  result := x1;
end;
 
constructor tBouton.Create(z: integer);
begin
  inherited create(_root, '', z + 1);
  numero := z;
  linestyle(2, Blue);
  moveTo(0, 0);
  beginFill(LightSteelBlue);
  lineTo(40, 00);
  lineTo(40, 40);
  lineTo(00, 40);
  lineTo(00, 00);
  endFill;
  _x := 10 + 40 * z;
  _y := 250;
end;
 
procedure tBouton.onRelease;
begin
  if pause > 0 then
    exit;
  if ajoute(g, numero) then
  begin
    dessine;
    if quatre_en_ligne or grille_pleine then
      fin_de_partie
    else
      begin
        ajoute(g, meilleurCoup);
        dessine;
        if quatre_en_ligne or grille_pleine then
          fin_de_partie;
      end;
  end;
end;
 
procedure tBouton.onEnterFrame;
begin
  if pause > 0 then inc(pause);
  if pause = 100 then
  begin
    initialise;
    dessine;
  end;
end;
 
var
  i: integer;
 
begin
  initialise;
  dessine;
  for i := 0 to 6 do boutons[i] := tBouton.create(i);
  stage.scaleMode := 'noScale';
end.

[Paul TOTH]

sympa

[Archimède]

Pas mal du tout !

[Roland Chastain]

Bonjour !

Voici une version un peu plus achevée.

Les fonctions d'arbitrage et les fonctions de recherche du meilleur coup ont été séparées. J'ai mis ces dernières dans une unité.

L'autre amélioration, c'est une sortie texte qui permet de voir pourquoi le coup a été choisi. Cela m'a permis de trouver les erreurs.

Il y a aussi un message d'accueil et des messages de fin de partie.

Maintenant je vais voir si je peux ajouter la chute des pions. Le problème, c'est que lorsque l'utilisateur joue, je fais jouer dans la foulée l'ordinateur, parce que je ne vois pas trop comment faire autrement. Du coup les pions n'ont pas le temps de tomber.

[Paul TOTH]

pour voir tomber les pièces c'est pas très compliqué, tu utilises une variable qui t'indique dans quelle colonne elle est en train de tomber. Si c'est aucune le clic fonctionne sinon le clic ne fait rien et dans onEnterFrame tu descend d'une case et quand elle est arrivée en bas tu reviens à "aucune".

[Roland Chastain]

Merci Paul pour la réponse.

Je me demandais comment j'allais faire jouer l'ordinateur après avoir laissé au pion le temps de tomber, vu que dans mon code actuel le coup de l'ordinateur est enchaîné au coup de l'utilisateur et est donc appelé à partir de la méthode onRelease de mes boutons.

J'ai essayé de déplacer l'appel dans la méthode onEnterFrame en utilisant la même variable globale que pour la chute de la pièce : ça semble fonctionner.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
 
program grille2;
 
{ Grille pour un "Puissance 4". }  
 
{$FRAME_WIDTH 459}
{$FRAME_HEIGHT 408}
{$BACKGROUND $310062}
 
uses
  Flash8, Couleurs;
 
const
  neant =  0;
  blanc =  1;
  noir  = -1;
 
type
  tMovieClip = class(MovieClip)
    e, cx, cy: integer;
    constructor Create(x, y: integer);
    procedure doRelease;
    procedure Colorie;
    procedure Attribue(ne: integer);
    procedure onEnterFrame; override;
  end;
 
var
  a: array [0..6, 0..5] of tMovieClip;
  dc: integer; // demi-coups
  trait: integer;
  gx, gy: integer;
 
procedure NouvellePartie;
var
  x, y: integer;
begin
  dc := 0;
  for x := 0 to 6 do for y := 0 to 5 do a[x, y].Attribue(neant);
  trait := blanc;
  gx := -1;
end;
 
constructor tMovieClip.Create(x, y: integer);
begin
  inherited Create(_root, 'mc' + IntToStr(x) + IntToStr(y), x + 7 * y);
  cx := x;
  cy := y;
  _x := x * 51 + 76;
  _y := y * 51 + 76;
  onRelease := doRelease;
end;
 
procedure tMovieClip.doRelease;
begin
  if (gx < 0) and (dc < 7 * 6) and (a[cx, 0].e = neant) then
  begin
    Inc(dc);
    gx := cx;
    gy := 0;
    a[gx, gy].Attribue(trait);
    trait := -trait;
  end;
end;
 
const
  r = 16;
 
procedure tMovieClip.Colorie;
begin
  lineStyle(0, DarkIndigo);
  moveTo(-r, 0);
  case e of
    neant: beginFill(Indigo);
    blanc: beginFill(Amethyst);
    noir : beginFill(PersianBlue);
  end;
  curveTo(-r, -r, 00, -r);
  curveTo(+r, -r, +r, 00);
  curveTo(+r, +r, 00, +r);
  curveTo(-r, +r, -r, 00);
end;
 
procedure tMovieClip.Attribue(ne: integer);
begin
  e := ne;
  Colorie;
end;
 
procedure JeuOrdinateur(c: integer);
begin
  Inc(dc);
  repeat
    gx := Trunc(Random * 7);
  until a[gx, 0].e = neant;
  gy := 0;
  a[gx, gy].Attribue(c);
  trait := -trait;
end;
 
procedure tMovieClip.onEnterFrame;
begin
  //////////////////////////////////////////////////////////////////////////////
  if (cx = gx) and (cy = gy) then
  begin
    if (cy = 5) or (a[cx, cy + 1].e <> neant) then
      gx := -1
    else
    begin
      Inc(gy);
      a[gx, gy].Attribue(e);
      Attribue(neant);
    end;
  end;
  //////////////////////////////////////////////////////////////////////////////
  if (gx = -1) and (trait = noir) then JeuOrdinateur(trait);
  //////////////////////////////////////////////////////////////////////////////
end;
 
var
  x, y: integer;
 
begin
  for x := 0 to 6 do for y := 0 to 5 do a[x,y] := tMovieClip.Create(x, y);
  NouvellePartie;
  stage.scaleMode := 'noScale';
end.

[Roland Chastain]

J'ai fini !

Je posterai le code dans les sources, quand j'y aurai donné un dernier coup de chiffon.