RSS    

   Ðåôåðàò: Ðàçðàáîòêà èãðîâîé ïðîãðàììû íà ÿçûêå ïðîãðàììèðîâàíèÿ Turbo Pascal

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

Ñòðàíèöû: 1, 2, 3, 4, 5


Íîâîñòè


Áûñòðûé ïîèñê

Ãðóïïà âÊîíòàêòå: íîâîñòè

Ïîêà íåò

Íîâîñòè â Twitter è Facebook

                   

Íîâîñòè

© 2010.