PROGRAM ARAIGNEE; (************************************************************************) (** **) (** **) (** ORONOS Marielle & PELAT Joseph **) (** **) (** Jeu de strategie : ARAIGNEE **) (** **) (** Licence Informatique **) (** Groupe 3 **) (** **) (** Universite de Pau et des Pays de l'Adour 2 Avril 1993 **) (** **) (** **) (************************************************************************) Begin Pref iiuwgraph block; (** Utilisation du graphisme **) (************************************************************************) (** Structure de donnees utilisee pour representer la table de jeu : **) (** un Cube **) (************************************************************************) UNIT cube : CLASS ; (****************************) (** 0 : le point est libre **) (** 1 : pion du joueur1 **) (** 2 : pion du joueur2 **) (****************************) VAR cub : arrayof arrayof arrayof integer , i,j : integer; BEGIN array cub dim (1:3); for i:=1 to 3 do array cub(i) dim (1:3) ; for j:=1 to 3 do array cub(i,j) dim (1:3) ; od; od; END; (************************************************************************) (** Structure de donnees utilisee pour representer un point du cube **) (************************************************************************) UNIT elt : CLASS ; VAR x,y,z : INTEGER ; END elt; (************************************************************************) (** Representation d'une ligne du cube **) (** Chaque ligne comporte 3 points **) (************************************************************************) UNIT ligne : CLASS ; VAR pt1,pt2,pt3 : elt ; BEGIN pt1 := new elt; pt2 := new elt; pt3 := new elt ; END ligne; (*************************************************************************) (** Determine la ligne et la colonne d'affichage d'un point du cube a **) (** l'ecran **) (*************************************************************************) UNIT AffichPt : Procedure ( pt : elt); VAR lig,col : integer; BEGIN If (pt.x <> 2) AND (pt.y = 2) Then col := 230; Fi; If (pt.y = 1) AND ( pt.z = 1) Then col := 142; Fi; If (pt.y = 1) AND ( pt.z = 2) Then col := 100; Fi; If (pt.y = 1) AND ( pt.z = 3) Then col := 60; Fi; If (pt.y = 3) AND ( pt.z = 1) Then col := 315; Fi; If (pt.y = 3) AND ( pt.z = 2) Then col := 359; Fi; If (pt.y = 3) AND ( pt.z = 3) Then col := 400; Fi; If ( pt.x = 1) AND ( pt.z = 1) Then lig := 120; Fi; If ( pt.x = 1) AND ( pt.z = 2) Then lig := 90; Fi; If ( pt.x = 1) AND ( pt.z = 3) Then lig := 60; Fi; If ( pt.x = 3) AND ( pt.z = 1) Then lig := 240; Fi; If ( pt.x = 3) AND ( pt.z = 2) Then lig := 270; Fi; If ( pt.x = 3) AND ( pt.z = 3) Then lig := 300; Fi; If ( pt.x = 2) AND ( pt.y <> 2) Then lig := 180; Fi; call move ( col , lig); END AffichPt; (*************************************************************************) (** Affichage du mot INTERDIT s'il y a une mauvaise action **) (*************************************************************************) UNIT Erreur1 : PROCEDURE; VAR i : integer ; BEGIN call color(15); call move(2,2); call HASCII(0);call Hascii (ord('I')); call HASCII(0);call Hascii (ord('N')); call HASCII(0);call Hascii (ord('T')); call HASCII(0);call Hascii (ord('E')); call HASCII(0);call Hascii (ord('R')); call HASCII(0);call Hascii (ord('D')); call HASCII(0);call Hascii (ord('I')); call HASCII(0);call Hascii (ord('T')); call HASCII(0);call Hascii (ord('!')); call HASCII(0);call Hascii (ord('!')); call HASCII(0);call Hascii (ord('!')); call move (2,2); tab := GETMAP(300,20); call move (2,2); For i := 1 To 10 Do call PUTMAP (tab); call move (2,2); tab := GETMAP(300,20); Od; call move (2,2); For i := 1 To 11 Do call HASCII(0);call Hascii (ord(' ')); Od; END Erreur1; (*************************************************************************) (** Procedure pour l'affichage de la table de jeu **) (*************************************************************************) UNIT AfficheTable : Procedure ; Begin call cls; call move (60,60); call draw(60,300 ); call draw(400,300); call move (60,60); call draw(400,60); call draw(400,300); call move (100,90); call draw(100,270); call draw(359,270); call move (100,90); call draw(359,90); call draw(359,270); call move (142,120); call draw(142,240); call draw(315,240); call move (142,120); call draw(315,120); call draw(315,240); call move (230,60); call draw(230,120); call move (60,180); call draw(142,180); call move (315,180); call draw(400,180); call move (230,240); call draw(230,300); call move(60,60) ; call HASCII(0) ; call HASCII(ord('+')); call move(230,60) ; call HASCII(0) ; call HASCII(ord('+')); call move(400,60) ; call HASCII(0) ; call HASCII(ord('+')); call move(400,180) ; call HASCII(0) ; call HASCII(ord('+')); call move(400,300) ; call HASCII(0) ; call HASCII(ord('+')); call move(230,300) ; call HASCII(0) ; call HASCII(ord('+')); call move(60,300) ; call HASCII(0) ; call HASCII(ord('+')); call move(60,180) ; call HASCII(0) ; call HASCII(ord('+')); call move(100,90) ; call HASCII(0) ; call HASCII(ord('+')); call move(100,180) ; call HASCII(0) ; call HASCII(ord('+')); call move(100,270) ; call HASCII(0) ; call HASCII(ord('+')); call move(142,120) ; call HASCII(0) ; call HASCII(ord('+')); call move(142,180) ; call HASCII(0) ; call HASCII(ord('+')); call move(142,240) ; call HASCII(0) ; call HASCII(ord('+')); call move(230,90) ; call HASCII(0) ; call HASCII(ord('+')); call move(230,120) ; call HASCII(0) ; call HASCII(ord('+')); call move(230,240) ; call HASCII(0) ; call HASCII(ord('+')); call move(230,270) ; call HASCII(0) ; call HASCII(ord('+')); call move(315,120) ; call HASCII(0) ; call HASCII(ord('+')); call move(315,180) ; call HASCII(0) ; call HASCII(ord('+')); call move(315,240) ; call HASCII(0) ; call HASCII(ord('+')); call move(359,270) ; call HASCII(0) ; call HASCII(ord('+')); call move(359,180) ; call HASCII(0) ; call HASCII(ord('+')); call move(359,90) ; call HASCII(0) ; call HASCII(ord('+')); call move(500,130) ; call HASCII(0) ; call HASCII(ord('A')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('R')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('A')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('I')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('G')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('N')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('E')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('E')); End afficheTable; (*************************************************************************) (** Affichage du joueur courant **) (*************************************************************************) UNIT AfficheJoueur : Procedure (i : integer); Begin If i = 1 then call color(3) else call color(5) ; fi; call move(530,170) ; call HASCII(0) ; call HASCII(ord('J')); call HASCII(0) ; call HASCII(ord('o')); call HASCII(0) ; call HASCII(ord('u')); call HASCII(0) ; call HASCII(ord('e')); call HASCII(0) ; call HASCII(ord('u')); call HASCII(0) ; call HASCII(ord('r')); End AfficheJoueur; (*************************************************************************) (** Affichage de la phase courante **) (** - 0 : Placement **) (** - 1 : Deplacement **) (** - 2 : Deplacement de moins de 3 pions **) (** - 3 : Manger **) (*************************************************************************) UNIT AffichePhase : Procedure (i : integer); Begin call color(15); call move(160,330) ; tab := GETMAP(600,340); If i = 0 then call HASCII(0) ; call HASCII(ord('P')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('l')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('a')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('c')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('e')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('m')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('e')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('n')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('t')); Fi; if i = 1 then call HASCII(0) ; call HASCII(ord('D')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('e')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('p')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('l')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('a')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('c')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('e')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('m')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('e')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('n')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('t')); Fi; If i = 2 then call HASCII(0) ; call HASCII(ord('D')); call HASCII(0) ; call HASCII(ord('e')); call HASCII(0) ; call HASCII(ord('p')); call HASCII(0) ; call HASCII(ord('l')); call HASCII(0) ; call HASCII(ord('a')); call HASCII(0) ; call HASCII(ord('c')); call HASCII(0) ; call HASCII(ord('e')); call HASCII(0) ; call HASCII(ord('m')); call HASCII(0) ; call HASCII(ord('e')); call HASCII(0) ; call HASCII(ord('n')); call HASCII(0) ; call HASCII(ord('t')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('m')); call HASCII(0) ; call HASCII(ord('o')); call HASCII(0) ; call HASCII(ord('i')); call HASCII(0) ; call HASCII(ord('n')); call HASCII(0) ; call HASCII(ord('s')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('d')); call HASCII(0) ; call HASCII(ord('e')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('3')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('p')); call HASCII(0) ; call HASCII(ord('i')); call HASCII(0) ; call HASCII(ord('o')); call HASCII(0) ; call HASCII(ord('n')); call HASCII(0) ; call HASCII(ord('s')); Fi; If i = 3 then call HASCII(0) ; call HASCII(ord('M')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('a')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('n')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('g')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('e')); Fi; For i := 1 To 20 Do call HASCII(0) ; call HASCII(ord(' ')); Od; End AffichePhase; (*************************************************************************) (** Dans une ligne comportant 3 points : pt1, pt2, pt3 **) (** recherche du ou des points se trouvant a proximite de pt1 **) (*************************************************************************) Unit RechPtProx : function (lig : ligne) : integer ; (**********************************) (** Result = 1 ==> point 2 **) (** 2 3 **) (** 3 point 3-2 **) (**********************************) Begin result := 0 ; IF (lig.pt1.x = lig.pt2.x) AND (* Recherche des *) (lig.pt2.x = lig.pt3.x) AND (* lignes *) (lig.pt1.y = lig.pt2.y) AND (* en profondeur *) (lig.pt2.y = lig.pt3.y) THEN IF (lig.pt1.z = (lig.pt2.z+1)) OR (lig.pt1.z = (lig.pt2.z-1)) THEN result := result + 1 ; FI; IF (lig.pt1.z = (lig.pt3.z+1)) OR (lig.pt1.z = (lig.pt3.z-1)) THEN result := result + 2 ; FI; ELSE (** Recherche des lignes a l'interieur d'un cadre **) IF (lig.pt1.x = (lig.pt2.x+1)) OR (lig.pt1.x = (lig.pt2.x-1)) OR (lig.pt1.y = (lig.pt2.y+1)) OR (lig.pt1.y = (lig.pt2.y-1)) THEN result := result + 1 ; FI; IF (lig.pt1.x = (lig.pt3.x+1)) OR (lig.pt1.x = (lig.pt3.x-1)) OR (lig.pt1.y = (lig.pt3.y+1)) OR (lig.pt1.y = (lig.pt3.y-1)) THEN result := result + 2 ; FI; FI; End RechPtProx; (*************************************************************************) (** Procedure verifiant que la priorite 1 ou 2 (suivant l'appelant) **) (** peut etre validee **) (*************************************************************************) Unit DeplPrior12 : procedure (ligne1,ligne2:ligne;output sortie : boolean); Var prox : integer; Begin (** S'il existe un pion appartenant au joueur courant,a proximite de **) (** l'intersection des 2 lignes, sur la ligne 2, la priorite peut etre **) (** validee **) sortie := false ; prox := RechPtProx (ligne2); IF Not defense THEN IF ((prox = 1) OR (prox = 3)) AND (table.cub(ligne2.pt2.x,ligne2.pt2.y,ligne2.pt2.z) = Numjoueur) THEN ptdep.x := ligne2.pt2.x; ptdep.y := ligne2.pt2.y; ptdep.z := ligne2.pt2.z; ptarr.x := ligne1.pt1.x; ptarr.y := ligne1.pt1.y; ptarr.z := ligne1.pt1.z; sortie := true ; ELSE IF ((prox = 2) OR (prox = 3)) AND (table.cub(ligne2.pt3.x,ligne2.pt3.y,ligne2.pt3.z) = Numjoueur) THEN ptdep.x := ligne2.pt3.x; ptdep.y := ligne2.pt3.y; ptdep.z := ligne2.pt3.z; ptarr.x := ligne1.pt1.x; ptarr.y := ligne1.pt1.y; ptarr.z := ligne1.pt1.z; sortie := true ; FI ; FI; ELSE IF (prox = 3) AND (((table.cub(ligne2.pt2.x,ligne2.pt2.y,ligne2.pt2.z) = Numjoueur) AND (table.cub(ligne2.pt3.x,ligne2.pt3.y,ligne2.pt3.z) = (3 - Numjoueur))) OR ((table.cub(ligne2.pt3.x,ligne2.pt3.y,ligne2.pt3.z) = Numjoueur) AND (table.cub(ligne2.pt2.x,ligne2.pt2.y,ligne2.pt2.z) = (3 - Numjoueur)))) THEN IF (table.cub(ligne2.pt2.x,ligne2.pt2.y,ligne2.pt2.z) = Numjoueur) THEN ptdep.x := ligne2.pt2.x; ptdep.y := ligne2.pt2.y; ptdep.z := ligne2.pt2.z; ELSE ptdep.x := ligne2.pt3.x; ptdep.y := ligne2.pt3.y; ptdep.z := ligne2.pt3.z; FI; ptarr.x := ligne1.pt1.x; ptarr.y := ligne1.pt1.y; ptarr.z := ligne1.pt1.z; sortie := true ; FI ; FI; End DeplPrior12 ; (*************************************************************************) (** Procedure permettant de rechercher toutes les lignes valides dans **) (** le cube **) (*************************************************************************) Unit RechLigne : procedure (i,j,k : integer; inout lig1 : ligne; output sortie : boolean); Begin sortie := true ; IF ((i = 2) OR (j = 2)) THEN (** Creation des lignes en profondeur **) IF i <> j (* la ligne du milieu du cube est inexistante *) THEN IF k = 1 THEN (** On cree ces lignes seuleument une fois ==> quand k = 1 **) lig1.pt1.x,lig1.pt2.x,lig1.pt3.x := i; lig1.pt1.y,lig1.pt2.y,lig1.pt3.y := j; lig1.pt1.z:=k; lig1.pt2.z:=k+1; lig1.pt3.z:=k+2; ELSE sortie := false; return; FI; ELSE sortie := false; return; FI; ELSE (** Creation des lignes pour chaque cadre **) lig1.pt1.z ,lig1.pt2.z, lig1.pt3.z := k; If (( i = 1 ) AND ( j = 1 )) OR (( i = 3 ) AND ( j = 3 )) Then (** Creation des lignes horizontales **) lig1.pt1.x,lig1.pt2.x,lig1.pt3.x := i; lig1.pt1.y := (j mod 3) + 1; lig1.pt2.y := ((j + 1) mod 3) + 1; lig1.pt3.y := ((j + 2) mod 3) + 1; Fi; If (( i = 1 ) AND ( j = 3 )) OR (( i = 3 ) AND ( j = 1 )) Then (** Creation des lignes verticales **) lig1.pt1.y,lig1.pt2.y,lig1.pt3.y := i; lig1.pt1.x := (j mod 3) + 1; lig1.pt2.x := ((j + 1) mod 3) + 1; lig1.pt3.x := ((j + 2) mod 3) + 1; Fi; Fi; End RechLigne; (*************************************************************************) (** Procedure permettant de rechercher les 2 lignes valides qui **) (** s'intersectent dans le cube a partir d'un point donne **) (*************************************************************************) Unit RechLignesCrois : procedure (i,j,k : integer; inout lig1,lig2 : ligne; output sortie : boolean); (** Cette procedure renvoie 2 lignes qui se croisent au point (i,j,k) *) Begin sortie := true; lig1.pt1.x,lig2.pt1.x := i; (* Creation du point *) lig1.pt1.y,lig2.pt1.y := j; (* d'intersection *) lig1.pt1.z,lig2.pt1.z := k; (* ==> pt1 *) IF (i = 2) OR (j = 2) THEN (** Recherche des lignes qui s'intersectent avec celles en profondeur **) IF (i<>j) (* la ligne du milieu est inexistante *) THEN (* creation de la ligne appartenant au cadre *) lig1.pt2.z,lig1.pt3.z := k; IF (i = 2) THEN lig1.pt2.x := 1 ; (* Creation d'une *) lig1.pt3.x := 3 ; (* ligne *) lig1.pt2.y := j; (* horrizontale *) lig1.pt3.y := j; FI; IF (j = 2) THEN lig1.pt2.x := i; (* Creation d'une *) lig1.pt3.x := i; (* ligne *) lig1.pt2.y := 1 ; (* verticale *) lig1.pt3.y := 3 ; FI; (* Creation de la ligne en profondeur *) lig2.pt2.x,lig2.pt3.x := i; lig2.pt2.y,lig2.pt3.y := j; IF (k = 1) THEN lig2.pt2.z := 2; lig2.pt3.z := 3; ELSE IF (k = 2) THEN lig2.pt2.z := 1; lig2.pt3.z := 3; ELSE lig2.pt2.z := 1; lig2.pt3.z := 2; FI; FI; ELSE sortie := false ; return; FI; ELSE (** Recherche des lignes qui se croisent dans le meme cadre **) (* Tous les points ont le meme cadre *) lig1.pt2.z, lig1.pt3.z, lig2.pt2.z, lig2.pt3.z := k; (* les points sur la ligne horizontale ont la meme abscisse *) lig1.pt2.x,lig1.pt3.x := i; (* les points sur la ligne verticale ont la meme ordonnee *) lig2.pt2.y, lig2.pt3.y := j; (* Calcul des abscisses de la ligne verticale *) If ( i = 1) Then lig2.pt2.x := 2; lig2.pt3.x := 3 ; Else lig2.pt2.x := 1; lig2.pt3.x := 2 ; Fi; (* Calcul des ordonnees de la ligne horizontale *) If ( j = 1) Then lig1.pt2.y := 2; lig1.pt3.y := 3 ; Else lig1.pt2.y := 1; lig1.pt3.y := 2 ; Fi; Fi; End RechLignesCrois; (*************************************************************************) (** Procedure permettant de determiner un point du cube ayant pour **) (** valeur le parametre n, de facon aleatoire **) (*************************************************************************) Unit RandomPlac : Procedure ( n : integer ); Var i, j, k : integer, a, b, c : real; Begin a := Random; ptarr.x := ((Round( a * 10000) ) mod 3) + 1; (* Calcul de *) b := Random; ptarr.y := ((Round( b * 10000) ) mod 3) + 1; (* 3 coordonnees *) c := Random; ptarr.z := ((Round( c * 10000) ) mod 3) + 1; (* aleatoires *) (** A partir du point calcule on cherche on cherche un point tel que sa valeur dans le cube soit n **) If (table.cub( ptarr.x, ptarr.y, ptarr.z ) <> n) OR ((ptarr.x = 2) AND (ptarr.y = 2)) Then For k := ptarr.z To 3 Do For j := ptarr.y To 3 Do For i := ptarr.x To 3 Do If (i = 2) AND (j = 2) Then repeat; Fi; If table.cub(i,j,k) = n Then ptarr.x := i; ptarr.y := j; ptarr.z := k; exit;exit;exit; Fi; Od; Od; Od; Fi; If (table.cub( ptarr.x, ptarr.y, ptarr.z ) <> n) OR ((ptarr.x = 2) AND (ptarr.y = 2)) Then For k := ptarr.z Downto 1 Do For j := ptarr.y Downto 1 Do For i := ptarr.x Downto 1 Do If (i = 2) AND (j = 2) Then repeat; Fi; If table.cub(i,j,k) = n Then ptarr.x := i; ptarr.y := j; ptarr.z := k; exit;exit;exit; Fi; Od; Od; Od; Fi; End RandomPlac; (*************************************************************************) (** Procedure permettant de determiner, de facon aleatoire, deux points **) (** du cube : - l'un ayant pour valeur le parametre n **) (** - l'autre,se trouvant a la proximite du premier,ayant **) (** la valeur 0 **) (*************************************************************************) Unit RandomDepl : Procedure ( lig1, lig2: ligne, n : integer ); Var trouve, sortie : boolean, i, j, k, prox : integer, a, b, c : real; Begin trouve := false; WHILE not trouve Do a := random; ptdep.x := ((Round(a * 10000)) mod 3) + 1; (* Calcul *) b := Random; ptdep.y := ((Round(b * 10000)) mod 3) + 1; (* du *) c := Random; ptdep.z := ((Round(c * 10000)) mod 3) + 1; (* point de depart *) (* A partir du point calcule on cherche un point tel que sa valeur soit n dans la table *) If (table.cub( ptdep.x, ptdep.y, ptdep.z ) <> n) OR ((ptdep.x = 2) AND (ptdep.y = 2)) Then For k := ptdep.z To 3 Do For j := ptdep.y To 3 Do For i := ptdep.x To 3 Do If (i = 2) AND (j = 2) Then repeat; Fi; If table.cub(i,j,k) = n Then ptdep.x := i; ptdep.y := j; ptdep.z := k; exit;exit;exit; Fi; Od; Od; Od; Fi; If (table.cub( ptdep.x, ptdep.y, ptdep.z ) <> n) OR ((ptdep.x = 2) AND (ptdep.y = 2)) Then For k := ptdep.z Downto 1 Do For j := ptdep.y Downto 1 Do For i := ptdep.x Downto 1 Do If (i = 2) AND (j = 2) Then repeat; Fi; If table.cub(i,j,k) = n Then ptdep.x := i; ptdep.y := j; ptdep.z := k; exit;exit;exit; Fi; Od; Od; Od; Fi; call RechLignesCrois (ptdep.x, ptdep.y, ptdep.z, lig1, lig2, sortie); (** Recherche d'une case libre sur la ligne lig1 *) prox := RechPtProx (lig1); If ((prox = 1) OR (prox = 3)) AND (table.cub(lig1.pt2.x, lig1.pt2.y, lig1.pt2.z) = 0 ) Then trouve := true; ptarr.x := lig1.pt2.x; ptarr.y := lig1.pt2.y; ptarr.z := lig1.pt2.z; exit; Else If ((prox = 2) OR (prox = 3)) AND (table.cub(lig1.pt3.x, lig1.pt3.y, lig1.pt3.z) = 0 ) Then trouve := true; ptarr.x := lig1.pt3.x; ptarr.y := lig1.pt3.y; ptarr.z := lig1.pt3.z; exit; Fi; Fi; (* Recherche d'une case libre sur la ligne lig2 *) prox := RechPtProx (lig2); If ((prox = 1) OR (prox = 3)) AND (table.cub(lig2.pt2.x, lig2.pt2.y, lig2.pt2.z) = 0 ) Then trouve := true; ptarr.x := lig2.pt2.x; ptarr.y := lig2.pt2.y; ptarr.z := lig2.pt2.z; exit; Else If ((prox = 2) OR (prox = 3)) AND (table.cub(lig2.pt3.x, lig2.pt3.y, lig2.pt3.z) = 0 ) Then trouve := true; ptarr.x := lig2.pt3.x; ptarr.y := lig2.pt3.y; ptarr.z := lig2.pt3.z; exit; Fi; Fi; OD; End RandomDepl; (*************************************************************************) (** Phase de placement des pions **) (** Cette phase est commune au 2 joueurs **) (** Mais suivant le joueur il observe une strategie offensive ou **) (** defensive **) (*************************************************************************) UNIT Phase0 : PROCEDURE ( lig1 , lig2 : ligne); VAR priorite : integer , x1, x2, x3, y1, y2, y3, z1, z2, z3 : integer , xx2, xx3, yy2, yy3, zz2, zz3 : integer , i, j, k : integer, sortie : boolean; BEGIN priorite := 6; (* Par defaut priorite maximum *) FOR k := 1 TO 3 DO FOR j := 1 TO 3 DO FOR i := 1 TO 3 DO (* Recherche de placement pour chaque ligne *) CALL RechLigne (i,j,k,lig1,sortie); x1 := lig1.pt1.x; y1 := lig1.pt1.y; z1 := lig1.pt1.z; x2 := lig1.pt2.x; y2 := lig1.pt2.y; z2 := lig1.pt2.z; x3 := lig1.pt3.x; y3 := lig1.pt3.y; z3 := lig1.pt3.z; IF sortie THEN (** Priorite = 1 **) (** Si sur une meme ligne il y a 2 pions du joueur1 on place **) (** le pion du joueur courant sur le troisieme point si la **) (** place n'est pas deja occupe **) (** Si le joueur courant est le joueur1 **) (** ==> alignement de pions **) (** Sinon **) (** ==>empechement d'alignement **) IF (table.cub(x1,y1,z1) = 1) AND (table.cub(x2,y2,z2) = 1) AND (table.cub(x3,y3,z3) = 0) THEN priorite := 1 ; ptarr.x := x3; ptarr.y := y3; ptarr.z := z3; exit;exit;exit; FI; IF (table.cub(x1,y1,z1) = 1) AND (table.cub(x2,y2,z2) = 0) AND (table.cub(x3,y3,z3) = 1) THEN priorite := 1 ; ptarr.x := x2; ptarr.y := y2; ptarr.z := z2; exit;exit;exit; FI; IF (table.cub(x1,y1,z1) = 0) AND (table.cub(x2,y2,z2) = 1) AND (table.cub(x3,y3,z3) = 1) THEN priorite := 1 ; ptarr.x := x1; ptarr.y := y1; ptarr.z := z1; exit;exit;exit; FI; (** Priorite = 2 **) (** Si sur une meme ligne il y a 2 pions du joueur2 on place **) (** le pion du joueur courant sur le troisieme point si la **) (** place n'est pas deja occupe **) (** Si le joueur courant est le joueur2 **) (** ==> alignement de pions **) (** Sinon **) (** ==>empechement d'alignement **) IF (table.cub(x1,y1,z1) = 2) AND (table.cub(x2,y2,z2) = 2) AND (table.cub(x3,y3,z3) = 0) AND (priorite > 2) THEN priorite := 2 ; ptarr.x := x3; ptarr.y := y3; ptarr.z := z3; FI; IF (table.cub(x1,y1,z1) = 2) AND (table.cub(x2,y2,z2) = 0) AND (table.cub(x3,y3,z3) = 2) AND (priorite > 2) THEN priorite := 2 ; ptarr.x := x2; ptarr.y := y2; ptarr.z := z2; FI; IF (table.cub(x1,y1,z1) = 0) AND (table.cub(x2,y2,z2) = 2) AND (table.cub(x3,y3,z3) = 2) AND (priorite > 2) THEN priorite := 2 ; ptarr.x := x1; ptarr.y := y1; ptarr.z := z1; FI; (** Priorite = 5 **) (** Si le point de coordonnees (1,2,2) est libre on choisit **) (** ce point **) IF (table.cub(1,2,2) = 0) AND (priorite = 6) THEN ptarr.x := 1; ptarr.y := 2; ptarr.z := 2; priorite := 5 ; FI; FI; OD; OD; OD; IF priorite > 2 THEN (** On traite toutes les lignes qui s'intersectent **) FOR k := 1 TO 3 DO FOR j := 1 TO 3 DO FOR i := 1 TO 3 DO (* Recherche pour chaque paire ligne qui s'intersectent *) CALL RechLignesCrois (i,j,k,lig1,lig2,sortie); x1 := lig1.pt1.x; y1 := lig1.pt1.y; z1 := lig1.pt1.z; x2 := lig1.pt2.x; y2 := lig1.pt2.y; z2 := lig1.pt2.z; x3 := lig1.pt3.x; y3 := lig1.pt3.y; z3 := lig1.pt3.z; xx2 := lig2.pt2.x; yy2 := lig2.pt2.y; zz2 := lig2.pt2.z; xx3 := lig2.pt3.x; yy3 := lig2.pt3.y; zz3 := lig2.pt3.z; IF sortie THEN (** Priorite = 3 **) (** Pour chaque paire de lignes qui s'intersectent a une **) (** case (x, y, z) de valeur 0 **) (** Si les valeurs des pions sur les 2 lignes sont **) (** 1, 0, 0 dans n'importe quel ordre alors on choisit **) (** la case (x, y, z) **) IF (table.cub(x1,y1,z1) = 0) AND (((table.cub(x2,y2,z2) = 1) AND (table.cub(x3,y3,z3) = 0)) OR ((table.cub(x2,y2,z2) = 0) AND (table.cub(x3,y3,z3) = 1))) AND (((table.cub(xx2,yy2,zz2) = 1) AND (table.cub(xx3,yy3,zz3) = 0)) OR ((table.cub(xx2,yy2,zz2) = 0) AND (table.cub(xx3,yy3,zz3) = 1))) THEN priorite := 3; ptarr.x := x1; ptarr.y := y1; ptarr.z := z1; exit;exit;exit; FI; (** Priorite = 4 **) (** Pour chaque paire de lignes qui s'intersectent a une **) (** case (x, y, z) de valeur 0 **) (** Si les valeurs des pions sur les 2 lignes sont **) (** 2, 0, 0 dans n'importe quel ordre alors on choisit **) (** la case (x, y, z) **) IF (table.cub(x1,y1,z1) = 0) AND (((table.cub(x2,y2,z2) = 2) AND (table.cub(x3,y3,z3) = 0)) OR ((table.cub(x2,y2,z2) = 0) AND (table.cub(x3,y3,z3) = 2))) AND (((table.cub(xx2,yy2,zz2) = 2) AND (table.cub(xx3,yy3,zz3) = 0)) OR ((table.cub(xx2,yy2,zz2) = 0) AND (table.cub(xx3,yy3,zz3) = 2))) AND (priorite > 4) THEN priorite := 4; ptarr.x := x1; ptarr.y := y1; ptarr.z := z1; FI; FI; OD; OD; OD; FI; (** Prioite = 6 **) (** Recherche aleatoire du pion a placer **) IF (priorite = 6) THEN CALL RandomPlac (0); FI; For i := 1 To temps Do call color(10); call AffichPt(ptarr); call HASCII(0); call HASCII(ord('#')); Od; END Phase0; (*************************************************************************) (** Phase de deplacement des pions **) (** Cette phase est commune au 2 joueurs **) (** Dans certains cas, le joueur 1 observe une strategie offensive **) (** et le joueur 2 une strategie defensive **) (*************************************************************************) UNIT Phase1 : PROCEDURE (lig1 , lig2 : ligne); VAR priorite, prox : integer, x1, x2, x3, y1, y2, y3, z1, z2, z3 : integer , xx2, xx3, yy2, yy3, zz2, zz3 : integer , i, j, k : integer , sortie, ok : boolean; BEGIN priorite := 6; (* Priorite initialise au maximum par defaut *) FOR k := 1 TO 3 DO FOR j := 1 TO 3 DO FOR i := 1 TO 3 DO (* On recherche les deplacements possibles sur des lignes qui s'intersectent car : - Il faut trouver le pion a deplacer - on doit regarder si le deplacement est possible dans les lignes qui passent par ce point *) call RechLignesCrois(i,j,k,lig1,lig2,sortie); x1 := lig1.pt1.x; y1 := lig1.pt1.y; z1 := lig1.pt1.z; x2 := lig1.pt2.x; y2 := lig1.pt2.y; z2 := lig1.pt2.z; x3 := lig1.pt3.x; y3 := lig1.pt3.y; z3 := lig1.pt3.z; xx2 := lig2.pt2.x; yy2 := lig2.pt2.y; zz2 := lig2.pt2.z; xx3 := lig2.pt3.x; yy3 := lig2.pt3.y; zz3 := lig2.pt3.z; IF sortie THEN (** Priorite = 1 **) (** Si sur une ligne il y a 2 pions du joueur1, et sur l'autre ligne il y a a proximite un autre pion du - joueur1 on place le pion du joueur1 … l'intersection ==> alignement - joueur2 on place le pion du joueur2 … l'intersection ==> empechement d'alignement **) If (table.cub(x1,y1,z1) = 0) AND (table.cub(x2,y2,z2) = 1) AND (table.cub(x3,y3,z3) = 1) Then If numjoueur = 1 Then defense := false; Else defense := true; Fi; call DeplPrior12 (lig1,lig2,ok); If ok Then priorite := 1; exit;exit;exit; Fi; Fi; If (table.cub(x1,y1,z1) = 0) AND (table.cub(xx2,yy2,zz2) = 1) AND (table.cub(xx3,yy3,zz3) = 1) Then If numjoueur = 1 Then defense := false; Else defense := true; Fi; call DeplPrior12 (lig2,lig1,ok); If ok Then priorite := 1; exit;exit;exit; Fi; Fi; (** Priorite = 2 **) (** Si sur une ligne il y a 2 pions du joueur2, et sur l'autre ligne il y a a proximite un autre pion du - joueur2 on place le pion du joueur2 … l'intersection ==> alignement - joueur1 on place le pion du joueur1 … l'intersection ==> empechement d'alignement **) If (table.cub(x1,y1,z1) = 0) AND (table.cub(x2,y2,z2) = 2) AND (table.cub(x3,y3,z3) = 2) AND (priorite > 2) Then If numjoueur = 2 Then defense := false; Else defense := true; Fi; call DeplPrior12 (lig1,lig2,ok); If ok Then priorite := 2; Fi; Fi; If (table.cub(x1,y1,z1) = 0) AND (table.cub(xx2,yy2,zz2) = 2) AND (table.cub(xx3,yy3,zz3) = 2) AND (priorite > 2) Then If numjoueur = 2 Then defense := false; Else defense := true; Fi; call DeplPrior12 (lig2,lig1,ok); If ok Then priorite := 2; Fi; Fi; (** Priorite = 3 **) (** Si sur une meme ligne il y a trois pions du meme joueur et a proximite une case libre, on deplace le pion sur la case libre ==> possibilite d'aligne ment pour le prochain coup **) If (table.cub(x1,y1,z1) = Numjoueur ) AND (table.cub(x2,y2,z2) = Numjoueur ) AND (table.cub(x3,y3,z3) = Numjoueur ) AND (priorite > 3) Then prox := RechPtProx(lig2); If ((prox = 1) Or (prox = 3)) And (table.cub(xx2,yy2,zz2) = 0) Then priorite := 3; ptdep.x := x1; ptdep.y := y1; ptdep.z := z1; ptarr.x := xx2; ptarr.y := yy2; ptarr.z := zz2; Else If ((prox = 2) Or (prox = 3)) And (table.cub(xx3,yy3,zz3) = 0) Then priorite := 3; ptdep.x := x1; ptdep.y := y1; ptdep.z := z1; ptarr.x := xx3; ptarr.y := yy3; ptarr.z := zz3; Fi; Fi; Fi; If (table.cub(x1,y1,z1) = Numjoueur ) AND (table.cub(xx2,yy2,zz2) = Numjoueur ) AND (table.cub(xx3,yy3,zz3) = Numjoueur ) AND (priorite > 3) Then prox := RechPtProx(lig1); If ((prox = 1) Or (prox = 3)) And (table.cub(x2,y2,z2) = 0) Then priorite := 3; ptdep.x := x1; ptdep.y := y1; ptdep.z := z1; ptarr.x := x2; ptarr.y := y2; ptarr.z := z2; Else If ((prox = 2) Or (prox = 3)) And (table.cub(x3,y3,z3) = 0) Then priorite := 3; ptdep.x := x1; ptdep.y := y1; ptdep.z := z1; ptarr.x := x3; ptarr.y := y3; ptarr.z := z3; Fi; Fi; Fi; (** Priorite = 4 **) (** Si sur une meme ligne on a 2 pions d'un meme joueur et qu'il y ait possibilite de rapprocher un eventuel troisieme pion du meme joueur, on effectue le deplacement ==> possibilite d'alignement au prochain coup **) If (table.cub(x1,y1,z1) = 0) AND (table.cub(x2,y2,z2) = Numjoueur) AND (table.cub(x3,y3,z3) = Numjoueur) AND (((table.cub(xx2,yy2,zz2) = Numjoueur)AND (table.cub(xx3,yy3,zz3) = 0))OR ((table.cub(xx3,yy3,zz3) = Numjoueur)AND (table.cub(xx2,yy2,zz2) = 0))) AND (priorite > 4) Then priorite := 4; If table.cub(xx2,yy2,zz2) = Numjoueur Then ptdep.x := xx2; ptdep.y := yy2; ptdep.z := zz2; ptarr.x := xx3; ptarr.y := yy3; ptarr.z := zz3; Else ptdep.x := xx3; ptdep.y := yy3; ptdep.z := zz3; ptarr.x := xx2; ptarr.y := yy2; ptarr.z := zz2; Fi; Fi; If (table.cub(x1,y1,z1) = 0) AND (table.cub(xx2,yy2,zz2) = Numjoueur) AND (table.cub(xx3,yy3,zz3) = Numjoueur) AND (((table.cub(x2,y2,z2) = Numjoueur)AND (table.cub(x3,y3,z3) = 0))OR ((table.cub(x3,y3,z3) = Numjoueur)AND (table.cub(x2,y2,z2) = 0))) AND (priorite > 4) Then priorite := 4; If table.cub(x2,y2,z2) = Numjoueur Then ptdep.x := x2; ptdep.y := y2; ptdep.z := z2; ptarr.x := x3; ptarr.y := y3; ptarr.z := z3; Else ptdep.x := x3; ptdep.y := y3; ptdep.z := z3; ptarr.x := x2; ptarr.y := y2; ptarr.z := z2; Fi; Fi; (** priorite = 5 **) (** Pour chaque paire de lignes qui s'intersectent a une case (x, y, z) de valeur 0 Si les valeurs des pions sur les 2 lignes sont 1, 0, 0 dans n'importe quel ordre alors on aligne deux pions ou on rapproche un pion ==> possibilite d'alignement de deux pions au prochain coup **) If (table.cub(x1,y1,z1) = 0) AND (((table.cub(x2,y2,z2) = Numjoueur) AND (table.cub(x3,y3,z3) = 0)) OR ((table.cub(x2,y2,z2) = 0) AND (table.cub(x3,y3,z3) = Numjoueur))) AND (((table.cub(xx2,yy2,zz2) = Numjoueur) AND (table.cub(xx3,yy3,zz3) = 0)) OR ((table.cub(xx2,yy2,zz2) = 0) AND (table.cub(xx3,yy3,zz3) = Numjoueur))) AND (priorite > 5) Then priorite := 5; prox := RechPtProx(lig1); (* si on peut aligne 2 pions on le fait sinon on avance un pion pour que le coup d'apres on puisse aligner les 2 pions *) If ((prox = 1) OR (prox = 3)) AND (table.cub(x2,y2,z2) = Numjoueur ) Then ptdep.x := x2; ptdep.y := y2; ptdep.z := z2; ptarr.x := x1; ptarr.y := y1; ptarr.z := z1; Else If ((prox = 2) OR (prox = 3)) AND (table.cub(x3,y3,z3) = Numjoueur) Then ptdep.x := x3; ptdep.y := y3; ptdep.z := z3; ptarr.x := x1; ptarr.y := y1; ptarr.z := z1; Else prox := RechPtProx(lig2); If ((prox = 1) OR (prox = 3)) AND (table.cub(xx2,yy2,zz2)=Numjoueur) Then ptdep.x := xx2; ptdep.y := yy2; ptdep.z := zz2; ptarr.x := x1; ptarr.y := y1; ptarr.z := z1; Else If ((prox=2) OR (prox =3)) AND (table.cub(xx3,yy3,zz3)=Numjoueur) Then ptdep.x := xx3; ptdep.y := yy3; ptdep.z := zz3; ptarr.x := x1; ptarr.y := y1; ptarr.z := z1; Else If (prox = 1) Then ptdep.x := xx3; ptdep.y := yy3; ptdep.z := zz3; ptarr.x := xx2; ptarr.y := yy2; ptarr.z := zz2; Else ptdep.x := xx2; ptdep.y := yy2; ptdep.z := zz2; ptarr.x := xx3; ptarr.y := yy3; ptarr.z := zz3; Fi; Fi; Fi; Fi; Fi; Fi; Fi; OD; OD; OD; (** Priorite = 6 **) (** Deplacement aleatoire **) IF priorite = 6 Then Call RandomDepl(lig1,lig2,Numjoueur); Fi; For i := 1 To temps Do call color(10); call AffichPt (ptdep); call HASCII(0); call HASCII(219); call Affichpt(ptarr); call HASCII(0); call HASCII(ord('#')); Od; END Phase1; (*************************************************************************) (** Phase de deplacement des pions lorsqu'il y a 3 pions ou moins **) (** Cette phase est commune au 2 joueurs **) (** Dans certains cas, le joueur 1 observe une strategie offensive **) (** et le joueur 2 une strategie defensive **) (*************************************************************************) UNIT Phase2 : PROCEDURE (lig1 , lig2 : ligne ); VAR priorite, prox, cpt : integer, x1, x2, x3, y1, y2, y3, z1, z2, z3 : integer , xx2, xx3, yy2, yy3, zz2, zz3 : integer , i, j, k : integer , sortie : boolean , pion1, pion2, pion3 : elt , pion11, pion12 : elt; BEGIN pion1 := NEW elt; pion2 := NEW elt; pion3 := NEW elt; pion11 := NEW elt; pion12 := NEW elt; priorite := 4; cpt := 1; For k := 1 To 3 Do For j := 1 To 3 Do For i := 1 To 3 Do call RechLignesCrois(i,j,k,lig1,lig2,sortie); x1 := lig1.pt1.x; y1 := lig1.pt1.y; z1 := lig1.pt1.z; x2 := lig1.pt2.x; y2 := lig1.pt2.y; z2 := lig1.pt2.z; x3 := lig1.pt3.x; y3 := lig1.pt3.y; z3 := lig1.pt3.z; xx2 := lig2.pt2.x; yy2 := lig2.pt2.y; zz2 := lig2.pt2.z; xx3 := lig2.pt3.x; yy3 := lig2.pt3.y; zz3 := lig2.pt3.z; If sortie Then (** On recherche l'action a faire et on localise les pions du joueur 1 **) (** Priorite = 1 **) (** On cherche … aligner 3 pions du joueur1 ou a contrer l'alignement **) If (((nbpion1 = 3) AND (Numjoueur = 1)) Or (Numjoueur = 2)) AND (table.cub(x1,y1,z1) = 0) AND (table.cub(x2,y2,z2) = 1) AND (table.cub(x3,y3,z3) = 1) AND (priorite > 1) Then priorite := 1; ptarr.x := x1; ptarr.y := y1; ptarr.z := z1; If Numjoueur = 1 Then pion11.x := x2; pion11.y := y2; pion11.z := z2; pion12.x := x3; pion12.y := y3; pion12.z := z3; Fi; Fi; If (((nbpion1 = 3) AND (Numjoueur = 1)) Or (Numjoueur = 2)) AND (table.cub(x1,y1,z1) = 0) AND (table.cub(xx2,yy2,zz2) = 1) AND (table.cub(xx3,yy3,zz3) = 1) AND (priorite > 1) Then priorite := 1; ptarr.x := x1; ptarr.y := y1; ptarr.z := z1; If Numjoueur = 1 Then pion11.x := xx2; pion11.y := yy2; pion11.z := zz2; pion12.x := xx3; pion12.y := yy3; pion12.z := zz3; Fi; Fi; (** Priorite = 2 **) (** On cherche a aligner 3 pions du joueur2 ou a contrer l'alignement **) If (((nbpion2 = 3) And (Numjoueur = 2)) OR (numjoueur = 1)) AND (table.cub(x1,y1,z1) = 0) AND (table.cub(x2,y2,z2) = 2) AND (table.cub(x3,y3,z3) = 2) AND (priorite > 2) Then priorite := 2; ptarr.x := x1; ptarr.y := y1; ptarr.z := z1; If Numjoueur = 2 Then pion11.x := x2; pion11.y := y2; pion11.z := z2; pion12.x := x3; pion12.y := y3; pion12.z := z3; Fi; Fi; If (((nbpion2 = 3) And (Numjoueur = 2)) OR (numjoueur = 1)) AND (table.cub(x1,y1,z1) = 0) AND (table.cub(xx2,yy2,zz2) = 2) AND (table.cub(xx3,yy3,zz3) = 2) AND (priorite > 2) Then priorite := 2; ptarr.x := x1; ptarr.y := y1; ptarr.z := z1; If Numjoueur = 2 Then pion11.x := xx2; pion11.y := yy2; pion11.z := zz2; pion12.x := xx3; pion12.y := yy3; pion12.z := zz3; Fi; Fi; (** Priorite = 3 **) (** On essaie d'aligner 2 pions si le joueur possede exactement 3 pions **) If (table.cub(x1,y1,z1) = 0 ) AND ((table.cub(x2,y2,z2) = Numjoueur ) OR (table.cub(x3,y3,z3) = Numjoueur )) AND (priorite >3) AND (nbpion1 = 3) Then priorite := 3; ptarr.x := x1; ptarr.y := y1; ptarr.z := z1; If table.cub(x2,y2,z2) = Numjoueur Then pion11.x := x2; pion11.y := y2; pion11.z := z2; Else pion11.x := x3; pion11.y := y3; pion11.z := z3; Fi; Fi; If (table.cub(x1,y1,z1) = 0 ) AND ((table.cub(xx2,yy2,zz2) = Numjoueur ) OR (table.cub(xx3,yy3,zz3) = Numjoueur )) AND (priorite >3) AND (nbpion1 = 3) Then priorite := 3; ptarr.x := x1; ptarr.y := y1; ptarr.z := z1; If table.cub(xx2,yy2,zz2) = Numjoueur Then pion11.x := xx2; pion11.y := yy2; pion11.z := zz2; Else pion11.x := xx3; pion11.y := yy3; pion11.z := zz3; Fi; Fi; (** On situe les 3 pions du joueur 1 **) If table.cub(x1,y1,z1) = Numjoueur Then If cpt = 1 Then pion1.x := x1; pion1.y := y1; pion1.z := z1; Fi; If cpt = 2 Then pion2.x := x1; pion2.y := y1; pion2.z := z1; Fi; If cpt = 3 Then pion3.x := x1; pion3.y := y1; pion3.z := z1; Fi; cpt := cpt + 1; Fi; Fi; Od; Od; Od; (** Priorite = 4 **) (** Placement aleatoire **) If priorite = 4 Then call RandomPlac(0); Fi; (** Determination du point de depart **) If ((priorite = 1) And (Numjoueur = 1)) OR ((priorite = 2) And (Numjoueur = 2)) Then If ((pion3.x<>pion11.x) Or (pion3.y<>pion11.y) Or (pion3.z<>pion11.z)) AND ((pion3.x<>pion12.x) Or (pion3.y<>pion12.y) Or (pion3.z<>pion12.z)) Then ptdep.x := pion3.x; ptdep.y := pion3.y; ptdep.z := pion3.z; Fi; If ((pion2.x<>pion11.x) Or (pion2.y<>pion11.y) Or (pion2.z<>pion11.z)) AND ((pion2.x<>pion12.x) Or (pion2.y<>pion12.y) Or (pion2.z<>pion12.z)) Then ptdep.x := pion2.x; ptdep.y := pion2.y; ptdep.z := pion2.z; Fi; If ((pion1.x<>pion11.x) Or (pion1.y<>pion11.y) Or (pion1.z<>pion11.z)) AND ((pion1.x<>pion12.x) Or (pion1.y<>pion12.y) Or (pion1.z<>pion12.z)) Then ptdep.x := pion1.x; ptdep.y := pion1.y; ptdep.z := pion1.z; Fi; Fi; If priorite = 3 Then If (pion1.x<>pion11.x) Or (pion1.y<>pion11.y) Or (pion1.z<>pion11.z) Then ptdep.x := pion1.x; ptdep.y := pion1.y; ptdep.z := pion1.z; Else ptdep.x := pion2.x; ptdep.y := pion2.y; ptdep.z := pion2.z; Fi; Fi; If ((priorite = 2) And (Numjoueur = 1)) Or ((priorite = 1) And (Numjoueur = 2)) Or (priorite = 4) Then ptdep.x := pion1.x; ptdep.y := pion1.y; ptdep.z := pion1.z; Fi; kill (pion1); kill (pion2); kill (pion3); kill (pion11); kill (pion12); For i := 1 To temps Do call color(10); call AffichPt(ptdep); call HASCII(0); call HASCII(219); call AffichPt(ptarr); call HASCII(0); call HASCII(ord('#')); Od; END Phase2; (*************************************************************************) (** Phase "Manger" a la suite d'un alignement **) (** Cette phase est commune au deux joueurs **) (*************************************************************************) UNIT Phase3 : PROCEDURE ( lig1 , lig2 : ligne ); VAR priorite, prox : integer, x1, x2, x3, y1, y2, y3, z1, z2, z3 : integer , xx2, xx3, yy2, yy3, zz2, zz3 : integer , i, j, k : integer , sortie : boolean; BEGIN priorite := 4 ; (* priorite initialise au maximum *) For k := 1 To 3 Do For j := 1 To 3 Do For i := 1 To 3 Do call RechLignesCrois(i,j,k,lig1,lig2,sortie); x1 := lig1.pt1.x; y1 := lig1.pt1.y; z1 := lig1.pt1.z; x2 := lig1.pt2.x; y2 := lig1.pt2.y; z2 := lig1.pt2.z; x3 := lig1.pt3.x; y3 := lig1.pt3.y; z3 := lig1.pt3.z; xx2 := lig2.pt2.x; yy2 := lig2.pt2.y; zz2 := lig2.pt2.z; xx3 := lig2.pt3.x; yy3 := lig2.pt3.y; zz3 := lig2.pt3.z; If Sortie Then (** Priorite = 1 **) (** Si l'adversaire a une possibilite d'aligner 3 pions au prochain coup on lui en mange un **) If (table.cub(x1, y1, z1) = 0) AND (table.cub(x2, y2, z2) = (3 - Numjoueur)) AND (table.cub(x3, y3, z3) = (3 - Numjoueur)) Then prox := RechPtProx(lig2); If ((( prox = 1) OR (prox = 3)) AND (table.cub(xx2,yy2,zz2)= (3 - Numjoueur)))OR (((prox = 2) OR (prox = 3)) AND (table.cub(xx3,yy3,zz3)= (3 - Numjoueur))) Then priorite := 1 ; prox := RechPtProx(lig1); If prox = 1 Then ptmange.x := x2; ptmange.y := y2; ptmange.z := z2; Else ptmange.x := x3; ptmange.y := y3; ptmange.z := z3; Fi; exit;exit;exit; Fi; Fi; If (table.cub(x1, y1, z1) = 0) AND (table.cub(xx2, yy2, zz2) = (3 - Numjoueur)) AND (table.cub(xx3, yy3, zz3) = (3 - Numjoueur)) Then prox := RechPtProx(lig1); If (((prox = 1) OR (prox = 3)) AND (table.cub(x2,y2,z2)= (3 - Numjoueur)))OR (((prox = 2) OR (prox = 3)) AND (table.cub(x3,y3,z3)= (3 - Numjoueur))) Then priorite := 1 ; prox := RechPtProx(lig2); If prox = 1 Then ptmange.x := xx2; ptmange.y := yy2; ptmange.z := zz2; Else ptmange.x := xx3; ptmange.y := yy3; ptmange.z := zz3; Fi; exit;exit;exit; Fi; Fi; (** Priorite = 2 **) (** Si l'adversaire a trois pions alignes on lui en mange un **) If (table.cub (x1, y1, z1) = (3 - Numjoueur)) AND (table.cub (x2, y2, z2) = (3 - Numjoueur)) AND (table.cub (x3, y3, z3) = (3 - Numjoueur)) AND (priorite > 2) Then priorite := 2; ptmange.x := x1; ptmange.y := y1; ptmange.z := z1; Fi; If (table.cub (x1, y1, z1) = (3 - Numjoueur)) AND (table.cub (xx2, yy2, zz2) = (3 - Numjoueur)) AND (table.cub (xx3, yy3, zz3) = (3 - Numjoueur)) AND (priorite > 2) Then priorite := 2; ptmange.x := x1; ptmange.y := y1; ptmange.z := z1; Fi; (** Priorite = 3 **) (** Si on a possibilite d'aligner 3 pions au prochain coup et que l'adversaire nous bloque on lui mange le pion **) If (priorite > 3) AND (table.cub (x1, y1, z1) = (3 - Numjoueur)) AND (table.cub (x2, y2, z2) = Numjoueur) AND (table.cub (x3, y3, z3) = Numjoueur) Then prox := RechPtProx(lig2); If (((prox = 1) OR (prox = 3)) AND (table.cub(xx2,yy2,zz2) = Numjoueur)) OR (((prox = 2) OR (prox = 3)) AND (table.cub(xx3,yy3,zz3) = Numjoueur)) Then priorite := 3; ptmange.x := x1; ptmange.y := y1; ptmange.z := z1; Fi; Fi; If (priorite > 3) AND (table.cub (x1, y1, z1) = (3 - Numjoueur)) AND (table.cub (xx2, yy2, zz2) = Numjoueur) AND (table.cub (xx3, yy3, zz3) = Numjoueur) Then prox := RechPtProx(lig1); If (((prox = 1) OR (prox = 3)) AND (table.cub(x2,y2,z2) = Numjoueur)) OR (((prox = 2) OR (prox = 3)) AND (table.cub(x3,y3,z3) = Numjoueur)) Then priorite := 3; ptmange.x := x1; ptmange.y := y1; ptmange.z := z1; Fi; Fi; Fi; Od; Od; Od; (** Priorite = 4 **) (** Placement aleatoire sur un pion du joueur adverse **) If priorite = 4 Then i := 3 - Numjoueur; call RandomPlac(i); ptmange.x := ptarr.x; ptmange.y := ptarr.y; ptmange.z := ptarr.z; Fi; For i := 1 To temps Do call color(10); call AffichPt(ptmange); call HASCII(0); call HASCII(219); Od; END Phase3; (***************************************************************************) (** **) (** Coroutine : JOUEUR1 **) (** **) (** Strategie offensive **) (** **) (***************************************************************************) UNIT joueur1 : COROUTINE; BEGIN return; DO IF phase = 0 THEN (* Placement des pions *) Call phase0 ( lig1, lig2 ); detach; (** Retour a la coroutine Arbitre **) FI; (** Fin de la phase 0 ; Placement de pion **) IF phase = 1 THEN (** deplacement d'un pion si le joueur 1 a plus de 3 pions **) call Phase1 (lig1 , lig2); detach; (** Retour a la coroutine Arbitre **) Fi; (** Fin phase = 1 ; Deplacement de pions . Nbpion1 >3 **) IF phase = 2 THEN (* Deplacement de pions si le nombre de pions du joueur 1 est <= a 3 *) Call Phase2 (lig1 , lig2); detach; (** Retour a la coroutine Arbitre **) FI; (** Fin phase = 2; Deplacement de pions. Nbpion1 <= 3 **) IF phase = 3 THEN (* Le joueur 1 mange un des pions du joueur 2 *) Call Phase3 (lig1 , lig2); detach; (** Retour a la coroutine Arbitre **) FI; (** Fin phase = 3; Manger Pion **) OD; END joueur1; (***************************************************************************) (** **) (** Coroutine : JOUEUR2 **) (** **) (** Strategie defensive **) (** **) (***************************************************************************) UNIT joueur2 : COROUTINE; BEGIN return; DO IF phase = 0 THEN (* Placement des pions *) Call phase0 ( lig1, lig2 ); detach; (** Retour a la coroutine Arbitre **) FI; (** Fin de la phase 0 ; Placement de pion **) IF phase = 1 THEN (** deplacement d'un pion si le joueur 1 a plus de 3 pions **) call Phase1 (lig1 , lig2); detach; (** Retour a la coroutine Arbitre **) Fi; (** Fin phase = 1 ; Deplacement de pions . Nbpion1 >3 **) IF phase = 2 THEN (* Deplacement de pions si le nombre de pions du joueur 1 est <= a 3 *) Call Phase2 (lig1 , lig2); detach; (** Retour a la coroutine Arbitre **) FI; (** Fin phase = 2; Deplacement de pions. Nbpion1 <= 3 **) IF phase = 3 THEN (* Le joueur 1 mange un des pions du joueur 2 *) Call Phase3 (lig1 , lig2); detach; (** Retour a la coroutine Arbitre **) FI; (** Fin phase = 3; Manger Pion **) OD; END joueur2; (***************************************************************************) (** **) (** Coroutine : ARBITRE **) (** **) (***************************************************************************) UNIT arbitre : COROUTINE ; Unit VerifPt : Class; (** Verifie : - si un joueur a place ou deplace un pion sur une case deja occupee - si 3 pions ont ete alignes lors du dernier coup joue Valide ou annule le coup **) Var sortie : boolean; Begin (** Verification de la validit‚ du point d'arrivee **) okpt := (table.cub(ptarr.x,ptarr.y,ptarr.z)=0); If okpt Then If (phase = 1) Or (phase = 2) Then table.cub(ptdep.x,ptdep.y,ptdep.z) := 0; call color(15); call AffichPt(ptdep); call HASCII(0); call HASCII(ord('+')); Fi; (** Mise a jour de la table de jeu : le cube **) table.cub(ptarr.x,ptarr.y,ptarr.z) := numjoueur ; If numjoueur = 1 Then call color(3); Else call color(5); Fi; call AffichPt(ptarr); call HASCII(0); call HASCII(219); inner; (* verification aligne ==> manger *) Call RechLignesCrois (ptarr.x,ptarr.y,ptarr.z,lig1,lig2,sortie); aligne := ((table.cub(lig1.pt1.x,lig1.pt1.y,lig1.pt1.z)=Numjoueur) And (table.cub(lig1.pt2.x,lig1.pt2.y,lig1.pt2.z)=Numjoueur) And (table.cub(lig1.pt3.x,lig1.pt3.y,lig1.pt3.z)=Numjoueur)); If not aligne Then aligne := ((table.cub(lig2.pt1.x,lig2.pt1.y,lig2.pt1.z)=Numjoueur) And (table.cub(lig2.pt2.x,lig2.pt2.y,lig2.pt2.z)=Numjoueur) And (table.cub(lig2.pt3.x,lig2.pt3.y,lig2.pt3.z)=Numjoueur)); Fi; Else (* mauvais placement *) If table.cub(ptarr.x,ptarr.y,ptarr.z) = 1 Then call color(3); Else call color(5); Fi; call AffichPt(ptarr); call HASCII(0); call HASCII(219); Fi; End VerifPt; Unit VerifLigne : verifpt Class; (** Verifie lors de la phase du deplacement de plus de 3 pions le bon deplacement du pion : - sur la meme ligne - dans un point proche **) Var Absx,Absy,Absz : integer ; Begin (* Si le deplacement n'est pas sur une ligne existante ou *) (* si le pion deplace a saute une ou plusieurs case *) (* alors le mouvement est mauvais *) Absx := Abs(ptdep.x - ptarr.x); Absy := Abs(ptdep.y - ptarr.y); Absz := Abs(ptdep.z - ptarr.z); If ((ptdep.x <> 2) And (ptdep.y <> 2) And (ptdep.z <> ptarr.z)) Or (Absx > 1) Or (Absy > 1) Or (Absz > 1) Or (Absx + Absy + Absz = 3) Or (Absx + Absy = 2) Or (Absx + Absz = 2) Or (Absz + Absy = 2) Then okligne := false; (* on remet le pion dans sa position initiale *) table.cub(ptdep.x,ptdep.y,ptdep.z):= numjoueur ; If numjoueur = 1 Then call color(3); Else call color(5); Fi; call AffichPt(ptdep); call HASCII(0); call HASCII(219); table.cub(ptarr.x,ptarr.y,ptarr.z):= 0 ; call color(15); call AffichPt(ptarr); call HASCII(0); call HASCII(ord('+')); Else okligne := true; Fi; End VerifLigne; Unit Gagne : Function : boolean; (** D‚termine si le joueur courant a gagne ou pas **) Begin If (nbpion1 < 3) Or (nbpion2 < 3) Then result := true; Else result := false; Fi; End gagne; Unit PionAligne : Procedure; Unit VerifMange : Function : boolean; (** Verifie si le pion mange appartient bien au joueur adverse **) begin result:=(table.cub(ptmange.x,ptmange.y,ptmange.z) = (3-Numjoueur)); If result Then table.cub(ptmange.x,ptmange.y,ptmange.z) := 0; else call Erreur1; Fi; If table.cub(ptmange.x,ptmange.y,ptmange.z) = 0 Then call color(15); call AffichPt(ptmange); call HASCII (0); call HASCII(ord('+')); Fi; If table.cub(ptmange.x,ptmange.y,ptmange.z) = 1 Then call color(3); call AffichPt(ptmange); call HASCII (0); call HASCII(219); Fi; If table.cub(ptmange.x,ptmange.y,ptmange.z) = 2 Then call color(5); call AffichPt(ptmange); call HASCII (0); call HASCII(219); Fi; End VerifMange; (** Pionaligne : appel de la phase 3 et mise a jour du nombre de pions **) Var mange : boolean; Begin mange := false; While not mange Do phase := 3; call affichephase(phase); if numjoueur = 1 then attach(J1); else attach(J2); fi; mange := Verifmange; Od; If numjoueur = 1 Then nbpion2 := nbpion2 - 1; Else nbpion1 := nbpion1 - 1; Fi; End PionAligne; VAR nbpionpla : integer, i : integer, okpt : boolean, aligne : boolean, okligne : boolean, verifpoint : verifpt, veriflig : verifligne, erreur : boolean, fini : boolean; BEGIN numjoueur := 1; nbpionpla := 0; Call affichejoueur(numjoueur); return; (* PLACEMENT DES PIONS *) While nbpionpla < 18 Do phase := 0; Call affichephase(phase); If numjoueur = 1 Then attach(J1); Else attach(J2); Fi; VerifPoint := NEW VerifPt; If Not okpt Then call erreur1; Else nbpionpla := nbpionpla + 1; If aligne Then call PionAligne; Fi; numjoueur := 3 - numjoueur; Call affichejoueur(numjoueur); Fi; kill (VerifPoint); Od; (* DEPLACEMENT DES PIONS *) Do erreur := false; call affichejoueur(numjoueur); If numjoueur = 1 Then if nbpion1 <= 3 then phase := 2; call affichephase(phase); attach(J1); else phase := 1; call affichephase(phase); attach(J1); fi; Else if nbpion2 <= 3 then phase := 2; call affichephase(phase); attach(J2); else phase := 1; call affichephase(phase); attach(J2); fi; Fi; If ((numjoueur = 1) And (nbpion1 <= 3)) Or ((numjoueur = 2) And (nbpion2 <= 3)) Then (** Moins de trois pions ==> Pas de verification sur le deplacement par rapport aux lignes **) Verifpoint := NEW verifpt; Else Veriflig := NEW verifligne; Fi; If Not okpt Then call erreur1; erreur := true; Else If ((numjoueur = 1) And (nbpion1 > 3)) Or ((numjoueur = 2) And (nbpion2 > 3)) Then if not okligne then call erreur1; erreur := true; else if aligne Then call PionAligne;fi; fi; Else if aligne Then call Pionaligne;fi; Fi; fini := gagne; If fini Then call affichejoueur(numjoueur); call move (520,210); call HASCII(0) ; call HASCII(ord('G')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('A')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('G')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('N')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('E')); call HASCII(0) ; call HASCII(ord(' ')); call HASCII(0) ; call HASCII(ord('!')); exit; Fi; Fi; If not erreur Then numjoueur := 3 - numjoueur; call affichejoueur(numjoueur); Fi; If ((numjoueur = 1) And (nbpion1 <= 3)) Or ((numjoueur = 2) And (nbpion2 <= 3)) Then kill (verifpoint); Else kill (veriflig); Fi; Od; END arbitre; (** Programme principal **) CONST temps = 1000; (* Constante permettant de ralentir l'affichage *) (* Si l'execution est trop rapide il suffit d'augmenter cette constante*) VAR table : cube, tab : arrayof integer, Numjoueur : integer, ptdep,ptarr,ptmange : elt, nbpion1, nbpion2 : integer, phase : integer, lig1,lig2 : ligne, defense : boolean, J1 : joueur1, J2 : joueur2, A : arbitre; BEGIN call GRON(0); table := NEW cube ; ptdep := NEW elt; ptarr := NEW elt; lig1 := NEW ligne; lig2 := NEW ligne; ptmange := NEW elt ; array tab dim (1:800); nbpion1, nbpion2 := 9; call AfficheTable; J1 := NEW joueur1; J2 := NEW joueur2; A := NEW arbitre; attach(A); END; END;