3 (*** 2ø PROJET DE LI1 DU BINOME : LAPORTE-FAURET Olivier
\r
6 CONST noir=0, bleu=1, rouge=4, jaune=14, blanc=15,
\r
7 bas_g=1, gauche=2, haut_g=3, haut=4,
\r
8 haut_d=5, droite=6, bas_d=7, bas=8;
\r
10 VAR nb_rouges,nb_bleus,libre : INTEGER,
\r
11 grille : ARRAYOF ARRAYOF rectangle,
\r
12 gr_prio : ARRAYOF ARRAYOF INTEGER,
\r
13 meill_coup : ARRAYOF infos,
\r
14 som_prio,nb_pions_pris : INTEGER,
\r
15 ligne,colonne : INTEGER;
\r
19 (***********************************************************************)
\r
21 UNIT points : CLASS;
\r
25 (***********************************************************************)
\r
27 UNIT rectangle : CLASS;
\r
28 VAR p1, p2 : points,
\r
32 (***********************************************************************)
\r
39 (***********************************************************************)
\r
41 UNIT affiche_grille : PROCEDURE;
\r
43 UNIT init_grille : PROCEDURE;
\r
44 (*** Cette proc
\82dure permet d'initialiser les grilles et les tableaux
\r
45 n
\82cessaires au bon d
\82roulement du programme. ***)
\r
47 VAR i,j,icks,igrec : INTEGER;
\r
49 (* initialisation de la grille devant contenir les pions rouges et bleus *)
\r
50 ARRAY grille DIM (1:8);
\r
53 ARRAY grille(i) DIM (1:8);
\r
61 grille(i,j):=NEW rectangle;
\r
62 grille(i,j).p1:=NEW points;
\r
63 grille(i,j).p2:=NEW points;
\r
64 grille(i,j).p1.x:=icks;
\r
65 grille(i,j).p1.y:=igrec;
\r
66 grille(i,j).p2.x:=icks+36;
\r
67 grille(i,j).p2.y:=igrec+30;
\r
68 grille(i,j).occupe:=noir;
\r
73 (* initialisation de la grille des priorit
\82s *)
\r
74 ARRAY gr_prio dim (1:8);
\r
77 ARRAY gr_prio(i) DIM (1:8);
\r
145 UNIT cercles_au_centre : PROCEDURE;
\r
148 CALL dessine_cercle(4,4,rouge);
\r
149 CALL dessine_cercle(4,5,bleu);
\r
150 CALL dessine_cercle(5,4,bleu);
\r
151 CALL dessine_cercle(5,5,rouge);
\r
152 nb_rouges:=2; nb_bleus:=2; libre:=60;
\r
153 END cercles_au_centre;
\r
155 UNIT chiffres : IIUWGRAPH PROCEDURE;
\r
156 VAR i,col,lig : INTEGER;
\r
175 UNIT quadrillage : IIUWGRAPH PROCEDURE;
\r
176 VAR col,lig : INTEGER;
\r
183 CALL DRAW(col,280);
\r
190 CALL DRAW(296,lig);
\r
195 VAR col,lig,tch : INTEGER;
\r
199 CALL cercles_au_centre;
\r
201 END affiche_grille;
\r
203 (***********************************************************************)
\r
205 UNIT dessine_cercle : IIUWGRAPH PROCEDURE(ptx,pty,couleur : INTEGER);
\r
206 VAR cx,cy : INTEGER;
\r
210 CALL COLOR(couleur);
\r
211 cx:=(grille(ptx,pty).p1.x + grille(ptx,pty).p2.x)/2;
\r
212 cy:=(grille(ptx,pty).p1.y + grille(ptx,pty).p2.y)/2;
\r
214 CALL CIRB(cx,cy,16,0.0,0.0,couleur,1,1,1);
\r
216 grille(ptx,pty).occupe:=couleur;
\r
218 END dessine_cercle;
\r
220 (***********************************************************************)
\r
222 UNIT efface : IIUWGRAPH PROCEDURE(x,y : INTEGER);
\r
223 VAR abscis : INTEGER;
\r
227 FOR abscis:=x TO 639
\r
229 CALL OUTSTRING(" ");
\r
230 CALL MOVE(abscis,y);
\r
234 (***********************************************************************)
\r
236 UNIT texte : IIUWGRAPH PROCEDURE (x,y,c : INTEGER; s : STRING);
\r
246 (***********************************************************************)
\r
248 UNIT fill : IIUWGRAPH PROCEDURE (x,y,large,haut,couleur:INTEGER) ;
\r
251 CALL COLOR(couleur);
\r
255 CALL DRAW(x+large,i) ;
\r
259 (***********************************************************************)
\r
261 UNIT saisie_rep : IIUWGRAPH PROCEDURE (couleur : INTEGER;
\r
262 OUTPUT valeur : CHAR);
\r
267 IF c=78 ORIF c=79 ORIF c=110 ORIF c=111 THEN EXIT FI;
\r
268 (* N *) (* O *) (* n *) (* o *)
\r
271 (*CALL COLOR(couleur);
\r
276 (***********************************************************************)
\r
278 UNIT pause : PROCEDURE(seconde : INTEGER);
\r
281 FOR temps:=1 TO (1000*seconde) DO OD;
\r
285 (***********************************************************************)
\r
287 UNIT test_couleur : PROCEDURE(couleur : INTEGER);
\r
289 IF couleur=rouge THEN
\r
290 nb_rouges:=nb_rouges+1;
\r
291 nb_bleus:=nb_bleus-1
\r
293 nb_bleus:=nb_bleus+1;
\r
294 nb_rouges:=nb_rouges-1;
\r
298 (***********************************************************************)
\r
299 (* Dans les 4 proc
\82dures qui suivent, les fl
\8aches pr
\82sentes sous les en_t
\88tes
\r
300 indiquent le sens dans lequel s'effectue la coloration *)
\r
302 UNIT diagonale_droite : PROCEDURE(xd,yd,xa,ya,colorie : INTEGER);
\r
312 WHILE i>=xa AND j<=ya
\r
314 CALL dessine_cercle(i,j,colorie);
\r
315 CALL test_couleur(colorie);
\r
319 END diagonale_droite;
\r
321 (***********************************************************************)
\r
323 UNIT diagonale_gauche : PROCEDURE(xd,yd,xa,ya,colorie : INTEGER);
\r
333 WHILE i>=xa AND j>=ya
\r
335 CALL dessine_cercle(i,j,colorie);
\r
336 CALL test_couleur(colorie);
\r
340 END diagonale_gauche;
\r
342 (***********************************************************************)
\r
344 UNIT verticale : PROCEDURE(xd,xa,y,colorie : INTEGER);
\r
355 CALL dessine_cercle(i,y,colorie);
\r
356 CALL test_couleur(colorie);
\r
361 (***********************************************************************)
\r
363 UNIT horizontale : PROCEDURE(x,yd,ya,colorie : INTEGER);
\r
374 CALL dessine_cercle(x,j,colorie);
\r
375 CALL test_couleur(colorie);
\r
380 (***********************************************************************)
\r
382 UNIT cherche_intervalle : IIUWGRAPH PROCEDURE(abscis,ordon,couleur : INTEGER;
\r
383 dessinez : BOOLEAN;
\r
384 OUTPUT trouve : BOOLEAN);
\r
385 VAR i,j,inverse : INTEGER,
\r
386 somme,nb_pris,so,nbp : INTEGER;
\r
388 IF couleur=rouge THEN inverse:=bleu ELSE inverse:=rouge FI;
\r
390 (* recherche en bas
\85 gauche *)
\r
392 i:=abscis; j:=ordon;
\r
394 so:=so+gr_prio(i,j);
\r
396 IF i>8 ORIF j<1 THEN EXIT FI;
\r
397 IF grille(i,j).occupe<>inverse THEN EXIT FI;
\r
400 IF i<=8 ANDIF i<>abscis+1 ANDIF j>=1 ANDIF j<>ordon-1
\r
401 ANDIF grille(i,j).occupe=couleur THEN
\r
402 somme:=so; nb_pris:=nbp;
\r
405 CALL diagonale_droite(i-1,j+1,abscis+1,ordon-1,couleur);
\r
407 IF couleur=rouge THEN RETURN FI;
\r
412 (* recherche vers la gauche *)
\r
416 so:=so+gr_prio(abscis,j);
\r
418 IF j<1 THEN EXIT FI;
\r
419 IF grille(abscis,j).occupe<>inverse THEN EXIT FI;
\r
422 IF j>=1 ANDIF j<>ordon-1 ANDIF grille(abscis,j).occupe=couleur THEN
\r
423 somme:=somme+so; nb_pris:=nb_pris+nbp;
\r
426 CALL horizontale(abscis,j+1,ordon-1,couleur);
\r
428 IF couleur=rouge THEN RETURN FI;
\r
432 (* recherche en haut
\85 gauche *)
\r
435 i:=abscis; j:=ordon;
\r
437 so:=so+gr_prio(i,j);
\r
439 IF i<1 ORIF j<1 THEN EXIT FI;
\r
440 IF grille(i,j).occupe<>inverse THEN EXIT FI;
\r
443 IF i>=1 ANDIF i<>abscis-1 ANDIF j>=1 ANDIF j<>ordon-1
\r
444 ANDIF grille(i,j).occupe=couleur THEN
\r
445 somme:=somme+so; nb_pris:=nb_pris+nbp;
\r
448 CALL diagonale_gauche(abscis-1,ordon-1,i+1,j+1,couleur);
\r
450 IF couleur=rouge THEN RETURN FI;
\r
456 (* recherche vers le haut *)
\r
461 so:=so+gr_prio(i,ordon);
\r
463 IF i<1 THEN EXIT FI;
\r
464 IF grille(i,ordon).occupe<>inverse THEN EXIT FI;
\r
467 IF i>=1 ANDIF i<>abscis-1 ANDIF grille(i,ordon).occupe=couleur THEN
\r
468 somme:=somme+so; nb_pris:=nb_pris+nbp;
\r
471 CALL verticale(i+1,abscis-1,ordon,couleur);
\r
473 IF couleur=rouge THEN RETURN FI;
\r
479 (* recherche en haut
\85 droite *)
\r
482 i:=abscis; j:=ordon;
\r
484 so:=so+gr_prio(i,j);
\r
486 IF i<1 ORIF j>8 THEN EXIT FI;
\r
487 IF grille(i,j).occupe<>inverse THEN EXIT FI;
\r
490 IF i>=1 ANDIF i<>abscis-1 ANDIF j<=8 ANDIF j<>ordon+1
\r
491 ANDIF grille(i,j).occupe=couleur THEN
\r
492 somme:=somme+so; nb_pris:=nb_pris+nbp;
\r
495 CALL diagonale_droite(abscis-1,ordon+1,i+1,j-1,couleur);
\r
497 IF couleur=rouge THEN RETURN FI;
\r
502 (* recherche vers la droite *)
\r
506 so:=so+gr_prio(abscis,j);
\r
508 IF j>8 THEN EXIT FI;
\r
509 IF grille(abscis,j).occupe<>inverse THEN EXIT FI;
\r
512 IF j<=8 ANDIF j<>ordon+1 ANDIF grille(abscis,j).occupe=couleur THEN
\r
513 somme:=somme+so; nb_pris:=nb_pris+nbp;
\r
516 CALL horizontale(abscis,ordon+1,j-1,couleur);
\r
518 IF couleur=rouge THEN RETURN FI;
\r
522 (* recherche en bas
\85 droite *)
\r
525 i:=abscis; j:=ordon;
\r
527 so:=so+gr_prio(i,j);
\r
529 IF i>8 ORIF j>8 THEN EXIT FI;
\r
530 IF grille(i,j).occupe<>inverse THEN EXIT FI;
\r
533 IF i<=8 ANDIF i<>abscis+1 ANDIF j<=8 ANDIF j<>ordon+1
\r
534 ANDIF grille(i,j).occupe=couleur THEN
\r
535 somme:=somme+so; nb_pris:=nb_pris+nbp;
\r
538 CALL diagonale_gauche(i-1,j-1,abscis+1,ordon+1,couleur)
\r
540 IF couleur=rouge THEN RETURN FI;
\r
546 (* recherche vers le bas *)
\r
551 so:=so+gr_prio(i,ordon);
\r
553 IF i>8 THEN EXIT FI;
\r
554 IF grille(i,ordon).occupe<>inverse THEN EXIT FI;
\r
557 IF i<=8 ANDIF i<>abscis+1 ANDIF grille(i,ordon).occupe=couleur THEN
\r
558 somme:=somme+so; nb_pris:=nb_pris+nbp;
\r
560 IF dessinez THEN CALL verticale(abscis+1,i-1,ordon,couleur) FI;
\r
563 IF trouve ANDIF dessinez THEN
\r
564 CALL dessine_cercle(abscis,ordon,couleur);
\r
565 IF couleur=rouge THEN nb_rouges:=nb_rouges+1
\r
566 ELSE nb_bleus:=nb_bleus+1;
\r
569 IF somme>=som_prio THEN
\r
570 IF nb_pris>nb_pions_pris THEN
\r
572 nb_pions_pris:=nb_pris;
\r
577 END cherche_intervalle;
\r
579 (***********************************************************************)
\r
582 UNIT cherche_case : PROCEDURE(abscis,ordon : INTEGER;
\r
583 OUTPUT trouve : BOOLEAN);
\r
585 (* Cette proc
\82dure va permettre de rechercher dans la matrice "grille",
\r
586 la position du point de coordonn
\82es (abscis,ordon) - ce point correspond
\r
587 en fait au point de clic de la souris. La case ainsi obtenue se situe
\r
588 \85 la ligne lig et en colonne col *)
\r
590 VAR verif : BOOLEAN,
\r
595 IF grille(lig,1).p1.y<=ordon ANDIF ordon<=grille(lig,1).p2.y THEN
\r
598 IF grille(lig,col).p1.x<=abscis ANDIF
\r
599 abscis<=grille(lig,col).p2.x THEN
\r
600 IF grille(lig,col).occupe=noir THEN
\r
601 CALL cherche_intervalle(lig,col,rouge,TRUE,trouve);
\r
611 (***********************************************************************)
\r
613 UNIT app_tch : IIUWGRAPH PROCEDURE;
\r
616 CALL texte(150,310,jaune,"APPUYER SUR ENTREE");
\r
619 IF tch=13 THEN EXIT FI;
\r
623 (***********************************************************************)
\r
625 UNIT resultat : PROCEDURE;
\r
627 WRITELN("Rouges = ",nb_rouges :2 ,", Bleus = ",nb_bleus :2);
\r
628 IF nb_rouges>nb_bleus THEN
\r
629 WRITE("Les Rouges ont gagn
\82 de ",nb_rouges-nb_bleus :2," point(s)") FI;
\r
630 IF nb_rouges<nb_bleus THEN
\r
631 WRITE("Les Bleus ont gagn
\82 de ",nb_bleus-nb_rouges :2," point(s)") FI;
\r
632 IF nb_rouges=nb_bleus THEN
\r
633 WRITE("Egalit
\82") FI;
\r
637 (***********************************************************************)
\r
639 UNIT peut_jouer : PROCEDURE(pion : INTEGER; OUTPUT passe : BOOLEAN);
\r
640 VAR lig,col : INTEGER,
\r
647 IF grille(lig,col).occupe=noir THEN
\r
648 CALL cherche_intervalle(lig,col,pion,FALSE,trouve);
\r
650 IF trouve ANDIF pion=rouge THEN EXIT FI;
\r
652 IF trouve ANDIF pion=rouge THEN EXIT FI;
\r
654 IF NOT trouve ANDIF pion=rouge THEN passe:=TRUE FI;
\r
655 IF nb_pions_pris=0 ANDIF pion=bleu THEN passe:=TRUE FI;
\r
658 (***********************************************************************)
\r
660 UNIT passe_son_tour : PROCEDURE(message : STRING);
\r
662 CALL fill(339,249,160,10,noir);
\r
663 CALL texte(340,150,blanc,message);
\r
665 CALL fill(339,149,240,10,noir);
\r
666 END passe_son_tour;
\r
668 (***********************************************************************)
\r
670 UNIT init_souris : MOUSE PROCEDURE;
\r
673 IF NOT INIT(nb) THEN
\r
674 CALL texte(300,100,rouge,"Erreur d'installation de la souris");EXIT;
\r
676 CALL DEFCURSOR(1,11,12);
\r
678 CALL SETWINDOW(0,625,0,330);
\r
681 (***********************************************************************)
\r
683 UNIT jeu : MOUSE PROCEDURE;
\r
684 VAR h,v,b,p : INTEGER,
\r
685 couleur,indx,indy : INTEGER,
\r
686 l,r,c,trouve : BOOLEAN,
\r
687 rouge_passe,bleu_passe : BOOLEAN,
\r
692 (*** Bloc concernant les pions rouges ***)
\r
693 CALL peut_jouer(rouge,rouge_passe);
\r
694 IF NOT rouge_passe THEN
\r
696 CALL efface(340,250);
\r
697 CALL texte(340,250,blanc,"Les Rouges jouent...");
\r
699 CALL GETPRESS(1,h,v,p,l,r,c);
\r
700 IF r THEN (* right button *)
\r
701 CALL fill(339,249,160,10,noir);
\r
702 CALL texte(115,310,jaune,"Etes-vous s
\96r de vouloir sortir (o/n) ? ");
\r
703 CALL saisie_rep(blanc,rep);
\r
704 IF rep='n' OR rep='N' THEN
\r
705 CALL fill(114,309,320,10,noir);
\r
706 CALL texte(340,250,blanc,"Les Rouges jouent...");
\r
710 CALL GETPRESS(0,h,v,p,l,r,c);
\r
711 IF l THEN (* left button *)
\r
712 IF 10<h ANDIF h<298 ANDIF 40<v ANDIF v<280 THEN
\r
713 CALL cherche_case(h,v,rouge,trouve);
\r
715 libre:=64-(nb_rouges+nb_bleus);
\r
716 CALL efface(340,250);
\r
719 CALL texte(320,130,blanc,"Vous ne pouvez pas jouer ici !");
\r
721 CALL fill(319,129,250,10,noir);
\r
723 FI; (* 10<h ANDIF h<298 ... *)
\r
724 FI; (* l ANDIF p=1 *)
\r
726 IF libre=0 THEN EXIT FI;
\r
727 ELSE (* Les Rouges passent leur tour ! *)
\r
728 IF bleu_passe THEN EXIT FI;
\r
729 CALL passe_son_tour("Vous devez passer votre tour !");
\r
730 FI; (* NOT rouge_passe *)
\r
732 (*** Bloc concernant les pions bleus ***)
\r
733 CALL texte(340,250,blanc,"Les Bleus jouent...");
\r
734 som_prio:=0; nb_pions_pris:=0;
\r
735 CALL peut_jouer(bleu,bleu_passe);
\r
736 IF NOT bleu_passe THEN
\r
737 rouge_passe:=FALSE;
\r
738 CALL cherche_intervalle(ligne,colonne,bleu,TRUE,trouve);
\r
739 libre:=64-(nb_rouges+nb_bleus);
\r
740 CALL efface(340,250);
\r
742 IF rouge_passe THEN EXIT FI;
\r
743 CALL passe_son_tour("Les Bleus passent leur tour.");
\r
744 FI; (* NOT bleu_passe *)
\r
745 IF libre=0 THEN EXIT FI;
\r
753 (****************** PROGRAMME PRINCIPAL ******************)
\r
756 PREF IIUWGRAPH BLOCK
\r
759 CALL affiche_grille;
\r
762 END; (* IIUWGRAPH *)
\r