}
uses Graph,Crt,Dos;
const Width=32; Height=20;
type Picture=array [0..Width-1,0..Height-1] of char;
type sprite=record
State,X,Y,Pnum,Predir: word;
end;
const Vgapath='c:\TP7\EGAVGA.BGI';
Fontpath='c:\TP7\TRIP.CHR';
Sprname='attack.res';
const ESC=#27;
F1=#59;
SPACE=#32;
UP=#72; DOWN=#80;
LEFT=#75; RIGHT=#77;
const Maxx=639; Maxy=479;
Cx=Maxx div 2; Cy=Maxy div 2;
Maxsprites=11;
Maxpictures=11;
Maxshoots=100;
const Leftdir=0;
Rightdir=1;
Updir=2;
Downdir=3;
Delta=2;
Shootradius=5;
var Ch:char;
s:String;
Hour,Min,Sec,Sec1,Secn,Secn1,Sec100,Seci,Seci1:Word;
var Driver, Mode, Font1, Currentsprites, Currentbottom,
Currentshoots, Shootx, Lives, Enemyshooter, Enemies,
Shootsprobability: integer;
Score,Level:longint;
Driverf,Fontf: file;
Driverp,Fontp: pointer;
Spr: array [1..Maxsprites] of Sprite;
Pict: array [1..Maxpictures] of Picture;
Shoots: array [1..Maxshoots] of Sprite;
Shooter,Dieme,Ingame,Initshoot:boolean;
procedure Wait;
var Ch:char;
begin
Reset (Input);
repeat until Keypressed;
Ch:=Readkey;
if Ch=#0 then Readkey;
end;
procedure Closeall;
begin
if Fontp <> nil then begin
Freemem(Fontp, Filesize(Fontf));
Close (Fontf);
end;
if Driverp <> nil then begin
Freemem(Driverp, Filesize(Driverf));
Close (Driverf);
end;
Closegraph;
end;
procedure Grapherror;
begin
Closeall;
Writeln('Graphics error:', Grapherrormsg(Graphresult));
Writeln('Press any key to halt program...');
Wait;
Halt (Graphresult);
end;
procedure Initall;
begin
Assign(Driverf, Vgapath);
Reset(Driverf, 1);
Getmem(Driverp, Filesize(Driverf));
Blockread(Driverf, Driverp, Filesize(Driverf));
if Registerbgidriver(Driverp)<0 then Grapherror;
Driver:=VGA; Mode:=Vgahi;
Initgraph(Driver, Mode,'');
if Graphresult < 0 then Grapherror;
Assign(Fontf, Fontpath);
Reset(Fontf, 1);
Getmem(Fontp, Filesize(Fontf));
Blockread(Fontf, Fontp, Filesize(Fontf));
Font1:=Registerbgifont(Fontp);
if Font1 < 0 then Grapherror;
end;
procedure Clearscreen;
begin
setfillstyle (Solidfill, White);
bar (0,0,Maxx,Maxy);
end;
procedure Window (x1,y1,x2,y2,Color,Fillcolor:integer);
begin
Setcolor (Color);
Setfillstyle (1,Fillcolor);
Bar (x1,y1,x2,y2);
Rectangle (x1+2,y1+2,x2-2,y2-2);
Rectangle (x1+4,y1+4,x2-4,y2-4);
Setfillstyle (1,DARKGRAY);
Bar (x1+8,y2+1,x2+8,y2+8);
Bar (x2+1,y1+8,x2+8,y2);
end;
procedure outtextcxy (y:integer; s:string);
begin
settextjustify (Centertext,Centertext);
outtextxy (Cx,y,s);
end;
procedure Start;
begin
Clearscreen;
Window (10,10,Maxx-10,Maxy-10,Blue,White);
Settextstyle(Font1, Horizdir, 4);
outtextcxy (25,'Атака з космосу');
Settextstyle(Font1, Horizdir, 1);
outtextcxy (Maxy-25,'Натисніть клавішу для початку');
Wait;
end;
procedure Restorescreen (Snum,Dir,Delta:word);
var X,Y:word;
begin
X:=Spr[Snum].X;
Y:=Spr[Snum].Y;
setfillstyle (Solidfill,White);
case Dir of
Leftdir: begin
bar (X+Width-Delta,Y,X+Width-1,Y+Height-1);
end;
Rightdir: begin
bar (X,Y,X+Delta,Y+Height-1);
end;
Updir: begin
bar (X,Y+Height-Delta,X+Width-1,Y+Height-1);
end;
Downdir: begin
bar (X,Y,X+Width-1,Y+Delta);
end;
end;
end;
procedure Drawsprite (Snum:word);
var i,j,x,y,n,b:integer;
begin
N:=Spr[Snum].Pnum;
x:=Spr[Snum].x;
y:=Spr[Snum].y;
for j:=y to y+Height-1 do
for i:=x to x+Width-1 do begin
b:=Ord(Pict[n,i-x,j-y]);
putpixel(i,j,b);
end;
end;
procedure Goleft;
var X,d2:word;
begin
X:=Spr[1].X;
d2:=delta*4;
if X>d2 then begin
Restorescreen (1,Leftdir,d2);
Dec(Spr[1].X,d2);
Drawsprite (1);
end;
end;
procedure Goright;
var X,d2:word;
begin
X:=Spr[1].X;
d2:=delta*4;
if X+Width < Maxx then begin
Restorescreen (1,Rightdir,d2);
Inc(Spr[1].X,d2);
Drawsprite (1);
end;
end;
procedure Showlives;
begin
str(Lives,s);
setfillstyle (Solidfill,White);
setcolor (Red);
bar (80,0,110,10);
outtextxy (82,2,s);
end;
procedure Showscore;
begin
str(Score,s);
setfillstyle (Solidfill,White);
setcolor (Blue);
bar (150,0,250,10);
outtextxy (152,2,s);
end;
procedure Showshoots;
begin
str(Currentshoots,s);
setfillstyle (Solidfill,White);
setcolor (Black);
bar (20,0,50,10);
outtextxy (20,2,s);
end;
procedure Showlevel;
begin
str(Level,s);
setfillstyle (Solidfill,White);
setcolor (Blue);
bar (251,0,350,10);
outtextxy (253,2,'Level '+s);
end;
procedure Shoot;
var i:integer;
begin
if Currentshoots>0 then begin
for i:=1 to Maxshoots do if (Sec<>Sec1) and (Shoots[i].State=0) then begin
Dec(Currentshoots);
Showshoots;
Spr[1].Pnum:=6;
Drawsprite (1);
Gettime(Hour,Min,Sec,Sec100);
Shootx:=Spr[1].X;
Shooter:=True;
Shoots[i].X:=Spr[1].X+ (Width div 2);
Shoots[i].Y:=Spr[1].Y - 5;
Shoots[i].Pnum:=Updir;
Shoots[i].State:=1;
break;
end;
end;
end;
procedure Help(s:string);
begin
setfillstyle (Solidfill,White);
setcolor (Blue);
bar (10,Maxy-10,Maxx-10,Maxy);
outtextxy (10,Maxy-9,s);
end;
procedure Error (Code:integer; str:String);
begin
Window (Cx-120,Cy-100,Cx+120,Cy-70,Black,Yellow);
case Code of
1: s:='Файл '+str+' не знайдений!';
end;
settextjustify (Lefttext, Toptext);
Settextstyle(Defaultfont, Horizdir, 1);
outtextxy (Cx-116,Cy-92,s);
Wait;
Closeall;
Halt(Code);
end;
procedure Drawfield;
var i,x,y:integer;
begin
Clearscreen;
with Spr[1] do begin
State:=1;
Pnum:=1;
X:=Maxx div 2;
Y:=Maxy - 10 - Height;
Drawsprite (1);
end;
x:=100;
y:=10;
for i:=2 to Currentsprites do begin
Spr[i].State:=1;
Spr[i].Pnum:=7;
Spr[i].x:=x;
Spr[i].y:=y;
Drawsprite (i);
inc(x,50);
if x>Maxx-width then begin
x:=100;
if y<Currentbottom-height then Inc(y,Height)
else y:=10;
end;
end;
for i:=1 to Maxshoots do Shoots[i].State:=0;
Shooter:=False;
Enemyshooter:=-1;
Sec:=0; Secn:=0;
Seci1:=100; Sec1:=100; Secn1:=100;
setfillstyle (Solidfill,Red);
Fillellipse (10,5,5,4);
Showshoots;
setfillstyle (Solidfill,Green);
bar (60,1,72,10);
setfillstyle (Solidfill,Lightgreen);
bar (62,3,70,8);
Showlives;
setfillstyle (Solidfill,Yellow);
setcolor (Black);
for i:=1 to 3 do begin
circle (126+i*2,5,4);
Fillellipse (126+i*2,5,4,4);
end;
Showscore;
Showlevel;
Ingame:=True;
end;
procedure Loadsprites;
var F:Text;
n,i,j,r:integer;
b:char;
begin
assign (f,Sprname);
{$I-}
reset (f);
{$I+}
if Ioresult<>0 then Error (1,Sprname);
For n:=1 to Maxpictures do
For j:=0 to Height-1 do
for i:=0 to Width-1 do begin
read (f,b);
Pict [n,i,j]:=b;
end;
close (f);
end;
procedure Deltas (Snum,Dir:integer; var dx,dy:integer);
var x,y:integer;
begin
x:=Spr[Snum].X;
y:=Spr[Snum].Y;
case Dir of
Leftdir: begin
Dec(x,Delta);
if x<0 then x:=0;
end;
Rightdir: begin
Inc(x,Delta);
if x>Maxx-width then x:=Maxx-width;
end;
Updir: begin
Dec (y,Delta);
if y<10 then y:=10;
end;
Downdir: begin
Inc(y,Delta);
if y>Currentbottom then y:=Currentbottom;
end;
end;
dx:=x;
dy:=y;
end;
function Between (a,x,b:integer):boolean;
begin
if (x>a) and (x<b) then Between:=true
else Between:=false;
end;
procedure Shootmovies;
var i,d,n:integer;
X,Y:Word;
found:boolean;
begin
for i:=1 to Maxshoots do if Shoots[i].State=1 then begin
x:=Shoots[i].X;
y:=Shoots[i].Y;
d:=Shoots[i].Pnum;
setfillstyle (Solidfill,White);
setcolor (White);
fillellipse (x,y,Shootradius,Shootradius);
if d=updir then begin
setfillstyle (Solidfill,Red);
if y<15 then begin
Shoots[i].State:=0;
continue;
end;
found:=false;
for n:=2 to Currentsprites do begin
if Spr[n].State=1 then begin
if (Between(Spr[n].x,x,Spr[n].x+Width)) and
(Between(Spr[n].y,y,Spr[n].y+Height)) then begin
Shoots[i].State:=0;
found:=true;
Spr[n].State:=2;
Inc(Spr[n].Pnum);
Inc(Score,10+5*n);
Showscore;
break;
end;
end;
end;
if not found then Dec(y,Delta);
end
else begin
setfillstyle (Solidfill,Blue);
if y>Maxy-10-(Height div 2) then begin
Shoots[i].State:=0;
continue;
end;
found:=false;
if Between(Spr[1].x,x,Spr[1].x+Width) and
Between(Spr[1].y,y,Spr[1].y+Height) then begin
Shoots[i].State:=0;
found:=true;
Inc(Spr[1].Pnum);
Dieme:=True;
Help ('You are missed one life :-(');
Drawsprite (1);
end;
if not found then Inc(y,Delta);
end;
if not found then begin
fillellipse (x,y,Shootradius,Shootradius);
Shoots[i].X:=x;
Shoots[i].Y:=y;
end;
end;
end;
procedure Enemiesstep;
var i,k,Dir,dx,dy,n:integer;
begin
Enemies:=0;
for i:=2 to Currentsprites do begin
if Spr[i].State=1 then begin
Inc(Enemies);
for k:=1 to 3 do begin
dir:=Random(4);
if dir=Spr[i].predir then break;
end;
Spr[i].predir:=dir;
Deltas (i, dir, dx, dy);
Restorescreen (i,Dir,Delta);
Spr[i].X:=dx;
Spr[i].Y:=dy;
Drawsprite (i);
Initshoot:=False;
Gettime(Hour,Min,Secn1,Sec100);
if (Secn1<>Secn) and (1+random(100)<Shootsprobability) then Initshoot:=True;
if Initshoot then begin
Secn:=Secn1;
for n:=1 to Maxshoots do
if (Shoots[n].State=0) and (Enemyshooter<>i) then begin
Enemyshooter:=i;
Shoots[n].X:=dx+ (Width div 2);
Shoots[n].Y:=dy +Height +5;
Shoots[n].Pnum:=Downdir;
Shoots[n].State:=1;
break;
end;
end;
end
else if Spr[i].State=2 then begin
Gettime (Hour,Min,Seci,Sec100);
Drawsprite (i);
if Seci<>Seci1 then begin
Seci1:=Seci;
if (Spr[i].Pnum<11) then Inc(Spr[i].Pnum)
else begin
Spr[i].State:=0;
setfillstyle (Solidfill, White);
bar (Spr[i].X,Spr[i].Y,Spr[i].X+Width-1,Spr[i].Y+Height-1);
end;
end;
end;
end;
end;
procedure Timefunctions;
var i:integer;
begin
if not Ingame then Exit;
Gettime(Hour,Min,Sec1,Sec100);
if (Shooter) and (Sec<>Sec1) then begin
Spr[1].Pnum:=1;
if Shootx=Spr[1].X then Drawsprite (1);
Shooter:=False;
end;
if (Dieme) and (Sec<>Sec1) then begin
if Spr[1].Pnum<5 then begin
Sec:=Sec1;
Inc(Spr[1].Pnum);
Drawsprite (1);
Dieme:=True;
end
else begin
Dieme:=False;
if Lives>0 then begin
Dec(Lives);
Showlives;
Spr[1].Pnum:=1;
Drawsprite (1);
end
else Ingame:=False;
end;
end;
end;
function getlonginttime:Longint; {Поверне системний час як Longint}
var Hour,Minute,Second,Sec100: word;
var k,r:longint;
begin
Gettime (Hour, Minute, Second, Sec100);
{Пряме обчислення по формулі Hour*360000+Minute*6000+Second*100+Sec100
не спрацює через неявне перетворення word в longint: }
k:=Hour;
r:=k*360000;
k:=Minute;
Inc (r,k*6000);
k:=Second;
Inc(r,k*100);
Inc(r,Sec100);
getlonginttime:=r;
end;
procedure Delay (ms:word); {Коректно працює із затримками до 65 сек.!}
var Endtime,Curtime : Longint;
cor:boolean; {ознака корекції часу з урахуванням переходу через добу}
begin
cor:=false;
Endtime:=getlonginttime + ms div 10;
if Endtime>8639994 then cor:=true;
{Ураховуємо можливий перехід через добу;
23*360000+59*6000+59*100+99=8639999 і відняли 5 мс із обліком
частоти спрацьовування системного таймера BIOS}
repeat
Curtime:=getlonginttime;
if cor=true then begin
if Curtime<360000 then Inc (Curtime,8639994);
end;
until Curtime>Endtime;
end;
label 10,20;
begin
Randomize;
Initall;
Ingame:=False;
Start;
settextstyle (Defaultfont,Horizdir,1);
settextjustify (Lefttext,Toptext);
Loadsprites;
Currentbottom:=200;
Currentshoots:=50;
Lives:=3;
Score:=0;
Level:=1;
Shootsprobability:=5;
Currentsprites:=5;
10:
Drawfield;
if Level>1 then begin
Str(Level-1,s);
Help ('Cool, you''re complete level '+s);
end
else Help ('Let''s go! Kill them, invaders!');
repeat
if Ingame then repeat
Enemiesstep;
if Enemies=0 then begin
Inc(Score,100+Level*10);
if Shootsprobability<100 then Inc (Shootsprobability);
if Currentsprites<Maxsprites then Inc(Currentsprites);
if Currentbottom<Maxy-10-4*Height then Inc(Currentbottom,10);
Currentshoots:=50;
Delay (1000);
Inc(Level);
goto 10;
end;
Shootmovies;
if not Ingame then begin
Help ('Sorry, you''re dead');
end;
Timefunctions;
until keypressed;
Ch:=Readkey;
case Ch of
SPACE: if not Dieme and Ingame then Shoot;
#0: begin
Ch:=Readkey;
case Ch of
F1: Help ('You need HELP there? You''re VERY strange man :-)');
LEFT: if not Dieme and Ingame then Goleft;
RIGHT: if not Dieme and Ingame then Goright;
UP: if not Dieme and Ingame then Shoot;
end;
end;
end;
until Ch=ESC;
Closeall;
end.
