Разработка игровой программы на языке программирования Turbo Pascal (стр. 3 из 4)

keyLeft = 75;

keyFive = 76;

keyRight = 77;

keyEnd = 79;

keyDown = 80;

keyPgDn = 81;

keyInsert = 82;

KeyPressed:Boolean = FALSE;

Var

Key :Array [1..128] of Boolean;

WasPressed:Array [1..128] of Boolean;

Const

CheckWarmReboot:Boolean = TRUE;

WarmRebootFlag :Boolean = FALSE;

Procedure InitButtons;

Procedure DoneButtons;

Function ButtonsInited:Boolean;

Function IsKeypressed:Boolean;

Function Pressed(Index:Byte):Boolean;

Procedure ClearKeys;

IMPLEMENTATION

Const

Init:Boolean=FALSE;

Var

OldKbdHandler:Pointer;

Procedure Int9; INTERRUPT;

Var

ScanCode,Tmp:Byte;

begin

ScanCode:=Port[$60];

if ScanCode and 128=0 then

begin

Key[ScanCode]:=TRUE;

KeyPressed:=TRUE;

end else

begin

ScanCode:=ScanCode xor 128;

Key[ScanCode]:=FALSE;

WasPressed[ScanCode]:=TRUE;

KeyPressed:=FALSE;

end;

if CheckWarmReboot and (ScanCode=keyDelete) then

begin

Tmp:=Mem[Seg0040:$0017];

if Tmp and 12=12 then

begin

Tmp:=Tmp xor 21;

WarmRebootFlag:=TRUE;

end;

Mem[Seg0040:$0017]:=Tmp;

end;

asm

in al,61h

or al,82h

out 61h,al

and al,7Fh

out 61h,al

mov al,20h

out 20h,al

end;

Procedure InitButtons;

begin

if not Init then

begin

GetIntVec($9,OldKbdHandler);

SetIntVec($9,@Int9);

FillChar(Key,SizeOf(Key),FALSE);

FillChar(WasPressed,SizeOf(WasPressed),FALSE);

CheckWarmReboot:=TRUE;

WarmRebootFlag:=FALSE;

Init:=TRUE;

end;

Procedure DoneButtons;

begin

if Init then

begin

SetIntVec($9,OldKbdHandler);

WarmRebootFlag:=FALSE;

Init:=FALSE;

end;

Function ButtonsInited;

begin

ButtonsInited:=Init;

end;

Function IsKeypressed;

Var

i:Byte;

f:Boolean;

begin

f:=false;

i:=1;

While (i<=128) and not f do

begin

f:=Key[i];

Inc(i);

end;

IsKeypressed:=f;

end;

Function Pressed;

begin

if WasPressed[Index] then

begin

WasPressed[Index]:=FALSE;

Pressed:=TRUE;

end else Pressed:=FALSE;

end;

Procedure ClearKeys;

begin

FillChar(Key,SizeOf(Key),false);

FillChar(WasPressed,SizeOf(WasPressed),false);

end;

END.

UNIT LogoScreen;

INTERFACE

IMPLEMENTATION

uses graph,crt;

const

a = 'Vera & Yulya presents';

b = ' science game';

d = ' for kids';

e = 'Magnitogorsk - 2001';

t = 'Siege';

var driver,mode,x1,x,y,

color:integer;i,j:word;

x2,y2,o:array[1..500] of integer; g,n:integer;

label 1;

begin

detectgraph(driver,mode);

