Ðåôåðàò: Ðàçðàáîòêà èãðîâîé ïðîãðàììû íà ÿçûêå ïðîãðàììèðîâàíèÿ Turbo Pascal
11. Turbo Pascal 7. 0, Ôàðîíîâ Â.Â. /Èçä. «Íîëèäæ», 1999.
ÏÐÈËÎÆÅÍÈÅ:
Program Siege;
Uses LogoScreen,
DOS, VGA13h, VGASpr, Retrace, Buttons,
SiegeLogo, SiegeS
pr;
Type
EnemyType = record
X,Y,D,S,A:Integer;
Falling:Boolean;
Free:Boolean;
end;
Const
MaxEnemies = 50;
ComboStr:Array [0..5] of String[20] =
('Looser!!!',
'',
'2 hit combo',
'Eat this!',
'Ough! 4 mans at once',
'Aaaaaaaaamazing!!!');
Var
ManX,StoneY,StoneX,EnemyDelay,EnemyLimit:Integer;
Enemies:Array [1..MaxEnemies] of EnemyType;
Score,Level,Kills,Combo:Word;
Timer:Longint;
GameOver:Boolean;
{==================================================================}
Const
ca:Word = 0;
cc:String[20] = '';
Procedure ComboString(s:String);
begin
if s<>'' then
begin
cc:=s;
ca:=10;
end;
if ca>0 then
begin
DrawString(Base2,160-Byte(cc[0])*4,90,cc);
Dec(ca);
end;
end;
Procedure NextLevel; forward;
{==================================================================}
Procedure InitEnemies;
Var
i:Byte;
begin
for i:=1 to MaxEnemies do Enemies[i].Free:=true;
end;
Procedure DrawEnemies;
Var
i:Byte;
begin
for i:=1 to MaxEnemies do
With Enemies[i] do if not Free then
DrawTSpr(Base2,X,Y,EnemyHgt,EnemyWdt,@EnemySpr[A]);
end;
Procedure MoveEnemies;
Var
i:Byte;
begin
for i:=1 to MaxEnemies do
With Enemies[i] do
if not Free then
begin
if Falling then
begin
Y:=Y+10;
if Y>199 then
begin
Free:=true;
if Kills=(Level+1)*20 then NextLevel;
end;
if D=0 then
begin
Inc(A);
if A>2 then A:=1;
D:=2;
end else Dec(D);
end else
if D=0 then
begin
Y:=Y-5;
if Y<40 then GameOver:=true;
Inc(A);
if A>2 then A:=1;
D:=S;
end else Dec(D);
end else
if (EnemyLimit>0) and (EnemyDelay=0) then
begin
X:=Random(38)*8;
Y:=200;
D:=0;
S:=(10-Level);
A:=1;
EnemyDelay:=(13-Level)*2+1;
Falling:=false;
Free:=false;
Dec(EnemyLimit);
end;
Dec(EnemyDelay);
end;
{==================================================================}
Procedure DrawScreen;
Var
x,y:Integer;
s:String[80];
tmp:String[6];
begin
Bar(Base2,0,0,319,9,8);
FillBase(Base2,3200,9600,$03030303);
for y:=0 to 15 do
for x:=0 to 31 do
DrawOSpr(Base2,x*10,40+y*10,BrickHgt,BrickWdt,@BrickSpr);
s:='þ ~SIEGE~ þ Level:';
Str(Level,tmp);
While Byte(tmp[0])<2 do tmp:='ú'+tmp;
s:=s+tmp+' þ Score:';
Str(Score,tmp);
While Byte(tmp[0])<5 do tmp:='ú'+tmp;
s:=s+tmp+' þ';
DrawString(Base2,1,1,s);
end;
{==================================================================}
Procedure DrawMan;
begin
if StoneY=0 then
begin
DrawTSpr(Base2,ManX*8,20,ManHgt,ManWdt,@ManSpr[2]);
DrawTSpr(Base2,ManX*8+4,17,StoneHgt,StoneWdt,@StoneSpr);
end else
begin
DrawTSpr(Base2,ManX*8,20,ManHgt,ManWdt,@ManSpr[1]);
DrawTSpr(Base2,StoneX,StoneY,StoneHgt,StoneWdt,@StoneSpr);
Inc(StoneY,10);
if StoneY>199 then
begin
StoneY:=0;
if Combo<7 then ComboString(ComboStr[Combo]) else ComboString('Kiiler!!!');
Combo:=0;
end;
end;
end;
{==================================================================}
Procedure CheckCollisions;
Var
i:Byte;
begin
if StoneY>0 then
for i:=1 to MaxEnemies do
With Enemies[i] do
if not Free and not Falling then
begin
if ((StoneX+8>X) and (StoneX<X+EnemyWdt)) and
((StoneY+8>Y) and (StoneY<Y+EnemyHgt)) then
begin
Falling:=true;
D:=0;
Inc(Score);
Inc(Kills);
Inc(Combo);
end;
end;
end;
{==================================================================}
Procedure NextLevel;
Var
i:Byte;
begin
Timer:=MemL[Seg0040:$006C];
Inc(Level);
for i:=1 to 30 do
begin
ClearBase(Base2);
DrawScreen;
DrawTSpr(Base2,ManX*8,20,ManHgt,ManWdt,@ManSpr[1+Byte(i and 1=1)]);
DrawString(Base2,132,80,'Level '+Char($30+Level));
WaitRetraceMode;
CopyBase(Base2,Base1);
While Timer=MemL[Seg0040:$006C] do;
Timer:=MemL[Seg0040:$006C];
end;
EnemyLimit:=(1+Level)*20;
EnemyDelay:=0;
Kills:=0;
ca:=0;
end;
Procedure GameOverProc;
Var
i:Byte;
begin
ClearBase(Base2);
DrawScreen;
DrawString(Base2,124,80,'Game Over');
WaitRetraceMode;
CopyBase(Base2,Base1);
Timer:=MemL[Seg0040:$006C];
for i:=1 to 30 do
begin
While Timer=MemL[Seg0040:$006C] do;
Timer:=MemL[Seg0040:$006C];
end;
end;
{==================================================================}
Procedure Init;
begin
if not DetectVGA then
begin
Writeln('Íåîáõîäèì VGA ñîâìåñòèìûé âèäåîàäàïòåð.'#7);
Halt(1);
end;
SetGraphMode;
InitButtons;
Randomize;
ManX:=19;
Timer:=MemL[Seg0040:$006C];
EnemyLimit:=(Level+1)*20;
GetIntVec($43, Pointer(Font));
end;
Procedure Game;
begin
InitEnemies;
Level:=0;
Score:=0;
Kills:=0;
Combo:=0;
EnemyLimit:=(Level+1)*20;
GameOver:=false;
Repeat
ClearBase(Base2);
DrawScreen;
DrawEnemies;
DrawMan;
ComboString('');
MoveEnemies;
CheckCollisions;
if Key[keyLeft] then if ManX>0 then Dec(ManX);
if Key[keyRight] then if ManX<38 then Inc(ManX);
if Key[keySpace] then if StoneY=0 then
begin
StoneX:=(ManX*8)+4;
StoneY:=24;
end;
WaitRetraceMode;
CopyBase(Base2,Base1);
While Timer=MemL[Seg0040:$006C] do;
Timer:=MemL[Seg0040:$006C];
Until Key[keyEsc] or (Level>=10) or GameOver;
if GameOver then GameOverProc;
end;
Procedure Done;
begin
DoneButtons;
SetTextMode;
DoneVirtualPage;
end;
{==================================================================}
Var
choice:Byte;
begin
Init;
Repeat
choice:=Logo;
Case choice of
1:Game;
2:Info;
3:Story;
end;
Until choice=4;
Done;
end.
UNIT Buttons;
INTERFACE
Uses DOS;
Const
keyESC = 1;
keyF1 = 59;
keyF2 = 60;
keyF3 = 61;
keyF4 = 62;
keyF5 = 63;
keyF6 = 64;
keyF7 = 65;
keyF8 = 66;
keyF9 = 67;
keyF10 = 68;
keyF11 = 87;
keyF12 = 88;
keyScrollLock = 70;
keyTilde = 41;
key1 = 2;
key2 = 3;
key3 = 4;
key4 = 5;
key5 = 6;
key6 = 7;
key7 = 8;
key8 = 9;
key9 = 10;
key0 = 11;
keyUnderline = 12;
keyEquality = 13;
keyBackspace = 14;
keyTab = 15;
keyQ = 16;
keyW = 17;
keyE = 18;
keyR = 19;
keyT = 20;
keyY = 21;
keyU = 22;
keyI = 23;
keyO = 24;
keyP = 25;
keyIndex = 26;
keyBackIndex = 27;
keyEnter = 28;
keyCapsLock = 58;
keyA = 30;
keyS = 31;
keyD = 32;
keyF = 33;
keyG = 34;
keyH = 35;
keyJ = 36;
keyK = 37;
keyL = 38;
keyDoublePeriod = 39;
keyApostroph = 40;
keyLShift = 42;
keyBackSlash = 43;
keyZ = 44;
keyX = 45;
keyC = 46;
keyV = 47;
keyB = 48;
keyN = 49;
keyM = 50;
keyComma = 51;
keyPeriod = 52;
keySlash = 53;
keyRShift = 54;
keyCtrl = 29;
keyAlt = 56;
keySpace = 57;
keyNumLock = 69;
keyMultiply = 55;
keyMinus = 74;
keyPlus = 78;
keyDelete = 83;
keyHome = 71;
keyUp = 72;
keyPgUp = 73;
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;
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;
end;
Procedure DoneButtons;
begin
if Init then
begin
SetIntVec($9,OldKbdHandler);
WarmRebootFlag:=FALSE;
Init:=FALSE;
end;
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;
1:
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);
