Программа
UNIT MODUL_53;
INTERFACE
Procedure Go(X,Y,Vx,Vy,a:real);
FUNCTION Menu:byte; { Функция вывода меню и получения ответа }
IMPLEMENTATION
Uses Crt,Graph; { Подключение модулей }
FUNCTION Menu:byte; { Функция вывода меню и получения ответа }
Const QuantityMenuPoint=2; { Количество пунктов меню }
ExitPoint=QuantityMenuPoint; { Пункт меню "Выход" }
MaxLengthMenuPoint=8; { Максимальная длина пункта меню }
MenuList:array[1..QuantityMenuPoint] of string[MaxLengthMenuPoint] =
('[1] Game',
'[2] EXIT');
Var MenuMeter:integer; { Счетчик }
Point:integer; { Текущий пункт меню }
Begin
ClrScr; { Очистка экрана }
for MenuMeter:=1 to QuantityMenuPoint do WriteLn(MenuList[MenuMeter]);
{ Цикл прорисовки меню }
repeat { Цикл чтения клавиатуры }
Point:=Ord(ReadKey); { Чтение клавиатуры }
if Point<>27 { Если нажатая клавиша не Esc, }
then Point:=Point-Ord('0') { то - вычисление введенного пункта меню }
else Point:=ExitPoint { иначе - переопределение пункта под "Выход" }
until (0<Point) and (Point<=QuantityMenuPoint);
{ Выход из цикла при пролучении корректного ответа }
{ Определение значения функции: }
if Point=ExitPoint then Menu:=255
else Menu:=Point
End;
Procedure SwitchingPage;{ Переключение отображаемой и активной видеостраниц }
const Page:boolean=FALSE; { Флаг страниц }
Begin
SetVisualPage(Ord(Page)); { Установка отображаемой страницы }
SetActivePage(Ord(not Page)); { Установка активной страницы }
Page:=not Page { Переустановка флага }
End;
Procedure DrawBackground;
Begin
Line(12*GetMaxX div 32,6*GetMaxY div 7,23*GetMaxX div 25,34*GetMaxY div 43);
Line(32*GetMaxX div 54,GetMaxY div 7,2*GetMaxX div 25,3*GetMaxY div 4);
Line(2*GetMaxX div 3,16*GetMaxY div 27,3*GetMaxX div 5,134*(GetMaxY div 432));
Line(32*GetMaxX div 34,GetMaxY div 37,2*GetMaxX div 35,GetMaxY div 2);
End;
Procedure Go(X,Y,Vx,Vy,a:real);
Const { Строки подсказок: }
Str1='Press any key to START';
Str2='Press ESC to EXIT';
FileName='REPORT'; { Имя файла с отчетом }
RemainderEnergy=0.9; { Остаток энергии после удара }
Var Exit:boolean; { Флаг выхода из программы }
YSurface:integer; { Координата поверхности }
r:integer; { Радиус мяча }
Ch:char; { Буфер клавиатуры }
i:integer; { Счетчик }
XPred,YPred:real; { Координаты мяча на экране }
F:text; { Файловая переменная }
VySurfaceStart,VySurface:real;
{ Скорость мяча у поверхности (расчетная) начальная и текущая }
VySurfaceBuf,XBuf,YBuf,VxBuf,VyBuf,YPredBuf,XPredBuf,YSurfaceBuf,YMax,ScaleY:real;
Begin
Exit:=FALSE; { Сброс флага выхода }
SetColor(White); { Установка белого цвета для текста и линий }
SetLineStyle(SolidLn,0,ThickWidth); { Установка толщины линии }
YSurface:=0; { Определение координаты поверхности }
r:=Round(GetMaxX/60); { Определение радиуса мяча }
if Y-r<0 then Y:=r; { Переопределение заданной некорректно координаты Y }
VySurfaceStart:=Sqrt(Sqr(Vy)+2*a*(Y-YSurface-r));
{ Аналитический расчет скорости мяча у поверхности }
VySurfaceBuf:=VySurfaceStart;
{ Начальное определение текущей скорости у поверхности }
XBuf:=X;
YBuf:=Y;
VxBuf:=Vx;
VyBuf:=Vy;
YSurfaceBuf:=YSurface;
YMax:=0;
while 0.5<=Sqr(VySurfaceBuf)/2/a do
begin
if YBuf>YMax then YMax:=YBuf;
{ Сохранение предыдущих координат: }
XPredBuf:=XBuf;
YPredBuf:=YBuf;
{ Вычисление новых координат: }
XBuf:=XBuf+VxBuf;
YBuf:=YBuf+VyBuf-a/2;
VyBuf:=VyBuf-a; { Пересчет скорости }
if (YBuf-r<=YSurfaceBuf-(YBuf-YPredBuf)/2)and(VyBuf<0) then
begin { Если мяч достиг поверхности и движется вниз, то - }
VySurfaceBuf:=Sqrt(0.9)*VySurfaceBuf; { Потеря энергии }
VxBuf:=Sqrt(0.9)*VxBuf;
VyBuf:=VySurfaceBuf
{-Vy}; {- отскок }
YBuf:=YSurfaceBuf+r; {- переопределение координаты мяча
по координате поверхности }
end;
end;
if Vx<>0 then Vx:=Vx*(GetMaxX-2*r)/XBuf;
ScaleY:=0.9*GetMaxY/YMax;
VySurface:=VySurfaceStart;
{ Начальное определение текущей скорости у поверхности }
r:=Round(r*ScaleY);
for i:=0 to 1 do { Цикл вывовода на две видедеостраницы }
begin
SwitchingPage; { Переключение видеостраниц }
Line(0,Round(9*GetMaxY/10-YSurface),GetMaxX,Round(9*GetMaxY/10-YSurface)); { Прорисовка поверхности }
OutTextXY((GetMaxX-TextWidth(Str1)) div 2, { Вывод подсказки }
19*GetMaxY div 20-TextHeight(Str1), Str1);
DrawBackground; { Прорисовка фона }
end;
Ch:=ReadKey; { Остановка программы }
{ Перевод настоящих координат мяча в координаты экрана }
for i:=0 to 1 do { Цикл вывовода на две видедеостраницы }
begin
SwitchingPage; { Переключение видеостраниц }
SetFillStyle(SolidFill,Black);
{ Установка типа и цвета заполнения фигур (однородный черный) }
Bar(0,9*GetMaxY div 10+3,GetMaxX,GetMaxY);{ Закрашивание предыдущей подсказки }
OutTextXY((GetMaxX-TextWidth(Str2)) div 2, { Вывод подсказки }
19*GetMaxY div 20-TextHeight(Str2), Str2);
SetFillStyle(SolidFill,White);
{ Установка типа и цвета заполнения фигур (однородный белый) }
PieSlice(Round(X),Round(9*GetMaxY div 10-ScaleY*Y),0,360,r);
{ Прорисовка мяча }
{ Сохранение предыдущих координат: }
DrawBackground; { Прорисовка фона }
XPred:=X;
YPred:=Y;
end;
Assign(F,FileName); { Связывание файла с файловой переменной }
Rewrite(F); { Открытие файла под запись }
{ Оформление шапки в файле отчета: }
WriteLn(F,'╔══════════════╤══════════════╤══════════════╤══════════════╤══════════════╗');
WriteLn(F,'║ X │ Y │ Vx │ Vy │ a ║');
WriteLn(F,'╠══════════════╪══════════════╪══════════════╪══════════════╪══════════════╣');
while (Ch<>#27) and (0.5<=Sqr(VySurface)/2/a)
{and(X<GetMaxX+r)and(X>-r)} do { Цикл движения }
begin
WriteLn(F,'║',X:14:5,'│',Y:14:5,'│',Vx/(GetMaxX-2*r)*XBuf:14:5,'│',Vy:14:5,'│',a:14:5,'║');
SetColor(Black); { Установка черного цвета для текста и линий }
SetFillStyle(SolidFill,Black);
{ Установка типа и цвета заполнения фигур (однородный черный) }
PieSlice(Round(XPred),Round(9*GetMaxY div 10-ScaleY*YPred),0,360,r); { Закрашивание мяча }
{ Сохранение предыдущих координат: }
XPred:=X;
YPred:=Y;
{ Вычисление новых координат: }
X:=X+Vx;
Y:=Y+Vy-a/2;
Vy:=Vy-a; { Пересчет скорости }
if (Y-r<=YSurface-(Y-YPred)/2)and(Vy<0) then
begin { Если мяч достиг поверхности и движется вниз, то - }
VySurface:=Sqrt(0.9)*VySurface; { Потеря энергии }
Vx:=Sqrt(0.9)*Vx;
Vy:=VySurface
{-Vy}; {- отскок }
Y:=(YSurface+r)/ScaleY; {- переопределение координаты мяча
по координате поверхности }
Y:=Y; {- переопределение абсолютной координаты мяча }
end;
SetColor(White); { Установка белого цвета для текста и линий }
SetFillStyle(SolidFill,White);
{ Установка типа и цвета заполнения фигур (однородный белый) }
PieSlice(Round(X),Round(9*GetMaxY div 10-ScaleY*Y),0,360,r); { Прорисовка мяча }
DrawBackground; { Прорисовка фона }
SwitchingPage; { Переключение видеостраниц }
if KeyPressed then Ch:=ReadKey
{ Если была нажата клавиша, то - чтение клавиатуры }
end;
WriteLn(F,'╚══════════════╧══════════════╧══════════════╧══════════════╧══════════════╝');
{ Закрвтие таблицы в файле отчета }
Close(F); { Закрытие файла }
while Ch<>#27 do Ch:=ReadKey { Чтение клавиатуры до нажатия Esc }
End;
END.
Бесплатные примеры программ
Примеры написанных программ
Помощь студентам по программированию