Реферат: Арканоид на Паскале
end;
procedure vostanovka_colors;
begin
setrgbpalette(black,0,0,0);
setrgbpalette(blue,0,0,40);
setrgbpalette(green,0,40,0);
setrgbpalette(cyan,0,40,40);
setrgbpalette(red,40,7,7);
setrgbpalette(magenta,40,0,40);
setrgbpalette(brown,40,30,0);
setrgbpalette(lightgray,49,49,49);
setrgbpalette(darkgray,26,26,26);
setrgbpalette(lightblue,0,0,63);
setrgbpalette(lightgreen,9,63,9);
setrgbpalette(lightcyan,0,63,63);
setrgbpalette(lightred,63,10,10);
setrgbpalette(lightmagenta,44,0,63);
setrgbpalette(yellow,63,63,18);
setrgbpalette(white,63,63,63);
end;
var y_planka,xmax,
x1_dv,x2_dv,x,y,i:t_kubik;
x_get,y_get,x_get_pred:word;
dx,dy:t_dx_dy;
a:t_arr;
numbering,liv:byte;
kol_kub:kol_kubik;
lb,rb,tb,dviguna:boolean;
buttoncount,errorcode,koeff:byte;
pause:word;
score:integer;
s2:string;
begin
s2:='Click to start';
initgr;
zastavka(s2);
vostanovka_colors;
setlinestyle(0,0,1);
randomize;
cleardevice;
xmax:=getmaxx-radius-1;
y:=getmaxy-shir-radius-1;
y_planka:=getmaxy-shir-radius-1;
liv:=10;
score:=-10;
dviguna:=chem_play;
pausing(pause);
razmer_planki(koeff);
for numbering:=1 to 10 do
begin
perehod_level(numbering);
cleardevice;
planka_sharik(koeff);
level(a,numbering,kol_kub);
naverhu_number(numbering);
naverhu_liv(liv);
naverhu_kubiki(kol_kub,score);
dx:=-1;
dy:=-1;
{а ¬Є }
setcolor(random(14)+1);
rectangle(0,21,getmaxx,getmaxy);
if dviguna then dviguna_mouse(koeff,x,x1_dv,x2_dv,y)
else dviguna_keyboard(koeff,x,x1_dv,x2_dv,y);
while kol_kub>0 do
begin
zar_nar(x,y,dx,dy);
delay(pause);
if (y=radius+1+21) or
((x1_dv
begin
dy:=-dy; musik; end else
if (x=xmax) or
(x=radius+1) then
begin
dx:=-dx; musik; end else
if y=y_planka
then
begin
setcolor(0);
circle(x,y,radius);
setfillstyle(0,0);
bar3d(x1_dv,y1_dv,x2_dv,y2_dv,0,false);
dy:=-1;
death;
livs(liv,score);
case
dviguna of
true:dviguna_mouse(koeff,x,x1_dv,x2_dv,y);
false:dviguna_keyboard(koeff,x,x1_dv,x2_dv,y);
end;
end;
case x of
1..49:
begin i:=37;izchez_vv_niz(dy,x,y,i,a,kol_kub,score); end;
50..99:
begin i:=75;izchez_vv_niz(dy,x,y,i,a,kol_kub,score); end;
100..148:begin
i:=113;izchez_vv_niz(dy,x,y,i,a,kol_kub,score); end;
149..197:begin
i:=151;izchez_vv_niz(dy,x,y,i,a,kol_kub,score); end;
198..246:begin
i:=189;izchez_vv_niz(dy,x,y,i,a,kol_kub,score); end;
247..295:begin
i:=227;izchez_vv_niz(dy,x,y,i,a,kol_kub,score); end;
296..344:begin
i:=265;izchez_vv_niz(dy,x,y,i,a,kol_kub,score); end;
345..393:begin
i:=303;izchez_vv_niz(dy,x,y,i,a,kol_kub,score); end;
394..442:begin
i:=341;izchez_vv_niz(dy,x,y,i,a,kol_kub,score); end;
443..491:begin
i:=379;izchez_vv_niz(dy,x,y,i,a,kol_kub,score); end;
492..540:begin
i:=417;izchez_vv_niz(dy,x,y,i,a,kol_kub,score); end;
541..588:begin
i:=455;izchez_vv_niz(dy,x,y,i,a,kol_kub,score); end;
589..637:begin
i:=493;izchez_vv_niz(dy,x,y,i,a,kol_kub,score); end;
end;
bok_bok(dx,x,y,a,kol_kub,score);
ugolki(dx,dy,x,y,a,kol_kub,score);
case dviguna of
false:
if
keypressed then
case
readkey of
#75:
left(koeff,x1_dv,x2_dv);
#77:
right(koeff,x1_dv,x2_dv);
#27:begin
closegraph; halt; end;
end;
true:
begin
getmousexy(x_get,y_get,lb,rb,tb);
if
x_get_pred<>x_get then begin
setcolor(0);
setfillstyle(0,0);
bar3d(x1_dv,y1_dv,x2_dv,y2_dv,0,false);
setfillstyle(6,13);
setcolor(13);
x1_dv:=x_get;
x2_dv:=x1_dv+koeff*shir;
bar3d(x1_dv,y1_dv,x2_dv,y2_dv,0,false);
x_get_pred:=x_get;
end;
if
rb then begin closegraph;halt;end;
end;
end;
end;
dec(score,10); end;
inc(score,10); ochki(score); s2:='The
end of game'; zastavka(s2); closegraph; end. Текст
сконструируемых
модулей: unit
markel; interface uses
crt,graph,mymouse,mark_zas; var
sverhu:string;
liv,numbering:byte; const
radius=7;
shir=15;
y1_dv=479-1;
y2_dv=479-shir; type
t_kubik=-10..640;
t_dx_dy=-1..1;
t_arr=array[1..494]
of t_kubik;
kol_kubik=0..247; procedure
livs(var liv:byte;score:integer); procedure
perehod_level(const numbering:byte); procedure
planka_sharik(koeff:byte); procedure
musik; procedure
izchez_vv_niz(var dy:t_dx_dy;x,y,i:t_kubik;var a:t_arr;var
kol_kub:kol_kubik;var score:integer); procedure
bok_bok(var dx:t_dx_dy;x,y:t_kubik;var a:t_arr;var
kol_kub:kol_kubik;var score:integer); procedure
death; procedure
ugolki(var dx,dy:t_dx_dy;x,y:t_kubik;var a:t_arr;var
kol_kub:kol_kubik;var score:integer); procedure
pausing(var pause:word); procedure
zapis(const xs,ys:t_kubik;i:t_kubik;var a:t_arr); procedure
level(var a:t_arr;const numbering:byte;var kol_kub:kol_kubik); procedure
left(const koeff:byte;var x1_dv,x2_dv:t_kubik); procedure
right(const koeff:byte;var x1_dv,x2_dv:t_kubik); procedure
dviguna_keyboard(const koeff:byte;var x,x1_dv,x2_dv:t_kubik;var
y:t_kubik); procedure
dviguna_mouse(const koeff:byte;var x,x1_dv,x2_dv:t_kubik;var
y:t_kubik); procedure
zar_nar(var x,y:t_kubik;const dx,dy:t_dx_dy); function
chem_play:boolean; procedure
razmer_planki(var koeff:byte); procedure
naverhu_liv(liv:byte); procedure
naverhu_number(numbering:byte); procedure
naverhu_kubiki(kol_kub:byte;var score:integer); procedure
naverhu_score(score:integer); implementation function
chem_play:boolean; var
mask:boolean;
greenvalue,bluevalue:0..64; i,j:-1..1; begin
setcolor(blue);
settextstyle(4{GothicFont},horizdir,5);
settextjustify(1,1);
outtextxy(round(getmaxx
/ 3.3), round(getmaxy / 2.3),'Mouse');
setcolor(green);
outtextxy(round(getmaxx
/ 1.5), round(getmaxy / 2.3),'Keyboard'); i:=1; j:=1;
greenvalue:=0; bluevalue:=0; while
true do begin repeat case
mask of
true:begin
setRGBpalette(blue,0,0,bluevalue);
inc(bluevalue,i);
if
(bluevalue = 63) or (bluevalue = 0) then
i:=-i;
end;
false:begin
setRGBpalette(green,0,greenvalue,0);
inc(greenvalue,j);
if
(greenvalue = 63) or (greenvalue = 0) then
j:=-j;
end; end; until
keypressed; case
readkey of #75:
mask:=true; #77:
mask:=false; #13:
begin chem_play:=mask; delay(5000); cleardevice; exit; end; #27:
begin closegraph; halt; end; end; end; end; procedure
ugolki(var dx,dy:t_dx_dy;x,y:t_kubik;var a:t_arr;var
kol_kub:kol_kubik;var score:integer); procedure
izchez(var dx,dy:t_dx_dy;var a:t_arr;var kol_kub:kol_kubik;i:word); begin setcolor(0);
setfillstyle(1,0);
bar3d(a[i],a[i+1],a[i]+48,a[i+1]-20,0,false); musik; a[i]:=0; a[i+1]:=0; dx:=-dx; dy:=-dy; dec(kol_kub); musik;
naverhu_kubiki(kol_kub,score); exit; end; var
i:1..496; begin i:=1; while
i<=493 do begin if
x-radius+1=a[i]+48 then if
(y-radius+1=a[i+1])or((y-radius+1
or(y+radius-1=a[i+1]-20)or((y+radius-1 then
izchez(dx,dy,a,kol_kub,i); if
x+radius-1=a[i] then if
(y+radius-1=a[i+1]-20)or((y+radius-1
or(y-radius+1=a[i+1])or((y-radius+1 then
izchez(dx,dy,a,kol_kub,i); if
y-radius+1=a[i+1] then if
(x-radius+1=a[i]+48)or((x-radius+1>a[i])and(x-radius+1
or(x+radius-1=a[i])or((x+radius-1>a[i])and(x+radius-1 then
izchez(dx,dy,a,kol_kub,i); if
y+radius-1=a[i+1]-20 then if
(x+radius-1=a[i])or((x+radius-1>a[i])and(x+radius-1
or(x-radius+1=a[i]+48)or((x-radius+1>a[i])and(x-radius+1 then
izchez(dx,dy,a,kol_kub,i); inc(i,2); end; end; procedure
pausing(var pause:word); var
xmax,y_planka,x,y:t_kubik; dx,dy:-1..1; s:string;
redvalue,bluevalue:0..63; i:-1..1; begin
setcolor(lightgray);
s:='Adjust
speed of a ball';{'отрегулируйте
скорость
шарика'}
settextstyle(4{GothicFont},horizdir,5);
settextjustify(1,1);
outtextxy(getmaxx
div 2, getmaxy div 2,s); i:=1; redvalue:=0; bluevalue:=0; repeat repeat
setRGBpalette(lightgray,redvalue,0,bluevalue);
inc(bluevalue,i);
inc(redvalue,i); until
keypressed or (bluevalue=63) or (bluevalue=0); i:=-i; until
keypressed; cleardevice;
{рамка}
setcolor(random(14)+1);
rectangle(0,0,getmaxx,getmaxy);
xmax:=getmaxx-radius-1;
y_planka:=getmaxy-shir-radius-1;
{планка
на весь низ}
setcolor(13);
setfillstyle(6,13);
bar3d(1,getmaxy-1,getmaxx,getmaxy-shir,0,false);
{шарик
над планкой}
x:=getmaxx
div 2;
y:=getmaxy-shir-radius-1; setcolor(10);
circle(x,y,radius); dx:=1; dy:=-1; pause:=6; repeat while
not(keypressed) do
begin
zar_nar(x,y,dx,dy);
delay(pause);
if y=radius+1
then
begin
dy:=-dy; musik; end else
if x=xmax then
begin
dx:=-dx; musik; end else
if y=y_planka
then
begin
dy:=-dy; musik; end else
if x=radius+1
then
begin
dx:=-dx; musik; end;
end; case
readkey of
#45{'-'}:if
pause<65535 then inc(pause);
#42{'*'}:if pause
>2 then dec(pause);
#13:begin
cleardevice; exit; end; end; until
false; end; procedure
razmer_planki(var koeff:byte); var
s:string;
x1,y1,x2,y2:integer; i:-1..1;
redvalue,bluevalue:0..63; begin
setcolor(red);
s:='Adjust
the size of a rod'{'отрегулируйте
размер
планки'};
settextstyle(4{GothicFont},horizdir,5);
settextjustify(1,1);
outtextxy(getmaxx
div 2, getmaxy div 2, s); i:=1; redvalue:=0; bluevalue:=0; repeat repeat
setRGBpalette(red,redvalue,bluevalue,0);
inc(bluevalue,i);
inc(redvalue,i); until
keypressed or (redvalue=0) or (redvalue=63); i:=-i; until
keypressed; cleardevice;
{рамка}
setcolor(random(14)+1);
rectangle(0,0,getmaxx,getmaxy);
{планка
посередине}
setcolor(13);
setfillstyle(6,13); koeff:=4;
x1:=round(getmaxx/2-(koeff/2)*shir-1);
y1:=getmaxy-1;
x2:=round(getmaxx/2+(koeff/2)*shir);
y2:=getmaxy-shir;
bar3d(x1,y1,x2,y2,0,false); repeat if
keypressed then
case readkey of
#42{'*'}:if
koeff<42 then
begin
inc(koeff);
x1:=round(getmaxx/2-(koeff/2)*shir-1);
y1:=getmaxy-1;
x2:=round(getmaxx/2+(koeff/2)*shir);
y2:=getmaxy-shir;
bar3d(x1,y1,x2,y2,0,false);
end;
#45{-}:if
koeff>2 then
begin
setcolor(0);
setfillstyle(0,0);
x1:=round(getmaxx/2-(koeff/2)*shir-1);
y1:=getmaxy-1;
x2:=round(getmaxx/2+(koeff/2)*shir);
y2:=getmaxy-shir;
bar3d(x1,y1,x2,y2,0,false);
dec(koeff);
setcolor(13);
setfillstyle(6,13);
x1:=round(getmaxx/2-(koeff/2)*shir-1);
y1:=getmaxy-1;
x2:=round(getmaxx/2+(koeff/2)*shir);
y2:=getmaxy-shir;
bar3d(x1,y1,x2,y2,0,false);
end;
#13:exit;
end; until
false; end; procedure
livs(var liv:byte;score:integer); var
s2:string; begin dec(liv);
naverhu_liv(liv); if
liv=0 then begin
ochki(score);
s2:='You have
lost !';
zastavka(s2);
closegraph; halt; end; end; procedure
perehod_level(const numbering:byte); var
i,j:30..330; s:string; begin
str(numbering,s); s:='level
'+s; cleardevice; setcolor(14);
settextstyle(4{GothicFont},horizdir,5);
settextjustify(1,1);
outtextxy(getmaxx
div 2, getmaxy div 2, s); i:=30; j:=280; {while
(i<>330) and (j<>30) do begin
sound(i);
delay(100);
sound(j);
delay(100);
inc(i);
dec(j); end; nosound;} delay(5000); end; procedure
planka_sharik(koeff:byte); var
x1,y1,x2,y2,x,y:integer; begin
{планка
посередине}
setcolor(13);
setfillstyle(6,13);
x1:=round(getmaxx/2-(koeff/2)*shir-1);
y1:=getmaxy-1;
x2:=round(getmaxx/2+(koeff/2)*shir);
y2:=getmaxy-shir;
bar3d(x1,y1,x2,y2,0,false);
{шарик
над планкой}
x:=getmaxx
div 2;
y:=getmaxy-shir-radius-1; setcolor(10);
circle(x,y,radius); end; procedure
musik; begin {sound(460); delay(130); nosound;} end; procedure
izchez_vv_niz(var dy:t_dx_dy;x,y,i:t_kubik;var a:t_arr;var
kol_kub:kol_kubik;var score:integer); var
p:-3..494; begin p:=i-36; while
(i>=p) and not((y-radius+1=a[i+1]) or (y+radius-1=a[i+1]-20)) do
dec(i,2); if
i<0 then inc(i,2); if
(y-radius+1=a[i+1]) or (y+radius-1=a[i+1]-20) then begin
setcolor(0);
setfillstyle(1,0);
bar3d(a[i],a[i+1],a[i]+48,a[i+1]-20,0,false);
musik;
a[i]:=0;
a[i+1]:=0;
dy:=-dy;
dec(kol_kub);
naverhu_kubiki(kol_kub,score); end; end; procedure
bok_bok(var dx:t_dx_dy;x,y:t_kubik;var a:t_arr;var
kol_kub:kol_kubik;var score:integer); var
i:1..496; begin i:=1; while
i<=493 do begin if
((x+radius-1=a[i]) and (y
((x-radius+1=a[i]+48)
and (y begin
setcolor(0);
setfillstyle(1,0);
bar3d(a[i],a[i+1],a[i]+48,a[i+1]-20,0,false);
musik;
a[i]:=0;
a[i+1]:=0;
dx:=-dx;
dec(kol_kub);
musik;
naverhu_kubiki(kol_kub,score);
exit; end;
inc(i,2); end; end; procedure
death; var
i:30..800; begin i:=800; {while
i<>30 do begin
sound(i);
delay(10);
dec(i); end; nosound;} end; procedure
zapis(const xs,ys:t_kubik;i:t_kubik;var a:t_arr); begin while
a[i]<>0 do
inc(i,2); a[i]:=xs; a[i+1]:=ys; end; procedure
level(var a:t_arr;const numbering:byte;var kol_kub:kol_kubik); var
xs,ys,i:t_kubik; f:text;
color,pattern:byte; number:string; begin for
i:=1 to 494 do a[i]:=0;
str(numbering,number);
assign(f,'levels\level'+number+'.den'); reset(f); while
not eof(f) do begin
readln(f,xs,ys);
color:=random(14)+1;
pattern:=random(11)+1;
setcolor(color);
setfillstyle(pattern,color);
bar3d(xs,ys,48+xs,ys-20,0,false); end; close(f); kol_kub:=0; reset(f); while
not eof(f) do begin
readln(f,xs,ys); if
xs<>0 then inc(kol_kub);
case xs of
1: begin
i:=1; zapis(xs,ys,i,a); end;
50: begin
i:=39; zapis(xs,ys,i,a); end;
99: begin
i:=77; zapis(xs,ys,i,a); end;
148: begin
i:=115; zapis(xs,ys,i,a); end;
197: begin
i:=153; zapis(xs,ys,i,a); end;
246: begin
i:=191; zapis(xs,ys,i,a); end;
295: begin
i:=229; zapis(xs,ys,i,a); end;
344: begin
i:=267; zapis(xs,ys,i,a); end;
393: begin
i:=305; zapis(xs,ys,i,a); end;
442: begin
i:=343; zapis(xs,ys,i,a); end;
491: begin
i:=381; zapis(xs,ys,i,a); end;
540: begin
i:=419; zapis(xs,ys,i,a); end;
589: begin
i:=457; zapis(xs,ys,i,a); end;
end; end; close(f); end; procedure
left(const koeff:byte;var x1_dv,x2_dv:t_kubik); begin if
x1_dv-8 <= 0 then begin
musik;
setcolor(0);
setfillstyle(0,0);
bar3d(x1_dv,y1_dv,x2_dv,y2_dv,0,false);
setfillstyle(6,13);
setcolor(13);
x1_dv:=1;
x2_dv:=koeff*shir;
bar3d(x1_dv,y1_dv,x2_dv,y2_dv,0,false); end
else begin
setcolor(0);
setfillstyle(0,0);
bar3d(x1_dv,y1_dv,x2_dv,y2_dv,0,false);
setfillstyle(6,13);
setcolor(13);
dec(x1_dv,8);
dec(x2_dv,8);
bar3d(x1_dv,y1_dv,x2_dv,y2_dv,0,false); end; end; procedure
right(const koeff:byte;var x1_dv,x2_dv:t_kubik); begin if
x2_dv+8 >= getmaxx then begin
musik;
setcolor(0);
setfillstyle(0,0);
bar3d(x1_dv,y1_dv,x2_dv,y2_dv,0,false);
setfillstyle(6,13);
setcolor(13);
x2_dv:=getmaxx-1;
x1_dv:=x2_dv-koeff*shir;
bar3d(x1_dv,y1_dv,x2_dv,y2_dv,0,false); end
else begin
setcolor(0);
setfillstyle(0,0);
bar3d(x1_dv,y1_dv,x2_dv,y2_dv,0,false);
setfillstyle(6,13);
setcolor(13);
inc(x1_dv,8);
inc(x2_dv,8);
bar3d(x1_dv,y1_dv,x2_dv,y2_dv,0,false); end; end; procedure
dviguna_keyboard(const koeff:byte;var x,x1_dv,x2_dv:t_kubik;var
y:t_kubik); begin
{Рисуем
планку с шариком
посередине}
planka_sharik(koeff);
{Ниже
--- координаты
планки и шарика(только-что
нарисованных)}
x1_dv:=round(getmaxx/2-(koeff/2)*shir-1);
x2_dv:=round(getmaxx/2+(koeff/2)*shir); x:=getmaxx
div 2;
y:=getmaxy-shir-radius-1; repeat case
readkey of #75:
if x > (koeff div 2)*shir then
begin
left(koeff,x1_dv,x2_dv);
setcolor(0);
circle(x,y,radius);
x:=round(x1_dv+shir*koeff/2);
setcolor(10);
circle(x,y,radius);
end; #77:
if x < getmaxx-(koeff/2)*shir then
begin
right(koeff,x1_dv,x2_dv);
setcolor(0);
circle(x,y,radius);
x:=round(x1_dv+shir*koeff/2);
setcolor(10);
circle(x,y,radius);
end; '
': exit;
#27:begin
closegraph; halt; end; end; until
false; end; procedure
dviguna_mouse(const koeff:byte;var x,x1_dv,x2_dv:t_kubik;var
y:t_kubik); var
x_get,y_get:word;
x_get_pred:word;
lb,rb,tb:boolean; begin
{Рисуем
планку с шариком
посередине}
planka_sharik(koeff);
{устанавливает
ограничение
перемещения
курсора мыши
по вертикали}
setYrange(5,5);
{устанавливает
ограничение
перемещения
курсора мыши
по горизонтали}
setXrange(1,getmaxx-koeff*shir-1);
{Ниже
--- координаты
планки и шарика(только-что
нарисованных)}
x1_dv:=round(getmaxx/2-(koeff/2)*shir-1);
x2_dv:=round(getmaxx/2+(koeff/2)*shir);
setmousexy(x1_dv,0); x:=getmaxx
div 2;
y:=getmaxy-shir-radius-1; repeat
getmousexy(x_get,y_get,lb,rb,tb); if
x_get_pred<>x_get then begin
setcolor(0);
setfillstyle(0,0);
bar3d(x1_dv,y1_dv,x2_dv,y2_dv,0,false);
setfillstyle(6,13);
setcolor(13);
x1_dv:=x_get;
x2_dv:=x1_dv+koeff*shir;
bar3d(x1_dv,y1_dv,x2_dv,y2_dv,0,false);
x_get_pred:=x_get;
setcolor(0);
circle(x,y,radius);
setcolor(10);
x:=x_get+round(koeff/2)*shir;
circle(x,y,radius); end; until
lb; end; procedure
zar_nar(var x,y:t_kubik;const dx,dy:t_dx_dy); begin setcolor(0);
circle(x,y,radius); inc(x,dx); inc(y,dy); setcolor(10);
circle(x,y,radius); end; procedure
naverhu_number(numbering:byte); var
s:string; begin
settextstyle(4{GothicFont},horizdir,3);
settextjustify(centertext,centertext);
setfillstyle(1,black);
bar(0,0,120,19);
setcolor(lightgreen);
str(numbering,s); s:='Level
'+s;
outtextxy(60,5,s); end; procedure
naverhu_liv(liv:byte); var
s:string; begin
settextstyle(4{GothicFont},horizdir,3);
settextjustify(centertext,centertext);
setfillstyle(1,black);
bar(140,0,250,19);
setcolor(lightgreen); str(liv,s); s:='Lifes
'+s;
outtextxy(195,5,s); end; procedure
naverhu_kubiki(kol_kub:byte;var score:integer); var
s:string; begin
settextstyle(4{GothicFont},horizdir,3);
settextjustify(centertext,centertext);
setfillstyle(1,black);
bar(270,0,420,19);
setcolor(lightgreen);
str(kol_kub,s); s:='Kubikov
'+s;
outtextxy(345,5,s);
inc(score,10);
naverhu_score(score); end; procedure
naverhu_score(score:integer); var
s:string; begin
settextstyle(4{GothicFont},horizdir,3);
settextjustify(centertext,centertext);
setfillstyle(1,black);
bar(440,0,630,19);
setcolor(lightgreen); str(score,s); s:='Score
'+s;
outtextxy(535,5,s); end; end. unit
mark_zas; interface uses
crt,graph,mymouse; type
t_mas=array [1..11] of word; procedure
zastavka(s2:string); procedure
text_na_ekran; procedure
ochki(score:word); implementation procedure
text_na_ekran; var
f:text; a:char; begin
assign(f,'pravila.txt'); reset(f); textmode(1);
textbackground(3); textcolor(0); clrscr; while
not eof(f) do begin
while not(eof(f))
do
begin
read(f,a);
write(a);
end;
writeln; end; while
not(keypressed) do case
readkey of
#27:exit; end; close(f); end; procedure
zastavka(s2:string); var
redvalue:-2..63;
greenvalue2:-2..63;
lb,rb,tb:boolean;
buttoncount,errorcode:byte; x,y:word; i:-1..1; begin
initmouse(buttoncount,errorcode); cleardevice;
setcolor(lightgreen);
setlinestyle(0,2,3);
rectangle(0,0,getmaxx,getmaxy);
settextjustify(centertext,centertext);
settextstyle(4{GothicFont},horizdir,9); setcolor(3);
outtextxy(getmaxx
div 2,round(getmaxy / 2.5),'Markball'); setcolor(1);
settextstyle(7{TSCR.CHR},horizdir,2);
settextjustify(lefttext,centertext); if
s2='Click to start' then
outtextxy(10,10,'Press
F1 for the help'); setcolor(2);
settextstyle(7{TSCR.CHR},horizdir,3);
outtextxy(getmaxx
div 2,round(getmaxy / 1.3), s2); i:=1; redvalue:=1;
greenvalue2:=62; repeat repeat
inc(redvalue,i);
setRGBpalette(3,redvalue,redvalue,0);
getmouseXY(x,y,lb,rb,tb);
inc(greenvalue2,-i);
setRGBpalette(2,0,greenvalue2,greenvalue2);
setRGBpalette(1,Greenvalue2,0,0); until
(redvalue=63) or (redvalue=0) or rb or lb or keypressed; i:=-i; if
keypressed then case
readkey of
#59{F1}:
begin
text_na_ekran;
SetGraphMode(vgahi);
setcolor(lightgreen);
setlinestyle(0,2,3);
rectangle(0,0,getmaxx,getmaxy);
settextjustify(centertext,centertext);
settextstyle(4{GothicFont},horizdir,9);
redvalue:=1;
greenvalue2:=62;
setcolor(3);
outtextxy(getmaxx
div 2,round(getmaxy / 2.5),'Markball');
setcolor(1);
settextstyle(7{TSCR.CHR},horizdir,2);
settextjustify(lefttext,centertext);
if
s2='Click to start' then
outtextxy(10,10,'Press
F1 for the help');
setcolor(2);
settextstyle(7{TSCR.CHR},horizdir,3);
outtextxy(getmaxx
div 2,round(getmaxy / 1.3), s2);
end;
#13:exit; end; until
rb or lb; end; procedure
ochki(score:word); var
f:text; s:string[15]; c:word;
numb,mynumber:-5..20; player:t_mas;
players_name:array
[1..11] of string[15]; x,y:word; i:char;
myname:string[15]; label
ld; begin
assign(f,'record.txt'); reset(f); readln(f); numb:=0; while
not eof(f) do begin
readln(f,c);
inc(numb);
player[numb]:=c;
readln(f); end; close(f); reset(f); numb:=0; while
not eof(f) do begin
readln(f,s);
inc(numb);
players_name[numb]:=s;
readln(f); end; close(f); x:=getmaxx
div 2-140; y:=35;
bar3d(x,y,x+280,y+100,0,false);
settextjustify(centertext,centertext);
settextstyle(4{Gothic
Font},horizdir,3);
setcolor(lightcyan);
outtextxy(x+140,y+10,'Enter
your name'); myname:=''; while
true do if
keypressed then begin
i:=readkey;
case i of
#13: goto ld;
else begin
outtextxy(x+20,y+40,i);
inc(x,18);
myname:=myname+i;
end;
end; end; ld: mynumber:=0; numb:=1; while
(numb <= 10) and (score < player[numb]) do
inc(numb); if
numb = 11 then begin
x:=getmaxx div
2-140; y:=35;
bar3d(x,y,x+280,y+300,0,false);
settextjustify(centertext,centertext);
settextstyle(4{Gothic
Font},horizdir,3);
setcolor(lightcyan);
outtextxy(x+140,y+10,'The
best players');
settextjustify(lefttext,centertext); y:=75; for
numb:=1 to 10 do begin
outtextxy(x+10,y,players_name[numb]);
str(player[numb],s);
outtextxy(x+190,y,s);
inc(y,25);
delay(1000); end; end else begin
settextstyle(4{Gothic
Font},horizdir,3);
mynumber:=numb; for
c:=10 downto numb do
begin
player[c+1]:=player[c];
players_name[c+1]:=players_name[c]; end;
player[mynumber]:=score;
players_name[mynumber]:=myname;
x:=getmaxx div
2-140; y:=35;
bar3d(x,y,x+280,y+300,0,false);
settextjustify(centertext,centertext);
settextstyle(4{Gothic
Font},horizdir,3);
setcolor(lightcyan);
outtextxy(x+140,y+10,'The
best players'); y:=75;
settextjustify(lefttext,centertext); for
numb:=1 to 10 do begin
outtextxy(x+10,y,players_name[numb]);
str(player[numb],s);
outtextxy(x+190,y,s);
inc(y,25);
delay(1000); end;
rewrite(f); for
numb:=1 to 10 do
begin
writeln(f,players_name[numb]);
writeln(f,player[numb]); end;
close(f); end; readkey; end; end. Дополнительная
программа для
построения
собственных
уровней : Правила
пользования
программой:
запустить
MARKEDIT.EXE нажимая
левую кнопку
мыши ставить(рисовать)
кубики;
после
построения
уровня нажать
правую кнопку
мыши; после
появления меню
номеров уровней
выбрать номер
сохраняемого
уровня (файла); Спецификации
подпрограмм:
1.
procedure
text_na_ekran; Назначение:
используется
как справка
и всегда показывается
при запуске;
Входные
данные:
нет;
Выходные
данные:
нет; 2.
function netu:boolean; Назначение:
при нажатии
левой кнопки
мыши определяет,
есть ли на этом
месте уже кубик
или нет; Входные
данные:
нет;
Выходные
данные:
True:
рисуем кубик;
False:
на этом месте
уже есть кубик,
значит не рисуем; 3.
procedure stroika; Назначение:
рисует кубик
и записывает
его координаты
в файл; Входные
данные: нет;
Выходные
данные: нет; 4.
procedure search_y; Назначение:
ищет подходящие
координаты
для построения
кубика; Входные
данные: нет;
Выходные
данные: нет; 5.
procedure build_level; Назначение:
строит этап,
используя
вышеописанные
подпрограммы; Входные
данные: нет;
Выходные
данные: нет;
Текст
программы: program
markedit; uses
graph,crt,mymouse; type
t_kubik=-10..640; t_arr=array[1..494]
of t_kubik; var
x,y:word; f,f_s:text; a:t_arr; i:1..494; procedure
initgr; var
grdriver,grmode:integer; begin grdriver:=vga; grmode:=vgahi; initgraph(grdriver,grmode,''); if
GraphResult <> grOk then halt; end; procedure
text_na_ekran; var
f:text; a:char; begin assign(f,'stroika.txt'); reset(f); textmode(1); textbackground(3); textcolor(0); clrscr; while
not eof(f) do begin while
not(eof(f)) do begin read(f,a); write(a); end; writeln; end; while
not(keypressed) do case
readkey of '
':exit; end; close(f); end; function
netu:boolean; var
k:1..494; begin for
k:=1 to 494 do begin if
a[k]=x then if
a[k+1]=y then begin
netu:=false; exit; end; end; netu:=true; end; procedure
stroika; var
color:1..15; pattern:1..12; begin if
netu then begin writeln(f,x,'
',y); a[i]:=x; a[i+1]:=y; inc(i,2); color:=random(14)+1; pattern:=random(11)+1; setcolor(color);
setfillstyle(pattern,color);
bar3d(x,y,48+x,y-20,0,false); end; end; procedure
search_y; begin case
y of 22..42:
begin y:=42; stroika; end; 43..63:
begin y:=63; stroika; end; 64..84:
begin y:=84; stroika; end; 85..105:
begin y:=105; stroika; end; 106..126:begin
y:=126; stroika; end; 127..147:begin
y:=147; stroika; end; 148..168:begin
y:=168; stroika; end; 169..189:begin
y:=189; stroika; end; 190..210:begin
y:=210; stroika; end; 211..231:begin
y:=231; stroika; end; 232..252:begin
y:=252; stroika; end; 263..273:begin
y:=273; stroika; end; 274..294:begin
y:=294; stroika; end; 295..315:begin
y:=315; stroika; end; 316..336:begin
y:=336; stroika; end; 337..357:begin
y:=357; stroika; end; 358..378:begin
y:=378; stroika; end; 379..399:begin
y:=399; stroika; end; 400..420:begin
y:=420; stroika; end; end; end; procedure
build_level; var
buttoncount,errorcode:byte; lb,rb,tb:boolean; x_pred:word; s,s_l:string; number:0..10; spusk:1..500; code:integer; begin initmouse(buttoncount,errorcode); cleardevice;
{а ¬Є } setcolor(random(14)+1); rectangle(0,21,getmaxx,getmaxy); setcolor(brown); s:='when
finish --- press the right button of the mouse';
settextstyle(7{GothicFont},horizdir,2); settextjustify(1,1); outtextxy(getmaxx
div 2,5,s); setYrange(21,420); setXrange(1,637); assign(f,'level.den'); rewrite(f); x:=10;y:=10; setmouseXY(x,y); x_pred:=0; mouseon; repeat getmouseXY(x,y,lb,rb,tb); if
lb then begin mouseoff; if
x<>x_pred then case
x of 1..49:
begin x:=1; search_y; end; 50..98:
begin x:=50; search_y; end; 99..147:begin
x:=99; search_y; end; 148..196:begin
x:=148; search_y; end; 197..245:begin
x:=197; search_y; end; 246..294:begin
x:=246; search_y; end; 295..343:begin
x:=295; search_y; end; 344..392:begin
x:=344; search_y; end; 393..441:begin
x:=393; search_y; end; 442..490:begin
x:=442; search_y; end; 491..539:begin
x:=491; search_y; end; 540..588:begin
x:=540; search_y; end; 589..637:begin
x:=589; search_y; end; end; x_pred:=x; mouseon;
end; until
rb; setfillstyle(1,black); bar(4,getmaxy
div 5-8,130,getmaxy div 5 +300+20); setcolor(yellow); s:='Save
as: '; spusk:=getmaxy
div 5;
settextstyle(4{GothicFont},horizdir,4);
settextjustify(lefttext,centertext); outtextxy(4,spusk,s); for
number:=1 to 10 do begin inc(spusk,30); str(number,s_l); s:='Level
'+s_l;
settextstyle(4{GothicFont},horizdir,4);
settextjustify(lefttext,centertext); outtextxy(4,spusk,s); end; close(f); repeat if
keypressed then begin s:=readkey; val(s,number,code); case
number of 0:begin
assign(f_s,'levels\level10.den'); erase(f_s);
rename(f,'levels\level10.den'); exit; end else
if number in [1..9] then begin
assign(f_s,'levels\level'+s+'.den');
erase(f_s);
rename(f,'levels\level'+s+'.den');
exit; end; end; end; until
false; end; var
j:1..494; begin {for
j:=1 to 494 do a[j]:=0;} i:=1; randomize; text_na_ekran; initgr; build_level; mouseoff; closegraph; end. Список
используемой
литературы: Ян
Белецкий «Турбо
Паскаль с графикой
для персональных
компьютеров» Walasek
J.Konwersacyjne otoczenie programowe Pascala. WNT, Warsawa Turbo
Tutor. Borland International. Scotts Valley, California Cherry G.
Pascal Programming Structures. Reston Publishing Company. Reston,
Virginia