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 keydivssed 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_divd <> 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_divd: = 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 keydivssed;
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 a [i +1] -20))
or (y + radius-1 = a [i +1] -20) or ((y + radius-1 a [i +1] -20))
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 a [i +1] -20))
or (y-radius +1 = a [i +1]) or ((y-radius +1 a [i +1] -20))
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 keydivssed or (bluevalue = 63) or (bluevalue = 0);
i: =- i;
until keydivssed;
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 (keydivssed) 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 keydivssed or (redvalue = 0) or (redvalue = 63);
i: =- i;
until keydivssed;
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 keydivssed 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 a [i +1] -20)) or
((X-radius +1 = a [i] +48) and (y 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;
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_divd: word;
lb, rb, tb: boolean;
begin
{Малюємо планку з кулькою посередині}
planka_sharik (koeff);
{Встановлює обмеження переміщення курсору миші по вертикалі}
setYrange (5,5);
{Встановлює обмеження переміщення курсору миші по горизонталі}
setXrange (1, getmaxx-koeff * shir-1);
{Нижче --- координати планки і кульки (тільки-що намальованих)}
0>42>65535> 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_divd <> 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_divd: = 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 (keydivssed) 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 keydivssed;
i: =- i;
if keydivssed 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 keydivssed 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 (keydivssed) 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_divd: 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 --- divss 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_divd: = 0;
mouseon;
repeat
getmouseXY (x, y, lb, rb, tb);
if lb then begin
mouseoff;
if x <> x_divd 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_divd: = 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 keydivssed 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