Правила форума
Карточная игра, помогите откомментировать
{Originally from Frederic Gaonac'h }
program memcards;
uses crt, graph;
type tableau= array[1..8,1..8] of integer;
procedure info;
var i, j, k: integer;
begin
for i:=1 to 2 do begin
if i=1 then
setcolor(3)
else setcolor(0);
outtextxy(200,20,'Programming:');
outtextxy(5,70,'Left: 1');
outtextxy(5,90,'Right: 3');
outtextxy(5,110,'Up: 5');
outtextxy(5,130,'Down: 2');
outtextxy(520,70,'Validate: ESP');
outtextxy(520,90,'Sound/Sil.: S');
outtextxy(520,110,'I wanna quit: Q');
outtextxy(140,460,'The goal is to get the same colours together');
if i=1 then begin
repeat
for j:=1 to 20 do begin
for k:=1 to 2 do begin
if k=1 then setcolor(4) else setcolor(0);
outtextxy(310+1*j,20,'F');
outtextxy(320+2*j,20,'r');
outtextxy(330+3*j,20,'e');
outtextxy(340+4*j,20,'d');
if k=1 then delay(700);
end;
end;
for j:=20 downto 1 do begin
for k:=1 to 2 do begin
if k=1 then setcolor(4) else setcolor(0);
outtextxy(310+1*j,20,'F');
outtextxy(320+2*j,20,'r');
outtextxy(330+3*j,20,'e');
outtextxy(340+4*j,20,'d');
if k=1 then delay(700);
end;
end;
until keypressed;
end;
end;
end;
procedure gagne;
var i, j, k: integer;
begin
settextstyle(1,0,4);
repeat
for j:=1 to 20 do begin
for k:=1 to 2 do begin
if k=1 then setcolor(4) else setcolor(0);
outtextxy(250+1*j,10,'G');
outtextxy(270+2*j,10,'r');
outtextxy(290+3*j,10,'e');
outtextxy(310+4*j,10,'a');
outtextxy(330+5*j,10,'t');
if k=1 then delay(700);
end;
end;
for j:=20 downto 1 do begin
for k:=1 to 2 do begin
if k=1 then setcolor(4) else setcolor(0);
outtextxy(250+1*j,10,'G');
outtextxy(270+2*j,10,'r');
outtextxy(290+3*j,10,'e');
outtextxy(310+4*j,10,'a');
outtextxy(330+5*j,10,'t');
if k=1 then delay(700);
end;
end;
until keypressed;
end;
var a, b, cc, i, j, k, n, x, y, ca, co, pilote, mode: integer;
t, tt: tableau;
test , son, efface1, efface2: boolean;
s: string;
blank: pointer;
begin
pilote:=detect;
initGraph(pilote,mode,'c:\tp\bgi');
clearviewport;
setcolor(10);
setbkcolor(black);
setfillstyle(1,0);
son:=false;
for j:=1 to 9 do begin
line(110,j*50,510,j*50);
end;
for i:=1 to 9 do begin
line(i*50+60,50,i*50+60,450);
end;
for a:=1 to 8 do begin
for b:=1 to 8 do begin
t[a,b]:=0;
tt[a,b]:=0;
end;
end;
randomize;
for a:=1 to 8 do begin
for b:=1 to 8 do begin
repeat
i:=random(8)+1;
j:=random(8)+1;
until t[i,j]=0;
if a<>6 then t[i,j]:=a else t[i,j]:=23;
end;
end;
for a:=1 to 8 do begin
for b:=1 to 8 do begin
if t[a,b]=7 then t[a,b]:=14;
end;
end;
ca:=4;
co:=4;
cc:=0;
efface1:=true;
efface2:=false;
setcolor(13);
x:=100;
y:=100;
test:=false;
n:=0;
setcolor(3);
str(n,s);
outtextxy(160,35,s);
outtextxy(110,35,'Tries: Info:I');
repeat
if efface1 then begin
setcolor(13);
rectangle(ca*50+75,co*50+15,ca*50+95,co*50+35);
setfillstyle(1,13);
floodfill(ca*50+80,co*50+20,13);
end;
if efface2 then begin
setcolor(0);
rectangle(ca*50+75,co*50+15,ca*50+95,co*50+35);
setfillstyle(1,0);
floodfill(ca*50+80,co*50+20,0);
end;
k:=ord(readkey);
if son then begin
sound(1000);
delay(70);
nosound;
end;
if efface1 then begin
setfillstyle(1,0);
floodfill(ca*50+80,co*50+20,10);
end;
if efface2 then begin
setfillstyle(1,t[ca,co]);
floodfill(ca*50+80,co*50+20,10);
end;
if (k=ord('3'))and(ca<8)and((ca<>x-1)or(co<>y)) then begin
if tt[ca+1,co]=0 then begin
efface1:=true;
efface2:=false;
end else begin
efface2:=true;
efface1:=false;
end;
ca:=ca+1;
end;
if (k=ord('1'))and(ca>1)and((ca<>x+1)or(co<>y)) then begin
if tt[ca-1,co]=0 then begin
efface1:=true;
efface2:=false;
end else begin
efface2:=true;
efface1:=false;
end;
ca:=ca-1;
end;
if (k=ord('2'))and(co<8)and((co<>y-1)or(ca<>x)) then begin
if tt[ca,co+1]=0 then begin
efface1:=true;
efface2:=false;
end else begin
efface2:=true;
efface1:=false;
end;
co:=co+1;
end;
if (k=ord('5'))and(co>1)and((co<>y+1)or(ca<>x)) then begin
if tt[ca,co-1]=0 then begin
efface1:=true;
efface2:=false;
end else begin
efface2:=true;
efface1:=false;
end;
co:=co-1;
end;
if (k=ord(' '))and((ca<>x)or(co<>y))and(tt[ca,co]=0) then begin
setfillstyle(1,t[ca,co]);
floodfill(ca*50+80,co*50+20,10);
if x=100 then begin
x:=ca;
y:=co;
cc:=t[ca,co];
efface1:=false;
efface2:=false;
end else begin
setcolor(0);
str(n,s);
outtextxy(160,35,s);
n:=n+1;
setcolor(3);
str(n,s);
outtextxy(160,35,s);
if (t[ca,co]<>cc) then begin
if son then begin
sound(200);
delay(500);
nosound;
end;
repeat until keypressed;
setfillstyle(1,0);
floodfill(ca*50+80,co*50+20,10);
setfillstyle(1,0);
floodfill(x*50+80,y*50+20,10);
efface1:=true;
efface2:=false;
end else begin
if son then begin
sound(2000);
delay(500);
nosound;
end;
tt[x,y]:=cc;
tt[ca,co]:=t[ca,co];
efface1:=false;
efface2:=false;
test:=true;
for i:=1 to 8 do
for j:=1 to 8 do
if tt[i,j]=0 then test:=false;
end;
x:=100;
y:=100;
end;
end;
if k=ord('s') then if son=true then son:=false else son:=true;
if k=ord('i') then info;
until (k=ord('q'))or(test=true);
if test=true then gagne;
closegraph;
end.
Сообщение отредактировано: saur -
