4 var couleur:integer,x:integer,y:integer;
\r
7 Unit init_tab:procedure;
\r
8 var i,j,valx,valy:integer;
\r
10 (* INITIALISATION DES COULEURS *)
\r
16 verif(i,j):=new elem;
\r
17 tab(i,j).couleur:=0;
\r
18 verif(i,j).couleur:=0;
\r
26 simul(i,j):=new elem;
\r
27 simul(i,j).couleur:=0;
\r
30 tab(1,1).couleur:=1;
\r
31 tab(8,8).couleur:=1;
\r
32 tab(8,1).couleur:=2;
\r
33 tab(1,8).couleur:=2;
\r
34 verif(1,1).couleur:=1;
\r
35 verif(8,8).couleur:=1;
\r
36 verif(8,1).couleur:=2;
\r
37 verif(1,8).couleur:=2;
\r
38 (* INITIALISATION DES POSITIONS *)
\r
69 Unit aff_tab:procedure;
\r
76 write(tab(i,j).couleur);
\r
82 Unit aff_simul:procedure;
\r
89 write(simul(i,j).couleur);
\r
95 Unit aff_verif:procedure;
\r
102 write(verif(i,j).couleur);
\r
109 Unit creatab:procedure;
\r
112 array tab dim(-1:10);
\r
115 array tab(i) dim(-1:10);
\r
117 array verif dim(-1:10);
\r
120 array verif(i) dim(-1:10);
\r
122 array simul dim(-2:11);
\r
125 array simul(i) dim(-2:11);
\r
130 unit recopie : procedure;
\r
137 simul(i,j).couleur:=tab(i,j).couleur;
\r
142 unit ecran : procedure;
\r
144 pref IIUWGRAPH block
\r
146 unit sortie:procedure;
\r
151 var i:integer,rep:char ;
\r
155 unit presentation:procedure;
\r
157 call bouton(110,150,530,330);
\r
158 call outstring(230,220," PROJET nø2 DE LI1 ",15,7);
\r
159 call outstring(230,240,"DOMINATE : jeu de strategie",15,7);
\r
160 call outstring(0,0,"ANTON JEAN-FRANCOIS",15,0);
\r
161 call outstring(0,20,"LAVIGNOTTE SEBASTIEN",15,0);
\r
162 call outstring(0,40,"Licence Informatique - Groupe II",15,0);
\r
163 call outstring(0,60,"Annee universitaire 1994/1995",15,0);
\r
164 call outstring(200,450,"Appuyer sur le bouton GAUCHE de votre souris...",15,0);
\r
166 (* Attente de l'appui de la souris *)
\r
167 while (Num_Mouse <> 1)
\r
169 Mouse:=getpress(x_s,y_s,Keyb1,Keyb2,Flag,Num_Mouse) ;
\r
177 unit finir : procedure;
\r
178 var i,j:integer,modifie :boolean;
\r
181 if num_joueur=1 then num_joueur:=2;
\r
182 else num_joueur:=1;
\r
189 if tab(i,j).couleur=0
\r
191 tab(i,j).couleur:=num_joueur;
\r
208 unit finjeu : procedure;
\r
210 call bouton(214,200,428,320);
\r
211 if ( nombre1 > nombre2 ) then
\r
212 call outstring(250,230,"VAINQUEUR : JOUEUR 1",15,7);
\r
214 call outstring(250,230,"VAINQUEUR : JOUEUR 2",15,7);
\r
216 call bouton(270,270,380,300);
\r
217 call outstring(280,280,"cliquez ici",15,7);
\r
218 while (Num_Mouse<>3)
\r
220 Mouse:=getpress(x_s,y_s,Keyb1,Keyb2,Flag,Num_Mouse) ;
\r
221 if num_mouse = 1 then
\r
222 if (x_s>=270 and x_s<=380) and (y_s>=270 and y_s<=300)
\r
231 unit tirage : procedure;
\r
232 var x:real,i,premier:integer;
\r
235 call bouton(214,200,428,320);
\r
236 call outstring(265,230,"Tirage au sort",15,7);
\r
238 if (x>=0 and x<0.5) then premier:=1;fi;
\r
239 if (x>=0.5 and x<1) then premier:=2;fi;
\r
242 call outstring(321,285,"³",15,7);
\r
243 call outstring(321,285,"\",15,7);
\r
244 call outstring(321,285," ",15,7);
\r
245 call outstring(321,285,"Ä",15,7);
\r
246 call outstring(321,285,"/",15,7);
\r
247 call outstring(321,285," ",15,7);
\r
249 if (premier=1) then
\r
250 call outstring(220,285,"Le JOUEUR 1 va commencer",15,7);
\r
252 else call outstring(220,285,"Le JOUEUR 2 va commencer",15,7);
\r
255 call bouton(250,250,360,280);
\r
256 call outstring(260,260,"cliquez ici",15,7);
\r
257 while (Num_Mouse<>3)
\r
259 Mouse:=getpress(x_s,y_s,Keyb1,Keyb2,Flag,Num_Mouse) ;
\r
260 if num_mouse = 1 then
\r
261 if (x_s>=250 and x_s<=360) and (y_s>=240 and y_s<=270)
\r
264 if num_joueur=1 then
\r
266 when 1 : call tourjeu;
\r
267 when 2 : call expansion;
\r
268 when 3 : call destruction;
\r
272 when 1 : call tourjeu;
\r
273 when 2 : call expansion;
\r
274 when 3 : call destruction;
\r
282 unit info1 : procedure;
\r
284 call patern(10,100,20,110,4,1);
\r
285 call outstring(30,100,"JOUEUR 1",4,0);
\r
286 call patern(100,100,110,110,4,1);
\r
287 call outstring(10,150,"POINTS : ",4,0);
\r
288 call track(80,150,nombre1,0,4);
\r
291 unit info2 : procedure;
\r
293 call patern(530,100,540,110,9,1);
\r
294 call outstring(550,100,"JOUEUR 2",9,0);
\r
295 call patern(620,100,630,110,9,1);
\r
296 call outstring(530,150,"POINTS : ",9,0);
\r
297 call track(600,150,nombre2,0,9);
\r
300 unit erreur : procedure;
\r
302 call patern(0,460,640,479,10,1);
\r
303 call outstring(260,465,"COUP IMPOSSIBLE A REALISER",15,10);
\r
309 unit choix : procedure;
\r
311 call bouton(189,175,453,345);
\r
312 call point(321,177);
\r
313 call draw(321,343);
\r
314 call outstring(223,185,"JOUEUR 1",0,7);
\r
315 call outstring(200,210,"humain",0,7);
\r
316 call patern(305,210,315,225,15,1);
\r
317 call outstring(200,240,"expansion",0,7);
\r
318 call patern(305,240,315,255,15,1);
\r
319 call outstring(200,270,"destruction",0,7);
\r
320 call patern(305,270,315,285,15,1);
\r
321 call outstring(355,185,"JOUEUR 2",0,7);
\r
322 call outstring(332,210,"humain",0,7);
\r
323 call patern(437,210,447,225,15,1);
\r
324 call outstring(332,240,"expansion",0,7);
\r
325 call patern(437,240,447,255,15,1);
\r
326 call outstring(332,270,"destruction",0,7);
\r
327 call patern(437,270,447,285,15,1);
\r
328 call bouton(306,300,336,320);
\r
329 call outstring(315,305,"OK",15,7);
\r
331 when 1 : call outstring(306,211,"X",0,15);
\r
332 when 2 : call outstring(306,241,"X",0,15);
\r
333 when 3 : call outstring(306,271,"X",0,15);
\r
336 when 1 : call outstring(438,211,"X",0,15);
\r
337 when 2 : call outstring(438,241,"X",0,15);
\r
338 when 3 : call outstring(438,271,"X",0,15);
\r
340 while (Num_mouse <> 3)
\r
342 Mouse:=getpress(x_s,y_s,Keyb1,Keyb2,Flag,Num_Mouse) ;
\r
343 if num_mouse = 1 then
\r
344 if (x_s>=306 and x_s<=336) and (y_s>=300 and y_s<=320)
\r
349 if (x_s>=305 and x_s<=315) and (y_s>=210 and y_s<=220)
\r
350 then call patern(305,210,315,225,15,1);
\r
351 call patern(305,240,315,255,15,1);
\r
352 call patern(305,270,315,285,15,1);
\r
353 call outstring(306,211,"X",0,15);
\r
356 if (x_s>=305 and x_s<=315) and (y_s>=240 and y_s<=250)
\r
357 then call patern(305,210,315,225,15,1);
\r
358 call patern(305,240,315,255,15,1);
\r
359 call patern(305,270,315,285,15,1);
\r
360 call outstring(306,241,"X",0,15);
\r
363 if (x_s>=305 and x_s<=315) and (y_s>=270 and y_s<=280)
\r
364 then call patern(305,210,315,225,15,1);
\r
365 call patern(305,240,315,255,15,1);
\r
366 call patern(305,270,315,285,15,1);
\r
367 call outstring(306,271,"X",0,15);
\r
370 if (x_s>=437 and x_s<=447) and (y_s>=210 and y_s<=220)
\r
371 then call patern(437,210,447,225,15,1);
\r
372 call patern(437,240,447,255,15,1);
\r
373 call patern(437,270,447,285,15,1);
\r
374 call outstring(438,211,"X",0,15);
\r
377 if (x_s>=437 and x_s<=447) and (y_s>=240 and y_s<=250)
\r
378 then call patern(437,210,447,225,15,1);
\r
379 call patern(437,240,447,255,15,1);
\r
380 call patern(437,270,447,285,15,1);
\r
381 call outstring(438,241,"X",0,15);
\r
384 if (x_s>=437 and x_s<=447) and (y_s>=270 and y_s<=280)
\r
385 then call patern(437,210,447,225,15,1);
\r
386 call patern(437,240,447,255,15,1);
\r
387 call patern(437,270,447,285,15,1);
\r
388 call outstring(438,271,"X",0,15);
\r
397 unit aide : procedure;
\r
399 call bouton(10,50,632,460);
\r
400 call outstring(304,80,"AIDE",15,7);
\r
401 call point(300,95);
\r
403 call outstring(20,110,"CONTROLE ET REGLE DU JEU",15,7);
\r
404 call outstring(20,125,"Bienvenue sur DOMINATE. Ce jeu est bas
\82 sur les r
\8agles du",0,7);
\r
405 call outstring(20,140,"tr
\8as vieux et tr
\8as c
\82l
\8abre 'GO'. C'est donc un jeu de",0,7);
\r
406 call outstring(20,155,"strat
\82gie de plateau o
\97 le but est de recouvrir un",0,7);
\r
407 call outstring(20,170,"maximum d'espaces avec la couleur de votre joueur.",0,7);
\r
408 call outstring(20,185,"MOUVEMENT DURANT LE JEU",15,7);
\r
409 call outstring(20,200,"Quand c'est votre tour de jouer, choisissez simplement la",0,7);
\r
410 call outstring(20,215,"pi
\8ace
\85 bouger en cliquant dessus
\85 l'aide du bouton",0,7);
\r
411 call outstring(20,230,"gauche de la souris. Durant le jeu, il est possible de",0,7);
\r
412 call outstring(20,245,"bouger sur une case voisine dans n'importe quelle",0,7);
\r
413 call outstring(20,260,"direction ou sauter horizontalement et verticalement par",0,7);
\r
414 call outstring(20,275,"dessus un obstacle. Si vous sautez, l'espace par dessus",0,7);
\r
415 call outstring(20,290,"lequel vous bougez garde son
\82tat initial, malgr
\82 que la",0,7);
\r
416 call outstring(20,305,"case de destination change de couleur.",0,7);
\r
417 call outstring(20,320,"Apr
\82s votre mouvement toutes les pi
\8aces adversaires ",0,7);
\r
418 call outstring(20,335,"voisines
\85 la case de destination deviennent de votre",0,7);
\r
419 call outstring(20,350,"couleur.",0,7);
\r
420 call outstring(20,365,"GAGNER UNE PARTIE",15,7);
\r
421 call outstring(20,380,"Lorsque toutes les cases du plateau sont utilis
\82es, ou si",0,7);
\r
422 call outstring(20,395,"un des deux joueurs ne peut plus bouger, l'ordinateur",0,7);
\r
423 call outstring(20,410,"remplit les cases libres, en correspondance avec les",0,7);
\r
424 call outstring(20,425,"mouvements de chaque joueur, le joueur qui poss
\8ade alors",0,7);
\r
425 call outstring(20,440," le plus de cases du plateau est le vainqueur.",0,7);
\r
426 call bouton(490,390,600,420);
\r
427 call outstring(500,400,"cliquez ici",15,7);
\r
428 while (Num_Mouse<>3)
\r
430 Mouse:=getpress(x_s,y_s,Keyb1,Keyb2,Flag,Num_Mouse) ;
\r
431 if num_mouse = 1 then
\r
432 if (x_s>=490 and x_s<=600) and (y_s>=390 and y_s<=420)
\r
441 unit cadre : procedure;
\r
444 if num_joueur=1 then call patern(25,95,95,115,15,0);
\r
445 else call patern(545,95,615,115,15,0);
\r
447 call bouton(5,5,640,30);
\r
448 call outstring(20,13,"QUITTER",15,7);
\r
449 call outstring(125,13,"JEU",15,7);
\r
450 call outstring(200,13,"AIDE",15,7);
\r
457 call patern(tab(i,j).x,tab(i,j).y,tab(i,j).x+50,tab(i,j).y+50,15,0);
\r
465 case tab(i,j).couleur
\r
467 when 1 : call patern(tab(i,j).x+1,tab(i,j).y+1,tab(i,j).x+49,tab(i,j).y+49,4,1);
\r
468 when 2 : call patern(tab(i,j).x+1,tab(i,j).y+1,tab(i,j).x+49,tab(i,j).y+49,9,1);
\r
469 when 3 : call patern(tab(i,j).x,tab(i,j).y,tab(i,j).x+50,tab(i,j).y+50,2,0);
\r
470 when 4 : call patern(tab(i,j).x,tab(i,j).y,tab(i,j).x+50,tab(i,j).y+50,14,0);
\r
478 unit affic : procedure;
\r
481 if num_joueur=1 then call patern(25,95,95,115,15,0);
\r
482 call patern(545,95,615,115,0,0);
\r
483 else call patern(545,95,615,115,15,0);
\r
484 call patern(25,95,95,115,0,0);
\r
486 call patern(79,149,95,172,0,1);
\r
487 call track(80,150,nombre1,0,4);
\r
488 call patern(599,149,615,172,0,1);
\r
489 call track(600,150,nombre2,0,9);
\r
494 case tab(i,j).couleur
\r
495 when 0 : call patern(tab(i,j).x+1,tab(i,j).y+1,tab(i,j).x+49,tab(i,j).y+49,0,1);
\r
496 when 1 : call patern(tab(i,j).x+1,tab(i,j).y+1,tab(i,j).x+49,tab(i,j).y+49,4,1);
\r
497 when 2 : call patern(tab(i,j).x+1,tab(i,j).y+1,tab(i,j).x+49,tab(i,j).y+49,9,1);
\r
498 when 3 : call patern(tab(i,j).x,tab(i,j).y,tab(i,j).x+50,tab(i,j).y+50,2,0);
\r
499 when 4 : call patern(tab(i,j).x,tab(i,j).y,tab(i,j).x+50,tab(i,j).y+50,14,0);
\r
506 unit vraiquit : procedure;
\r
508 call bouton(214,200,428,320);
\r
509 call outstring(290,230,"QUITTER ?",15,7);
\r
510 call bouton(250,300,300,280);
\r
511 call outstring(260,285,"OUI",15,7);
\r
512 call bouton(342,300,392,280);
\r
513 call outstring(352,285,"NON",15,7);
\r
514 while (Num_Mouse<>3)
\r
516 Mouse:=getpress(x_s,y_s,Keyb1,Keyb2,Flag,Num_Mouse) ;
\r
517 if num_mouse = 1 then
\r
518 if (x_s>=250 and x_s<=300) and (y_s>=280 and y_s<=300)
\r
522 if (x_s>=342 and x_s<=392) and (y_s>=280 and y_s<=300)
\r
532 unit noujeu : procedure;
\r
534 call bouton(214,200,428,320);
\r
535 call outstring(270,230,"NOUVEAU JEU ?",15,7);
\r
536 call bouton(250,300,300,280);
\r
537 call outstring(260,285,"OUI",15,7);
\r
538 call bouton(342,300,392,280);
\r
539 call outstring(352,285,"NON",15,7);
\r
540 while (Num_Mouse<>3)
\r
542 Mouse:=getpress(x_s,y_s,Keyb1,Keyb2,Flag,Num_Mouse) ;
\r
543 if num_mouse = 1 then
\r
544 if (x_s>=250 and x_s<=300) and (y_s>=280 and y_s<=300)
\r
545 then call init_tab;
\r
551 if (x_s>=342 and x_s<=392) and (y_s>=280 and y_s<=300)
\r
561 unit menu0 : procedure;
\r
564 * Affichage et gestion du premier
\r
565 * menu utilisateur du programme.
\r
569 while (Num_Mouse<>3)
\r
571 Mouse:=getpress(x_s,y_s,Keyb1,Keyb2,Flag,Num_Mouse) ;
\r
572 if num_mouse = 1 then
\r
573 if (x_s>=20 and x_s<=80) and (y_s>=5 and y_s<=30)
\r
574 then call vraiquit;
\r
576 if (x_s>=125 and x_s<=155) and (y_s>=5 and y_s<=30)
\r
580 if (x_s>=200 and x_s<=240) and (y_s>=5 and y_s<=30)
\r
584 if (x_s>=120 and x_s<=520) and (y_s>=50 and y_s<=450)
\r
586 if num_joueur=1 then
\r
588 when 1 : call tourjeu;
\r
589 when 2 : call expansion;
\r
590 when 3 : call destruction;
\r
594 when 1 : call tourjeu;
\r
595 when 2 : call expansion;
\r
596 when 3 : call destruction;
\r
606 unit tourjeu : procedure;
\r
614 call remis0(verif);
\r
618 if (possible) then
\r
624 Mouse:=getpress(x_s,y_s,Keyb1,Keyb2,Flag,Num_Mouse);
\r
625 if (num_mouse = 1) then
\r
626 if y_s <30 then call menu0;fi;
\r
627 call reccase1(x_s,y_s);
\r
630 if (tab(coury,courx).couleur = num_joueur)
\r
633 call remis0(verif);
\r
639 while (not termine)
\r
641 Mouse:=getpress(x_s,y_s,Keyb1,Keyb2,Flag,Num_Mouse);
\r
642 if (num_mouse = 1) then
\r
643 if y_s <30 then call menu0;fi;
\r
644 call reccase2(x_s,y_s);
\r
647 if ( (indx=courx) and (indy=coury))
\r
651 if ((tab(indy,indx).couleur <>3) and (tab(indy,indx).couleur <>4))
\r
656 case tab(indy,indx).couleur
\r
657 when 3 :tab(indy,indx).couleur:=num_joueur;
\r
658 verif(indy,indx).couleur:=num_joueur;
\r
662 call remis0(verif);
\r
667 when 4 : tab(coury,courx).couleur:=0;
\r
668 tab(indy,indx).couleur:=num_joueur;
\r
669 verif(coury,courx).couleur:=0;
\r
670 verif(indy,indx).couleur:=num_joueur;
\r
674 call remis0(verif);
\r
682 if num_joueur=1 then num_joueur:=2;
\r
690 if num_joueur=1 then
\r
693 when 1 : call tourjeu;
\r
694 when 2 : call expansion;
\r
695 when 3 : call destruction;
\r
699 when 1 : call tourjeu;
\r
700 when 2 : call expansion;
\r
701 when 3 : call destruction;
\r
711 unit expansion : procedure;
\r
712 var i,j,a,b:integer,ok:boolean;
\r
723 if tab(i,j).couleur=num_joueur
\r
735 if (tab(a,b).couleur = 3) then
\r
737 tab(a,b).couleur:=num_joueur;
\r
738 verif(a,b).couleur:=num_joueur;
\r
741 call remis0(verif);
\r
754 case tab(a,b).couleur
\r
755 when 4 : if (not ok) then
\r
756 tab(coury,courx).couleur:=0;
\r
757 tab(a,b).couleur:=num_joueur;
\r
758 verif(coury,courx).couleur:=0;
\r
759 verif(a,b).couleur:=num_joueur;
\r
762 call remis0(verif);
\r
773 if num_joueur=1 then num_joueur:=2;
\r
779 if num_joueur=1 then
\r
781 when 1 : call tourjeu;
\r
782 when 2 : call expansion;
\r
783 when 3 : call destruction;
\r
787 when 1 : call tourjeu;
\r
788 when 2 : call expansion;
\r
789 when 3 : call destruction;
\r
799 unit destruction : procedure;
\r
800 var i,j,a,b,premx,premy,derx,dery,actuel : integer,teremi:boolean;
\r
807 if num_joueur=1 then actuel:=nombre1;
\r
808 else actuel:=nombre2;
\r
813 do call remis0(tab);
\r
815 if tab(i,j).couleur=num_joueur
\r
825 if (a>=1 and a<=8) and (b>=1 and b<=8)
\r
827 case tab(a,b).couleur
\r
828 when 3 : simul(a,b).couleur:=num_joueur;
\r
832 if ( nomb > actuel )
\r
838 when 4 : simul(a,b).couleur:=num_joueur;
\r
839 simul(i,j).couleur:=0;
\r
843 if ( nomb > actuel )
\r
860 if (tab(premy,premx).couleur = num_joueur) then
\r
861 indx:=premx;indy:=premy;
\r
863 case tab(dery,derx).couleur
\r
864 when 3 : tab(dery,derx).couleur:=num_joueur;
\r
865 verif(dery,derx).couleur:=num_joueur;
\r
868 call remis0(verif);
\r
869 indx:=derx;indy:=dery;
\r
872 when 4 : tab(premy,premx).couleur:=0;
\r
873 tab(dery,derx).couleur:=num_joueur;
\r
874 verif(premy,premx).couleur:=0;
\r
875 verif(dery,derx).couleur:=num_joueur;
\r
878 call remis0(verif);
\r
879 indx:=derx;indy:=dery;
\r
887 if num_joueur=1 then num_joueur:=2;
\r
893 if num_joueur=1 then
\r
895 when 1 : call tourjeu;
\r
896 when 2 : call expansion;
\r
897 when 3 : call destruction;
\r
901 when 1 : call tourjeu;
\r
902 when 2 : call expansion;
\r
903 when 3 : call destruction;
\r
911 call remis0(verif);
\r
914 unit compte : procedure;
\r
916 i,j,jou1,jou2:integer;
\r
924 if tab(i,j).couleur=1 then jou1:=jou1+1;fi;
\r
925 if tab(i,j).couleur=2 then jou2:=jou2+1;fi;
\r
933 unit simcom : procedure;
\r
935 i,j,jou1,jou2:integer;
\r
943 if simul(i,j).couleur=1 then jou1:=jou1+1;fi;
\r
944 if simul(i,j).couleur=2 then jou2:=jou2+1;fi;
\r
955 unit consequence : procedure;
\r
957 if tab(indy-1,indx-1).couleur<>0 then
\r
958 tab(indy-1,indx-1).couleur:=num_joueur;
\r
959 verif(indy-1,indx-1).couleur:=num_joueur;fi;
\r
960 if tab(indy-1,indx).couleur<>0 then
\r
961 tab(indy-1,indx).couleur:=num_joueur;
\r
962 verif(indy-1,indx).couleur:=num_joueur;fi;
\r
963 if tab(indy-1,indx+1).couleur<>0 then
\r
964 tab(indy-1,indx+1).couleur:=num_joueur;
\r
965 verif(indy-1,indx+1).couleur:=num_joueur;fi;
\r
966 if tab(indy,indx-1).couleur<>0 then
\r
967 tab(indy,indx-1).couleur:=num_joueur;
\r
968 verif(indy,indx-1).couleur:=num_joueur;fi;
\r
969 if tab(indy,indx+1).couleur<>0 then
\r
970 tab(indy,indx+1).couleur:=num_joueur;
\r
971 verif(indy,indx+1).couleur:=num_joueur;fi;
\r
972 if tab(indy+1,indx-1).couleur<>0 then
\r
973 tab(indy+1,indx-1).couleur:=num_joueur;
\r
974 verif(indy+1,indx-1).couleur:=num_joueur;fi;
\r
975 if tab(indy+1,indx).couleur<>0 then
\r
976 tab(indy+1,indx).couleur:=num_joueur;
\r
977 verif(indy+1,indx).couleur:=num_joueur;fi;
\r
978 if tab(indy+1,indx+1).couleur<>0 then
\r
979 tab(indy+1,indx+1).couleur:=num_joueur;
\r
980 verif(indy+1,indx+1).couleur:=num_joueur;fi;
\r
984 unit cons : procedure;
\r
986 call remis0(simul);
\r
987 if simul(iy-1,ix-1).couleur<>0 then
\r
988 simul(iy-1,ix-1).couleur:=num_joueur;
\r
990 if simul(iy-1,ix).couleur<>0 then
\r
991 simul(iy-1,ix).couleur:=num_joueur;
\r
993 if simul(iy-1,ix+1).couleur<>0 then
\r
994 simul(iy-1,ix+1).couleur:=num_joueur;
\r
996 if simul(iy,ix-1).couleur<>0 then
\r
997 simul(iy,ix-1).couleur:=num_joueur;
\r
999 if simul(iy,ix+1).couleur<>0 then
\r
1000 simul(iy,ix+1).couleur:=num_joueur;
\r
1002 if simul(iy+1,ix-1).couleur<>0 then
\r
1003 simul(iy+1,ix-1).couleur:=num_joueur;
\r
1005 if simul(iy+1,ix).couleur<>0 then
\r
1006 simul(iy+1,ix).couleur:=num_joueur;
\r
1008 if simul(iy+1,ix+1).couleur<>0 then
\r
1009 simul(iy+1,ix+1).couleur:=num_joueur;
\r
1015 unit affpos : procedure;
\r
1016 var i,j : integer;
\r
1020 if (tab(i,j).couleur=num_joueur) then
\r
1021 if tab(i-1,j-1).couleur=0 then tab(i-1,j-1).couleur:=3;pos:=pos+1;fi;
\r
1022 if tab(i-1,j).couleur=0 then tab(i-1,j).couleur:=3;pos:=pos+1;fi;
\r
1023 if tab(i-1,j+1).couleur=0 then tab(i-1,j+1).couleur:=3;pos:=pos+1;fi;
\r
1024 if tab(i,j-1).couleur=0 then tab(i,j-1).couleur:=3;pos:=pos+1;fi;
\r
1025 if tab(i,j+1).couleur=0 then tab(i,j+1).couleur:=3;pos:=pos+1;fi;
\r
1026 if tab(i+1,j-1).couleur=0 then tab(i+1,j-1).couleur:=3;pos:=pos+1;fi;
\r
1027 if tab(i+1,j).couleur=0 then tab(i+1,j).couleur:=3;pos:=pos+1;fi;
\r
1028 if tab(i+1,j+1).couleur=0 then tab(i+1,j+1).couleur:=3;pos:=pos+1;fi;
\r
1029 if tab(i+2,j).couleur=0 then tab(i+2,j).couleur:=4;pos:=pos+1;fi;
\r
1030 if tab(i-2,j).couleur=0 then tab(i-2,j).couleur:=4;pos:=pos+1;fi;
\r
1031 if tab(i,j+2).couleur=0 then tab(i,j+2).couleur:=4;pos:=pos+1;fi;
\r
1032 if tab(i,j-2).couleur=0 then tab(i,j-2).couleur:=4;pos:=pos+1;fi;
\r
1040 unit reccase1 : procedure(x_s,y_s:integer);
\r
1041 var px,py :integer;
\r
1043 px:=120;py:=50;courx:=1;coury:=1;
\r
1045 (* recherche de x *)
\r
1046 if ((x_s<120) or (y_s>520)) then call erreur;
\r
1048 while (not trouve)
\r
1050 if ((x_s>=px) and (x_s<px+50))
\r
1059 (* recherche de y *)
\r
1061 if ((y_s<50) or (y_s>450)) then call erreur;
\r
1063 while (not trouve)
\r
1065 if ((y_s>=py) and (y_s<py+50))
\r
1077 unit reccase2 : procedure(x_s,y_s:integer);
\r
1078 var px,py :integer;
\r
1080 px:=120;py:=50;indx:=1;indy:=1;
\r
1082 (* recherche de x *)
\r
1083 if ((x_s<120) or (x_s>520)) then call erreur;
\r
1085 while (not termine)
\r
1087 if ((x_s>=px) and (x_s<px+50))
\r
1096 (* recherche de y *)
\r
1098 if ((y_s<50) or (y_s>450)) then call erreur;
\r
1100 while (not termine)
\r
1102 if ((y_s>=py) and (y_s<py+50))
\r
1114 unit verifjeu : procedure;
\r
1115 var a,b : integer;
\r
1118 call remis0(verif);
\r
1123 if (verif(a,b).couleur=num_joueur) then
\r
1124 if verif(a-1,b-1).couleur=0 then verif(a-1,b-1).couleur:=3;fi;
\r
1125 if verif(a-1,b).couleur=0 then verif(a-1,b).couleur:=3;fi;
\r
1126 if verif(a-1,b+1).couleur=0 then verif(a-1,b+1).couleur:=3;fi;
\r
1127 if verif(a,b-1).couleur=0 then verif(a,b-1).couleur:=3;fi;
\r
1128 if verif(a,b+1).couleur=0 then verif(a,b+1).couleur:=3;fi;
\r
1129 if verif(a+1,b-1).couleur=0 then verif(a+1,b-1).couleur:=3;fi;
\r
1130 if verif(a+1,b).couleur=0 then verif(a+1,b).couleur:=3;fi;
\r
1131 if verif(a+1,b+1).couleur=0 then verif(a+1,b+1).couleur:=3;fi;
\r
1132 if verif(a+2,b).couleur=0 then verif(a+2,b).couleur:=4;fi;
\r
1133 if verif(a-2,b).couleur=0 then verif(a-2,b).couleur:=4;fi;
\r
1134 if verif(a,b+2).couleur=0 then verif(a,b+2).couleur:=4;fi;
\r
1135 if verif(a,b-2).couleur=0 then verif(a,b-2).couleur:=4;fi;
\r
1144 case verif(a,b).couleur
\r
1145 when 3 : possible:=true;
\r
1146 when 4 : possible:=true;
\r
1150 call remis0(verif);
\r
1151 if num_joueur=1 and nombre1=0 then possible:=false;fi;
\r
1152 if num_joueur=2 and nombre2=0 then possible:=false;fi;
\r
1155 unit remis0 : procedure(rem : arrayof arrayof elem);
\r
1156 var i,j : integer;
\r
1162 if ((rem(i,j).couleur=3) or (rem(i,j).couleur=4))
\r
1164 rem(i,j).couleur:=0;
\r
1170 unit Bouton:procedure(xa,ya,xb,yb:integer);
\r
1172 * Affiche un cadre
\85 la WINDOWS.
\r
1176 call patern(xa ,ya ,xb ,yb ,8 ,1 );
\r
1177 call patern(xa+3,ya+3,xb-2,yb-2,0 ,1);
\r
1178 call patern(xa+4,ya+4,xb-1,yb-1,15,1);
\r
1179 call patern(xa+4,ya+4,xb-3,yb-3,7 ,1);
\r
1184 (* Variable du programme Principal *)
\r
1194 Num_Mouse :integer;
\r
1196 begin (* Begin du block :
\82cran *)
\r
1200 call presentation;
\r
1209 tab : arrayof arrayof elem,
\r
1210 simul : arrayof arrayof elem,
\r
1211 verif : arrayof arrayof elem,
\r
1212 nombre1,nombre2,num_joueur,indx,indy,courx,
\r
1213 type1,type2,coury,nomb,ix,iy,pos:integer,
\r
1214 termine,possible,trouve,fini : boolean;
\r