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