Помогите игру написать!, игра *ловушка* Опции

[punkska]

Игра: c верхней части экрана падают шары. Управляя ловушкой, игрок должен собрать как можно больше шаров за одну минуту. С течением времени плотность падения шаров уменьшиться, а скорость увеличивается. По истечении времени (1 мин.) на экран выводиться колво пойманных шаров.10 лучших храняться в файле и выводятся на экран по запросу пользователя.


помогите написать или найти похожий исходник!!!

<...>
возможно аплата н разумная!

Сообщение отредактировано: volvo - 15.05.2005 16:09

[Дож]

Какой компилятор будешь использовать?

[volvo]

возможно аплата н разумная!

Нет уж... "Возможно - да, возможно - нет" не пойдет... Если готов платить деньги, я перенесу тему в "Задачи на заказ". Там и восстановишь ICQ #...

[Дож]

Вот набросок:

Исходный код

Uses keyBoard;

Type TScreen = array[1..64000] of byte;
PScreen = ^TScreen;

TPoint = record
x,y:integer;
end;

points = array[1..255] of TPoint;

Const trapY = 190;
BalloonMaxY = 200;
startBalloonY = 1;
minX = 5;
maxX = 315;
TrapSpeed = 2;

Var balloons : ^points;
trap : TPoint;
score : word;
balloonScorePlus : word;
balloonScoreMinus : word;
level : byte;
nowBalloon : byte;
BalloonLength : word;
balloonStep : byte;
keys : array[1..5] of byte;
nowKey : array[1..10] of byte;
keyNum : byte;
exit : boolean;

Procedure initMCGA;
begin
asm
mov ax,0013h
int 10h
end;
END;

Procedure PutPixel(x,y:integer;col:byte);
begin
asm
mov ah,0Ch
mov al,[col]
mov cx,[x]
mov dx,[y]
mov bx,[1]
int 10h
end;
end;

function length(x1,y1,x2,y2:integer):longint;
begin
length:=round(sqrt(abs(sqr(x1-x2))+abs(sqr(y1-y2))));
end;

Procedure setStartPos(A : Tpoint);
begin
A.x:=random(maxX-minX)+minX;
A.y:=startBalloonY;
end;

Procedure drawBalloon(x0,y0:integer);
begin
PutPixel(x0,y0,50);
end;

Procedure drawTrap(x0,y0:integer);
begin
PutPixel(x0,y0,45);
end;

Procedure clearBalloon(x0,y0:integer);
begin
PutPixel(x0,y0,0);
end;

Procedure clearTrap(x0,y0:integer);
begin
PutPixel(x0,y0,0);
end;


Procedure deleteBalloons;
Var i:integer;
begin
i:=0;
While i<>nowBalloon do begin
i:=i+1;
If length(trap.x,trap.y,balloons^[i].x,balloons^[i].y)<=balloonLength
then begin
setStartPos(balloons^[i]);
If (65535-score)>balloonScorePlus then
score:=score+balloonScorePlus
else
score:=65535;
end;
If balloons^[i].y>startBalloonY then begin
setStartPos(balloons^[i]);
If score>balloonScoreMinus then
score:=score-balloonScoreMinus
else score:=0;
end;
end;
end;

Procedure balloonsDraw;
Var i:integer;
begin
i:=0;
While i<>nowBalloon do begin
i:=i+1;
drawBalloon(balloons^[i].x,balloons^[i].y);
end;
end;

Procedure balloonsClear;
Var i:integer;
begin
i:=0;
While i<>nowBalloon do begin
i:=i+1;
ClearBalloon(balloons^[i].x,balloons^[i].y);
end;
end;

Procedure balloonsStep;
Var i:integer;
begin
i:=0;
While i<>nowBalloon do begin
i:=i+1;
balloons^[i].y:=balloons^[i].y+balloonStep;
end;
end;

Procedure ReNewScoreState;
begin
end;

Procedure reNewKeys;
begin
While Mkeypressed do begin
If KeyNum=10 then break;
KeyNum:=KeyNum+1;
nowKey[keyNum]:=Mreadkey;
end;
end;

Procedure keysEvents;
begin
While KeyNum<>0 do begin
Case nowKey[keyNum] of
left : Trap.x:=Trap.x-TrapSpeed;
right : Trap.x:=Trap.x+TrapSpeed;
Esc : exit:=true;
end;
keyNum:=KeyNum-1;
end;
end;

Procedure initGameState;
Var i:integer;
begin
new(balloons);
trap.x:=150;
trap.y:=trapY;
score:=0;
balloonScorePlus:=1;
balloonScoreMinus:=2;
level:=1;
nowBalloon:=2;
BalloonLength:=5;
balloonStep:=1;
keyNum:=0;
exit:=false;
i:=0;
While i<>255 do begin
i:=i+1;
setStartPos(balloons^[i]);
end;
end;


begin
initMCGA;
initGameState;
While not(exit) do begin
Balloonsdraw;
drawTrap(Trap.x,Trap.y);
deleteBalloons;
reNewScoreState;
reNewKeys;
keysEvents;
Balloonsclear;
clearTrap(Trap.x,Trap.y);
end;
end.

(не реализованно сохранение лидеров, жизней и процедура length глючит)

Сообщение отредактировано: volvo - 15.05.2005 22:07

[Digitalator]

неча на length пенять коли руки кривы

[Дож]

:fire: Это всего лишь набросок, написанный за 45 мин!!!

[volvo]

Дож,
исправь программу (выложи доп. модуль для того, чтобы программа скомпилировалась), иначе я ее просто удалю. (Читай правила)

[mithquessir]

Ребят, я с челом уже договорился решить за WMZ, так что не решайте, pls.

Ок, закрываю тему... ;)

Сообщение отредактировано: volvo - 15.05.2005 22:05