initgraph(driver,mode,'c:\');

if graphresult<>0 then write('Ошибка!')

else for g:=1 to 500 do

begin

n:=random(18);

case n of

1: o[g]:=1;

2: o[g]:=3;

3: o[g]:=4;

4: o[g]:=5;

5: o[g]:=9;

6: o[g]:=11;

7: o[g]:=12;

8: o[g]:=13;

9: o[g]:=14;

10: o[g]:=15

end;

x2[g]:=random(640);

y2[g]:=random(480);

putpixel(x2[g],y2[g],o[g])

end;

setcolor(9);

begin

j:=getmaxx-250;

i:=1;

settextstyle(7,0,4);

while i<=getmaxx-length(a)-400 do

begin

setcolor(black);

outtextxy(i-length(a)-2,10,a);

outtextxy(j+2,50,b);

outtextxy(j+2,90,d);

setcolor(1+random(14));

outtextxy(i-length(a),10,a);

outtextxy(j,50,b);

outtextxy(j,90,d);

j:=j-2;

i:=i+2;

if keypressed then goto 1;

end;

color:=getcolor;

settextstyle(4,0,1);

for i:=1 to 10 do

begin

setcolor(black);

outtextxy(230,getmaxy-20-i+1,e);

delay(100);

setcolor(color);

outtextxy(230,getmaxy-20-i,e);

end;

settextstyle(4,0,15);

setviewport(1,1,639,479,false);

repeat

for i:=15 downto 1 do

begin

if(i=1)or(i=5)then continue;

setcolor(i);

outtextxy((GetMaxX div 2)-(TextWidth(t) div 2),180,t);

delay(100);

end;

for i:=1 to 15 do

begin

if(i=1)or(i=5)then continue;

setcolor(i);

outtextxy((GetMaxX div 2)-(TextWidth(t) div 2),180,t);

delay(100);

end;

until keypressed;

setcolor(black);

setfillstyle(1,1);

SetBkcolor(1);

setviewport(1,1,639,479,true);

for i:=1 to 90 do

begin

sector(getmaxx div 2,getmaxy div 2,0,i,400,400);

sector(getmaxx div 2,getmaxy div 2,90,90+i,400,400);

sector(getmaxx div 2,getmaxy div 2,180,180+i,400,400);

sector(getmaxx div 2,getmaxy div 2,270,270+i,400,400);

end;

setcolor(Magenta);

settextstyle(7,0,8);

outtextxy((getmaxx div 2)-(TextWidth('Good luck!!!') div 2),

(getmaxy div 2)-180,'Good luck!!!');

Delay(1000);

closegraph;

end;

END.

UNIT Retrace;

INTERFACE

Procedure WaitRetraceMode;

IMPLEMENTATION

Procedure WaitRetraceMode;

begin

While Port[$3DA] and 8<>0 do;

end;

END.

UNIT SiegeLogo;

INTERFACE

Uses Buttons, VGA13h;

Type

PFont = ^TFont;

TFont = Array [0..255,0..7] of Byte;

Var

Font:PFont;

Procedure DrawString(Base:Word;xp,yp:Integer;Const s:String); Function Logo:Byte;

Procedure Info;

Procedure Story;

IMPLEMENTATION

Procedure DrawString;

Var

x,y,l,t:Byte;

begin

if Byte(s[0])>0 then

begin

for l:=1 to Byte(s[0]) do

begin

for y:=0 to 7 do

begin

t:=Font^[Byte(s[l])][y];

for x:=0 to 7 do

begin

if t and 128=128 then PutPixel(Base,xp+x,yp+y,15);

t:=t shl 1;

end;

xp:=xp+8;

end;

Function Logo;

Var

Res,Old:Byte;

begin

ClearKeys;

Old:=0;

Res:=1;

ClearBase(Base1);

DrawString(Base1,30,60,'Play the game');

DrawString(Base1,30,70,'Instructions');

DrawString(Base1,30,80,'Story');

DrawString(Base1,30,90,'Exit to DOS');

Repeat

if Old<>Res then

begin

Bar(Base1,20,60,28,100,0);

DrawString(Base1,20,60+(Res-1)*10,'>');

Old:=Res;

end;

if Pressed(keyUp) then

begin

Res:=Res-1;

if Res<1 then Res:=4;

end;

if Pressed(keyDown) then

begin

Res:=Res+1;

if Res>4 then Res:=1;

end;

Until Key[keyEnter];

Logo:=Res;

end;

Procedure Center(y:Integer;Const s:String);

begin

DrawString(Base1,160-(Length(s)*8 div 2),y,s);

end;

Procedure Info;

begin

ClearBase(Base1);

Center(2,'Instructions');

Center(20,'Arrows - moving Hero');

Center(30,'Space - throw stone');

Center(40,'Esc - exit the game');

Center(190,'Press any key');

ClearKeys;

Repeat Until IsKeypressed;

end;

Procedure Story;

begin

ClearBase(Base1);

Center(2,'Предыстория');

DrawString(Base1,1,20,'Много лет назад на Землю упал метеорит.');

DrawString(Base1,1,30,'При исследовании в лаборатории ученые ');

DrawString(Base1,1,40,'обнаружили в нем биологическое вещес- ');

DrawString(Base1,1,50,'тво внеземного происхождения. Поняв всю');

DrawString(Base1,1,60,'опасность этого вируса, они попытались ');

DrawString(Base1,1,70,'нейтрализовать его.Но вирус стал быстро');

DrawString(Base1,1,80,'распространяться и заразил всех участни ');

DrawString(Base1,1,90,'ков исследования. Выйдя за стены лабора-');

DrawString(Base1,1,100,' тории он стал зарожать людей.Зараженные');

DrawString(Base1,1,110,'вирусом внешне не отличались от обычных');

DrawString(Base1,1,120,'людей, но подчинялись внеземному разуму.');

DrawString(Base1,1,130,'Их задачей было:уничтожить оставшееся ');

DrawString(Base1,1,140,'население.Тогда люди стали объединять- ');

DrawString(Base1,1,150,'ся,чтобы защитить себя. Они устроили ');

DrawString(Base1,1,160,'засаду в крепости. Но агрессивных "лик-');

DrawString(Base1,1,170,'видаторов ничто не могло остановить.....');

ClearKeys;

Repeat Until IsKeypressed;

end;

END.

UNIT SiegeSpr;

INTERFACE

Const

BrickHgt = 10;

BrickWdt = 10;

BrickSpr:Array [1..BrickHgt,1..BrickWdt] of Byte =

((7,7,7,7,7,7,7,7,7,7),

(4,4,4,4,4,4,4,4,4,7),

(7,7,7,7,7,7,7,7,7,7),

(4,4,4,4,7,4,4,4,4,4),

(4,4,4,4,7,4,4,4,4,4));

Const

StoneHgt = 8;

StoneWdt = 8;

StoneSpr:Array [1..StoneHgt,1..StoneWdt] of Byte =

((0,0,8,8,8,8,0,0),

(0,8,7,7,8,8,8,0),

(8,7,8,8,8,8,8,8),

(8,8,8,8,8,8,8,8),

(0,8,8,8,8,8,8,0),

(0,0,8,8,8,8,0,0));

Const

ManHgt = 20;

ManWdt = 16;

ManSpr:Array [1..2,1..ManHgt,1..ManWdt] of Byte =

(((00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00),

(00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00),

(00,00,00,00,00,00, 7, 7, 7, 7,00,00,00,00,00,00),

(00,00,00,00,00, 7, 7, 7, 7, 7, 7,00,00,00,00,00),

(00,00,00,00,00, 7,15,15,15,15, 7,00,00,00,00,00),

(00,00,00,00,00,15, 3, 1, 1, 3,15,00,00,00,00,00),

(00,00,00,00,00,15,15,15,15,15,15,00,00,00,00,00),

(00,00,00,00,00,15,15, 8, 8,15,15,00,00,00,00,00),

(00,00,00,00,00,15,15,13,13,15,15,00,00,00,00,00),

(00,00,00,00,00,00,15,15,15,15,00,00,00,00,00,00),

(00,00,00,00,12,12,15,15,15,15,12,12,00,00,00,00),

(00,12,12,12,12,12,12,14,14,12,12,12,12,12,12,00),

(12,12,12,12,12,12,12,14,14,12,12,12,12,12,12,12),

(12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12),

(12,12, 8,12,12,12,12,12,12,12,12,12,12, 8,12,12),

(12,12, 8,12,12,12,12,12, 8,12,12,12,12, 8,12,12),

(12,12, 8,12,12,12,12,12,12,12,12,12,12, 8,12,12),

(12,12, 8,12,12,12,12,12, 8,12,12,12,12, 8,12,12)),

((00,00,00,15,00,00,00,00,00,00,00,00,15,00,00,00),

(00,00,00,15,00,00,00,00,00,00,00,00,15,00,00,00),

(00,00,12,12,00,00,00,00,00,00,00,00,12,12,00,00),

(00,00,12,12,00,00, 7, 7, 7, 7,00,00,12,12,00,00),

(00,00,12,12,00, 7, 7, 7, 7, 7, 7,00,12,12,00,00),

(00,12,12,00,00, 7,15,15,15,15, 7,00,00,12,12,00),

(00,12,12,00,00,15, 3, 1, 1, 3,15,00,00,12,12,00),

(00,12,12,00,00,15,15,15,15,15,15,00,00,12,12,00),

(00,12,12,00,00,15,15, 8, 8,15,15,00,00,12,12,00),

(00,12,12,00,00,15,15,13,13,15,15,00,00,12,12,00),

(00,12,12,12,00,00,15,15,15,15,00,00,12,12,12,00),

(00,00,12,12,12,12,15,15,15,15,12,12,12,12,00,00),

(00,00,12,12,12,12,12,14,14,12,12,12,12,12,00,00),

(00,00,12,12,12,12,12,12,12,12,12,12,12,12,00,00),

(00,00,00,12,12,12,12,12,12,12,12,12,12,00,00,00),

(00,00,00,12,12,12,12,12, 8,12,12,12,12,00,00,00),

(00,00,00,12,12,12,12,12,12,12,12,12,12,00,00,00),

(00,00,00,12,12,12,12,12, 8,12,12,12,12,00,00,00)));

Const

EnemyHgt = 42;

EnemyWdt = 16;

EnemySpr:Array [1..2,1..EnemyHgt,1..EnemyWdt] of Byte =

(((00,00,00,00,00,00,00,00,00,00,00,00,00,00,15,00),

(00,00,00,00,00,00,00,00,00,00,00,00,00,00,15,00),

(00,00,00,00,00,00,00,00,00,00,00,00,00,10,10,00),

(00,00,00,00,00,00, 7, 7, 7, 7,00,00,00,10,10,00),

(00,00,00,00,00, 7, 7, 7, 7, 7, 7,00,00,10,10,00),

(00,00,00,00,00,15, 7, 7, 7, 7,15,00,00,10,10,00),

(00,00,00,00,00,00,15,15,15,15,00,00,10,10,10,00),

(00,00,00,00,10,10,15,15,15,15,10,10,10,10,00,00),

(00,10,10,10,10,10,10,10,10,10,10,10,10,10,00,00),

(10,10,10,10,10,10,10,10,10,10,10,10,10,10,00,00),

(10,10,00,10,10,10,10,10,10,10,10,10,10,00,00,00),

(00,10,10,10,10,10,10,10,10,10,10,10,10,00,00,00),

(00,00,00,10,10,10,10,10,10,10,10,10,10,00,00,00),

(00,00,00, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,00,00,00),

(00,00,00, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,00,00,00),

(00,00, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,00,00,00),

(00, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,00,00,00),

(00, 8, 8, 8, 8,00,00,00,00, 8, 8, 8, 8,00,00,00),

( 8, 8, 8, 8, 8,00,00,00,00, 8, 8, 8, 8, 8,00,00),

( 8, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8, 8,00,00),

(00, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8, 8,00,00),

(00,00, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8, 8,00),

(00,00,00,00,00,00,00,00,00,00,00, 8, 8, 8, 8,00),

(00,00,00,00,00,00,00,00,00,00,00, 8, 8, 8, 8,00)),

((00,15,00,00,00,00,00,00,00,00,00,00,00,00,00,00),

(00,15,00,00,00,00,00,00,00,00,00,00,00,00,00,00),

(00,10,10,00,00,00,00,00,00,00,00,00,00,00,00,00),

(00,10,10,00,00,00, 7, 7, 7, 7,00,00,00,00,00,00),

(00,10,10,00,00, 7, 7, 7, 7, 7, 7,00,00,00,00,00),

(00,10,10,00,00,15, 7, 7, 7, 7,15,00,00,00,00,00),

(00,10,10,10,00,00,15,15,15,15,00,00,00,00,00,00),

(00,00,10,10,10,10,15,15,15,15,10,10,10,10,00,00),

(00,00,10,10,10,10,10,10,10,10,10,10,10,10,10,00),

(00,00,10,10,10,10,10,10,10,10,10,10,10,10,10,10),

(00,00,00,10,10,10,10,10,10,10,10,10,10,00,10,10),

(00,00,00,10,10,10,10,10,10,10,10,10,10,10,10,00),

(00,00,00,10,10,10,10,10,10,10,10,10,10,00,00,00),

(00,00,00, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,00,00,00),

(00,00,00, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,00,00,00),

(00,00,00, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,00,00),

(00,00,00, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,00),

(00,00, 8, 8, 8, 8, 8,00,00,00,00, 8, 8, 8, 8,00),

(00,00, 8, 8, 8, 8, 8,00,00,00,00, 8, 8, 8, 8, 8),

(00,00, 8, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8, 8),

(00,00, 8, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8,00),