Program con4pro;
Uses crt,graph;
Var maxsco,col,nocrash,nbusers,found,pt1,pt2,x,y,hz,vt,xb,yb,cx,cy,plc,pl,
m,j,sr,s,sw,tai,k,winner,li,staal,pilote,mode,idpl,valpar,son:integer;
z:char;
Cradq:array[-2..10,-2..9] of integer;
nom1,nom2,win1,win2,point,ggan,t1,t2,t3,t4,t5,t6,t7,t8,aff:string;
Procedure crazysound; (*son a frequence croissante*)
begin
for k:=1 to 100 do
begin
sound(200+k*18);
delay(10);
end;
nosound;
end;
Procedure sony; (*mettre ou enlever le son*)
begin
son:=1-son;
setfillstyle(0,0);
bar(200,getmaxy,430,getmaxy-20);
if son=0 then outtextxy(getmaxx-300,getmaxy-10,'S effets sonores')
else
begin
crazysound;
outtextxy(getmaxx-300,getmaxy-10,'S enlever le son');
end;
end;
Procedure music1; (*musique de victoire 1*)
begin
sound(262);delay(200);
sound(330);delay(200);
sound(262);delay(200);
sound(330);delay(200);
sound(393);delay(400);
sound(196);delay(400);
sound(262);delay(400);
nosound;
end;
Procedure music2; (*musique de defaite 1*)
begin
sound(262);delay(350);
sound(294);delay(350);
sound(312);delay(350);
sound(416);delay(350);
sound(393);delay(350);
sound(312);delay(350);
sound(371);delay(500);
nosound;
end;
Procedure music0; (*musique match nul*)
begin
for k:=1 to 5 do
begin
sound(300);delay(50);nosound;delay(50);
end;end;
Procedure amazing; (*cercles de couleurs aleatoires*)
Begin
repeat
begin
col:=random(6)+1;
setcolor(col+6);
case k of
0:outtextxy(getmaxx div 2,getmaxy div 2,'Connect multimode');
1:outtextxy(getmaxx div 2,getmaxy div 2,'Par Charles Desharnais');
3:outtextxy(getmaxx div 2,getmaxy div 2,Ggan);
4:outtextxy(getmaxx div 2,getmaxy div 2,'Au revoir');
6:outtextxy(getmaxx div 2,getmaxy div 2,'Redemarrez le programme, choisissez le volet un usager');
7:outtextxy(getmaxx div 2,getmaxy div 2,'et entrez slidemaze comme nom d usager');
end;
tai:=random(80)+20;
x:=random(650)+1;
y:=random(480)+1;
setfillstyle(1,col);
fillellipse(x,y,tai,tai);
delay(100);
if keypressed then
begin
k:=k+1;
cleardevice;
z:=readkey;
end;
end
until k mod 3=2;
end;
Procedure askfirst; (*demande nom 1er usager*)
begin
cleardevice;
outtextxy(325,100,'usager 1, entre ton prenom');
readln(nom1);
k:=length(nom1);
if k>13 then
begin
outtextxy(325,200,'ton prenom est trop long. Recommence');
readln;
end;
end;
Procedure asksec; (*demande nom 2e usager*)
begin
cleardevice;
outtextxy(325,100,'usager 2, entre ton prenom');
readln(nom2);
k:=length(nom2);
if k>13 then
begin
outtextxy(325,200,'ton prenom est trop long. Recommence');
readln;
end;
end;
Procedure reglescon4; (*regles du connect4*)
begin
t1:='connect 4';
t2:='C est le jeu original. Dans une grille 7x6';
t3:='Chaque joueur place tour a tour un jeton de sa couleur.';
t4:='Il peut choisir dans quelle colonne il joue, mais doit';
t5:='obligatoirement placer son jeton dans la case vide';
t6:='la plus basse de sa colonne. Le premier joueur qui parvient';
t7:='a aligner quatre de ses jetons a l horizontale, a la diagonale';
t8:='ou a la verticale remporte la partie.';
end;
Procedure reglescon3; (*regles du connect3*)
begin
t1:='connect 3';
t2:='Meme principe, mais cette fois, chaque joueur';
t3:='a deux couleurs. Le premier usager a les bleus et les cyans,';
t4:='le deuxieme a les verts et les rouges.';
t5:='Ordre de jeu:bleu,vert,cyan,rouge,bleu,vert...';
t6:='Pour gagner,un joueur doit aligner trois jetons';
t7:='de la meme couleur.';
t8:='';
end;
Procedure reglesmode; (*instructions pour le mode*)
begin
t1:='Mode traditionnel vs mode recursif';
t2:='En mode traditionnel, si la grille se remplit completement';
t3:='sans qu un des joueurs ne gagne, la partie est nulle.';
t4:='Cependant, en mode recursif, si la rangee basse se remplit,';
t5:='la rangee disparait et tous les jetons descendent d une case.';
t6:='La partie peut donc ne jamais se terminer!!';
t7:='Exception: si le dernier jeton qui complete la rangee provoque';
t8:='une connection gagnante, la rangee reste intacte et le joueur gagne';
end;
Procedure protocole; (*instructions pour le mode*)
begin
t1:='Protocole';
t2:='';
t3:='Pour jouer un coup, tapez une touche de 1 a 7.';
t4:='Tapez S pour enlever ou ajouter le son.';
t5:='Tapez X pour quitter.';
t6:='';
t7:='';
t8:='';
end;
Procedure infovicto; (*instructions pour le mode*)
begin
t1:='Victoire finale';
t2:='Si un joueur parvient a remporter 10 parties, c est termine.';
t3:='Il est sacre champion.';
t4:='';
t5:='Si un joueur parvient a battre le joueur virtuel 10 fois';
t6:='sans subir la moindre defaite, on lui revele le mot de passe';
t7:='qui lui permet de decrocher une nouvelle option: voir le joueur';
t8:='virtuel jouer contre lui-meme.';
end;
Procedure infovirtu; (*information sur le joueur virtuel*)
begin
t1:='Joueur virtuel';
t3:='Le joueur virtuel possede toujours les verts.';
t4:='Il est de niveau moyen. Il joue vite au depart,';
t5:='mais peut prendre du temps plus la grille se remplit.';
t6:='Le joueur virtuel n est pas disponible pour le jeu connect 3.';
t2:='';
t7:='';
t8:='';
end;
Procedure instr; (*manuel d instructions*)
begin
k:=0;
repeat
begin
if k=0 then k:=1;
case k of
1:reglescon4;
2:reglescon3;
3:reglesmode;
4:infovirtu;
5:protocole;
6:infovicto;
end;
cleardevice;
outtextxy(325,75,t1);
outtextxy(325,150,t2);
outtextxy(325,175,t3);
outtextxy(325,200,t4);
outtextxy(325,225,t5);
outtextxy(325,250,t6);
outtextxy(325,275,t7);
outtextxy(325,300,t8);
if k>1 then outtextxy(325,375,'1 Precedent');
if k<6 then outtextxy(325,400,'2 Suivant') else outtextxy(325,400,'2 Terminer');
Z:=Upcase(readkey);
case z of
'1':k:=k-1;
'2':k:=k+1;
end;
cleardevice;
end;
until k=7;
end;
Procedure askuse; (*demande la nombre d usagers*)
begin
cleardevice;
outtextxy(325,100,'Choisis le nombre d usagers');
outtextxy(325,200,'1 un usager avec joueur virtuel');
outtextxy(325,300,'2 deux usagers');
repeat
begin
z:=upcase(readkey);staal:=0;
case z of
'1':nbusers:=1;
'2':nbusers:=2;
else staal:=1;end;
end
until staal=0;
end;
Procedure askjeu; (*demande le jeu*)
begin
cleardevice;
outtextxy(325,100,'Choisis un jeu');
outtextxy(325,200,'1 Connect 4');
outtextxy(325,300,'2 Connect 3');
repeat
begin
z:=upcase(readkey);staal:=0;
case z of
'1':j:=1;
'2':j:=2;
else staal:=1;end;
end
until staal=0;
end;
Procedure askmode; (*demande le mode*)
begin
cleardevice;
outtextxy(325,100,'Choisis un mode');
outtextxy(325,200,'1 traditionnel');
outtextxy(325,300,'2 recursif');
repeat
begin
z:=upcase(readkey);staal:=0;
case z of
'1':m:=1;
'2':m:=2;
else staal:=1;end;
end
until staal=0;
end;
Procedure askinst; (*propose le manuel d instructions*)
begin
cleardevice;
outtextxy(325,100,'Voulez vous consulter le manuel d instructions?');
outtextxy(325,200,'1 Oui');
outtextxy(325,300,'2 Non');
repeat
begin
z:=upcase(readkey);staal:=0;
case z of
'1':j:=j;
'2':j:=j;
else staal:=1;end;
end
until staal=0;
if z='1' then instr;
end;
Procedure asknew; (*propose une nouvelle partie*)
begin
cleardevice;
outtextxy(325,100,'Voulez-vous rejouer?');
outtextxy(325,200,'O Oui');
outtextxy(325,300,'N Non');
repeat
begin
z:=upcase(readkey);staal:=0;
case z of
'O':j:=j;
'N':j:=j;
else staal:=1;end;
end
until staal=0;
end;
Procedure afficheur; (*affiche le mode et le jeu pendant la partie*)
begin
settextstyle(5,1,4);
for k:=1 to 34 do
begin
if (k+s) mod 8=0 then setcolor(4)
else setcolor((k+s) mod 8);
outtextxy(15,500-15*k,aff[k mod length(aff)+1]);
end;
setcolor(white);
settextstyle(1,0,1);
end;
Procedure AIovercheck; (*le AI ne joue pas sur une mauvaise case*)
begin
for cx:=-1 to 1 do for cy:=-1 to 1 do
begin
inc(nocrash);
hz:=x;vt:=1+y;
if (abs(cx)+abs(cy)<>0) and (cradq[hz,vt]=0) and (nocrash<12000) and
(idpl=cradq[hz+cx,vt+cy]) and (idpl=cradq[hz+2*cx,vt+2*cy]) and
((idpl=cradq[hz+3*cx,vt+3*cy]) or (idpl=cradq[hz-cx,vt-cy])) then
staal:=1;
end;
end;
Procedure AIlook; (*le AI repere les possibilites de victoire, et bloque l adversaire*)
begin
for hz:= 1 to 7 do for vt:=1 to 6 do for cx:=-1 to 1 do for cy:=-1 to 1 do
if (abs(cx)+abs(cy)<>0) and (cradq[hz,vt-1]>0) and (cradq[hz,vt]=0) and
(idpl=cradq[hz+cx,vt+cy]) and (idpl=cradq[hz+2*cx,vt+2*cy]) and
((idpl=cradq[hz+3*cx,vt+3*cy]) or (idpl=cradq[hz-cx,vt-cy])) then
begin
x:=hz;
found:=1;
if nom1='slidemaze' then
begin
sound(400);
delay(80);
nosound;
end;
end;
end;
Procedure virtu ; (*procede de choix de coup pour le AI*)
begin
found:=0;
idpl:=pl;AIlook;
if found=0 then begin idpl:=3-pl;AIlook;end;
if found=0 then
begin
randomize;
K:=random(39)+1;
case k of
1..2:x:=1;
3..5:x:=2;
6..13:x:=3;
14..26:x:=4;
27..34:x:=5;
35..37:x:=6;
38..39:x:=7;
end;end;
end;
Procedure lund; begin (*trace la ligne de la victoire*)
case li of
1: begin xb:=hz;yb:=vt+3;end;
2: begin xb:=hz+3;yb:=vt;end;
3: begin xb:=hz+3;yb:=vt+3;end;
4: begin xb:=hz-3;yb:=vt+3;end;
5: begin xb:=hz;yb:=vt+2;end;
6: begin xb:=hz+2;yb:=vt;end;
7: begin xb:=hz+2;yb:=vt+2;end;
8: begin xb:=hz-2;yb:=vt+2;end;
end;
line(100+50*hz, 400-50*vt, 100+50*xb, 400-50*yb);
winner:=pl;
end;
Procedure newboard; (*trace une nouvelle grille*)
begin
Setfillstyle(1,lightgray); bar(125,375, 475,75);setfillstyle(1,0);
For x:=1 to 7 do
begin
outtextxy(100+x*50,385,point[x]);
for y:=1 to 6 do
begin
rectangle(75+50*x,425-50*y, 125+50*x,375-50*y);
Fillellipse(100+50*x, 400-50*y, 20,20);
end;end;
end;
Procedure decale; (*supprime la rangee complete et decale les jetons*)
begin
Delay(100);
line(150, 350, 450, 350);
if son=1 then crazysound else delay(300);
Newboard; For x:= 1 to 7 do for y:=1 to 5 do begin
Cradq[x,y]:= Cradq[x,y+1]; setfillstyle(1, Cradq[x,y]);
if Cradq[x,y]>0 then Fillellipse(100+50*x, 400-50*y, 20,20);end;
For x := 1 to 7 do
Cradq[x,6]:= 0;
end;
Procedure findrecur; (*repere une rangee complete*)
begin
K:=1; for hz:=1 to 7 do
k:= Cradq[hz,1]*k;
If (k>0) then decale;
end;
Procedure verify; begin (*repere une ligne gagnante*)
If j=1 then begin
For hz := 1 to 7 do for vt:=1 to 3 do
Begin k:=Cradq[hz,vt];
If (k>0) and (k=Cradq[hz,vt+1]) and (k=Cradq[hz,vt+2]) and (k=Cradq[hz,vt+3]) then begin li:=1; lund; end;end;
For hz := 1 to 4 do for vt:=1 to 7 do
Begin k:=Cradq[hz,vt];
If (k>0) and (k=Cradq[hz+1,vt]) and (k=Cradq[hz+2,vt]) and (k=Cradq[hz+3,vt]) then begin li:=2; lund; end;end;
For hz := 1 to 4 do for vt:=1 to 3 do
Begin k:=Cradq[hz,vt];
If (k>0) and (k=Cradq[hz+1,vt+1]) and (k=Cradq[hz+2,vt+2]) and (k=Cradq[hz+3,vt+3]) then begin li:=3; lund; end;end;
For hz := 4 to 7 do for vt:=1 to 3 do
Begin k:=Cradq[hz,vt];
If (k>0) and (k=Cradq[hz-1,vt+1]) and (k=Cradq[hz-2,vt+2]) and (k=Cradq[hz-3,vt+3]) then begin li:=4; lund; end;end;end
Else begin
For hz := 1 to 7 do for vt:=1 to 4 do
Begin k:=Cradq[hz,vt];
If (k>0) and (k=Cradq[hz,vt+1]) and (k=Cradq[hz,vt+2]) then begin li:=5; lund; end;end;
For hz := 1 to 5 do for vt:=1 to 7 do
Begin k:=Cradq[hz,vt];
If (k>0) and (k=Cradq[hz+1,vt]) and (k=Cradq[hz+2,vt]) then begin li:=6; lund; end;end;
For hz := 1 to 5 do for vt:=1 to 4 do
Begin k:=Cradq[hz,vt];
If (k>0) and (k=Cradq[hz+1,vt+1]) and (k=Cradq[hz+2,vt+2]) then begin li:=7; lund; end;end;
For hz := 3 to 7 do for vt:=1 to 4 do
Begin k:=Cradq[hz,vt];
If (k>0) and (k=Cradq[hz-1,vt+1]) and (k=Cradq[hz-2,vt+2]) then begin li:=8; lund; end;end;end;end;
Procedure flutab; (*place un jeton*)
Begin
y:=0;
repeat inc(y) until (Cradq[x,y]=0) or (y=7);
if ((pl=2) or (nom1='slidemaze')) and (nbusers=1) and (found=0) then AIovercheck;
if y=7 then staal:=1;
if staal=0 then
begin
Cradq[x,y] :=plc;
Setfillstyle(1,plc);
Fillellipse(100+50*x, 400-50*y, 20,20);
if (nom1='slidemaze') and (nbusers=1) then delay(500);
nocrash:=0;
if son=1 then begin sound(200);delay(60);nosound;end;
Afficheur;verify;
if (m=2) and (li=0) then findrecur;
end;
end;
Procedure move; (*joue un coup, modifie les parametres en consequence*)
Begin
if staal=0 then
begin
plc:=plc mod (2*j)+1;
pl:=2- plc mod 2;
if m=1 then inc(sr);
inc(s);
setfillstyle(1,plc);
end;
staal:=0;
setfillstyle(0,1);
bar(270,1,430,70);
setcolor(plc);
if pl=1 then outtextxy(350,50,nom1) else outtextxy(350,50,nom2);
setcolor(white);
if ((pl=2)or (nom1='slidemaze')) and (nbusers=1) then virtu
else
begin
z:=upcase(readkey);
case z of
'1': x:=1;
'2': x:=2;
'3': x:=3;
'4': x:=4;
'5': x:=5;
'6': x:=6;
'7': x:=7;
else staal:=1;
end;
end;
if z='S' then sony;
if staal= 0 then flutab;end;
Procedure game; (*organise une partie*)
Begin
askinst;
if nbusers=2 then askjeu else j:=1;
askmode;
valpar:=2*j+m;
case valpar of
3:aff:=' connect 4 traditionnel';
4:aff:=' connect 4 recursif';
5:aff:=' connect 3 traditionnel';
6:aff:=' connect 3 recursif';
end;
outtextxy(getmaxx-100,getmaxy-10,'X sortir');
son:=1-son;
Sw:=1-sw;
plc:=sw;
sr:=0;
li:=0;
winner:=0;
sony;
newboard;
afficheur;
outtextxy(200,50,'a toi de jouer');
outtextxy(550,270,point[pt1]);
outtextxy(590,270,point[pt2]);
rectangle(530,100,570,300);
rectangle(610,100,570,300);
rectangle(610,250,530,300);
settextstyle(1,1,1);
outtextxy(550,175,nom1);
outtextxy(590,175,nom2);
settextstyle(1,0,1);
for hz:=1 to 7 do for vt:=1 to 6 do cradq[hz,vt]:=0;
repeat move
until (winner>0) or (z ='X') or (sr=42) ;
setfillstyle(0,0);
bar(100,1,500,75);
case winner of
1:begin outtextxy(300,50,win1);inc(pt1);if son=1 then music1 else delay(1500);end;
2:begin outtextxy(300,50,win2);inc(pt2);if son=1 then music2 else delay(1500);end;
else outtextxy(300,50,'match nul');if son=1 then music0 else delay(1500);end;
setcolor(yellow);
outtextxy(300,225,'Pressez Enter');
setcolor(white);
readln;
if (pt1<maxsco) and (pt2<maxsco) then asknew;
end;
Begin
clrscr;
nosound;
pilote:=detect;
maxsco:=10;
pt1:=0;
pt2:=0;
point:='123456789';
initgraph(pilote,mode,'m:/bgi');
settextjustify(1,1);
settextstyle(4,0,6);
amazing; (*effet de bulles initial*)
settextstyle(1,0,1);
setcolor(white);
askuse;
cleardevice;
repeat askfirst
until k<14;
if nbusers=2 then
begin
repeat asksec
until k<14;
win2:='tu as gagne! '+nom2;
end
else
begin
nom2:='Ordinateur';
win2:='Tu as perdu! '+nom1;
end;
win1:='tu as gagne! '+nom1;
for hz:=-2 to 10 do for vt:=-2 to 9 do
Cradq[hz,vt]:=53+2*vt+hz;
for hz:=1 to 7 do for vt:=1 to 6 do
Cradq[hz,vt]:=0;
repeat game
until (pt1=maxsco) or (pt2=maxsco) or (z='N');
cleardevice;
if z='N' then k:=4
else
begin
Ggan:='Meilleure chance la prochaine fois, '+nom1;
if pt1=maxsco then Ggan:='Bravo '+nom1+', tu es le grand gagnant';
if (pt2=maxsco) and (nbusers=2) then Ggan:='Bravo '+nom2+', tu es le grand gagnant';
k:=3;
if pt1-pt2-nbusers=maxsco-1 then k:=6;
end;
settextstyle(4,0,3);
amazing; (*presentation finale*)
closegraph;
end.
(*
guide des variables
ENTIERS
k:variable a tout faire
x,y,hz,vt:variables principales pour les coordonnes des jetons
x et hz:position horizontale
y et vt:position veriticale
hz et vt:variables de detection (et parfois execution)
x et y:variables d execution
xb et yb:variables pour tracer des lignes victorieuses
cx et cy:variables d orientation des detections
plc:numero de couleur
pl:numero de joueur
idpl:joueur dont le AI analyse les combinaisons possibles
m:mode
j:jeu
s: nombre de coups joues dans une partie
sr: nombre de coups joues dans une partie recursive
sw: alterne le joueur qui debute a chaque nouvelle partie
winner:gagnant
li:type de ligne
pt1 et pt2:pointages
maxsco:pointage necessaire pour une victoire definitive
nbusers:nombre d utilisateurs
nocrash:empeche l AI de s emprisonner dans ses procedures de detection
VARIABLES BIVALENTES
Etat normal Etat anormal
Staal =0 =1;bloque l execution du coup et recommence
Found =0 =1;AI sait quoi jouer:il ne cherche plus.
Son =0 =1; il y a du son
CRADQ:tableau de jeu
TEXTES
t1 a t8: instructions
nom1 et nom2: noms d usagers
win1 et win2: indique le gagnant
point:banque de pointage
ggan:grand gagnant
valpar:mode et jeu
*)