src/game/g_shells.pas

   1 (* Copyright (C)  Doom 2D: Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, version 3 of the License ONLY.
   6  *
   7  * This program is distributed in the hope that it will be useful,
   8  * but WITHOUT ANY WARRANTY; without even the implied warranty of
   9  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  10  * GNU General Public License for more details.
  11  *
  12  * You should have received a copy of the GNU General Public License
  13  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  14  *)
  15 {$INCLUDE ../shared/a_modes.inc}
  16 unit g_shells;
  17
  18 interface
  19
  20   uses g_phys;
  21
  22   const
  23     SHELL_BULLET   = 0;
  24     SHELL_SHELL    = 1;
  25     SHELL_DBLSHELL = 2;
  26     SHELL_LAST     = SHELL_DBLSHELL;
  27
  28     DefaultShellTimeout = 60000;
  29     DefaultShellMax = 300;
  30
  31   type
  32     PShell = ^TShell;
  33     TShell = record
  34       alive:    Boolean;
  35       SType:    Byte;
  36       RAngle:   Integer;
  37       Timeout:  Cardinal;
  38       Obj:      TObj;
  39
  40       procedure getMapBox (out x, y, w, h: Integer); inline;
  41       procedure moveBy (dx, dy: Integer); inline;
  42
  43       procedure positionChanged ();  inline; //WARNING! call this after entity position was changed, or coldet will not >
  44     end;
  45
  46   var
  47     gShells: Array of TShell;
  48
  49   procedure g_Shells_SetMax (Count: Word);
  50   function g_Shells_GetMax (): Word;
  51
  52   procedure g_Shells_Create (fX, fY, dX, dY: Integer; T: Byte);
  53   procedure g_Shells_RemoveAll;
  54   procedure g_Shells_Update;
  55
  56 implementation
  57
  58   uses SysUtils, g_base, g_game, g_sound;
  59
  60   var
  61     SHELL_TIMEOUT: Cardinal = DefaultShellTimeout;
  62     MaxShells: Word = DefaultShellMax;
  63     CurrentShell: Integer = 0;
  64
  65   procedure TShell.getMapBox (out x, y, w, h: Integer); inline;
  66   begin
  67     x := Obj.X;
  68     y := Obj.Y;
  69     w := Obj.Rect.Width;
  70     h := Obj.Rect.Height;
  71   end;
  72
  73   procedure TShell.moveBy (dx, dy: Integer); inline;
  74   begin
  75     if (dx <> 0) or (dy <> 0) then
  76     begin
  77       Obj.X += dx;
  78       Obj.Y += dy;
  79       positionChanged;
  80     end;
  81   end;
  82
  83   procedure TShell.positionChanged (); inline;
  84   begin
  85   end;
  86
  87   procedure g_Shells_SetMax (Count: Word);
  88   begin
  89     MaxShells := Count;
  90     SetLength(gShells, Count);
  91     if CurrentShell >= Count then
  92       CurrentShell := 0;
  93   end;
  94
  95   function g_Shells_GetMax (): Word;
  96   begin
  97     Result := MaxShells;
  98   end;
  99
 100   procedure g_Shells_Create (fX, fY, dX, dY: Integer; T: Byte);
 101   begin
 102     if (gShells = nil) or (Length(gShells) = 0) then
 103       Exit;
 104
 105     with gShells[CurrentShell] do
 106     begin
 107       g_Obj_Init(@Obj);
 108       Obj.Rect.X := 0;
 109       Obj.Rect.Y := 0;
 110       if T = SHELL_BULLET then
 111       begin
 112         Obj.Rect.Width := 4;
 113         Obj.Rect.Height := 2;
 114       end
 115       else
 116       begin
 117         Obj.Rect.Width := 7;
 118         Obj.Rect.Height := 3;
 119       end;
 120       SType := T;
 121       alive := True;
 122       Obj.X := fX;
 123       Obj.Y := fY;
 124       g_Obj_Push(@Obj, dX + Random(4)-Random(4), dY-Random(4));
 125       positionChanged(); // this updates spatial accelerators
 126       RAngle := Random(360);
 127       Timeout := gTime + SHELL_TIMEOUT;
 128       if CurrentShell >= High(gShells) then
 129         CurrentShell := 0
 130       else
 131         Inc(CurrentShell);
 132     end;
 133   end;
 134
 135   procedure g_Shells_RemoveAll;
 136     var i: Integer;
 137   begin
 138     if gShells <> nil then
 139       for i := 0 to High(gShells) do
 140         gShells[i].alive := false;
 141   end;
 142
 143   procedure g_Shells_SoundBounce(X, Y: Integer; T: Byte);
 144     var k: Integer;
 145   begin
 146     k := 1 + Random(2);
 147     if T = SHELL_BULLET then
 148       g_Sound_PlayExAt('SOUND_PLAYER_CASING' + IntToStr(k), X, Y)
 149     else
 150       g_Sound_PlayExAt('SOUND_PLAYER_SHELL' + IntToStr(k), X, Y);
 151   end;
 152
 153   procedure g_Shells_Update;
 154     var i: Integer; vel: TPoint2i; mr: Word;
 155   begin
 156     if gShells = nil then
 157       Exit;
 158
 159     for i := 0 to High(gShells) do
 160     begin
 161       if gShells[i].alive then
 162       begin
 163         with gShells[i] do
 164         begin
 165           Obj.oldX := Obj.X;
 166           Obj.oldY := Obj.Y;
 167
 168           vel := Obj.Vel;
 169           mr := g_Obj_Move(@Obj, True, False, True);
 170           positionChanged(); // this updates spatial accelerators
 171
 172           if WordBool(mr and MOVE_FALLOUT) or (gShells[i].Timeout < gTime) then
 173           begin
 174             alive := False;
 175             Continue;
 176           end;
 177
 178         // Отлетает от удара о стену/потолок/пол:
 179           if WordBool(mr and MOVE_HITWALL) then
 180           begin
 181             Obj.Vel.X := -(vel.X div 2);
 182             if not WordBool(mr and MOVE_INWATER) then
 183               g_Shells_SoundBounce(Obj.X, Obj.Y, SType);
 184           end;
 185           if WordBool(mr and (MOVE_HITCEIL or MOVE_HITLAND)) then
 186           begin
 187             Obj.Vel.Y := -(vel.Y div 2);
 188             if Obj.Vel.X <> 0 then Obj.Vel.X := Obj.Vel.X div 2;
 189             if (Obj.Vel.X = 0) and (Obj.Vel.Y = 0) then
 190             begin
 191               if RAngle mod 90 <> 0 then
 192                 RAngle := (RAngle div 90) * 90;
 193             end
 194             else if not WordBool(mr and MOVE_INWATER) then
 195               g_Shells_SoundBounce(Obj.X, Obj.Y, SType);
 196           end;
 197
 198           if (Obj.Vel.X >= 0) then
 199           begin // Clockwise
 200             RAngle := RAngle + Abs(Obj.Vel.X)*8 + Abs(Obj.Vel.Y);
 201             if RAngle >= 360 then
 202               RAngle := RAngle mod 360;
 203           end else begin // Counter-clockwise
 204             RAngle := RAngle - Abs(Obj.Vel.X)*8 - Abs(Obj.Vel.Y);
 205             if RAngle < 0 then
 206               RAngle := (360 - (Abs(RAngle) mod 360)) mod 360;
 207           end;
 208         end;
 209       end;
 210     end;
 211   end;
 212
 213 end.