Арканоид на Паскале
Работа из раздела: «
Программирование и комп-ры»
Министерство общего и профессионального образования РФ
Белгородская Государственная Технологическая Академия
Строительных Материалов.
Кафедра ПОВТиАС
[pic]
Выполнил:
Студент факультета АПиИТ
Группы ПВ-22
Маркелов Денис
Руководитель:
Белгород – 2000.
СОДЕРЖАНИЕ
1. ПРЕДИСЛОВИЕ
2. ВВЕДЕНИЕ
3. ЗАДАНИЕ КУРСОВОЙ РАБОТЫ
4. ПРАВИЛА ПОЛЬЗОВАНИЯ ПРОГРАММОЙ «АРКАНОИД»
5. ИСПОЛЬЗУЕМЫЕ СТРУКТУРЫ ДАННЫХ
6. ИСПОЛЬЗУЕМЫЕ МОДУЛИ
7. СПЕЦИФИКАЦИЯ ПОДПРОГРАММ
8. ТЕКСТ ПРОГРАММЫ И СКОНСТРУИРОВАННЫХ МОДУЛЕЙ
9. правила пользования дополнительной программой для построения уровней
«MARKEDIT»
10. СПЕЦИФИКАЦИЯ ПОДПРОГРАММ В ПРОГРАММЕ «MARKEDIT»
11. ТЕКСТ ПРОГРАММЫ «MARKEDIT” И СКОНСТРУИРОВАННЫХ МОДУЛЕЙ
12. СПИСОК ИСПОЛЬЗУЕМОЙ ЛИТЕРАТУРЫ
Предисловие
Язык Турбо Паскаль – это один из самых распространённых языков
программирования микрокомпьютеров. Он разработан фирмой «Борланд» как
диалект стандартного языка Паскаль, но благодаря своей популярности сам
стал стандартом языка программирования 8- и 16-разрядных микрокомпьютеров.
К важнейшим достоинствам языка Турбо Паскаль относятся небольшой размер
компилятора, высокая степень соответствия стандартному Паскалю, очень
быстрая компиляция программ, объединение компилятора с интерактивным
экранным редактором, предупреждение об ошибках на уровне исходной
программы, обширная библиотека подпрограмм и полезные расширения,
упрощающие системное программирование.
Введение
Одной из основных проблем, с которой сталкиваются в процессе
программирования, является написание программы, не содержащей ошибок.
Ошибку наиболее полно можно определить как расхождение поведения программы
с ожиданиями пользователя. Сюда входит как несоответствие результатов
исходным данным, так и другие, порой более опасные эффекты: зацикливание,
аварийная остановка программ и т.п.
Наиболее явно наблюдаемыми историческими тенденциями в программировании
являются непрерывный рост пользовательских требований, лавинообразное
усложнение функциональности программы и, как следствие, - усложнение её
разработки.В связи с увеличением трудоёмкости програмных средств возникла
необходимость выработки интеллектуальных инструментов, позволяющих
разработчикам справляться с возросшей сложностью своего труда.
В настоящий момент можно утверждать, что практически каждая программа
составляется с применением той или иной технологии программирования.
«В связи с тем,что за последние десять или пятьнадцать лет
производительность вычислительных машин увеличилась в тысячи раз,
пользователи стали гораздо более бесцеремонными при выборе проблем, которые
они считают «технически разрешимыми». Пользователи хотят, чтобы размеры,
сложность и изощрённость программ увеличивалась исключительно быстрыми
темпами, и в последние годы стало очевидным, что в целом наши
программистские возможности не поспевают за этими неумеренными аппетитами».
По мере того, как мощь компьютеров росла, а область применения всё
расширялась, увеличивались не только размеры, и сложность программ, но и
количество ошибок в них.
Главной задачей современного программиста при написании программы является
не подвегание её бесконечным тестированиям, а тщательный, полный анализ
исходного текста программы, а также отладка программы с помощью
дополнительных програмных средств.
Задание на проектирование
Разработать алгоритм игры «АРКАНОИД», цель которой заключается в наборе как
можно большего количества очков, которые увеличиваются при выбивании
очередного кубика.
При выбивании всех кубиков текущего уровня осуществляется переход на
следующий уровень, количество которых – десять.
В конце игры в зависимости от количества набранных очков, введённое по
запросу программы имя игрока должно быть занесено в десятку лучших и
записано в файл.
Над рамкой, в течение игры должны отображаться:
1) № текущего этапа;
2) количество оставшихся жизней, первоначально которых – 10;
1) количество оставшихся кубиков;
2) количество набранных очков.
Правила пользования программой:
1) запустить MARKBALL.EXE
2) выбрать чем играть:
2a) мышь
2б) клавиатура
3) выбрать скорость шарика
4) выбрать размер планки
Используемые структуры данных:
type t_kubik=0..640;
t_dx_dy=-1..1;
t_arr=array[1..494] of t_kubik;
kol_kubik=0..247;
t_kubik – значения всех переменных, используемых в программе, заданы в этих
пределах (и не более);
t_dx_dy – значение, которое принимает коэффициент, от которого зависит
направление движения по оси ОХ или ОУ;
t_arr – значения координат, которые принимает кубик, в соответствии со
своим отображением (изображением) на экране;
kol_kubik – максимальное количество кубиков;
Используемые модули:
Стандартные:
1) CRT;
2) GRAPH;
3) WINDOS – модуль требуемый сконструируемым модулем MYMOUSE;
4) STRINGS – модуль требуемый сконструируемым модулем MYMOUSE;
Сконструированные:
1) MARKEL – основные игровые подпрограммы;
2) MARK_ZAS – содержит инструментарий интерфейса (заставка, помощь,
счёт лучших игроков в конце игры);
3) MYMOUSE – работа с мышью
Спецификация подпрограмм:
Модуль MARKEL
a. procedure livs(var liv:byte);
Назначение: считает оставшиеся жизни, если число жизней будет равно
нулю, то выводит на экран мигающую надпись: «YOU HAVE LOST»;
Входные данные: liv – число жизней;
Выходные данные: liv – оставшиеся количество жизней;
2. procedure perehod_level(const numbering:byte);
Назначение: выводит по середине экрана надпись, соответствующую началу
нового этапа;
Входные данные: numbering – номер нового этапа;
Выходные данные: нет;
3. procedure planka_sharik(koeff:byte);
Назначение: рисует планку, размером, определённым от значения koeff,
посередине экрана и шарик над ней;
Входные данные: koeff – число определяющее размер планки;
Выходные данные: нет;
4. procedure musik;
Назначение: выдаёт звуковой сигнал, соответствующий какому-либо
касанию шарика о что нибудь;
Входные данные: нет;
Выходные данные: нет;
5.procedure izchez_vv_niz(var dy:t_dx_dy;x,y,i:t_kubik;var
a:t_arr;var kol_kub:kol_kubik);
Назначение: определяет коснулся ли шарик кубика о верхнюю или нижнюю
грань;
Входные данные:
2) dy – направление движения шарика по оси Y;
3) x,y – текущие координаты центра шарика;
4) i – значение, от которого зависит какие кубики проверять на сбивание;
5) a – массив координат кубиков;
6) kol_kub – количество кубиков на данный момент;
Выходные данные:
7) dy – изменённое направление движения шарика по оси Y;
8) a – изменённый массив координат кубиков;
9) kol_kub – изменённое количество кубиков;
6. procedure bok_bok(var dx:t_dx_dy;x,y:t_kubik;var a:t_arr;var
kol_kub:kol_kubik);
Назначение: определяет коснулся ли шарик кубика о левую или правую
грань;
Входные данные:
10) dx – направление движения шарика по оси X;
11) x,y – текущие координаты центра шарика;
12) a – массив координат кубиков;
13) kol_kub – количество кубиков на данный момент;
Выходные данные:
14) dx – изменённое направление движения шарика по оси X;
15) a – изменённый массив координат кубиков;
16) kol_kub – изменённое количество кубиков;
7. procedure death;
Назначение: выдаёт звуковой сигнал, соответствующий проигрышу одной
жизни;
Входные данные: нет;
Выходные данные: нет;
8. procedure ugolki(var dx,dy:t_dx_dy;x,y:t_kubik;var a:t_arr;var
kol_kub:kol_kubik);
Назначение: определяет коснулся ли шарик кубика об углы;
Входные данные:
17) dx,dy – направление движения шарика по осям X и Y;
18) x,y – текущие координаты центра шарика;
19) a – массив координат кубиков;
20) kol_kub – количество кубиков на данный момент;
Выходные данные:
21) dx,dy – изменённое направление движения шарика по осям X и Y;
22) a – изменённый массив координат кубиков;
23) kol_kub – изменённое количество кубиков;
9. procedure pausing(var pause:word);
Назначение: определяет скорость движения шарика по выбору самим
пользователем, с наглядным графическим интерфейсом;
Входные данные:
pause – предполагаемая пауза;
Выходные данные:
pause – уже определённая пауза;
10. procedure zapis(const xs,ys:t_kubik; i:t_kubik;var a:t_arr);
Назначение: определяет на какие места в массиве записывать координаты
кубика;
Входные данные:
1) xs,ys – координаты шарика, которые и нужно записать в массив;
24) i – переменная от которой зависит с какого номера искать подходящее
место для координат кубика;
25) a – массив координат кубиков;
Выходные данные: нет
11. procedure level(var a:t_arr;const numbering:byte;var
kol_kub:kol_kubik);
Назначение: открывает файл и считывая с него координаты кубиков,
рисует их;
Входные данные:
1) a – массив координат кубиков;
2) numbering – номер открываемого этапа;
3) kol_kub – количество кубиков;
Выходные данные:
1) a – массив координат кубиков;
2) kol_kub – количество нарисованных кубиков;
12. procedure left(const koeff:byte;var x1_dv,x2_dv:t_kubik);
Назначение: движение планки влево;
Входные данные:
1) koeff – коэффициент, от которого зависит размер планки;
2) x1_dv,x2_dv – координаты планки по оси Х;
Выходные данные:
x1_dv,x2_dv – изменившиеся координаты планки по оси Х;
13. procedure right(const koeff:byte;var x1_dv,x2_dv:t_kubik);
Назначение: движение планки вправо;
Входные данные:
1) koeff – коэффициент, от которого зависит размер планки;
3) x1_dv,x2_dv – координаты планки по оси Х;
Выходные данные:
x1_dv,x2_dv – изменившиеся координаты планки по оси Х;
14. procedure dviguna_keyboard(const koeff:byte;var
x,x1_dv,x2_dv:t_kubik;var y:t_kubik);
Назначение: ожидание нажатия клавиши для начала нового этапа, если
пользователь играет на клавиатуре;
Входные данные:
1) koeff – коэффициент, от которого зависит размер планки;
1) x,y – координаты шарика;
2) x1_dv,x2_dv – координаты планки по оси Х;
Выходные данные:
3) x,y – координаты шарика;
4) x1_dv,x2_dv – изменившиеся координаты планки по оси Х;
15. procedure dviguna_mouse(const koeff:byte;var
x,x1_dv,x2_dv:t_kubik;var y:t_kubik);
Назначение: ожидание нажатия кнопки мыши для начала нового этапа, если
пользователь играет мышью;
Входные данные:
1) koeff – коэффициент, от которого зависит размер планки;
2) x,y – координаты шарика;
5) x1_dv,x2_dv – координаты планки по оси Х;
Выходные данные:
f. x,y – координаты шарика;
g. x1_dv,x2_dv – изменившиеся координаты планки по оси Х;
16. procedure zar_nar(var x,y:t_kubik;const dx,dy:t_dx_dy);
Назначение: закраска уже нарисованного шарика и нарисование нового
шарика с изменёнными координатами;
Входные данные:
1) x,y – координаты шарика;
2) dx,dy – от значения этих переменных зависит движение шарика в ту
или иную сторону;
Выходные данные:
x,y – координаты шарика;
17. function chem_play:boolean;
Назначение: определение пользователем чем играть (клавиатурой или
мышью), с наглядным графическим интерфейсом;
Входные данные:
Нет;
Выходные данные:
true – играем мышью;
false – играем на клавиатуре;
18. procedure razmer_planki(var koeff:byte);
Назначение: определение пользователем размера планки;
Входные данные:
Koeff – коэффициент, определяющий размер планки;
Выходные данные:
Koeff – коэффициент, определяющий размер планки; граем мышью;
19. procedure naverhu_liv(liv:byte);
Назначение: отображение над рамкой в течение игры количества
оставшихся жизней;
Входные данные:
liv – число жизней;
Выходные данные:
нет;
20.procedure naverhu_number(numbering:byte);
Назначение: отображение над рамкой в течение игры номера текущего
уровня;
Входные данные:
numbering – номер уровня;
Выходные данные:
нет;
21. procedure naverhu_kubiki(kol_kub:byte);
Назначение: отображение над рамкой в течение игры количества
оставшихся кубиков;
Входные данные:
Kol_kub – число оставшихся кубиков;
Выходные данные:
нет;
Модуль MARK_ZAS
1. procedure zastavka(s2:string);
Назначение: в начале игры используется в качестве заставки с мигающей
большой надписью «MARKBALL» и ниже мигающей надписью «Click to start»
,также используется при потере всех жизней , но при этом нижняя надпись
будет «You have lost» , а при прохождении всех этапов нижняя надпись будет
«The end of game»;
Входные данные:
S2 – нижняя мигающая надпись;
Выходные данные:
нет;
2. procedure text_na_ekran;
Назначение: используется как справка пока игра ещё не началась при
нажатии клавиши «F1»;
Входные данные:
нет;
Выходные данные:
нет;
3. procedure ochki(score:word);
Назначение: в конце игры считает в соответствии с набранными очками:
займёт ли данный игрок, который ввёл по запросу программы своё имя, какое-
нибудь место среди представленных десяти мест; если количество набранных
очков позволяет игроку занять некоторое место, то программа выводит на
экран таблицу лидеров, включающую в себя имя данного игрока, в противном
случае на экран всё же будет выведена таблица лидеров, но имени данного
игрока содержаться там не будет;
Входные данные:
Score – количество набранных в течении игры очков;
Выходные данные:
нет;
Основная программа
1. Procedure initgr;
Назначение: инициализирует графику в режиме vgahi;
Входные данные: нет;
Выходные данные: нет;
2. Procedure vostanovka_colors;
Назначение: восстанавливает цвета со стандартными оттенками;
Входные данные: нет;
Выходные данные: нет;
Текст программы:
program mark_ball;
uses graph,crt,mymouse,markel,mark_zas;
procedure initgr;
var grdriver,grmode:integer;
begin
grdriver:=vga;
grmode:=vgahi;
initgraph(grdriver,grmode,'');
if GraphResult <> grOk then halt;
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_dvx_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+1a[i+1]-
20))
or(y+radius-1=a[i+1]-20)or((y+radius-1a[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-1a[i+1]-20))
or(y-radius+1=a[i+1])or((y-radius+1a[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+1a[i])and(x+radius-1a[i])and(x+radius-1a[i])and(x-radius+12 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 (ya[i+1]-20)) or
((x-radius+1=a[i]+48) and (ya[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_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.
Дополнительная программа для построения собственных уровней :
Правила пользования программой:
1) запустить MARKEDIT.EXE
2) нажимая левую кнопку мыши ставить(рисовать) кубики;
3) после построения уровня нажать правую кнопку мыши;
4) после появления меню номеров уровней выбрать номер сохраняемого
уровня (файла);
Спецификации подпрограмм:
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.
Список используемой литературы:
1) Ян Белецкий «Турбо Паскаль с графикой для персональных компьютеров»
2) Walasek J.Konwersacyjne otoczenie programowe Pascala. WNT, Warsawa
3) Turbo Tutor. Borland International. Scotts Valley, California
4) Cherry G. Pascal Programming Structures. Reston Publishing Company.
Reston, Virginia
