Форум «Всё о Паскале» > Помогите игру написать!

Помощь - Поиск - Пользователи - Календарь

Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи > Задачи на заказ

punkska

15.05.2005 16:56

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

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

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

Дож

15.05.2005 19:59

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

volvo

15.05.2005 20:09

Цитата(punkska @ 15.05.05 12:56)

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

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

Дож

15.05.2005 23:24

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

Исходный код

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 глючит)

Digitalator

15.05.2005 23:47

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

Дож

16.05.2005 0:02

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

volvo

16.05.2005 0:04

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

mithquessir

16.05.2005 1:59

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

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

Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.