kursovik (Разработка игровой программы на языке программирования Turbo Pascal), страница 2
Описание файла
Документ из архива "Разработка игровой программы на языке программирования Turbo Pascal", который расположен в категории "". Всё это находится в предмете "информатика" из , которые можно найти в файловом архиве . Не смотря на прямую связь этого архива с , его также можно найти и в других разделах. Архив можно найти в разделе "рефераты, доклады и презентации", в предмете "информатика, программирование" в общих файлах.
Онлайн просмотр документа "kursovik"
Текст 2 страницы из документа "kursovik"
3.1 Описание назначения модулей.
S i e g e – основная программа, вызывающая на выполнение программные модули.
Модуль S i e g e S p r - модуль, содержащий игровые объекты (картинки).
Модуль V G A S p r – модуль для рисования спрайтов.
Модуль L o g o s c r e e n –заставка курсовой работы.
Модуль S i e g e L o g o – модуль, содержащий меню, инструкцию, предысторию.
Модуль B u t t o n s – модуль, позволяющий осуществлять нажатие и отпускание клавиши, информацию о состоянии клавиш в реальном времени и об отпущенных клавишах.
Модуль R e t r a c e – модуль,позволяющий осуществлять синхронизацию вывода в видеопамять.
Модуль V G A 1 3 H - модуль для работы с графикой.
ЗАКЛЮЧЕНИЕ
Таким образом, представляемая компьютерная игра относится к классу комбинаторных игр, поскольку может быть использована как в качестве развивающей внимание, реакцию, психомоторные навыки (способности) игры, так и для приятного времяпрепровождения и отдыха. При создании компьютерной игры мы старались сделать её по возможности красочнее, интереснее и увлекательнее.
Мы бы порекомендовали эту игру для детей школьного возраста, однако, показав ее врозлым, она заинтересовала и их. Поэтому нам кажется,что она вполне пригодна и для более взрослой аудитории.
СПИСОК ИСПОЛЬЗУЕМОЙ ЛИТЕРАТУРЫ
-
Игнатьева А.И. Компьютерные игры. (с. 3-10, 31-35) М. 1988.
-
Домашний компьютер - №4(с. 62-68),1999
-
Домашний компьютер - №12(с. 78-88),1999
-
Инфо–№2: Компьютерные игры в обучение (с.61-65) /Под ред. Марнуми Е., Когов Ю. 1990.
-
Лукашенко М.А. «Информатика в играх и задачах» (с.1-5) //Нач.шк. /Приложение к газете «1 сентября» - 1994, №44
-
Инфо-№4: Компьютерная игра: учим или играем (64-67) /Под ред.
Марусева И.В. 1997.
7. Коубс Р. и Влейминк И. Интерфейс (36-40) 1991.
8. Ла Мот А. Секреты программирования игр (7-10) 1995.
9. Фридланд А.Я. Информатика. Толковый словарь основных терминов. (57-62) М. 1998.
10. 350 игр для IBM PC, Дж. Дворак, «Пергамент» - Санкт -Петербург, 1994 .
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 ((StoneY+8>Y) and (StoneY 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); 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; end; xp:=xp+8; end; end; 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), (4,4,4,4,4,4,4,4,4,7), (4,4,4,4,4,4,4,4,4,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), (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,7,8,8,8,8,8,8), (8,8,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,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,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,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,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, 7, 7, 7, 7, 7, 7,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, 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,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,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), (10,10,00,10,10,10,10,10,10,10,10,10,10,00,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,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,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,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), ( 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, 8,00,00), (00, 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, 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,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,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,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, 7, 7, 7, 7, 7, 7,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, 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,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,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,00,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,10,10,00), (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,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, 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), (00,00, 8, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8,00), (00, 8, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8,00,00), (00, 8, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8,00,00), (00, 8, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8,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,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))); IMPLEMENTATION END. UNIT VGA13h; INTERFACE Type PScreen = ^TScreen; TScreen = Array [0..199,0..319] of Byte; Const ScreenHeight = 200; ScreenWidth = 320; GetMaxY = ScreenHeight-1; GetMaxX = ScreenWidth-1; MidX = GetMaxX div 2; MidY = GetMaxY div 2; PageSize = ScreenHeight*ScreenWidth; QuarterSize = PageSize div 4; VideoSegment:Word = 0; Base1:Word = 0; Base2:Word = 0; Page1:PScreen = NIL; Page2:PScreen = NIL; Function DetectVGA:Boolean; Procedure SetGraphMode; Procedure SetTextMode; Procedure MakePixelSquare; Procedure CopyBase(Source,Destin:Word); Procedure ClearBase(Base:Word); Procedure FillBase(Base,Ofs,Count:Word;Color:Longint); Procedure MoveBase(Source,Destin,Count:Word); Procedure TileBase(Base,Ofs,Count:Word;Tile:Pointer;Len:Word); Procedure PutPixel(Base:Word;x,y:Integer;Color:Byte); Function GetPixel(Base:Word;x,y:Integer):Byte; Procedure Line(Base:Word;x1,y1,x2,y2:Integer;Color:Byte); Procedure VLine(Base:Word;x,y1,y2:Integer;Color:Byte); Procedure HLine(Base:Word;y,x1,x2:Integer;Color:Byte); Procedure Bar(Base:Word;x1,y1,x2,y2:Integer;Color:Byte); Procedure Polygon(Base:Word;x1,y1,x2,y2,x3,y3,x4,y4:Integer;c:Byte); Function InitVirtualPage:Boolean; Procedure DoneVirtualPage; IMPLEMENTATION Var VirtualPage:Pointer; {$L VGA13H.OBJ} Function DetectVGA; external; Procedure SetGraphMode; external; Procedure SetTextMode; external; Procedure MakePixelSquare; external; Procedure CopyBase; external; Procedure ClearBase; external; Procedure FillBase; external; Procedure MoveBase; external; Procedure TileBase; external; Procedure PutPixel; external; Function GetPixel; external; Procedure HLine; external; Procedure VLine; external; Procedure Polygon; Var xpos:array [0..199,0..1] of Word; mny,mxy,y:Integer; i:Word; s1,s2,s3,s4:Shortint; begin mny:=y1; if y2 if y3 if y4 mxy:=y1; if y2>mxy then mxy:=y2; if y3>mxy then mxy:=y3; if y4>mxy then mxy:=y4; s1:=byte(y1 s2:=byte(y2 s3:=byte(y3 s4:=byte(y4 y:=y1; if y1<>y2 then Repeat xpos[y,byte(y1 y:=y+s1; Until y=y2+s1 else xpos[y,byte(y1 y:=y2; if y2<>y3 then Repeat xpos[y,byte(y2 y:=y+s2; Until y=y3+s2 else xpos[y,byte(y2 y:=y3; if y3<>y4 then Repeat xpos[y,byte(y3 y:=y+s3; Until y=y4+s3 else xpos[y,byte(y3 y:=y4; if y4<>y1 then Repeat xpos[y,byte(y4 y:=y+s4; Until y=y1+s4 else xpos[y,byte(y1 for y:=mny to mxy do HLine(Base,y,xpos[y,0],xpos[y,1],c); end; Procedure Line; Var dx,dy,sx,sy,d,d1,d2,x,y,i:Integer; begin dx:=Abs(x2-x1); dy:=Abs(y2-y1); if x2>=x1 then sx:=+1 else sx:=-1; if y2>=y1 then sy:=+1 else sy:=-1; Mem[Base:(y1 shl 8)+(y1 shl 6)+x1]:=Color; if dy<=dx then begin d:=(dy shl 1)-dx; d1:=dy shl 1; d2:=(dy-dx) shl 1; x:=x1+sx; y:=y1; for i:=1 to dx do begin if d>0 then begin d:=d+d2; y:=y+sy; end else d:=d+d1; Mem[Base:(y shl 8)+(y shl 6)+x]:=Color; x:=x+sx; end; end else begin d:=(dx shl 1)-dy; d1:=dx shl 1; d2:=(dx-dy) shl 1; x:=x1; y:=y1+sy; for i:=1 to dy do begin if d>0 then begin d:=d+d2; x:=x+sx; end else d:=d+d1; Mem[Base:(y shl 8)+(y shl 6)+x]:=Color; y:=y+sy; end; end; end; Procedure Bar; Var Row,Column:Integer; begin for Row:=y1 to y2 do for Column:=x1 to x2 do Mem[Base:(Row shl 8)+(Row shl 6)+Column]:=Color; end; Function InitVirtualPage; Var Temp:Longint; begin VirtualPage:=NIL; Base2:=0; Page2:=NIL; InitVirtualPage:=false; GetMem(VirtualPage,PageSize+15); Temp:=(Longint(Seg(VirtualPage^)) shl 4)+Longint(Ofs(VirtualPage^)); if Temp and $F<>0 then Temp:=(Temp shr 4)+1 else Temp:=Temp shr 4; Base2:=Temp; Page2:=Ptr(Base2,0); ClearBase(Base2); InitVirtualPage:=true; end; Procedure DoneVirtualPage; begin FreeMem(VirtualPage,PageSize+15); VirtualPage:=NIL; Base2:=0; Page2:=NIL; end; {==================================================================} BEGIN VideoSegment:=SegA000; Base1:=VideoSegment; Page1:=Ptr(Base1,0); InitVirtualPage; END. UNIT VGASpr; INTERFACE Uses VGA13h; Type BA=Array [0..$FFF0] of Byte; Var TopX,TopY,BotX,BotY:Integer; Procedure SetClipRect(x1,y1,x2,y2:Integer); Procedure DrawTSpr(Base:Word;x,y:Integer;h,w:Word;Image:Pointer); Procedure DrawOSpr(Base:Word;x,y:Integer;h,w:Word;Image:Pointer); IMPLEMENTATION Procedure SetClipRect; Function Max(a,b:Integer):Integer; begin if a>b then Max:=a else Max:=b; end; Function Min(a,b:Integer):Integer; begin if a end; begin TopX:=Max(0,Min(x1,x2)); BotX:=Min(GetMaxX,Max(x1,x2)); TopY:=Max(0,Min(y1,y2)); BotY:=Min(GetMaxY,Max(y1,y2)); end; Procedure DrawTSpr; Var fx,fy,x1,y1,x2,y2:Word; c:Byte; begin if (x+w-1 if x if y if x+w>BotX then x2:=BotX-x else x2:=w-1; if y+h>BotY then y2:=BotY-y else y2:=h-1; for fy:=y1 to y2 do for fx:=x1 to x2 do begin c:=BA(Image^)[fy*w+fx]; if c<>0 then Mem[Base:((y+fy) shl 8)+((y+fy) shl 6)+(x+fx)]:=c; end; end; Procedure DrawOSpr; Var fx,fy,x1,y1,x2,y2:Word; begin if (x+w-1 if x if y if x+w>BotX then x2:=BotX-x else x2:=w-1; if y+h>BotY then y2:=BotY-y else y2:=h-1; for fy:=y1 to y2 do for fx:=x1 to x2 do Mem[Base:((y+fy) shl 8)+((y+fy) shl 6)+(x+fx)]:=BA(Image^)[fy*w+fx]; end; BEGIN SetClipRect(0,0,GetMaxX,GetMaxY); END.
