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
  27     DefaultShellTimeout = 60000;
  28     DefaultShellMax = 300;
  29
  30   type
  31     PShell = ^TShell;
  32     TShell = record
  33       alive:    Boolean;
  34       SType:    Byte;
  35       RAngle:   Integer;
  36       Timeout:  Cardinal;
  37       Obj:      TObj;
  38
  39       procedure getMapBox (out x, y, w, h: Integer); inline;
  40       procedure moveBy (dx, dy: Integer); inline;
  41
  42       procedure positionChanged ();  inline; //WARNING! call this after entity position was changed, or coldet will not >
  43     end;
  44
  45   var
  46     gShells: Array of TShell;
  47
  48   procedure g_Shells_SetMax (Count: Word);
  49   function g_Shells_GetMax (): Word;
  50
  51   procedure g_Shells_Create (fX, fY, dX, dY: Integer; T: Byte);
  52   procedure g_Shells_RemoveAll;
  53   procedure g_Shells_Update;
  54
  55 implementation
  56
  57   uses SysUtils, g_base, g_game, g_sound;
  58
  59   var
  60     SHELL_TIMEOUT: Cardinal = DefaultShellTimeout;
  61     MaxShells: Word = DefaultShellMax;
  62     CurrentShell: Integer = 0;
  63
  64   procedure TShell.getMapBox (out x, y, w, h: Integer); inline;
  65   begin
  66     x := Obj.X;
  67     y := Obj.Y;
  68     w := Obj.Rect.Width;
  69     h := Obj.Rect.Height;
  70   end;
  71
  72   procedure TShell.moveBy (dx, dy: Integer); inline;
  73   begin
  74     if (dx <> 0) or (dy <> 0) then
  75     begin
  76       Obj.X += dx;
  77       Obj.Y += dy;
  78       positionChanged;
  79     end;
  80   end;
  81
  82   procedure TShell.positionChanged (); inline;
  83   begin
  84   end;
  85
  86   procedure g_Shells_SetMax (Count: Word);
  87   begin
  88     MaxShells := Count;
  89     SetLength(gShells, Count);
  90     if CurrentShell >= Count then
  91       CurrentShell := 0;
  92   end;
  93
  94   function g_Shells_GetMax (): Word;
  95   begin
  96     Result := MaxShells;
  97   end;
  98
  99   procedure g_Shells_Create (fX, fY, dX, dY: Integer; T: Byte);
 100   begin
 101     if (gShells = nil) or (Length(gShells) = 0) then
 102       Exit;
 103
 104     with gShells[CurrentShell] do
 105     begin
 106       g_Obj_Init(@Obj);
 107       Obj.Rect.X := 0;
 108       Obj.Rect.Y := 0;
 109       if T = SHELL_BULLET then
 110       begin
 111         Obj.Rect.Width := 4;
 112         Obj.Rect.Height := 2;
 113       end
 114       else
 115       begin
 116         Obj.Rect.Width := 7;
 117         Obj.Rect.Height := 3;
 118       end;
 119       SType := T;
 120       alive := True;
 121       Obj.X := fX;
 122       Obj.Y := fY;
 123       g_Obj_Push(@Obj, dX + Random(4)-Random(4), dY-Random(4));
 124       positionChanged(); // this updates spatial accelerators
 125       RAngle := Random(360);
 126       Timeout := gTime + SHELL_TIMEOUT;
 127       if CurrentShell >= High(gShells) then
 128         CurrentShell := 0
 129       else
 130         Inc(CurrentShell);
 131     end;
 132   end;
 133
 134   procedure g_Shells_RemoveAll;
 135     var i: Integer;
 136   begin
 137     i := g_Shells_GetMax();
 138     g_Shells_SetMax(0);
 139     g_Shells_SetMax(i);
 140   end;
 141
 142   procedure g_Shells_SoundBounce(X, Y: Integer; T: Byte);
 143     var k: Integer;
 144   begin
 145     k := 1 + Random(2);
 146     if T = SHELL_BULLET then
 147       g_Sound_PlayExAt('SOUND_PLAYER_CASING' + IntToStr(k), X, Y)
 148     else
 149       g_Sound_PlayExAt('SOUND_PLAYER_SHELL' + IntToStr(k), X, Y);
 150   end;
 151
 152   procedure g_Shells_Update;
 153     var i: Integer; vel: TPoint2i; mr: Word;
 154   begin
 155     if gShells = nil then
 156       Exit;
 157
 158     for i := 0 to High(gShells) do
 159     begin
 160       if gShells[i].alive then
 161       begin
 162         with gShells[i] do
 163         begin
 164           Obj.oldX := Obj.X;
 165           Obj.oldY := Obj.Y;
 166
 167           vel := Obj.Vel;
 168           mr := g_Obj_Move(@Obj, True, False, True);
 169           positionChanged(); // this updates spatial accelerators
 170
 171           if WordBool(mr and MOVE_FALLOUT) or (gShells[i].Timeout < gTime) then
 172           begin
 173             alive := False;
 174             Continue;
 175           end;
 176
 177         // Отлетает от удара о стену/потолок/пол:
 178           if WordBool(mr and MOVE_HITWALL) then
 179           begin
 180             Obj.Vel.X := -(vel.X div 2);
 181             if not WordBool(mr and MOVE_INWATER) then
 182               g_Shells_SoundBounce(Obj.X, Obj.Y, SType);
 183           end;
 184           if WordBool(mr and (MOVE_HITCEIL or MOVE_HITLAND)) then
 185           begin
 186             Obj.Vel.Y := -(vel.Y div 2);
 187             if Obj.Vel.X <> 0 then Obj.Vel.X := Obj.Vel.X div 2;
 188             if (Obj.Vel.X = 0) and (Obj.Vel.Y = 0) then
 189             begin
 190               if RAngle mod 90 <> 0 then
 191                 RAngle := (RAngle div 90) * 90;
 192             end
 193             else if not WordBool(mr and MOVE_INWATER) then
 194               g_Shells_SoundBounce(Obj.X, Obj.Y, SType);
 195           end;
 196
 197           if (Obj.Vel.X >= 0) then
 198           begin // Clockwise
 199             RAngle := RAngle + Abs(Obj.Vel.X)*8 + Abs(Obj.Vel.Y);
 200             if RAngle >= 360 then
 201               RAngle := RAngle mod 360;
 202           end else begin // Counter-clockwise
 203             RAngle := RAngle - Abs(Obj.Vel.X)*8 - Abs(Obj.Vel.Y);
 204             if RAngle < 0 then
 205               RAngle := (360 - (Abs(RAngle) mod 360)) mod 360;
 206           end;
 207         end;
 208       end;
 209     end;
 210   end;
 211
 212 end.