program snake;
uses crt,graph;
var nom1: string;
var pilote, mode, x1, c5,aa,bb, d,gg, x,rr, slt, y, r, z,ttc, x3, f, g,n, tc, u,k,l, v, w,d1, points : integer;
var p: string;
var a,ab, reponsed, reponsemodejeu :char;
var giroux, ragout, xx1, xx3: integer;
var kk, ll, ccc, goujat, xx, yy, tc2,ttc2: integer;
var b,c, ca, cb,bbc, cc, prea, preb:char;
var temps,w3 : integer;
var t,w2, nom2: string; {Ce sont toutes, ou presque, les variables utilisees dans le programme}
tbl : array[1..550,1..2] of integer;
tbl2: array[1..550,1..2] of integer;
procedure snakeord; {Ceci est un nom de procedure}
var pilote, mode, nn, giroux, ragout, xx1, xx3, grosragout, babouin: integer;
var kk, ll, x1, aa,bb, ccc, goujat, d, x,xx,slt, y, yy,r, z,tc2,ttc,ttc2, x3, f, g,n, tc, u,k,l, v, w,d1, points : integer;
label wl, al, sl, dl,l5,l1,l2,l3, debut1; {Un label permet de renvoyer l'ordinateur a un endroit dans le code}
Procedure mort;
begin
if (x=xx) and (y=yy) then {C'est une condition a lexecution des instructions qui suivent}
begin
setcolor(lightgreen); {Permet de definir la couleur du contour}
setfillstyle(1,lightgreen); {Permet de definir la couleur du rectangle}
bar(384, 405, 505, 415 ); {Permet de definir les coordonnes du rectangle}
textcolor(darkgray);
setcolor(darkgray);
setfillstyle(2,yellow);
settextstyle(0,0,1);
outtextxy(385,406,'Match nul!');
delay(2000); {Cest un delai avant lexecution des prochaines instructions}
a:='M';
end;
for gg:=50 to 550 do
begin
if ((x=tbl[gg,1]) and (y=tbl[gg,2])) or ((x=tbl2[gg,1]) and (y=tbl2[gg,2])) then
begin
setcolor(lightgreen);
setfillstyle(1,lightgreen);
bar(339, 405, 505, 415 );
textcolor(darkgray);
setcolor(darkgray);
setfillstyle(2,yellow);
settextstyle(0,0,1);
outtextxy(385,406,'Vous etes mort');
delay(2000);
setcolor(lightgreen);
setfillstyle(1,lightgreen);
bar(339, 405, 505, 415 );
textcolor(darkgray);
setcolor(darkgray);
setfillstyle(2,yellow);
settextstyle(0,0,1);
outtextxy(340,406,'L''ordinateur a gagne');
delay(2000);
a:='M';
end;
end;
end;
Procedure mort2;
begin
if (x=xx) and (y=yy) then
begin
setcolor(lightgreen);
setfillstyle(1,lightgreen);
bar(384, 405, 505, 415 );
textcolor(darkgray);
setcolor(darkgray);
setfillstyle(2,yellow);
settextstyle(0,0,1);
outtextxy(385,406,'Match nul!');
delay(2000);
a:='M';
end;
for gg:=50 to 550 do
begin
if ((xx=tbl[gg,1]) and (yy=tbl[gg,2])) or ((xx=tbl2[gg,1]) and (yy=tbl2[gg,2])) then
begin
setcolor(lightgreen);
setfillstyle(1,lightgreen);
bar(339, 405, 505, 415 );
textcolor(darkgray);
setcolor(darkgray);
setfillstyle(2,yellow);
settextstyle(0,0,1);
outtextxy(340,406,'L''ordinateur est mort');
delay(2000);
setcolor(lightgreen);
setfillstyle(1,lightgreen);
bar(339, 405, 505, 415 );
textcolor(darkgray);
setcolor(darkgray);
setfillstyle(2,yellow);
settextstyle(0,0,1);
outtextxy(380,406,'Vous avez gagne!');
delay(2000);
a:='M';
end;
end;
end;
procedure annule;
begin
end;
procedure avant;
label pointnoir;
var nnn , aa, bb: integer;
begin
{for n:=50 to 150 do }
if ((x=k) and (y=l)) then {met un nouveau point si celui ci est mange}
begin
slt:=2;
inc(tc);
if ((points mod 10) = 0) and (points<>0) then
begin
d1:=d1-5;
if d1<=0 then d1:=5;
pointnoir:
kk:=random(38)*10+110;
ll:=random(28)*10+110;
for
nnn:= 1 to 500 do
if ((x=kk) and (y=ll)) or ((kk=tbl[nnn,1]) and (ll=tbl[nnn,2])) then
goto pointnoir;
{pour qu'un point ne soit pas au dessus dun autre}
n:=551 ;
repeat
dec(n);
until tbl[n,1]=0;
tbl[n,1]:=kk;
tbl[n,2]:=ll;
setcolor(black);
setfillstyle(1,black);
fillellipse(kk,ll,4,4) ;
end;
for nnn:=550 to 501 do
kk:=random(38)*10+110;
ll:=random(28)*10+110;
for nnn:=50 to 150 do
if ((x=k) and (y=l)) or ((k=tbl[nnn,1]) and (l=tbl[nnn,2])) then {pour qu'un point ne soit pas au dessus dun autre}
begin
kk:=random(38)*10+110;
ll:=random(28)*10+110;
end;
k:=random(38)*10+110;
l:=random(28)*10+110;
for nnn:=50 to 150 do
if ((x=k) and (y=l)) or ((k=tbl[nnn,1]) and (l=tbl[nnn,2])) then {pour qu'un point ne soit pas au dessus dun autre}
begin
k:=random(38)*10+110;
l:=random(28)*10+110;
end;
if (tc mod 15 = lightgray) or (tc mod 15 = white) or (tc mod 15= black) then
begin
inc(tc);
end;
setfillstyle(1,white);
setcolor(white);
fillellipse(k,l,4,4);
setfillstyle(1, tc mod 15);
setcolor(tc mod 15);
fillellipse(k,l,2,2);
inc(points);
str(points,p); {transforme integer en string}
{setcolor(white);
setfillstyle(1,white); {pour afficher le score} {
fillellipse(55,55,40,20);
textcolor(red);
setcolor(red);
setfillstyle(2,yellow);
settextstyle(1,0,2);
outtextxy(40,40,p); }
if (tbl[x1,1]=0) and (tbl[x1,2]=0) then
begin {pour cree des segment de serpent}
tbl[x1,1]:=x; {coordonne de la tete}
tbl[x1,2]:=y;
end
else
x1:=x1+1;
if (tbl[x1,1]=0) and (tbl[x1,2]=0) then
begin
tbl[x1,1]:=tbl[x1-1,1];
tbl[x1,2]:=tbl[x1-1,2];
end
end else
begin
r:=140;
repeat
dec(r);
setcolor(lightgray);
setfillstyle(1,lightgray);
if (tbl[r,1]<>0) and (tbl[r,2]<>0) then {pour effacer la 2e partie}
for aa:=(tbl[r,2]-5) to(tbl[r,2]+5) do
begin
for bb:=(tbl[r,1]-5) to (tbl[r,1]+5) do
begin
setcolor((bb*aa)mod(3)+9);
line(bb,aa,bb,aa);
end;
end;
until (tbl[r,1]<>0) or (r<50) ;
{delay(00);}
if (r<50) then
begin
setcolor(lightgray);
setfillstyle(1,lightgray);
for aa:=(y-5) to(y+5) do
begin
for bb:=(x-5) to (x+5) do
begin
setcolor((bb*aa)mod(3)+9);
line(bb,aa,bb,aa);
end;
end;
end;
end;
end;
procedure avant2;
label pointnoir;
var n, aa, bb:integer;
begin
{ for n:=50 to 150 do }
if ((xx=k) and (yy=l)) then {met un nouveau point si celui ci est mange}
begin
slt:=2;
inc(tc);
if ((points mod 10) = 0) and (points<>0) then
begin
d1:=d1-5;
if d1<=0 then d1:=5;
pointnoir:
kk:=random(38)*10+110;
ll:=random(28)*10+110;
for
n:= 1 to 500 do
if ((xx=kk) and (yy=ll)) or ((kk=tbl2[n,1]) and (ll=tbl2[n,2])) then
goto pointnoir;
{pour qu'un point ne soit pas au dessus dun autre}
n:=551 ;
repeat
dec(n);
until tbl2[n,1]=0;
tbl2[n,1]:=kk;
tbl2[n,2]:=ll;
setcolor(black);
setfillstyle(1,black);
fillellipse(kk,ll,4,4);
end;
for n:=550 to 501 do
kk:=random(38)*10+110;
ll:=random(28)*10+110;
for n:=50 to 150 do
if ((xx=k) and (yy=l)) or ((k=tbl2[n,1]) and (l=tbl2[n,2])) then {pour qu'un point ne soit pas au dessus dun autre}
begin
kk:=random(38)*10+110;
ll:=random(28)*10+110;
end;
k:=random(38)*10+110;
l:=random(28)*10+110;
for n:=50 to 150 do
if ((xx=k) and (yy=l)) or ((k=tbl2[n,1]) and (l=tbl2[n,2])) then {pour qu'un point ne soit pas au dessus dun autre}
begin
k:=random(38)*10+110;
l:=random(28)*10+110;
end;
if (tc2 mod 15 = lightgray) or (tc2 mod 15 = white) or (tc2 mod 15= black) then
begin
inc(tc2);
end;
setfillstyle(1,white);
setcolor(white);
fillellipse(k,l,4,4);
setfillstyle(1, tc2 mod 15);
setcolor(tc2 mod 15);
fillellipse(k,l,2,2);
inc(points);
str(points,p); {transforme integer en string}
if (tbl2[xx1,1]=0) and (tbl2[xx1,2]=0) then
begin {pour cree des segment de serpent}
tbl2[xx1,1]:=xx; {coordonne de la tete}
tbl2[xx1,2]:=yy;
end
else
xx1:=xx1+1;
if (tbl2[xx1,1]=0) and (tbl2[xx1,2]=0) then
begin
tbl2[xx1,1]:=tbl2[xx1-1,1];
tbl2[xx1,2]:=tbl2[xx1-1,2];
end
end else
begin
r:=400;
repeat
dec(r);
setcolor(lightgray);
setfillstyle(1,lightgray);
if (tbl2[r,1]<>0) and (tbl2[r,2]<>0) then {pour effacer la 2e partie}
for aa:=(tbl2[r,2]-5) to(tbl2[r,2]+5) do
begin
for bb:=(tbl2[r,1]-5) to (tbl2[r,1]+5) do
begin
setcolor((bb*aa)mod(3)+9);
line(bb,aa,bb,aa);
end;
end;
until (tbl2[r,1]<>0) or (r<50) ;
{delay(00);}
if (r<50) then
begin
setcolor(lightgray);
setfillstyle(1,lightgray);
for aa:=(yy-5) to(yy+5) do
begin
for bb:=(xx-5) to (xx+5) do
begin
setcolor((bb*aa)mod(3)+9);
line(bb,aa,bb,aa);
end;
end;
end;
end;
end;
procedure apres;
label apresl; {ecrit la nouvelle tete}
var x3: integer;
begin
if ((x=k) and (y=l)) then
inc(ttc);
if (ttc mod 15 = lightgray) or (ttc mod 15 = white) or (ttc mod 15= black) then
begin
inc(ttc);
end;
apresl:
setcolor(ttc mod 15);
setfillstyle(1,ttc mod 15);
fillellipse(x,y,5,5);
end;
procedure apres2;
label apresl2; {ecrit la nouvelle tete}
begin
if ((xx=k) and (yy=l)) then
inc(ttc2);
if (ttc2 mod 15 = lightgray) or (ttc2 mod 15 = white) or (ttc2 mod 15= black) then
begin
inc(ttc2);
end;
apresl2:
setcolor(ttc2 mod 15);
setfillstyle(1,ttc2 mod 15);
fillellipse(xx,yy,5,5);
end;
procedure mur; {retourner de l'autre cote apres avoir toucher un mur}
begin
if x>490 then x:=110;
if x<110 then x:=490;
if y<110 then y:=390;
if y>390 then y:=110;
end;
procedure mur2; {retourner de l'autre cote apres avoir toucher un mur}
begin
if xx>490 then xx:=110;
if xx<110 then xx:=490;
if yy<110 then yy:=390;
if yy>390 then yy:=110;
end;
procedure serpent;
var x3: integer;
begin
for x3:=150 downto 51 do
if (tbl[x3,1]<>0) and (tbl[x3,2]<>0) then
begin
tbl[x3,1]:=tbl[x3-1,1];
tbl[x3,2]:=tbl[x3-1,2];
end;
if (tbl[50,1]<>0) and (tbl[50,2]<>0) then
begin
tbl[50,1]:=x;
tbl[50,2]:=y;
end;
if f=1 then
begin
inc(d);
inc(f);
end;
end;
procedure serpent2;
var xx3: integer;
begin
for xx3:=150 downto 51 do
if (tbl2[xx3,1]<>0) and (tbl2[xx3,2]<>0) then
begin
tbl2[xx3,1]:=tbl2[xx3-1,1];
tbl2[xx3,2]:=tbl2[xx3-1,2];
end;
if (tbl2[50,1]<>0) and (tbl2[50,2]<>0) then
begin
tbl2[50,1]:=xx;
tbl2[50,2]:=yy;
end;
if f=1 then
begin
inc(d);
inc(f);
end;
end;
{-----------------------------}
begin
x1:=50;
xx1:=50;
d1:=57;
closegraph;
pilote:=detect;
initgraph(pilote, mode, 'M:/BGI');
setbkcolor(darkgray);
begin
for aa:=1 to 1000 do
begin
for bb:=1 to 1000 do
begin
setcolor((aa*bb)mod(3)+7);
line(bb,aa,bb,aa);
end;
end;
end;
begin
for aa:=1 to 1000 do
begin
for bb:=1 to 1000 do
begin
setcolor((aa*bb)mod(3)+9);
if (bb>94) and (bb<506) and (aa>94) and (aa<406) then
line(bb,aa,bb,aa);
end;
end;
settextstyle(0,0,2);
textcolor(red);
end;
rectangle(95,95,505,405) ;
setfillstyle(1,lightgray);
{bar(95,95,505,405); }
{
for aa:=1 to 1000 do
begin
for bb:=1 to 1000 do
begin
setcolor(lightgray);
if (bb>505) or (bb<95) or (aa>405) or (aa<95) then
line(bb,aa,bb,aa);
end;
end; }
for ccc:=1 to 250 do
for v:=1 to 2 do
tbl[ccc,v]:=0;
ttc:=blue;
tc:=green;
ttc2:=blue;
tc2:=green;
randomize;
k:=random(38)*10+110;
l:=random(28)*10+110;
setcolor(white);
setfillstyle(1,white);
fillellipse(k,l,4,4);
setfillstyle(1,green);
setcolor(green);
fillellipse(k,l,2,2);
setcolor(blue);
setfillstyle(1,blue);
x:=200;
y:=200;
fillellipse(x,y,5,5);
xx:=350;
yy:=350;
fillellipse(xx,yy,5,5);
d:=0;
f:=1;
g:=1;
grosragout:=0;
a:='D';
b:='3';
repeat
inc(grosragout);
debut1:
bb:=1 ;
repeat
if (keypressed) and (a<>'M') then
begin
c:=upcase(readkey);
case c of
'W': begin if a<>'S' then prea:='W'; end;
'A': begin if a<>'D' then prea:='A'; end;
'S': begin if a<>'W' then prea:='S'; end;
'D': begin if a<> 'A' then prea:='D'; end;
'M': a:='M';
end;
end;
until (not keypressed) ;
case prea of
'W': begin if a<>'S' then a:='W'; end;
'A': begin if a<>'D' then a:='A'; end;
'S': begin if a<>'W' then a:='S'; end;
'D': begin if a<> 'A' then a:='D'; end;
'M': a:='M';
end;
if babouin<>2 then begin
if( abs(k-(xx-10))<abs(k-xx)) and (bbc<>'3') then
b:='1'else
if (abs(l-(yy+10))<abs(l-yy)) and (bbc<>'5') then
b:='2' else
if (abs(l-(yy-10))<abs(l-yy)) and (bbc<>'2') then
b:='5' else
if (bbc<>'1') then
b:='3';
end;
babouin:=1;
for nn:=50 to 150 do
begin
if (((abs(xx-tbl2[nn+2,1])<=(10)) and ((abs(yy-tbl2[nn+2,2]))<=10))) then
begin
babouin:=2;
case b of
'1': if xx-10=tbl2[nn,1] then if bbc<>'5' then b:='2';
'2': if yy+10=tbl2[nn,2] then if bbc<>'1' then b:='3';
'3': if xx+10=tbl2[nn,1] then if bbc<>'2' then b:='5';
'5': if yy-10=tbl2[nn,2] then if bbc<>'3' then b:='1';
end;
case b of
'1': if xx-10=tbl2[nn,1] then if bbc<>'5' then b:='2';
'2': if yy+10=tbl2[nn,2] then if bbc<>'1' then b:='3';
'3': if xx+10=tbl2[nn,1] then if bbc<>'2' then b:='5';
'5': if yy-10=tbl2[nn,2] then if bbc<>'3' then b:='1';
end;
case b of
'1': if xx-10=tbl2[nn,1] then if bbc<>'5' then b:='2';
'2': if yy+10=tbl2[nn,2] then if bbc<>'1' then b:='3';
'3': if xx+10=tbl2[nn,1] then if bbc<>'2' then b:='5';
'5': if yy-10=tbl2[nn,2] then if bbc<>'3' then b:='1';
end;
end;
end;
begin
for nn:=50 to 150 do
if (abs(xx-tbl[nn,1])<=20) and (abs(yy-tbl[nn,2])<=20) then
{begin
if ((abs(tbl[nn,1]-(xx-10))>(k-yy))) and (b<>'3') then
b:='1'else
if ((abs(tbl[nn,2]-(yy+10))>abs(l-yy))) and (b<>'5') then
b:='2' else
if ((abs(l-(tbl[nn,2]-10))>abs(l-yy))) and (b<>'2') then
b:='5' else
if b<>'1' then
b:='3';
end;}
bb:=0;
end;
case b of
'1': if bbc<>'3' then bbc:=b;
'2': if bbc<>'5' then bbc:=b;
'3': if bbc<>'1' then bbc:=b;
'5': if bbc<>'2' then bbc:=b;
end;
points:=0 ;
if grosragout= 8 then grosragout:=0;
goujat:=2;
case a of
'W':
begin
inc(z);
begin
wl:
begin
avant;
serpent;
y:=y-10 ;
mur;
apres;
delay(d1);
mort;
end;
annule;
{ a:='O';
repeat
c:=upcase(readkey);
case c of
'W': a:='W';
'A': a:='A';
'D': a:='D';
end;
until (a<>'O') ;
}
end;
end;
'A':
begin
inc(z);
begin
al:
if (x>100) and (x<500) and (y>100) and (y<500) then
begin
avant;
serpent;
x:=x-10;
mur;
apres;
delay(d1);
mort;
end
else
begin
z:=1000;
inc(x);
end;
annule;
{a:='O';
repeat
c:=upcase(readkey);
case c of
'W': a:='W';
'A': a:='A';
'S': a:='S';
end;
until (a<>'O') ;
}
end;
end;
'S':
begin
inc(z);
begin
sl:
if (x>100) and (x<500) and (y>100) and (y<500) then
begin
avant;
serpent;
y:=y+10;
mur;
apres;
delay(d1);
mort;
end
else
begin
z:=1000;
dec(y);
end;
annule;
{ a:='O';
repeat
c:=upcase(readkey);
case c of
'A': a:='A';
'S': a:='S';
'D': a:='D';
end;
until (a<>'O') ;
}
end;
end;
'D':
begin
inc(z);
begin
dl:
if (x>100) and (x<500) and (y>100) and (y<500) then
begin
avant;
serpent;
x:=x+10;
mur;
apres;
delay(d1);
mort;
end
else
begin
z:=1000;
dec(x);
end;
annule;
{ a:='O';
repeat
c:=upcase(readkey);
case c of
'W': a:='W';
'S': a:='S';
'D': a:='D';
end;
until (a<>'O') ;
}
end;
end;
end;
case bbc of
'5':
if bb<>0 then
begin
inc(bb);
inc(z);
begin
l5:
begin
avant2;
serpent2;
yy:=yy-10 ;
mur2;
apres2;
delay(d1);
mort2;
end;
annule;
{
b:='O';
repeat
c:=upcase(readkey);
case c of
'1': b:='1';
'3': b:='3';
'5': b:='5';
end;
until (b<>'O') ;
}
end;
end;
'1':
if bb<>0 then
begin
inc(bb);
inc(z);
begin
l1:
if (x>100) and (x<500) and (y>100) and (y<500) then
begin
avant2;
serpent2;
xx:=xx-10;
mur2;
apres2;
delay(d1);
mort2;
end
else
begin
z:=1000;
inc(x);
end;
annule;
{
b:='O';
repeat
c:=upcase(readkey);
case c of
'1': b:='1';
'2': b:='2';
'5': b:='5';
end;
until (b<>'O') ;
}
end;
end;
'2':
if bb<>0 then
begin
inc(bb);
inc(z);
begin
l2:
if (x>100) and (x<500) and (y>100) and (y<500) then
begin
avant2;
serpent2;
yy:=yy+10;
mur2;
apres2;
delay(d1);
mort2;
end
else
begin
z:=1000;
dec(y);
end;
annule;
{
b:='O';
repeat
c:=upcase(readkey);
case c of
'1': b:='1';
'2': b:='2';
'3': b:='3';
end;
until (b<>'O');
}
end;
end;
'3':
if bb<>0 then
begin
inc(bb);
inc(z);
begin
l3:
if (x>100) and (x<500) and (y>100) and (y<500) then
begin
avant2;
serpent2;
xx:=xx+10;
mur2;
apres2;
delay(d1);
mort2;
end
else
begin
z:=1000;
dec(x);
end;
annule;
{
b:='O';
repeat
c:=upcase(readkey);
case c of
'2': b:='2';
'3': b:='3';
'5': b:='5';
end;
until (b<>'O');
}
end;
end;
end;
until a='M' ;
closegraph;
end;
Procedure fin;
label qwerty;
begin
setbkcolor(cyan);
setfillstyle(1,white) ;
setcolor(green);
y:=1;
for x:=141 to 300 do
begin
n:=round(20*sin(x/30));
fillellipse(x,n+50,y,y);
if x mod 10 = 0 then inc(y);
end;
for x:=300 to 700 do
begin
n:=round(20*sin(x/30));
fillellipse(x,n+50,17,17);
end;
y:=1;
for x:=499 downto 341 do
begin
n:=round(20*sin(x/30));
fillellipse(x,n+430,y,y);
if x mod 10 = 0 then inc(y);
end;
for x:=340 downto -100 do
begin
n:=round(20*sin(x/30));
fillellipse(x,n+430,17,17);
end;
y:=1;
for x:=141 to 300 do
begin
n:=round(20*sin(x/30));
fillellipse(n+590,x,y,y);
if x mod 10 = 0 then inc(y);
end;
for x:=300 to 700 do
begin
n:=round(20*sin(x/30));
fillellipse(n+590,x,17,17);
end;
y:=1;
for x:=499 downto 341 do
begin
n:=round(20*sin(x/30));
fillellipse(n+50,x-160,y,y);
if x mod 10 = 0 then inc(y);
end;
for x:=340 downto -100 do
begin
n:=round(20*sin(x/30));
fillellipse(n+50,x-160,17,17);
end;
settextstyle(0,0,2);
setcolor(blue);
outtextxy(120,160,'Merci d''avoir utilise');
outtextxy(155,230,'notre programme!!!');
settextstyle(5,0,8);
setcolor(red);
outtextxy(165,280,'Au revoir!');
delay(2500);
cleardevice;
setbkcolor(darkgray);
for kk:=500 downto 0 do
begin
setfillstyle(0,8);
setcolor(8);
bar(0,0,640,480);
settextstyle(0,0,2);
setcolor(white);
outtextxy(160,kk,'Programmeurs');
outtextxy(140,kk+25,'Hugo Latendresse');
outtextxy(140,kk+50,'Vincent Giroux');
outtextxy(160,kk+100,'Artistes');
outtextxy(140,kk+125,'Vincent Giroux');
outtextxy(140,kk+150,'Hugo Latendresse');
outtextxy(160,kk+200,'Directeurs de productions');
outtextxy(140,kk+225,'Hugo Latendresse');
outtextxy(140,kk+250,'Vincent Giroux');
outtextxy(160,kk+300,'Directeurs artistiques');
outtextxy(140,kk+325,'Vincent Giroux');
outtextxy(140,kk+350,'Hugo Latendresse');
delay(2);
if keypressed then goto qwerty
end;
qwerty:
end;
procedure instruction1;
begin
setbkcolor(cyan);
setfillstyle(1,white) ;
setcolor(green);
y:=1;
for x:=141 to 300 do
begin
n:=round(20*sin(x/30));
fillellipse(x,n+50,y,y);
if x mod 10 = 0 then inc(y);
end;
for x:=300 to 700 do
begin
n:=round(20*sin(x/30));
fillellipse(x,n+50,17,17);
end;
y:=1;
for x:=499 downto 341 do
begin
n:=round(20*sin(x/30));
fillellipse(x,n+430,y,y);
if x mod 10 = 0 then inc(y);
end;
for x:=340 downto -100 do
begin
n:=round(20*sin(x/30));
fillellipse(x,n+430,17,17);
end;
y:=1;
for x:=141 to 300 do
begin
n:=round(20*sin(x/30));
fillellipse(n+590,x,y,y);
if x mod 10 = 0 then inc(y);
end;
for x:=300 to 700 do
begin
n:=round(20*sin(x/30));
fillellipse(n+590,x,17,17);
end;
y:=1;
for x:=499 downto 341 do
begin
n:=round(20*sin(x/30));
fillellipse(n+50,x-160,y,y);
if x mod 10 = 0 then inc(y);
end;
for x:=340 downto -100 do
begin
n:=round(20*sin(x/30));
fillellipse(n+50,x-160,17,17);
end;
setcolor(red);
settextstyle(0,0,2);
outtextxy(120,110,'Mode 1 joueur');
settextstyle(0,0,1);
outtextxy(120,135,'Dans ce mode vous jouez seul.');
outtextxy(120,150,'Votre but est de faire le plus de points.');
outtextxy(122,165,'Voici les regles de ce jeu.');
outtextxy(135,180,'-Deplacez vous grace aux touches w, a, s, d.');
outtextxy(135,195,'-Ramasser des pommes en les mangeant.');
outtextxy(135,210,'-Si vous atteignez un des cotes,');
outtextxy(145,225,'vous retournerez de l''autre cote.');
outtextxy(135,240,'-Si vous mangez une partie de votre');
outtextxy(145,255,'serpent, vous mourrez.');
outtextxy(135,270,'-A tout les 10 points, la vitesse augmente et');
outtextxy(145,285,'une roche apparait. Si vous la mangez vous mourrez.');
outtextxy(135,300,'-A la fin, vouz devrez repondre a plusieurs questions.');
outtextxy(135,315,'-Le temps pour repondre depend de votre pointage.');
outtextxy(135,330,'-Lorsque vous jouez, ne gardez pas la touche enfonce.');
outtextxy(120,345,'-Pendant le jeu, vous pouvez vous suicider grace a la touche M.');
readkey ;
cleardevice;
end;
procedure instruction2;
begin
setbkcolor(cyan);
setfillstyle(1,white) ;
setcolor(green);
y:=1;
for x:=141 to 300 do
begin
n:=round(20*sin(x/30));
fillellipse(x,n+50,y,y);
if x mod 10 = 0 then inc(y);
end;
for x:=300 to 700 do
begin
n:=round(20*sin(x/30));
fillellipse(x,n+50,17,17);
end;
y:=1;
for x:=499 downto 341 do
begin
n:=round(20*sin(x/30));
fillellipse(x,n+430,y,y);
if x mod 10 = 0 then inc(y);
end;
for x:=340 downto -100 do
begin
n:=round(20*sin(x/30));
fillellipse(x,n+430,17,17);
end;
y:=1;
for x:=141 to 300 do
begin
n:=round(20*sin(x/30));
fillellipse(n+590,x,y,y);
if x mod 10 = 0 then inc(y);
end;
for x:=300 to 700 do
begin
n:=round(20*sin(x/30));
fillellipse(n+590,x,17,17);
end;
y:=1;
for x:=499 downto 341 do
begin
n:=round(20*sin(x/30));
fillellipse(n+50,x-160,y,y);
if x mod 10 = 0 then inc(y);
end;
for x:=340 downto -100 do
begin
n:=round(20*sin(x/30));
fillellipse(n+50,x-160,17,17);
end;
setcolor(red);
settextstyle(0,0,2);
outtextxy(100,110,'Mode humain contre humain');
settextstyle(0,0,1);
outtextxy(120,135,'Dans ce mode vous jouez a deux.');
outtextxy(120,150,'Votre but est de faire plus de points que l''adversaire.');
outtextxy(122,165,'Voici les regles de ce jeu.');
outtextxy(135,180,'-Le joueur 1 se deplace grace aux touches w, a, s, d.');
outtextxy(135,195,'-Le joueur 2 se deplace grace aux touches 5, 1, 2, 3,');
outtextxy(135,210,' situees sur le pad numerique');
outtextxy(135,225,'-Ramassez des pommes en les mangeant.');
outtextxy(135,240,'-Si vous atteignez un des cotes,');
outtextxy(145,255,'vous retournerez de l''autre cote.');
outtextxy(135,270,'-Si vous mangez une partie de votre serpent ou celui de');
outtextxy(145,285,'votre adversaire, vous mourrez.');
outtextxy(135,300,'-Lorsque vous jouez, ne gardez pas la touche enfonce.');
outtextxy(135,315,'-Le premier joueur est situe en haut a gauche');
outtextxy(135,330,'-Le deuxieme joueur est situe en bas a droite.');
outtextxy(135,345,'-Dans ce mode, il n''y a pas de question a la fin.');
readkey ;
cleardevice;
end;
procedure instruction3;
begin
setbkcolor(cyan);
setfillstyle(1,white) ;
setcolor(green);
y:=1;
for x:=141 to 300 do
begin
n:=round(20*sin(x/30));
fillellipse(x,n+50,y,y);
if x mod 10 = 0 then inc(y);
end;
for x:=300 to 700 do
begin
n:=round(20*sin(x/30));
fillellipse(x,n+50,17,17);
end;
y:=1;
for x:=499 downto 341 do
begin
n:=round(20*sin(x/30));
fillellipse(x,n+430,y,y);
if x mod 10 = 0 then inc(y);
end;
for x:=340 downto -100 do
begin
n:=round(20*sin(x/30));
fillellipse(x,n+430,17,17);
end;
y:=1;
for x:=141 to 300 do
begin
n:=round(20*sin(x/30));
fillellipse(n+590,x,y,y);
if x mod 10 = 0 then inc(y);
end;
for x:=300 to 700 do
begin
n:=round(20*sin(x/30));
fillellipse(n+590,x,17,17);
end;
y:=1;
for x:=499 downto 341 do
begin
n:=round(20*sin(x/30));
fillellipse(n+50,x-160,y,y);
if x mod 10 = 0 then inc(y);
end;
for x:=340 downto -100 do
begin
n:=round(20*sin(x/30));
fillellipse(n+50,x-160,17,17);
end;
setcolor(red);
settextstyle(0,0,2);
outtextxy(100,110,'Mode humain contre ordinateur');
settextstyle(0,0,1);
outtextxy(120,135,'Dans ce mode vous jouez contre l''ordinateur');
outtextxy(120,150,'Votre but est de faire plus de points que l''adversaire.');
outtextxy(122,165,'Voici les regles de ce jeu:');
outtextxy(135,180,'-Le joueur 1 se deplace grace aux touches w, a, s, d.');
outtextxy(135,195,'-Ramasser des pommes en les mangeant.');
outtextxy(135,210,'-Si vous atteignez un des cotes,');
outtextxy(145,225,'vous retournerez de l''autre cote.');
outtextxy(135,240,'-Si vous mangez une partie de votre serpent ou celui de');
outtextxy(145,255,'votre adversaire, vous mourerez.');
outtextxy(135,270,'-Lorsque vous jouez, ne gardez pas la touche enfonce');
outtextxy(135,285,'-Dans ce mode, il n''y a pas de question a la fin.');
outtextxy(135,300,'-Votre serpent debute en-haut a gauche.');
outtextxy(120,315,'-Pendant le jeu, vous pouvez vous suicider grace a la touche M.');
readkey;
cleardevice;
end;
procedure difficulte;
label reponsel;
begin
setbkcolor(cyan);
setfillstyle(1,white) ;
setcolor(green);
y:=1;
for x:=141 to 300 do
begin
n:=round(20*sin(x/30));
fillellipse(x,n+50,y,y);
if x mod 10 = 0 then inc(y);
end;
for x:=300 to 700 do
begin
n:=round(20*sin(x/30));
fillellipse(x,n+50,17,17);
end;
y:=1;
for x:=499 downto 341 do
begin
n:=round(20*sin(x/30));
fillellipse(x,n+430,y,y);
if x mod 10 = 0 then inc(y);
end;
for x:=340 downto -100 do
begin
n:=round(20*sin(x/30));
fillellipse(x,n+430,17,17);
end;
y:=1;
for x:=141 to 300 do
begin
n:=round(20*sin(x/30));
fillellipse(n+590,x,y,y);
if x mod 10 = 0 then inc(y);
end;
for x:=300 to 700 do
begin
n:=round(20*sin(x/30));
fillellipse(n+590,x,17,17);
end;
y:=1;
for x:=499 downto 341 do
begin
n:=round(20*sin(x/30));
fillellipse(n+50,x-160,y,y);
if x mod 10 = 0 then inc(y);
end;
for x:=340 downto -100 do
begin
n:=round(20*sin(x/30));
fillellipse(n+50,x-160,17,17);
end;
setcolor(red);
settextstyle(0,0,2);
outtextxy(140,100,'Veuillez choisir votre');
outtextxy(145,130,'niveau de difficulte');
settextstyle(0,0,2);
setcolor(lightgray);
setfillstyle(1,lightgray);
textcolor(red);
bar(210,200,410,230);
bar(210,250,410,280);
bar(210,300,410,330);
setcolor(green);
outtextxy(217,210,'1: Limace');
outtextxy(217,260,'2: Couleuvre');
outtextxy(217,310,'3: Python');
reponsel:
reponsed:=upcase(readkey);
setfillstyle(1,darkgray) ;
setcolor(red);
case reponsed of
'1': begin
d1:=150;
bar(210,200,410,230);
outtextxy(217,210,'1: Limace');
end;
'2': begin
d1:=100;
bar(210,250,410,280);
outtextxy(217,260,'2: Couleuvre');
end;
'3': begin
d1:=50;
bar(210,300,410,330);
outtextxy(217,310,'3: Python');
end;
else goto reponsel;
end;
delay(1000);
cleardevice;
end;
procedure modejeu;
label modejeul;
begin
pilote:=detect;
initgraph(pilote,mode,'M:/BGI');
setbkcolor(cyan);
setfillstyle(1,white) ;
setcolor(green);
for x:=1 to 550 do
begin
tbl[x,1]:=0;
tbl[x,2]:=0;
tbl2[x,1]:=0;
tbl2[x,2]:=0;
end;
y:=1;
for x:=141 to 300 do
begin
n:=round(20*sin(x/30));
fillellipse(x,n+50,y,y);
if x mod 10 = 0 then inc(y);
end;
for x:=300 to 700 do
begin
n:=round(20*sin(x/30));
fillellipse(x,n+50,17,17);
end;
y:=1;
for x:=499 downto 341 do
begin
n:=round(20*sin(x/30));
fillellipse(x,n+430,y,y);
if x mod 10 = 0 then inc(y);
end;
for x:=340 downto -100 do
begin
n:=round(20*sin(x/30));
fillellipse(x,n+430,17,17);
end;
y:=1;
for x:=141 to 300 do
begin
n:=round(20*sin(x/30));
fillellipse(n+590,x,y,y);
if x mod 10 = 0 then inc(y);
end;
for x:=300 to 700 do
begin
n:=round(20*sin(x/30));
fillellipse(n+590,x,17,17);
end;
y:=1;
for x:=499 downto 341 do
begin
n:=round(20*sin(x/30));
fillellipse(n+50,x-160,y,y);
if x mod 10 = 0 then inc(y);
end;
for x:=340 downto -100 do
begin
n:=round(20*sin(x/30));
fillellipse(n+50,x-160,17,17);
end;
setcolor(red);
settextstyle(0,0,2);
outtextxy(160,120,'Veuillez choisir le');
outtextxy(165,150,'mode de jeu desire');
settextstyle(0,0,2);
setcolor(lightgray);
setfillstyle(1,lightgray);
textcolor(red);
bar(90,200,530,230);
bar(90,250,530,280);
bar(90,300,530,330);
bar(90,350,530,380);
setcolor(green);
outtextxy(97,210,'1: Un joueur');
outtextxy(97,260,'2: Humain contre humain');
outtextxy(97,310,'3: Humain contre ordinateur');
outtextxy(97,360,'x: Quitter');
modejeul:
reponsemodejeu:=upcase(readkey);
setfillstyle(1,darkgray) ;
setcolor(red);
case reponsemodejeu of
'1': begin
d1:=150;
bar(90,200,530,230);
outtextxy(97,210,'1: Un joueur');
end;
'2': begin
d1:=110;
bar(90,250,530,280);
outtextxy(97,260,'2: Humain contre humain');
end;
'3': begin
d1:=70;
bar(90,300,530,330);
outtextxy(97,310,'3: Humain contre ordinateur');
end;
'X': begin
bar(90,350,530,380);
outtextxy(97,360,'x: Quitter');
end;
else goto modejeul;
end;
delay(1000);
cleardevice;
end;
procedure chargement;
begin
pilote:=detect;
initgraph(pilote,mode,'M:/BGI');
randomize;
setcolor(red);
settextstyle(0,0,2);
outtextxy(220,190,'Chargement');
delay(2000);
setbkcolor(cyan);
setfillstyle(1,cyan);
setcolor(darkgray);
rectangle(219,244,371,256);
setfillstyle(1,red);
setcolor(red);
for n:=220 to 368 do
begin
bar(n,245,n+2,255);
delay(random(60));
end;
delay(1000);
cleardevice;
end;
Procedure demandedenom; {Les procedures sont des sous-programmes places avant le debut du programme.
Lorsque le programme, lors de son execution, lit le nom dune procedure, il fait les actions ecrites dans la procedure}
Begin
clrscr;
gotoxy(20,10);
write('Bonjour, quel est votre nom? '); {writeln(): cela ecrit ce qui est demande, puis change de ligne}
readln(nom1); {readln(): cela donne a la variable precisee entre parenthese la valeur ecrites par lutilisateur}
End; {end;: cest ainsi que se termine une procedure.}
Procedure bienvenue;
begin;
setbkcolor(cyan);
setfillstyle(1,white) ;
setcolor(green);
y:=1;
for x:=141 to 300 do
begin
n:=round(20*sin(x/30));
fillellipse(x,n+50,y,y);
if x mod 10 = 0 then inc(y);
end;
for x:=300 to 700 do
begin
n:=round(20*sin(x/30));
fillellipse(x,n+50,17,17);
end;
y:=1;
for x:=499 downto 341 do
begin
n:=round(20*sin(x/30));
fillellipse(x,n+430,y,y);
if x mod 10 = 0 then inc(y);
end;
for x:=340 downto -100 do
begin
n:=round(20*sin(x/30));
fillellipse(x,n+430,17,17);
end;
y:=1;
for x:=141 to 300 do
begin
n:=round(20*sin(x/30));
fillellipse(n+590,x,y,y);
if x mod 10 = 0 then inc(y);
end;
for x:=300 to 700 do
begin
n:=round(20*sin(x/30));
fillellipse(n+590,x,17,17);
end;
y:=1;
for x:=499 downto 341 do
begin
n:=round(20*sin(x/30));
fillellipse(n+50,x-160,y,y);
if x mod 10 = 0 then inc(y);
end;
for x:=340 downto -100 do
begin
n:=round(20*sin(x/30));
fillellipse(n+50,x-160,17,17);
end;
setcolor(red);
settextstyle(1,0,6);
outtextxy(180,100,'SNAKE 1.0');
delay(1000);
settextstyle(1,0,2);
outtextxy(110,210,'Bienvenue dans notre programme,');
delay(700);
outtextxy(480,210,nom1);
settextstyle(0,0,1);
delay(1000);
outtextxy(170,350,'Appuyez sur n''importe quelle touche');
readkey;
cleardevice;
end;
procedure snake10;
label wl, al, sl, dl;
{A FAIRE:
pouvoir sortir des le debut
menu au debut
faire le pointage souaeg avec les carres verts en haut a gauche et en bas a droite
faire du son quand on meurt
}
procedure annule;
begin
end;
Procedure mort;
begin
for g:=50 to 550 do
begin
if (x=tbl[g,1]) and (y=tbl[g,2]) then
begin
setcolor(lightgreen);
setfillstyle(1,lightgreen);
bar(384, 405, 505, 417 );
textcolor(darkgray);
setcolor(darkgray);
setfillstyle(2,yellow);
settextstyle(0,0,1);
outtextxy(385,405,'Vous etes mort');
delay(2000);
a:='M';
end;
end;
end;
procedure avant;
label pointnoir;
begin
if ((x=k) and (y=l)) then {met un nouveau point si celui ci est mange}
begin
inc(rr);
slt:=2;
inc(tc);
if ((points mod 10) = 0) and (points<>0) then
begin
d1:=d1-5;
if d1<=0 then d1:=5;
pointnoir:
kk:=random(38)*10+110;
ll:=random(28)*10+110;
for
n:= 1 to (55+rr) do
if ((x=kk) and (y=ll)) or ((kk=tbl[n,1]) and (ll=tbl[n,2])) then
goto pointnoir;
{pour qu'un point ne soit pas au dessus dun autre}
n:=551 ;
repeat
dec(n);
until tbl[n,1]=0;
tbl[n,1]:=kk;
tbl[n,2]:=ll;
setcolor(black);
setfillstyle(1,black);
fillellipse(kk,ll,4,4);
end;
{ for n:=550 to 501 do
kk:=random(38)*10+110;
ll:=random(28)*10+110;
for n:=50 to 500 do
if ((x=k) and (y=l)) or ((k=tbl[n,1]) and (l=tbl[n,2])) then {pour qu'un point ne soit pas au dessus dun autre}
{ begin
kk:=random(38)*10+110;
ll:=random(28)*10+110;
end; }
k:=random(38)*10+110;
l:=random(28)*10+110;
for n:=50 to (rr+55) do
if ((x=k) and (y=l)) or ((k=tbl[n,1]) and (l=tbl[n,2])) then {pour qu'un point ne soit pas au dessus dun autre}
begin
k:=random(38)*10+110;
l:=random(28)*10+110;
end;
if (tc mod 15 = lightgray) or (tc mod 15 = white) or (tc mod 15= black) then
begin
inc(tc);
end;
setfillstyle(1,white);
setcolor(white);
fillellipse(k,l,4,4);
setfillstyle(1, tc mod 15);
setcolor(tc mod 15);
fillellipse(k,l,2,2);
inc(points);
str(points,p); {transforme integer en string}
setcolor(lightgreen);
setfillstyle(1,lightgreen); {pour afficher le score}
bar(219, 83, 250, 95 );
textcolor(darkgray);
setcolor(darkgray);
setfillstyle(2,yellow);
settextstyle(0,0,1);
outtextxy(220,85,p);
if (tbl[x1,1]=0) and (tbl[x1,2]=0) then
begin {pour cree des segment de serpent}
tbl[x1,1]:=x; {coordonne de la tete}
tbl[x1,2]:=y;
end
else
x1:=x1+1;
if (tbl[x1,1]=0) and (tbl[x1,2]=0) then
begin
tbl[x1,1]:=tbl[x1-1,1];
tbl[x1,2]:=tbl[x1-1,2];
end
end else
begin
r:=rr;
repeat
dec(r);
setcolor(lightgray);
setfillstyle(1,lightgray);
if (tbl[r,1]<>0) and (tbl[r,2]<>0) then {pour effacer la 2e partie}
for aa:=(tbl[r,2]-5) to(tbl[r,2]+5) do
begin
for bb:=(tbl[r,1]-5) to (tbl[r,1]+5) do
begin
setcolor((bb*aa)mod(3)+9);
line(bb,aa,bb,aa);
end;
end;
until (tbl[r,1]<>0) or (r<50) ;
{delay(00);}
if (r<50) then
begin
setcolor(lightgray);
setfillstyle(1,lightgray);
for aa:=(y-5) to(y+5) do
begin
for bb:=(x-5) to (x+5) do
begin
setcolor((bb*aa)mod(3)+9);
line(bb,aa,bb,aa);
end;
end;
end;
end;
end;
procedure apres;
label apresl; {ecrit la nouvelle tete}
begin
if ((x=k) and (y=l)) then
inc(ttc);
if (ttc mod 15 = lightgray) or (ttc mod 15 = white) or (ttc mod 15= black) then
begin
inc(ttc);
end;
apresl:
setcolor(ttc mod 15);
setfillstyle(1,ttc mod 15);
fillellipse(x,y,5,5);
end;
procedure mur; {retourner de l'autre cote apres avoir toucher un mur}
begin
if x>490 then x:=110;
if x<110 then x:=490;
if y<110 then y:=390;
if y>390 then y:=110;
end;
procedure serpent;
begin
for x3:=(rr+5) downto 51 do
if (tbl[x3,1]<>0) and (tbl[x3,2]<>0) then
begin
tbl[x3,1]:=tbl[x3-1,1];
tbl[x3,2]:=tbl[x3-1,2];
end;
if (tbl[50,1]<>0) and (tbl[50,2]<>0) then
begin
tbl[50,1]:=x;
tbl[50,2]:=y;
end;
if f=1 then
begin
inc(d);
inc(f);
end;
end; {-----------------------------}
begin
x1:=50;
rr:=55;
points:=0;
{debut du program}
pilote:=detect;
initgraph(pilote, mode, 'M:/BGI');
setbkcolor(darkgray);
begin
for aa:=1 to 1000 do
begin
for bb:=1 to 1000 do
begin
setcolor((aa*bb)mod(3)+7);
line(bb,aa,bb,aa);
end;
end;
end;
begin
for aa:=1 to 1000 do
begin
for bb:=1 to 1000 do
begin
setcolor((aa*bb)mod(3)+9);
if (bb>94) and (bb<506) and (aa>94) and (aa<406) then
line(bb,aa,bb,aa);
end;
end;
end;
rectangle(95,95,505,405) ;
setfillstyle(1,lightgreen);
bar(95,83,250,95);
settextstyle(0,0,1);
textcolor(darkgray);
setcolor(darkgray);
outtextxy(96,85,'Votre pointage:');
setfillstyle(1,lightgray);
{bar(95,95,505,405); }
{
for aa:=1 to 1000 do
begin
for bb:=1 to 1000 do
begin
setcolor(lightgray);
if (bb>505) or (bb<95) or (aa>405) or (aa<95) then
line(bb,aa,bb,aa);
end;
end; }
for ccc:=1 to 250 do
for v:=1 to 2 do
tbl[ccc,v]:=0;
ttc:=blue;
tc:=green;
randomize;
k:=random(38)*10+110;
l:=random(28)*10+110;
setcolor(white);
setfillstyle(1,white);
fillellipse(k,l,4,4);
setfillstyle(1,green);
setcolor(green);
fillellipse(k,l,2,2);
setcolor(blue);
setfillstyle(1,blue);
x:=200;
y:=200;
fillellipse(x,y,5,5);
repeat
a:=upcase(readkey);
until (a='W') or (a='A') or (a='S') or (a='D') or (a='M');
d:=0;
f:=1;
g:=1;
repeat
case a of
'W':
begin
inc(z);
begin
wl:
repeat
begin
avant;
serpent;
y:=y-10 ;
mur;
apres;
delay(d1);
mort;
end
until (keypressed) or (a='M');
if a<> 'M' then a:=upcase(readkey);
annule;
if (a<>'A') and (a<>'D') and (a<>'M') then goto wl;
end;
end;
'A':
begin
inc(z);
begin
al:
repeat
if (x>100) and (x<500) and (y>100) and (y<500) then
begin
avant;
serpent;
x:=x-10;
mur;
apres;
delay(d1);
mort;
end
else
begin
z:=1000;
inc(x);
end;
until (keypressed) or (a='M');
if a<>'M' then a:=upcase(readkey);
annule;
if (a<>'W') and (a<>'S') and (a<>'M') then goto al;
end;
end;
'S':
begin
inc(z);
begin
sl:
repeat
if (x>100) and (x<500) and (y>100) and (y<500) then
begin
avant;
serpent;
y:=y+10;
mur;
apres;
delay(d1);
mort;
end
else
begin
z:=1000;
dec(y);
end;
until (keypressed) or (a='M');
if a<>'M' then a:=upcase(readkey);
annule;
if (a<>'A') and (a<>'D') and (a<>'M') then goto sl;
end;
end;
'D':
begin
inc(z);
begin
dl:
repeat
if (x>100) and (x<500) and (y>100) and (y<500) then
begin
avant;
serpent;
x:=x+10;
mur;
apres;
delay(d1);
mort;
end
else
begin
z:=1000;
dec(x);
end;
until (keypressed) or (a='M');
if a<>'M' then a:=upcase(readkey);
annule;
if (a<>'W') and (a<>'S') and (a<>'M') then goto dl;
end;
end;
end;
until (a='M');
closegraph;
end;
procedure snake222;
label wl, al, sl, dl,l5,l1,l2,l3, debut1;
{A FAIRE:
enlever laffichage de points
}
procedure annule;
begin
end;
Procedure mort;
begin
if (x=xx) and (y=yy) then
begin
setcolor(lightgreen);
setfillstyle(1,lightgreen);
bar(384, 405, 505, 415 );
textcolor(darkgray);
setcolor(darkgray);
setfillstyle(2,yellow);
settextstyle(0,0,1);
outtextxy(385,406,'Match nul!');
delay(2000);
a:='M';
end;
for g:=50 to 550 do
begin
if ((x=tbl[g,1]) and (y=tbl[g,2])) or ((x=tbl2[g,1]) and (y=tbl2[g,2])) then
begin
setcolor(lightgreen);
setfillstyle(1,lightgreen);
bar(350, 405, 505, 415 );
setcolor(yellow);
settextstyle(0,0,1);
textcolor(yellow);
outtextxy(351,406,nom1);
outtextxy(351,406,' est mort');
delay(2000);
setcolor(lightgreen);
setfillstyle(1,lightgreen);
bar(349, 405, 505, 417 );
setcolor(yellow);
settextstyle(0,0,1);
textcolor(red);
outtextxy(350,406,nom2);
outtextxy(351,406,' a gagne');
delay(3000);
a:='M';
end;
end;
end;
Procedure mort2;
begin
if (x=xx) and (y=yy) then
begin
setcolor(lightgreen);
setfillstyle(1,lightgreen);
bar(384, 405, 505, 415 );
textcolor(darkgray);
setcolor(darkgray);
setfillstyle(2,yellow);
settextstyle(0,0,1);
outtextxy(385,406,'Match nul!');
delay(2000);
a:='M';
end;
for g:=50 to 550 do
begin
if ((xx=tbl[g,1]) and (yy=tbl[g,2])) or ((xx=tbl2[g,1]) and (yy=tbl2[g,2])) then
begin
setcolor(lightgreen);
setfillstyle(1,lightgreen);
bar(350, 405, 505, 415 );
setcolor(yellow);
settextstyle(0,0,1);
textcolor(yellow);
outtextxy(351,406,nom2);
outtextxy(351,406,' est mort');
delay(2000);
setcolor(lightgreen);
setfillstyle(1,lightgreen);
bar(349, 405, 505, 417 );
setcolor(yellow);
settextstyle(0,0,1);
textcolor(red);
outtextxy(350,406,nom1);
outtextxy(351,406,' a gagne');
delay(3000);
a:='M';
end;
end;
end;
procedure avant;
label pointnoir;
begin
{for n:=50 to 150 do }
if ((x=k) and (y=l)) then {met un nouveau point si celui ci est mange}
begin
slt:=2;
inc(tc);
if ((points mod 10) = 0) and (points<>0) then
begin
d1:=d1-5;
if d1<=0 then d1:=5;
pointnoir:
kk:=random(38)*10+110;
ll:=random(28)*10+110;
for
n:= 1 to 500 do
if ((x=kk) and (y=ll)) or ((kk=tbl[n,1]) and (ll=tbl[n,2])) then
goto pointnoir;
{pour qu'un point ne soit pas au dessus dun autre}
n:=551 ;
repeat
dec(n);
until tbl[n,1]=0;
tbl[n,1]:=kk;
tbl[n,2]:=ll;
setcolor(black);
setfillstyle(1,black);
fillellipse(kk,ll,4,4) ;
end;
for n:=550 to 501 do
kk:=random(38)*10+110;
ll:=random(28)*10+110;
for n:=50 to 150 do
if ((x=k) and (y=l)) or ((k=tbl[n,1]) and (l=tbl[n,2])) then {pour qu'un point ne soit pas au dessus dun autre}
begin
kk:=random(38)*10+110;
ll:=random(28)*10+110;
end;
k:=random(38)*10+110;
l:=random(28)*10+110;
for n:=50 to 150 do
if ((x=k) and (y=l)) or ((k=tbl[n,1]) and (l=tbl[n,2])) then {pour qu'un point ne soit pas au dessus dun autre}
begin
k:=random(38)*10+110;
l:=random(28)*10+110;
end;
if (tc mod 15 = lightgray) or (tc mod 15 = white) or (tc mod 15= black) then
begin
inc(tc);
end;
setfillstyle(1,white);
setcolor(white);
fillellipse(k,l,4,4);
setfillstyle(1, tc mod 15);
setcolor(tc mod 15);
fillellipse(k,l,2,2);
inc(points);
str(points,p); {transforme integer en string}
{setcolor(white);
setfillstyle(1,white); {pour afficher le score} {
fillellipse(55,55,40,20);
textcolor(red);
setcolor(red);
setfillstyle(2,yellow);
settextstyle(1,0,2);
outtextxy(40,40,p); }
if (tbl[x1,1]=0) and (tbl[x1,2]=0) then
begin {pour cree des segment de serpent}
tbl[x1,1]:=x; {coordonne de la tete}
tbl[x1,2]:=y;
end
else
x1:=x1+1;
if (tbl[x1,1]=0) and (tbl[x1,2]=0) then
begin
tbl[x1,1]:=tbl[x1-1,1];
tbl[x1,2]:=tbl[x1-1,2];
end
end else
begin
r:=140;
repeat
dec(r);
setcolor(lightgray);
setfillstyle(1,lightgray);
if (tbl[r,1]<>0) and (tbl[r,2]<>0) then {pour effacer la 2e partie}
for aa:=(tbl[r,2]-5) to(tbl[r,2]+5) do
begin
for bb:=(tbl[r,1]-5) to (tbl[r,1]+5) do
begin
setcolor((bb*aa)mod(3)+9);
line(bb,aa,bb,aa);
end;
end;
until (tbl[r,1]<>0) or (r<50) ;
{delay(00);}
if (r<50) then
begin
setcolor(lightgray);
setfillstyle(1,lightgray);
for aa:=(y-5) to(y+5) do
begin
for bb:=(x-5) to (x+5) do
begin
setcolor((bb*aa)mod(3)+9);
line(bb,aa,bb,aa);
end;
end;
end;
end;
end;
procedure avant2;
label pointnoir;
begin
{ for n:=50 to 150 do }
if ((xx=k) and (yy=l)) then {met un nouveau point si celui ci est mange}
begin
slt:=2;
inc(tc);
if ((points mod 10) = 0) and (points<>0) then
begin
d1:=d1-5;
if d1<=0 then d1:=5;
pointnoir:
kk:=random(38)*10+110;
ll:=random(28)*10+110;
for
n:= 1 to 500 do
if ((xx=kk) and (yy=ll)) or ((kk=tbl2[n,1]) and (ll=tbl2[n,2])) then
goto pointnoir;
{pour qu'un point ne soit pas au dessus dun autre}
n:=551 ;
repeat
dec(n);
until tbl2[n,1]=0;
tbl2[n,1]:=kk;
tbl2[n,2]:=ll;
setcolor(black);
setfillstyle(1,black);
fillellipse(kk,ll,4,4);
end;
for n:=550 to 501 do
kk:=random(38)*10+110;
ll:=random(28)*10+110;
for n:=50 to 150 do
if ((xx=k) and (yy=l)) or ((k=tbl2[n,1]) and (l=tbl2[n,2])) then {pour qu'un point ne soit pas au dessus dun autre}
begin
kk:=random(38)*10+110;
ll:=random(28)*10+110;
end;
k:=random(38)*10+110;
l:=random(28)*10+110;
for n:=50 to 150 do
if ((xx=k) and (yy=l)) or ((k=tbl2[n,1]) and (l=tbl2[n,2])) then {pour qu'un point ne soit pas au dessus dun autre}
begin
k:=random(38)*10+110;
l:=random(28)*10+110;
end;
if (tc2 mod 15 = lightgray) or (tc2 mod 15 = white) or (tc2 mod 15= black) then
begin
inc(tc2);
end;
setfillstyle(1,white);
setcolor(white);
fillellipse(k,l,4,4);
setfillstyle(1, tc2 mod 15);
setcolor(tc2 mod 15);
fillellipse(k,l,2,2);
inc(points);
str(points,p); {transforme integer en string}
if (tbl2[xx1,1]=0) and (tbl2[xx1,2]=0) then
begin {pour cree des segment de serpent}
tbl2[xx1,1]:=xx; {coordonne de la tete}
tbl2[xx1,2]:=yy;
end
else
xx1:=xx1+1;
if (tbl2[xx1,1]=0) and (tbl2[xx1,2]=0) then
begin
tbl2[xx1,1]:=tbl2[xx1-1,1];
tbl2[xx1,2]:=tbl2[xx1-1,2];
end
end else
begin
r:=400;
repeat
dec(r);
setcolor(lightgray);
setfillstyle(1,lightgray);
if (tbl2[r,1]<>0) and (tbl2[r,2]<>0) then {pour effacer la 2e partie}
for aa:=(tbl2[r,2]-5) to(tbl2[r,2]+5) do
begin
for bb:=(tbl2[r,1]-5) to (tbl2[r,1]+5) do
begin
setcolor((bb*aa)mod(3)+9);
line(bb,aa,bb,aa);
end;
end;
until (tbl2[r,1]<>0) or (r<50) ;
{delay(00);}
if (r<50) then
begin
setcolor(lightgray);
setfillstyle(1,lightgray);
for aa:=(yy-5) to(yy+5) do
begin
for bb:=(xx-5) to (xx+5) do
begin
setcolor((bb*aa)mod(3)+9);
line(bb,aa,bb,aa);
end;
end;
end;
end;
end;
procedure apres;
label apresl; {ecrit la nouvelle tete}
begin
if ((x=k) and (y=l)) then
inc(ttc);
if (ttc mod 15 = lightgray) or (ttc mod 15 = white) or (ttc mod 15= black) then
begin
inc(ttc);
end;
apresl:
setcolor(ttc mod 15);
setfillstyle(1,ttc mod 15);
fillellipse(x,y,5,5);
end;
procedure apres2;
label apresl2; {ecrit la nouvelle tete}
begin
if ((xx=k) and (yy=l)) then
inc(ttc2);
if (ttc2 mod 15 = lightgray) or (ttc2 mod 15 = white) or (ttc2 mod 15= black) then
begin
inc(ttc2);
end;
apresl2:
setcolor(ttc2 mod 15);
setfillstyle(1,ttc2 mod 15);
fillellipse(xx,yy,5,5);
end;
procedure mur; {retourner de l'autre cote apres avoir toucher un mur}
begin
if x>490 then x:=110;
if x<110 then x:=490;
if y<110 then y:=390;
if y>390 then y:=110;
end;
procedure mur2; {retourner de l'autre cote apres avoir toucher un mur}
begin
if xx>490 then xx:=110;
if xx<110 then xx:=490;
if yy<110 then yy:=390;
if yy>390 then yy:=110;
end;
procedure serpent;
begin
for x3:=150 downto 51 do
if (tbl[x3,1]<>0) and (tbl[x3,2]<>0) then
begin
tbl[x3,1]:=tbl[x3-1,1];
tbl[x3,2]:=tbl[x3-1,2];
end;
if (tbl[50,1]<>0) and (tbl[50,2]<>0) then
begin
tbl[50,1]:=x;
tbl[50,2]:=y;
end;
if f=1 then
begin
inc(d);
inc(f);
end;
end;
procedure serpent2;
begin
for xx3:=150 downto 51 do
if (tbl2[xx3,1]<>0) and (tbl2[xx3,2]<>0) then
begin
tbl2[xx3,1]:=tbl2[xx3-1,1];
tbl2[xx3,2]:=tbl2[xx3-1,2];
end;
if (tbl2[50,1]<>0) and (tbl2[50,2]<>0) then
begin
tbl2[50,1]:=xx;
tbl2[50,2]:=yy;
end;
if f=1 then
begin
inc(d);
inc(f);
end;
end;
{-----------}
begin
x1:=50;
xx1:=50;
d1:=45;
{debut du program}
cleardevice;
Begin
outtextxy(40,150,'Quel est le nom du 2e joueur? '); {writeln(): cela ecrit ce qui est demande, puis change de ligne}
delay(1500);
cleardevice;
readln(nom2); {readln(): cela donne a la variable precisee entre parenthese la valeur ecrites par lutilisateur}
End;
begin
for aa:=1 to 1000 do
begin
for bb:=1 to 1000 do
begin
setcolor((aa*bb)mod(3)+7);
line(bb,aa,bb,aa);
end;
end;
end;
begin
for aa:=1 to 1000 do
begin
for bb:=1 to 1000 do
begin
setcolor((aa*bb)mod(3)+9);
if (bb>94) and (bb<506) and (aa>94) and (aa<406) then
line(bb,aa,bb,aa);
end;
end;
settextstyle(0,0,2);
textcolor(red);
end;
rectangle(95,95,505,405) ;
setfillstyle(1,lightgray);
{bar(95,95,505,405); }
{
for aa:=1 to 1000 do
begin
for bb:=1 to 1000 do
begin
setcolor(lightgray);
if (bb>505) or (bb<95) or (aa>405) or (aa<95) then
line(bb,aa,bb,aa);
end;
end; }
for ccc:=1 to 250 do
for v:=1 to 2 do
tbl[ccc,v]:=0;
ttc:=blue;
tc:=green;
ttc2:=blue;
tc2:=green;
randomize;
k:=random(38)*10+110;
l:=random(28)*10+110;
setcolor(white);
setfillstyle(1,white);
fillellipse(k,l,4,4);
setfillstyle(1,green);
setcolor(green);
fillellipse(k,l,2,2);
setcolor(blue);
setfillstyle(1,blue);
x:=200;
y:=200;
fillellipse(x,y,5,5);
xx:=350;
yy:=350;
fillellipse(xx,yy,5,5);
d:=0;
f:=1;
g:=1;
a:='D';
b:='3';
repeat
ragout:=0;
giroux:=0;
debut1:
repeat
if (keypressed) and (a<>'M') then
begin
c:=upcase(readkey);
case c of
'1', '2', '3', '5': begin inc(giroux); end;
'W', 'A', 'S', 'D': begin inc(ragout); end;
end;
case c of
'W': begin if a<>'S' then prea:='W'; end;
'A': begin if a<>'D' then prea:='A'; end;
'S': begin if a<>'W' then prea:='S'; end;
'D': begin if a<> 'A' then prea:='D'; end;
'1': begin if b<> '3' then preb:='1'; end;
'2': begin if b<>'5' then preb:='2'; end;
'3': begin if b<>'1' then preb:='3'; end;
'5': begin if b<>'2' then preb:='5'; end;
end;
end;
until (not keypressed) or (c='M');
repeat
if (keypressed) and (a<>'M') then
begin
c:=upcase(readkey);
if giroux<>0 then
begin
case c of
'W', 'A', 'S', 'D': inc(ragout);
else c:=c;
end;
end;
if ragout<>0 then case c of
'1', '2', '3', '5': begin inc(giroux); end;
else c:=c;
end;
case c of
'W': begin if a<>'S' then prea:='W'; end;
'A': begin if a<>'D' then prea:='A'; end;
'S': begin if a<>'W' then prea:='S'; end;
'D': begin if a<> 'A' then prea:='D'; end;
'1': begin if b<> '3' then preb:='1'; end;
'2': begin if b<>'5' then preb:='2'; end;
'3': begin if b<>'1' then preb:='3'; end;
'5': begin if b<>'2' then preb:='5'; end;
end;
end;
until (not keypressed) or (c='M'); {or ((ragout<>0) and (giroux<>0)); }
points:=0;
case prea of
'W': begin if a<>'S' then a:='W'; end;
'A': begin if a<>'D' then a:='A'; end;
'S': begin if a<>'W' then a:='S'; end;
'D': begin if a<> 'A' then a:='D'; end;
end;
case preb of
'1': begin if b<>'3' then b:='1'; end;
'2': begin if b<>'5' then b:='2'; end;
'3': begin if b<>'1' then b:='3'; end;
'5': begin if b<>'2' then b:='5'; end;
end;
{
goujat:=2; }
case a of
'W':
begin
inc(z);
begin
wl:
begin
avant;
serpent;
y:=y-10 ;
mur;
apres;
delay(d1);
mort;
end;
annule;
end;
end;
'A':
begin
inc(z);
begin
al:
if (x>100) and (x<500) and (y>100) and (y<500) then
begin
avant;
serpent;
x:=x-10;
mur;
apres;
delay(d1);
mort;
end
else
begin
z:=1000;
inc(x);
end;
annule;
end;
end;
'S':
begin
inc(z);
begin
sl:
if (x>100) and (x<500) and (y>100) and (y<500) then
begin
avant;
serpent;
y:=y+10;
mur;
apres;
delay(d1);
mort;
end
else
begin
z:=1000;
dec(y);
end;
annule;
end;
end;
'D':
begin
inc(z);
begin
dl:
if (x>100) and (x<500) and (y>100) and (y<500) then
begin
avant;
serpent;
x:=x+10;
mur;
apres;
delay(d1);
mort;
end
else
begin
z:=1000;
dec(x);
end;
annule;
end;
end;
end;
case b of
'5':
begin
inc(z);
begin
l5:
begin
avant2;
serpent2;
yy:=yy-10 ;
mur2;
apres2;
delay(d1);
mort2;
end;
annule;
end;
end;
'1':
begin
inc(z);
begin
l1:
if (x>100) and (x<500) and (y>100) and (y<500) then
begin
avant2;
serpent2;
xx:=xx-10;
mur2;
apres2;
delay(d1);
mort2;
end
else
begin
z:=1000;
inc(x);
end;
annule;
end;
end;
'2':
begin
inc(z);
begin
l2:
if (x>100) and (x<500) and (y>100) and (y<500) then
begin
avant2;
serpent2;
yy:=yy+10;
mur2;
apres2;
delay(d1);
mort2;
end
else
begin
z:=1000;
dec(y);
end;
annule;
{
b:='O';
repeat
c:=upcase(readkey);
case c of
'1': b:='1';
'2': b:='2';
'3': b:='3';
end;
until (b<>'O');
}
end;
end;
'3':
begin
inc(z);
begin
l3:
if (x>100) and (x<500) and (y>100) and (y<500) then
begin
avant2;
serpent2;
xx:=xx+10;
mur2;
apres2;
delay(d1);
mort2;
end
else
begin
z:=1000;
dec(x);
end;
annule;
{
b:='O';
repeat
c:=upcase(readkey);
case c of
'2': b:='2';
'3': b:='3';
'5': b:='5';
end;
until (b<>'O');
}
end;
end;
end;
until a='M' ;
cleardevice;
end;
procedure question;
label theend,q1,q2,q3,q4,q5,q6,q7,q8,q9,q10,q11,q12,q13,q14,q15,q16,q17,q18,q19,q20,q21,fini;
procedure pointstemps;
begin
setcolor(7);
setfillstyle(1,7);
fillellipse(90,200,20,20);
fillellipse(400,200,20,20);
settextstyle(0,0,1);
setcolor(green);
outtextxy(70,170,'temps');
outtextxy(380,170,'points');
setcolor(red);
str(points,p);
str(temps,t);
settextstyle(0,0,2);
outtextxy(75,193,t);
outtextxy(385,193,p);
end;
procedure bon;
begin
cleardevice;
setcolor(blue);
settextstyle(4,0,7);
outtextxy(190,150,'Bravo!');
settextstyle(0,0,2);
outtextxy(170,250,'Bonne reponse');
delay(500);
cleardevice;
end;
procedure mal;
begin
cleardevice;
setcolor(red);
settextstyle(1,0,5);
outtextxy(140,150,'Mauvaise reponse');
settextstyle(1,0,1);
outtextxy(200,250,'Vous perdez un points');
delay(500);
cleardevice;
end;
procedure intro;
begin
{cleardevice;
setcolor(white);
settextstyle(1,0,3);
outtextxy(200,200,'question : ');
str(w3,w2);
outtextxy(325,200,w2);
delay(600); }
cleardevice;
end;
procedure fin1;
begin
cleardevice;
setcolor(red);
settextstyle(1,0,4);
outtextxy(200,190,'Partie terminee!');
setcolor(brown);
settextstyle(1,0,2);
outtextxy(150,250,'Votre score est de ');
str(points,p);
outtextxy(340,250,p);
outtextxy(382,250,'points');
delay(4000);
end;
begin {----------}
temps:=points;
points:=0;
pilote:=detect;
initgraph(pilote, mode, 'M:/BGI');
setbkcolor(darkgray);
begin {intro}
settextstyle(0,0,1);
setcolor(green);
outtextxy(40,40,'Maintenant vous devez repondre a une serie de question pour determiner');
outtextxy(40,58,'votre score final.');
settextstyle(3,0,2);
outtextxy(75,80,'Vous aurez');
setcolor(red);
outtextxy(200,80,p);
setcolor(green);
outtextxy(240,80,'secondes pour repondre.');
settextstyle(0,0,1);
setcolor(white);
outtextxy(350,130,'Appuyez sur entree pour continuer.');
readln;
cleardevice;
setcolor(blue);
outtextxy(30,30,'Voici quelques consignes avant de commencer.');
outtextxy(60,45,'1- Une bonne reponse vous donne 2 points.');
outtextxy(60,60,'2- Une mauvaise reponse vous enleve 1 point.');
outtextxy(60,75,'3- Si vous passez, vous ne perdrez pas de points.');
outtextxy(60,90,'4- Si vous passez, vous ne pourrez pas revenir a la question.');
setcolor(white);
outtextxy(350,130,'Appuyez sur entree pour continuer.');
readln;
end; {fin intro}
begin {question1}
w3:=1;
intro;
q1:
cleardevice;
repeat
settextstyle(0,0,1);
setcolor(blue);
outtextxy(60,60,'Question 1');
outtextxy(80,80,'En quelle annee la ville de quebec a-t-elle ete fondee?');
outtextxy(90,90, 'Q-1534');
outtextxy(90,100,'W-1600');
outtextxy(90,110,'E-1608');
outtextxy(90,120,'R-1704');
outtextxy(90,130,'T-passe');
dec(temps);
pointstemps;
if temps<1 then goto fini
else delay(1000);
until keypressed;
b:=upcase(readkey);
case b of
'Q','W','R':
begin
dec(points);
pointstemps;
mal;
goto q2;
end;
'E':
begin
inc(points,2);
pointstemps;
bon;
goto q2;
end;
'T': goto q2;
else goto q1;
end; {fin case of}
end; {fin q1}
begin
inc(w3);
intro;
q2:
cleardevice;
repeat
settextstyle(0,0,1);
setcolor(blue);
outtextxy(60,60,'Question 2');
outtextxy(80,80,'En quelle annee a commence la premiere guerre mondiale?');
outtextxy(90,90, 'Q-1914');
outtextxy(90,100,'W-1939');
outtextxy(90,110,'E-1886');
outtextxy(90,120,'R-1970');
outtextxy(90,130,'T-passe');
dec(temps);
pointstemps;
if temps=0 then goto fini
else delay(1000);
until keypressed;
b:=upcase(readkey);
case b of
'E','W','R':
begin
dec(points);
pointstemps;
mal;
goto q3;
end;
'Q':
begin
inc(points,2);
pointstemps;
bon;
goto q3;
end;
'T': goto q3;
else goto q2;
end; {fin case of}
end; {fin q2}
begin {debut q3}
inc(w3);
intro;
q3:
cleardevice;
repeat
settextstyle(0,0,1);
setcolor(blue);
outtextxy(60,60,'Question 3');
outtextxy(80,80,'En quelle annee a ete decouvert l''Amerique?');
outtextxy(90,90, 'Q-1550');
outtextxy(90,100,'W-1492');
outtextxy(90,110,'E-1510');
outtextxy(90,120,'R-1530');
outtextxy(90,130,'T-passe');
dec(temps);
pointstemps;
if temps=0 then goto fini
else delay(1000);
until keypressed;
b:=upcase(readkey);
case b of
'Q','E','R':
begin
dec(points);
pointstemps;
mal;
goto q4;
end;
'W':
begin
inc(points,2);
pointstemps;
bon;
goto q4;
end;
'T': goto q4;
else goto q3;
end; {fin case of}
end; {fin q3}
begin {debut q4}
inc(w3);
intro;
q4:
cleardevice;
repeat
settextstyle(0,0,1);
setcolor(blue);
outtextxy(60,60,'Question 4');
outtextxy(80,80,'Qui estle premier homme a avoir marche sur la lune?');
outtextxy(90,90, 'Q-Tintin');
outtextxy(90,100,'W-Neil Armstrong');
outtextxy(90,110,'E-Lance Armstrong');
outtextxy(90,120,'R-Roger Armstrong');
outtextxy(90,130,'T-passe');
dec(temps);
pointstemps;
if temps=0 then goto fini
else delay(1000);
until keypressed;
b:=upcase(readkey);
case b of
'Q','E','R':
begin
dec(points);
pointstemps;
mal;
goto q5;
end;
'W':
begin
inc(points,2);
pointstemps;
bon;
goto q5;
end;
'T': goto q5;
else goto q4;
end; {fin case of}
end; {fin q4}
begin {debut q5}
inc(w3);
intro;
q5:
cleardevice;
repeat
settextstyle(0,0,1);
setcolor(blue);
outtextxy(60,60,'Question 5');
outtextxy(80,80,'Comment se nomme l''actuel premier ministre du Quebec?');
outtextxy(90,90, 'Q-Rene Levesque');
outtextxy(90,100,'W-Bernard Landry');
outtextxy(90,110,'E-Maurice Duplessi');
outtextxy(90,120,'R-Jean Charest');
outtextxy(90,130,'T-passe');
dec(temps);
pointstemps;
if temps=0 then goto fini
else delay(1000);
until keypressed;
b:=upcase(readkey);
case b of
'Q','E','W':
begin
dec(points);
pointstemps;
mal;
goto q6;
end;
'R':
begin
inc(points,2);
pointstemps;
bon;
goto q6;
end;
'T': goto q6;
else goto q5;
end; {fin case of}
end; {fin q5}
begin {debut q6}
inc(w3);
intro;
q6:
cleardevice;
repeat
settextstyle(0,0,1);
setcolor(blue);
outtextxy(60,60,'Question 6');
outtextxy(80,80,'Combien d''etats y a-t-il aux Etats-Unis?');
outtextxy(90,90, 'Q-50');
outtextxy(90,100,'W-34');
outtextxy(90,110,'E-65');
outtextxy(90,120,'R-90');
outtextxy(90,130,'T-passe');
dec(temps);
pointstemps;
if temps=0 then goto fini
else delay(1000);
until keypressed;
b:=upcase(readkey);
case b of
'R','E','W':
begin
dec(points);
pointstemps;
mal;
goto q7;
end;
'Q':
begin
inc(points,2);
pointstemps;
bon;
goto q7;
end;
'T': goto q7;
else goto q6;
end; {fin case of}
end; {fin q6}
begin {debut q7}
inc(w3);
intro;
q7:
cleardevice;
repeat
settextstyle(0,0,1);
setcolor(blue);
outtextxy(60,60,'Question 7');
outtextxy(80,80,'En quelle annee a ete invente le 1er ordinateur portable?');
outtextxy(90,90, 'Q-1930');
outtextxy(90,100,'W-1990');
outtextxy(90,110,'E-1965');
outtextxy(90,120,'R-1981');
outtextxy(90,130,'T-passe');
dec(temps);
pointstemps;
if temps=0 then goto fini
else delay(1000);
until keypressed;
b:=upcase(readkey);
case b of
'R','E','W':
begin
dec(points);
pointstemps;
mal;
goto q8;
end;
'Q':
begin
inc(points,2);
pointstemps;
bon;
goto q8;
end;
'T': goto q8;
else goto q7;
end; {fin case of}
end; {fin q6}
begin {debut q8}
inc(w3);
intro;
q8:
cleardevice;
repeat
settextstyle(0,0,1);
setcolor(blue);
outtextxy(60,60,'Question 8');
outtextxy(80,80,'Donner le resultat de cette equation: (9x4)+(3*2)=?');
outtextxy(90,90, 'Q-42');
outtextxy(90,100,'W-34');
outtextxy(90,110,'E-24');
outtextxy(90,120,'R-43');
outtextxy(90,130,'T-passe');
dec(temps);
pointstemps;
if temps=0 then goto fini
else delay(1000);
until keypressed;
b:=upcase(readkey);
case b of
'R','E','W':
begin
dec(points);
pointstemps;
mal;
goto q9;
end;
'Q':
begin
inc(points,2);
pointstemps;
bon;
goto q9;
end;
'T': goto q9;
else goto q8;
end; {fin case of}
end; {fin q8}
begin {debut q9}
inc(w3);
intro;
q9:
cleardevice;
repeat
settextstyle(0,0,1);
setcolor(blue);
outtextxy(60,60,'Question 9');
outtextxy(80,80,'Identifiez le verbe mal orthographie');
outtextxy(90,90, 'Q-Je mangerai');
outtextxy(90,100,'W-Il mangeais');
outtextxy(90,110,'E-Tu mangeras');
outtextxy(90,120,'R-Nous mangerons');
outtextxy(90,130,'T-passe');
dec(temps);
pointstemps;
if temps=0 then goto fini
else delay(1000);
until keypressed;
b:=upcase(readkey);
case b of
'R','E','Q':
begin
dec(points);
pointstemps;
mal;
goto q10;
end;
'W':
begin
inc(points,2);
pointstemps;
bon;
goto q10;
end;
'T': goto q10;
else goto q9;
end; {fin case of}
end; {fin q9}
begin {debut q10}
inc(w3);
intro;
q10:
cleardevice;
repeat
settextstyle(0,0,1);
setcolor(blue);
outtextxy(60,60,'Question 10');
outtextxy(80,80,'Quel est le cri de l''elephant?');
outtextxy(90,90, 'Q-Le hululement');
outtextxy(90,100,'W-Le mialement');
outtextxy(90,110,'E-Le bariement');
outtextxy(90,120,'R-Le jappement');
outtextxy(90,130,'T-passe');
dec(temps);
pointstemps;
if temps=0 then goto fini
else delay(1000);
until keypressed;
b:=upcase(readkey);
case b of
'R','W','Q':
begin
dec(points);
pointstemps;
mal;
goto q11;
end;
'E':
begin
inc(points,2);
pointstemps;
bon;
goto q11;
end;
'T': goto q11;
else goto q10;
end; {fin case of}
end; {fin q10}
begin {debut q11}
inc(w3);
intro;
q11:
cleardevice;
repeat
settextstyle(0,0,1);
setcolor(blue);
outtextxy(60,60,'Question 11');
outtextxy(80,80,'Quel est le plus grand pays du monde?');
outtextxy(90,90, 'Q-Canada');
outtextxy(90,100,'W-Bresil');
outtextxy(90,110,'E-Chine');
outtextxy(90,120,'R-Russie');
outtextxy(90,130,'T-passe');
dec(temps);
pointstemps;
if temps=0 then goto fini
else delay(1000);
until keypressed;
b:=upcase(readkey);
case b of
'E','W','Q':
begin
dec(points);
pointstemps;
mal;
goto q12;
end;
'R':
begin
inc(points,2);
pointstemps;
bon;
goto q12;
end;
'T': goto q12;
else goto q11;
end; {fin case of}
end; {fin q11}
begin {debut q12}
inc(w3);
intro;
q12:
cleardevice;
repeat
settextstyle(0,0,1);
setcolor(blue);
outtextxy(60,60,'Question 12');
outtextxy(80,80,'Quelle est la capital de la Russie?');
outtextxy(90,90, 'Q-St Petersbourg');
outtextxy(90,100,'W-Moscou');
outtextxy(90,110,'E-Strejevoi');
outtextxy(90,120,'R-Ottawa');
outtextxy(90,130,'T-passe');
dec(temps);
pointstemps;
if temps=0 then goto fini
else delay(1000);
until keypressed;
b:=upcase(readkey);
case b of
'E','R','Q':
begin
dec(points);
pointstemps;
mal;
goto q13;
end;
'W':
begin
inc(points,2);
pointstemps;
bon;
goto q13;
end;
'T': goto q13;
else goto q12
end; {fin case of}
end; {fin q12}
begin {debut q13}
inc(w3);
q13:
cleardevice;
repeat
settextstyle(0,0,1);
setcolor(blue);
outtextxy(60,60,'Question ?');
outtextxy(80,80,'A quelle question etes vous rendu?');
outtextxy(90,90, 'Q-12');
outtextxy(90,100,'W-15');
outtextxy(90,110,'E-11');
outtextxy(90,120,'R-13');
outtextxy(90,130,'T-passe');
dec(temps);
pointstemps;
if temps=0 then goto fini
else delay(1000);
until keypressed;
b:=upcase(readkey);
case b of
'E','W','Q':
begin
dec(points);
pointstemps;
mal;
goto q14;
end;
'R':
begin
inc(points,2);
pointstemps;
bon;
goto q14;
end;
'T': goto q14;
else goto q13
end; {fin case of}
end; {fin q13}
begin {debut q14}
inc(w3);
intro;
q14:
cleardevice;
repeat
settextstyle(0,0,1);
setcolor(blue);
outtextxy(60,60,'Question 14');
outtextxy(80,80,'Quel est le pays le plus peuple du monde?');
outtextxy(90,90, 'Q-Chine');
outtextxy(90,100,'W-Inde');
outtextxy(90,110,'E-Canada');
outtextxy(90,120,'R-Mexique');
outtextxy(90,130,'T-passe');
dec(temps);
pointstemps;
if temps=0 then goto fini
else delay(1000);
until keypressed;
b:=upcase(readkey);
case b of
'E','W','R':
begin
dec(points);
pointstemps;
mal;
goto q15;
end;
'Q':
begin
inc(points,2);
pointstemps;
bon;
goto q15;
end;
'T': goto q15;
else goto q14
end; {fin case of}
end; {fin q14}
begin {debut q15}
inc(w3);
intro;
q15:
cleardevice;
repeat
settextstyle(0,0,1);
setcolor(blue);
outtextxy(60,60,'Question 15');
outtextxy(80,80,'Comment s''appelle les eleves qui ont cree ce programme?');
outtextxy(90,90, 'Q-Carl et Louis');
outtextxy(90,100,'W-Vincent et Hugo');
outtextxy(90,110,'E-Hugo et Laurent');
outtextxy(90,120,'R-Laurent et Charles');
outtextxy(90,130,'T-passe');
dec(temps);
pointstemps;
if temps=0 then goto fini
else delay(1000);
until keypressed;
b:=upcase(readkey);
case b of
'E','Q','R':
begin
dec(points);
pointstemps;
mal;
goto q16;
end;
'W':
begin
inc(points,2);
pointstemps;
bon;
goto q16
end;
'T': goto q16;
else goto q15
end; {fin case of}
end; {fin q15}
begin {debut q16}
inc(w3);
intro;
q16:
cleardevice;
repeat
settextstyle(0,0,1);
setcolor(blue);
outtextxy(60,60,'Question 16');
outtextxy(80,80,'Parmis les suivant, quel est le fruit qui contien le plsu d''eau?');
outtextxy(90,90, 'Q-Pomme');
outtextxy(90,100,'W-Raisin');
outtextxy(90,110,'E-Pasteque');
outtextxy(90,120,'R-Fraise');
outtextxy(90,130,'T-passe');
dec(temps);
pointstemps;
if temps=0 then goto fini
else delay(1000);
until keypressed;
b:=upcase(readkey);
case b of
'W','Q','R':
begin
dec(points);
pointstemps;
mal;
goto q17;
end;
'E':
begin
inc(points,2);
pointstemps;
bon;
goto q17
end;
'T': goto q17;
else goto q16
end; {fin case of}
end; {fin q16}
begin {debut q17}
inc(w3);
intro;
q17:
cleardevice;
repeat
settextstyle(0,0,1);
setcolor(blue);
outtextxy(60,60,'Question 17');
outtextxy(80,80,'Quel est la monnaie qui circule en Inde?');
outtextxy(90,90, 'Q-Euro');
outtextxy(90,100,'W-Pesos');
outtextxy(90,110,'E-Roupie');
outtextxy(90,120,'R-Yen');
outtextxy(90,130,'T-passe');
dec(temps);
pointstemps;
if temps=0 then goto fini
else delay(1000);
until keypressed;
b:=upcase(readkey);
case b of
'W','Q','R':
begin
dec(points);
pointstemps;
mal;
goto q18;
end;
'E':
begin
inc(points,2);
pointstemps;
bon;
goto q18
end;
'T': goto q18;
else goto q17
end; {fin case of}
end; {fin q17}
begin {debut q18}
inc(w3);
intro;
q18:
cleardevice;
repeat
settextstyle(0,0,1);
setcolor(blue);
outtextxy(60,60,'Question 18');
outtextxy(80,80,'Quel est la monnaie qui circule en Inde?');
outtextxy(90,90, 'Q-Euro');
outtextxy(90,100,'W-Pesos');
outtextxy(90,110,'E-Roupie');
outtextxy(90,120,'R-Yen');
outtextxy(90,130,'T-passe');
dec(temps);
pointstemps;
if temps=0 then goto fini
else delay(1000);
until keypressed;
b:=upcase(readkey);
case b of
'W','Q','R':
begin
dec(points);
pointstemps;
mal;
goto q19;
end;
'E':
begin
inc(points,2);
pointstemps;
bon;
goto q19
end;
'T': goto q19;
else goto q18
end; {fin case of}
end; {fin q18}
begin {debut q19}
inc(w3);
intro;
q19:
cleardevice;
repeat
settextstyle(0,0,1);
setcolor(blue);
outtextxy(60,60,'Question 19');
outtextxy(80,80,'Quel est l''homme le plus riche au monde?');
outtextxy(90,90, 'Q-Bill Gates');
outtextxy(90,100,'W-Warren Buffet');
outtextxy(90,110,'E-Mukesh Ambani');
outtextxy(90,120,'R-Lakshmi Mittal');
outtextxy(90,130,'T-passe');
dec(temps);
pointstemps;
if temps=0 then goto fini
else delay(1000);
until keypressed;
b:=upcase(readkey);
case b of
'W','E','R':
begin
dec(points);
pointstemps;
mal;
goto q20;
end;
'Q':
begin
inc(points,2);
pointstemps;
bon;
goto q20;
end;
'T': goto q20;
else goto q19
end; {fin case of}
end; {fin q19}
begin {debut q20}
inc(w3);
intro;
q20:
cleardevice;
repeat
settextstyle(0,0,1);
setcolor(blue);
outtextxy(60,60,'Question 20');
outtextxy(80,80,'En quel annee a ete fonde le college Andre-Grasset?');
outtextxy(90,90, 'Q-1932');
outtextxy(90,100,'W-1920');
outtextxy(90,110,'E-1915');
outtextxy(90,120,'R-1927');
outtextxy(90,130,'T-passe');
dec(temps);
pointstemps;
if temps=0 then goto fini
else delay(1000);
until keypressed;
b:=upcase(readkey);
case b of
'W','E','Q':
begin
dec(points);
pointstemps;
mal;
goto q21;
end;
'R':
begin
inc(points,2);
pointstemps;
bon;
goto q21;
end;
'T': goto q21;
else goto q20
end; {fin case of}
end; {fin q20}
q21:
fini:
fin1;
end;
label charles;
begin {C'est le debut du programme}
closegraph;
clrscr;
demandedenom; {Ce sont les appels des differentes procedures}
chargement;
bienvenue;
charles:
modejeu;
case reponsemodejeu of
'1':
begin
difficulte;
instruction1;
snake10;
question;
goto charles;
end;
'2':
begin
instruction2;
snake222;
goto charles;
end;
'3':
begin
instruction3;
snakeord;
goto charles;
end;
'X': fin;
end;
end. {C'est la fin du programme}