НАУЧНЫЕ РАБОТЫ

Разработка игровой программы на языке программирования Turbo Pascal

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;

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 (i0 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 i0 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 Res4 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),

(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)));

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 y2mxy then mxy:=y2;

if y3>mxy then mxy:=y3;

if y4>mxy then mxy:=y4;

s1:=byte(y1y2 then

Repeat

xpos[y,byte(y1y3 then

Repeat

xpos[y,byte(y2y4 then

Repeat

xpos[y,byte(y3y1 then

Repeat

xpos[y,byte(y4=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 dy0 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;

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 aBotX) or (y>BotY) then Exit;

if xBotX 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-1BotX) or (y>BotY) then Exit;

if xBotX 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.

-----------------------

VGA13H

Buttons

Refrace

SiegeLogo

LogoScreen

VGASpr

SiegeSpr

Siege

Страницы: 1, 2

Приглашения

09.12.2013 - 16.12.2013

Международный конкурс хореографического искусства в рамках Международного фестиваля искусств «РОЖДЕСТВЕНСКАЯ АНДОРРА»

09.12.2013 - 16.12.2013

МЕНЮ

НАУЧНЫЕ РАБОТЫ

Разработка игровой программы на языке программирования Turbo Pascal

Приглашения

Международный конкурс хореографического искусства в рамках Международного фестиваля искусств «РОЖДЕСТВЕНСКАЯ АНДОРРА»

Международный конкурс хорового искусства в АНДОРРЕ «РОЖДЕСТВЕНСКАЯ АНДОРРА»