src/game/opengl/r_player.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 r_player;
  17
  18 interface
  19
  20   uses g_player, g_base; // TPlayer, TRGB
  21
  22   procedure r_Player_Load;
  23   procedure r_Player_Free;
  24
  25   procedure r_Player_DrawAll;
  26   procedure r_Player_DrawDebug (p: TPlayer);
  27   procedure r_Player_DrawHealth;
  28
  29   procedure r_Player_DrawCorpses;
  30   procedure r_Player_DrawShells;
  31
  32   procedure r_Player_Draw (p: TPlayer);
  33   procedure r_Player_DrawIndicator (p: TPlayer; Color: TRGB);
  34   procedure r_Player_DrawBubble (p: TPlayer);
  35   procedure r_Player_DrawAim (p: TPlayer);
  36   procedure r_Player_DrawGUI (pl: TPlayer);
  37   procedure r_Player_DrawRulez (p: TPlayer);
  38   procedure r_Player_DrawPain (p: TPlayer);
  39   procedure r_Player_DrawPickup (p: TPlayer);
  40
  41   procedure r_Player_DrawCorpse (p: TCorpse);
  42
  43 implementation
  44
  45   uses
  46     SysUtils, Classes, Math,
  47     MAPDEF, utils,
  48     g_basic, g_game, g_phys, g_map, g_menu, g_language, g_weapons, g_items, g_net, g_options,
  49 {$IFDEF ENABLE_HOLMES}
  50     g_holmes,
  51 {$ENDIF}
  52     r_playermodel, r_graphics, r_animations, r_textures, r_items
  53   ;
  54
  55   var
  56     PunchFrames: array [Boolean, 0..2] of DWORD;
  57
  58   procedure r_Player_Load;
  59   begin
  60     g_Frames_CreateWAD(@PunchFrames[False, 0], 'FRAMES_PUNCH', GameWAD + ':WEAPONS\PUNCH', 64, 64, 4, False);
  61     g_Frames_CreateWAD(@PunchFrames[False, 1], 'FRAMES_PUNCH_UP', GameWAD + ':WEAPONS\PUNCH_UP', 64, 64, 4, False);
  62     g_Frames_CreateWAD(@PunchFrames[False, 2], 'FRAMES_PUNCH_DN', GameWAD + ':WEAPONS\PUNCH_DN', 64, 64, 4, False);
  63     g_Frames_CreateWAD(@PunchFrames[True, 0], 'FRAMES_PUNCH_BERSERK', GameWAD + ':WEAPONS\PUNCHB', 64, 64, 4, False);
  64     g_Frames_CreateWAD(@PunchFrames[True, 1], 'FRAMES_PUNCH_BERSERK_UP', GameWAD + ':WEAPONS\PUNCHB_UP', 64, 64, 4, False);
  65     g_Frames_CreateWAD(@PunchFrames[True, 2], 'FRAMES_PUNCH_BERSERK_DN', GameWAD + ':WEAPONS\PUNCHB_DN', 64, 64, 4, False);
  66   end;
  67
  68   procedure r_Player_Free;
  69   begin
  70     g_Frames_DeleteByName('FRAMES_PUNCH');
  71     g_Frames_DeleteByName('FRAMES_PUNCH_UP');
  72     g_Frames_DeleteByName('FRAMES_PUNCH_DN');
  73     g_Frames_DeleteByName('FRAMES_PUNCH_BERSERK');
  74     g_Frames_DeleteByName('FRAMES_PUNCH_BERSERK_UP');
  75     g_Frames_DeleteByName('FRAMES_PUNCH_BERSERK_DN');
  76   end;
  77
  78   procedure r_Player_DrawAll;
  79     var i: Integer;
  80   begin
  81     if gPlayers <> nil then
  82       for i := 0 to High(gPlayers) do
  83         if gPlayers[i] <> nil then
  84           r_Player_Draw(gPlayers[i])
  85   end;
  86
  87 procedure r_Player_DrawDebug (p: TPlayer);
  88 var
  89   fW, fH: Byte;
  90 begin
  91   if p = nil then Exit;
  92   if (@p.Obj) = nil then Exit;
  93
  94   e_TextureFontGetSize(gStdFont, fW, fH);
  95
  96   e_TextureFontPrint(0, 0     , 'Pos X: ' + IntToStr(p.Obj.X), gStdFont);
  97   e_TextureFontPrint(0, fH    , 'Pos Y: ' + IntToStr(p.Obj.Y), gStdFont);
  98   e_TextureFontPrint(0, fH * 2, 'Vel X: ' + IntToStr(p.Obj.Vel.X), gStdFont);
  99   e_TextureFontPrint(0, fH * 3, 'Vel Y: ' + IntToStr(p.Obj.Vel.Y), gStdFont);
 100   e_TextureFontPrint(0, fH * 4, 'Acc X: ' + IntToStr(p.Obj.Accel.X), gStdFont);
 101   e_TextureFontPrint(0, fH * 5, 'Acc Y: ' + IntToStr(p.Obj.Accel.Y), gStdFont);
 102   e_TextureFontPrint(0, fH * 6, 'Old X: ' + IntToStr(p.Obj.oldX), gStdFont);
 103   e_TextureFontPrint(0, fH * 7, 'Old Y: ' + IntToStr(p.Obj.oldY), gStdFont);
 104 end;
 105
 106 procedure r_Player_DrawHealth;
 107 var
 108   i: Integer;
 109   fW, fH: Byte;
 110 begin
 111   if gPlayers = nil then Exit;
 112   e_TextureFontGetSize(gStdFont, fW, fH);
 113
 114   for i := 0 to High(gPlayers) do
 115     if gPlayers[i] <> nil then
 116     begin
 117       e_TextureFontPrint(gPlayers[i].Obj.X + gPlayers[i].Obj.Rect.X,
 118       gPlayers[i].Obj.Y + gPlayers[i].Obj.Rect.Y + gPlayers[i].Obj.Rect.Height - fH * 2,
 119       IntToStr(gPlayers[i].Health), gStdFont);
 120       e_TextureFontPrint(gPlayers[i].Obj.X + gPlayers[i].Obj.Rect.X,
 121       gPlayers[i].Obj.Y + gPlayers[i].Obj.Rect.Y + gPlayers[i].Obj.Rect.Height - fH,
 122       IntToStr(gPlayers[i].Armor), gStdFont);
 123     end;
 124 end;
 125
 126   procedure r_Player_DrawCorpses;
 127     var i: Integer;
 128   begin
 129     if gCorpses <> nil then
 130       for i := 0 to High(gCorpses) do
 131         if gCorpses[i] <> nil then
 132           r_Player_DrawCorpse(gCorpses[i])
 133   end;
 134
 135 procedure r_Player_DrawShells;
 136 var
 137   i, fX, fY: Integer;
 138   a: TDFPoint;
 139 begin
 140   if gShells <> nil then
 141     for i := 0 to High(gShells) do
 142       if gShells[i].alive then
 143         with gShells[i] do
 144         begin
 145           if not g_Obj_Collide(sX, sY, sWidth, sHeight, @Obj) then
 146             Continue;
 147
 148           Obj.lerp(gLerpFactor, fX, fY);
 149
 150           a.X := CX;
 151           a.Y := CY;
 152
 153           e_DrawAdv(SpriteID, fX, fY, 0, True, False, RAngle, @a, TMirrorType.None);
 154         end;
 155 end;
 156
 157 procedure r_Player_DrawIndicator (p: TPlayer; Color: TRGB);
 158 var
 159   indX, indY, fX, fY, fSlope: Integer;
 160   indW, indH: Word;
 161   indA: Single;
 162   a: TDFPoint;
 163   nW, nH: Byte;
 164   ID: DWORD;
 165   c: TRGB;
 166 begin
 167   if p.Alive then
 168   begin
 169     p.Obj.lerp(gLerpFactor, fX, fY);
 170     fSlope := nlerp(p.SlopeOld, p.Obj.slopeUpLeft, gLerpFactor);
 171
 172     case gPlayerIndicatorStyle of
 173       0:
 174         begin
 175           if g_Texture_Get('TEXTURE_PLAYER_INDICATOR', ID) then
 176           begin
 177             e_GetTextureSize(ID, @indW, @indH);
 178             a.X := indW div 2;
 179             a.Y := indH div 2;
 180
 181             if (p.Obj.X + p.Obj.Rect.X) < 0 then
 182             begin
 183               indA := 90;
 184               indX := fX + p.Obj.Rect.X + p.Obj.Rect.Width;
 185               indY := fY + p.Obj.Rect.Y + (p.Obj.Rect.Height - indW) div 2;
 186             end
 187
 188             else if (p.Obj.X + p.Obj.Rect.X + p.Obj.Rect.Width) > Max(gMapInfo.Width, gPlayerScreenSize.X) then
 189             begin
 190               indA := 270;
 191               indX := fX + p.Obj.Rect.X - indH;
 192               indY := fY + p.Obj.Rect.Y + (p.Obj.Rect.Height - indW) div 2;
 193             end
 194
 195             else if (p.Obj.Y - indH) < 0 then
 196             begin
 197               indA := 180;
 198               indX := fX + p.Obj.Rect.X + (p.Obj.Rect.Width - indW) div 2;
 199               indY := fY + p.Obj.Rect.Y + p.Obj.Rect.Height;
 200             end
 201
 202             else
 203             begin
 204               indA := 0;
 205               indX := fX + p.Obj.Rect.X + (p.Obj.Rect.Width - indW) div 2;
 206               indY := fY - indH;
 207             end;
 208
 209             indY := indY + fSlope;
 210             indX := EnsureRange(indX, 0, Max(gMapInfo.Width, gPlayerScreenSize.X) - indW);
 211             indY := EnsureRange(indY, 0, Max(gMapInfo.Height, gPlayerScreenSize.Y) - indH);
 212
 213             c := e_Colors;
 214             e_Colors := Color;
 215             e_DrawAdv(ID, indX, indY, 0, True, False, indA, @a);
 216             e_Colors := c;
 217           end;
 218         end;
 219
 220       1:
 221         begin
 222           e_TextureFontGetSize(gStdFont, nW, nH);
 223           indX := fX + p.Obj.Rect.X + (p.Obj.Rect.Width - Length(p.Name) * nW) div 2;
 224           indY := fY - nH + fSlope;
 225           e_TextureFontPrintEx(indX, indY, p.Name, gStdFont, Color.R, Color.G, Color.B, 1.0, True);
 226         end;
 227     end;
 228   end
 229 end;
 230
 231 procedure r_Player_DrawBubble (p: TPlayer);
 232 var
 233   bubX, bubY, fX, fY: Integer;
 234   ID: LongWord;
 235   Rb, Gb, Bb,
 236   Rw, Gw, Bw: SmallInt;
 237   Dot: Byte;
 238   CObj: TObj;
 239 begin
 240   CObj := p.getCameraObj();
 241   CObj.lerp(gLerpFactor, fX, fY);
 242   // NB: _F_Obj.Rect is used to keep the bubble higher; this is not a mistake
 243   bubX := fX + p.Obj.Rect.X + IfThen(p.Direction = TDirection.D_LEFT, -4, 18);
 244   bubY := fY + p.Obj.Rect.Y - 18;
 245   Rb := 64;
 246   Gb := 64;
 247   Bb := 64;
 248   Rw := 240;
 249   Gw := 240;
 250   Bw := 240;
 251   case gChatBubble of
 252     1: // simple textual non-bubble
 253     begin
 254       bubX := fX + p.Obj.Rect.X - 11;
 255       bubY := fY + p.Obj.Rect.Y - 17;
 256       e_TextureFontPrint(bubX, bubY, '[...]', gStdFont);
 257       Exit;
 258     end;
 259     2: // advanced pixel-perfect bubble
 260     begin
 261       if p.Team = TEAM_RED then
 262         Rb := 255
 263       else
 264         if p.Team = TEAM_BLUE then
 265           Bb := 255;
 266     end;
 267     3: // colored bubble
 268     begin
 269       Rb := p.Model.Color.R;
 270       Gb := p.Model.Color.G;
 271       Bb := p.Model.Color.B;
 272       Rw := Min(Rb * 2 + 64, 255);
 273       Gw := Min(Gb * 2 + 64, 255);
 274       Bw := Min(Bb * 2 + 64, 255);
 275       if (Abs(Rw - Rb) < 32)
 276       or (Abs(Gw - Gb) < 32)
 277       or (Abs(Bw - Bb) < 32) then
 278       begin
 279         Rb := Max(Rw div 2 - 16, 0);
 280         Gb := Max(Gw div 2 - 16, 0);
 281         Bb := Max(Bw div 2 - 16, 0);
 282       end;
 283     end;
 284     4: // custom textured bubble
 285     begin
 286       if g_Texture_Get('TEXTURE_PLAYER_TALKBUBBLE', ID) then
 287         if p.Direction = TDirection.D_RIGHT then
 288           e_Draw(ID, bubX - 6, bubY - 7, 0, True, False)
 289         else
 290           e_Draw(ID, bubX - 6, bubY - 7, 0, True, False, TMirrorType.Horizontal);
 291       Exit;
 292     end;
 293   end;
 294
 295   // Outer borders
 296   e_DrawQuad(bubX + 1, bubY    , bubX + 18, bubY + 13, Rb, Gb, Bb);
 297   e_DrawQuad(bubX    , bubY + 1, bubX + 19, bubY + 12, Rb, Gb, Bb);
 298   // Inner box
 299   e_DrawFillQuad(bubX + 1, bubY + 1, bubX + 18, bubY + 12, Rw, Gw, Bw, 0);
 300
 301   // Tail
 302   Dot := IfThen(p.Direction = TDirection.D_LEFT, 14, 5);
 303   e_DrawLine(1, bubX + Dot, bubY + 14, bubX + Dot, bubY + 16, Rb, Gb, Bb);
 304   e_DrawLine(1, bubX + IfThen(p.Direction = TDirection.D_LEFT, Dot - 1, Dot + 1), bubY + 13, bubX + IfThen(p.Direction = TDirection.D_LEFT, Dot - 1, Dot + 1), bubY + 15, Rw, Gw, Bw);
 305   e_DrawLine(1, bubX + IfThen(p.Direction = TDirection.D_LEFT, Dot - 2, Dot + 2), bubY + 13, bubX + IfThen(p.Direction = TDirection.D_LEFT, Dot - 2, Dot + 2), bubY + 14, Rw, Gw, Bw);
 306   e_DrawLine(1, bubX + IfThen(p.Direction = TDirection.D_LEFT, Dot - 3, Dot + 3), bubY + 13, bubX + IfThen(p.Direction = TDirection.D_LEFT, Dot - 3, Dot + 3), bubY + 13, Rw, Gw, Bw);
 307   e_DrawLine(1, bubX + IfThen(p.Direction = TDirection.D_LEFT, Dot - 3, Dot + 3), bubY + 14, bubX + IfThen(p.Direction = TDirection.D_LEFT, Dot - 1, Dot + 1), bubY + 16, Rb, Gb, Bb);
 308
 309   // Dots
 310   Dot := 6;
 311   e_DrawFillQuad(bubX + Dot,     bubY + 8, bubX + Dot + 1, bubY + 9, Rb, Gb, Bb, 0);
 312   e_DrawFillQuad(bubX + Dot + 3, bubY + 8, bubX + Dot + 4, bubY + 9, Rb, Gb, Bb, 0);
 313   e_DrawFillQuad(bubX + Dot + 6, bubY + 8, bubX + Dot + 7, bubY + 9, Rb, Gb, Bb, 0);
 314 end;
 315
 316 procedure r_Player_Draw (p: TPlayer);
 317 var
 318   ID: DWORD;
 319   w, h: Word;
 320   dr: Boolean;
 321   Mirror: TMirrorType;
 322   fX, fY, fSlope: Integer;
 323 begin
 324   p.Obj.lerp(gLerpFactor, fX, fY);
 325   fSlope := nlerp(p.SlopeOld, p.Obj.slopeUpLeft, gLerpFactor);
 326
 327   if p.Alive then
 328   begin
 329     if p.Direction = TDirection.D_RIGHT then
 330       Mirror := TMirrorType.None
 331     else
 332       Mirror := TMirrorType.Horizontal;
 333
 334     if p.PunchAnim.enabled then
 335     begin
 336       if p.FKeys[KEY_DOWN].Pressed then ID := PunchFrames[R_BERSERK in p.FRulez, 2]
 337       else if p.FKeys[KEY_UP].Pressed then ID := PunchFrames[R_BERSERK in p.FRulez, 1]
 338       else ID := PunchFrames[R_BERSERK in p.FRulez, 0];
 339       r_AnimationState_Draw(ID, p.PunchAnim, fX + IfThen(p.Direction = TDirection.D_LEFT, 15 - p.Obj.Rect.X, p.Obj.Rect.X - 15), fY + fSlope + p.Obj.Rect.Y - 11, Mirror);
 340     end;
 341
 342     if (p.FMegaRulez[MR_INVUL] > gTime) and ((gPlayerDrawn <> p) or (p.SpawnInvul >= gTime)) then
 343       if g_Texture_Get('TEXTURE_PLAYER_INVULPENTA', ID) then
 344       begin
 345         e_GetTextureSize(ID, @w, @h);
 346         if p.Direction = TDirection.D_LEFT then
 347           e_Draw(ID, fX + p.Obj.Rect.X + (p.Obj.Rect.Width div 2) - (w div 2) + 4,
 348                      fY + p.Obj.Rect.Y + (p.Obj.Rect.Height div 2) - (h div 2) - 7 + fSlope, 0, True, False)
 349         else
 350           e_Draw(ID, fX + p.Obj.Rect.X + (p.Obj.Rect.Width div 2) - (w div 2) - 2,
 351                      fY + p.Obj.Rect.Y + (p.Obj.Rect.Height div 2) - (h div 2) - 7 + fSlope, 0, True, False)
 352       end;
 353
 354     if p.FMegaRulez[MR_INVIS] > gTime then
 355     begin
 356       if (gPlayerDrawn <> nil) and ((p = gPlayerDrawn) or
 357          ((p.Team = gPlayerDrawn.Team) and (gGameSettings.GameMode <> GM_DM))) then
 358       begin
 359         if (p.FMegaRulez[MR_INVIS] - gTime) <= 2100 then
 360           dr := not Odd((p.FMegaRulez[MR_INVIS] - gTime) div 300)
 361         else
 362           dr := True;
 363         if dr then
 364           r_PlayerModel_Draw(p.Model, fX, fY + fSlope, 200)
 365         else
 366           r_PlayerModel_Draw(p.Model, fX, fY + fSlope);
 367       end
 368       else
 369         r_PlayerModel_Draw(p.Model, fX, fY + fSlope, 254);
 370     end
 371     else
 372       r_PlayerModel_Draw(p.Model, fX, fY + fSlope);
 373   end;
 374
 375   if g_debug_Frames then
 376   begin
 377     e_DrawQuad(p.Obj.X + p.Obj.Rect.X,
 378                p.Obj.Y + p.Obj.Rect.Y,
 379                p.Obj.X + p.Obj.Rect.X + p.Obj.Rect.Width - 1,
 380                p.Obj.Y + p.Obj.Rect.Y + p.Obj.Rect.Height - 1,
 381                0, 255, 0);
 382   end;
 383
 384   if (gChatBubble > 0) and (p.FKeys[KEY_CHAT].Pressed) and not p.Ghost then
 385     if (p.FMegaRulez[MR_INVIS] <= gTime) or ((gPlayerDrawn <> nil) and ((p = gPlayerDrawn) or
 386        ((p.Team = gPlayerDrawn.Team) and (gGameSettings.GameMode <> GM_DM)))) then
 387       r_Player_DrawBubble(p);
 388
 389  // e_DrawPoint(5, 335, 288, 255, 0, 0); // DL, UR, DL, UR
 390   if gAimLine and p.Alive and ((p = gPlayer1) or (p = gPlayer2)) then
 391     r_Player_DrawAim(p);
 392 end;
 393
 394 procedure r_Player_DrawAim (p: TPlayer);
 395
 396   procedure drawCast (sz: Integer; ax0, ay0, ax1, ay1: Integer);
 397   var
 398     ex, ey: Integer;
 399   begin
 400
 401 {$IFDEF ENABLE_HOLMES}
 402     if p.isValidViewPort() and (p = gPlayer1) then
 403     begin
 404       g_Holmes_plrLaser(ax0, ay0, ax1, ay1);
 405     end;
 406 {$ENDIF}
 407
 408     e_DrawLine(sz, ax0, ay0, ax1, ay1, 255, 0, 0, 96);
 409     if (g_Map_traceToNearestWall(ax0, ay0, ax1, ay1, @ex, @ey) <> nil) then
 410     begin
 411       e_DrawLine(sz, ax0, ay0, ex, ey, 0, 255, 0, 96);
 412     end
 413     else
 414     begin
 415       e_DrawLine(sz, ax0, ay0, ex, ey, 0, 0, 255, 96);
 416     end;
 417   end;
 418
 419 var
 420   wx, wy, xx, yy: Integer;
 421   angle: SmallInt;
 422   sz, len: Word;
 423 begin
 424   wx := p.Obj.X + WEAPONPOINT[p.Direction].X + IfThen(p.Direction = TDirection.D_LEFT, 7, -7);
 425   wy := p.Obj.Y + WEAPONPOINT[p.Direction].Y;
 426   angle := p.Angle_;
 427   len := 1024;
 428   sz := 2;
 429   case p.CurrWeap of
 430     0: begin // Punch
 431       len := 12;
 432       sz := 4;
 433     end;
 434     1: begin // Chainsaw
 435       len := 24;
 436       sz := 6;
 437     end;
 438     2: begin // Pistol
 439       len := 1024;
 440       sz := 2;
 441       if angle = ANGLE_RIGHTUP then Dec(angle, 2);
 442       if angle = ANGLE_RIGHTDOWN then Inc(angle, 4);
 443       if angle = ANGLE_LEFTUP then Inc(angle, 2);
 444       if angle = ANGLE_LEFTDOWN then Dec(angle, 4);
 445     end;
 446     3: begin // Shotgun
 447       len := 1024;
 448       sz := 3;
 449       if angle = ANGLE_RIGHTUP then Dec(angle, 2);
 450       if angle = ANGLE_RIGHTDOWN then Inc(angle, 4);
 451       if angle = ANGLE_LEFTUP then Inc(angle, 2);
 452       if angle = ANGLE_LEFTDOWN then Dec(angle, 4);
 453     end;
 454     4: begin // Double Shotgun
 455       len := 1024;
 456       sz := 4;
 457       if angle = ANGLE_RIGHTUP then Dec(angle, 2);
 458       if angle = ANGLE_RIGHTDOWN then Inc(angle, 4);
 459       if angle = ANGLE_LEFTUP then Inc(angle, 2);
 460       if angle = ANGLE_LEFTDOWN then Dec(angle, 4);
 461     end;
 462     5: begin // Chaingun
 463       len := 1024;
 464       sz := 3;
 465       if angle = ANGLE_RIGHTUP then Dec(angle, 2);
 466       if angle = ANGLE_RIGHTDOWN then Inc(angle, 4);
 467       if angle = ANGLE_LEFTUP then Inc(angle, 2);
 468       if angle = ANGLE_LEFTDOWN then Dec(angle, 4);
 469     end;
 470     6: begin // Rocket Launcher
 471       len := 1024;
 472       sz := 7;
 473       if angle = ANGLE_RIGHTUP then Inc(angle, 2);
 474       if angle = ANGLE_RIGHTDOWN then Inc(angle, 4);
 475       if angle = ANGLE_LEFTUP then Dec(angle, 2);
 476       if angle = ANGLE_LEFTDOWN then Dec(angle, 4);
 477     end;
 478     7: begin // Plasmagun
 479       len := 1024;
 480       sz := 5;
 481       if angle = ANGLE_RIGHTUP then Inc(angle);
 482       if angle = ANGLE_RIGHTDOWN then Inc(angle, 3);
 483       if angle = ANGLE_LEFTUP then Dec(angle);
 484       if angle = ANGLE_LEFTDOWN then Dec(angle, 3);
 485     end;
 486     8: begin // BFG
 487       len := 1024;
 488       sz := 12;
 489       if angle = ANGLE_RIGHTUP then Inc(angle, 1);
 490       if angle = ANGLE_RIGHTDOWN then Inc(angle, 2);
 491       if angle = ANGLE_LEFTUP then Dec(angle, 1);
 492       if angle = ANGLE_LEFTDOWN then Dec(angle, 2);
 493     end;
 494     9: begin // Super Chaingun
 495       len := 1024;
 496       sz := 4;
 497       if angle = ANGLE_RIGHTUP then Dec(angle, 2);
 498       if angle = ANGLE_RIGHTDOWN then Inc(angle, 4);
 499       if angle = ANGLE_LEFTUP then Inc(angle, 2);
 500       if angle = ANGLE_LEFTDOWN then Dec(angle, 4);
 501     end;
 502   end;
 503   xx := Trunc(Cos(-DegToRad(angle)) * len) + wx;
 504   yy := Trunc(Sin(-DegToRad(angle)) * len) + wy;
 505   {$IF DEFINED(D2F_DEBUG)}
 506   drawCast(sz, wx, wy, xx, yy);
 507   {$ELSE}
 508   e_DrawLine(sz, wx, wy, xx, yy, 255, 0, 0, 96);
 509   {$ENDIF}
 510 end;
 511
 512 procedure r_Player_DrawGUI (pl: TPlayer);
 513 var
 514   ID: DWORD;
 515   X, Y, SY, a, p, m: Integer;
 516   tw, th: Word;
 517   cw, ch: Byte;
 518   s: string;
 519   stat: TPlayerStatArray;
 520 begin
 521   X := gPlayerScreenSize.X;
 522   SY := gPlayerScreenSize.Y;
 523   Y := 0;
 524
 525   if gShowGoals and (gGameSettings.GameMode in [GM_TDM, GM_CTF]) then
 526   begin
 527     if gGameSettings.GameMode = GM_CTF then
 528       a := 32 + 8
 529     else
 530       a := 0;
 531     if gGameSettings.GameMode = GM_CTF then
 532     begin
 533       s := 'TEXTURE_PLAYER_REDFLAG';
 534       if gFlags[FLAG_RED].State = FLAG_STATE_CAPTURED then
 535         s := 'TEXTURE_PLAYER_REDFLAG_S';
 536       if gFlags[FLAG_RED].State = FLAG_STATE_DROPPED then
 537         s := 'TEXTURE_PLAYER_REDFLAG_D';
 538       if g_Texture_Get(s, ID) then
 539         e_Draw(ID, X-16-32, 240-72-4, 0, True, False);
 540     end;
 541
 542     s := IntToStr(gTeamStat[TEAM_RED].Goals);
 543     e_CharFont_GetSize(gMenuFont, s, tw, th);
 544     e_CharFont_PrintEx(gMenuFont, X-16-a-tw, 240-72-4, s, TEAMCOLOR[TEAM_RED]);
 545
 546     if gGameSettings.GameMode = GM_CTF then
 547     begin
 548       s := 'TEXTURE_PLAYER_BLUEFLAG';
 549       if gFlags[FLAG_BLUE].State = FLAG_STATE_CAPTURED then
 550         s := 'TEXTURE_PLAYER_BLUEFLAG_S';
 551       if gFlags[FLAG_BLUE].State = FLAG_STATE_DROPPED then
 552         s := 'TEXTURE_PLAYER_BLUEFLAG_D';
 553       if g_Texture_Get(s, ID) then
 554         e_Draw(ID,  X-16-32, 240-32-4, 0, True, False);
 555     end;
 556
 557     s := IntToStr(gTeamStat[TEAM_BLUE].Goals);
 558     e_CharFont_GetSize(gMenuFont, s, tw, th);
 559     e_CharFont_PrintEx(gMenuFont, X-16-a-tw, 240-32-4, s, TEAMCOLOR[TEAM_BLUE]);
 560   end;
 561
 562   if g_Texture_Get('TEXTURE_PLAYER_HUDBG', ID) then
 563     e_DrawFill(ID, X, 0, 1, (gPlayerScreenSize.Y div 256)+IfThen(gPlayerScreenSize.Y mod 256 > 0, 1, 0),
 564                0, False, False);
 565
 566   if g_Texture_Get('TEXTURE_PLAYER_HUD', ID) then
 567     e_Draw(ID, X+2, Y, 0, True, False);
 568
 569   if gGameSettings.GameType in [GT_CUSTOM, GT_SERVER, GT_CLIENT] then
 570   begin
 571     if gShowStat then
 572     begin
 573       s := IntToStr(pl.Frags);
 574       e_CharFont_GetSize(gMenuFont, s, tw, th);
 575       e_CharFont_PrintEx(gMenuFont, X-16-tw, Y, s, _RGB(255, 0, 0));
 576
 577       s := '';
 578       p := 1;
 579       m := 0;
 580       stat := g_Player_GetStats();
 581       if stat <> nil then
 582       begin
 583         p := 1;
 584
 585         for a := 0 to High(stat) do
 586           if stat[a].Name <> pl.Name then
 587           begin
 588             if stat[a].Frags > m then m := stat[a].Frags;
 589             if stat[a].Frags > pl.Frags then p := p+1;
 590           end;
 591       end;
 592
 593       s := IntToStr(p)+' / '+IntToStr(Length(stat))+' ';
 594       if pl.Frags >= m then s := s+'+' else s := s+'-';
 595       s := s+IntToStr(Abs(pl.Frags-m));
 596
 597       e_CharFont_GetSize(gMenuSmallFont, s, tw, th);
 598       e_CharFont_PrintEx(gMenuSmallFont, X-16-tw, Y+32, s, _RGB(255, 0, 0));
 599     end;
 600
 601     if gLMSRespawn > LMS_RESPAWN_NONE then
 602     begin
 603       s := _lc[I_GAME_WARMUP];
 604       e_CharFont_GetSize(gMenuFont, s, tw, th);
 605       s := s + ': ' + IntToStr((gLMSRespawnTime - gTime) div 1000);
 606       e_CharFont_PrintEx(gMenuFont, X-64-tw, SY-32, s, _RGB(0, 255, 0));
 607     end
 608     else if gShowLives and (gGameSettings.MaxLives > 0) then
 609     begin
 610       s := IntToStr(pl.Lives);
 611       e_CharFont_GetSize(gMenuFont, s, tw, th);
 612       e_CharFont_PrintEx(gMenuFont, X-16-tw, SY-32, s, _RGB(0, 255, 0));
 613     end;
 614   end;
 615
 616   e_CharFont_GetSize(gMenuSmallFont, pl.Name, tw, th);
 617   e_CharFont_PrintEx(gMenuSmallFont, X+98-(tw div 2), Y+8, pl.Name, _RGB(255, 0, 0));
 618
 619   if R_BERSERK in pl.FRulez then
 620     e_Draw(gItemsTexturesID[ITEM_MEDKIT_BLACK], X+37, Y+45, 0, True, False)
 621   else
 622     e_Draw(gItemsTexturesID[ITEM_MEDKIT_LARGE], X+37, Y+45, 0, True, False);
 623
 624   if g_Texture_Get('TEXTURE_PLAYER_ARMORHUD', ID) then
 625     e_Draw(ID, X+36, Y+77, 0, True, False);
 626
 627   s := IntToStr(IfThen(pl.Health > 0, pl.Health, 0));
 628   e_CharFont_GetSize(gMenuFont, s, tw, th);
 629   e_CharFont_PrintEx(gMenuFont, X+178-tw, Y+40, s, _RGB(255, 0, 0));
 630
 631   s := IntToStr(pl.Armor);
 632   e_CharFont_GetSize(gMenuFont, s, tw, th);
 633   e_CharFont_PrintEx(gMenuFont, X+178-tw, Y+68, s, _RGB(255, 0, 0));
 634
 635   s := IntToStr(pl.GetAmmoByWeapon(pl.CurrWeap));
 636
 637   case pl.CurrWeap of
 638     WEAPON_KASTET:
 639     begin
 640       s := '--';
 641       ID := gItemsTexturesID[ITEM_WEAPON_KASTET];
 642     end;
 643     WEAPON_SAW:
 644     begin
 645       s := '--';
 646       ID := gItemsTexturesID[ITEM_WEAPON_SAW];
 647     end;
 648     WEAPON_PISTOL: ID := gItemsTexturesID[ITEM_WEAPON_PISTOL];
 649     WEAPON_CHAINGUN: ID := gItemsTexturesID[ITEM_WEAPON_CHAINGUN];
 650     WEAPON_SHOTGUN1: ID := gItemsTexturesID[ITEM_WEAPON_SHOTGUN1];
 651     WEAPON_SHOTGUN2: ID := gItemsTexturesID[ITEM_WEAPON_SHOTGUN2];
 652     WEAPON_SUPERPULEMET: ID := gItemsTexturesID[ITEM_WEAPON_SUPERPULEMET];
 653     WEAPON_ROCKETLAUNCHER: ID := gItemsTexturesID[ITEM_WEAPON_ROCKETLAUNCHER];
 654     WEAPON_PLASMA: ID := gItemsTexturesID[ITEM_WEAPON_PLASMA];
 655     WEAPON_BFG: ID := gItemsTexturesID[ITEM_WEAPON_BFG];
 656     WEAPON_FLAMETHROWER: ID := gItemsTexturesID[ITEM_WEAPON_FLAMETHROWER];
 657   end;
 658
 659   e_CharFont_GetSize(gMenuFont, s, tw, th);
 660   e_CharFont_PrintEx(gMenuFont, X+178-tw, Y+158, s, _RGB(255, 0, 0));
 661   e_Draw(ID, X+20, Y+160, 0, True, False);
 662
 663   if R_KEY_RED in pl.FRulez then
 664     e_Draw(gItemsTexturesID[ITEM_KEY_RED], X+78, Y+214, 0, True, False);
 665
 666   if R_KEY_GREEN in pl.FRulez then
 667     e_Draw(gItemsTexturesID[ITEM_KEY_GREEN], X+95, Y+214, 0, True, False);
 668
 669   if R_KEY_BLUE in pl.FRulez then
 670     e_Draw(gItemsTexturesID[ITEM_KEY_BLUE], X+112, Y+214, 0, True, False);
 671
 672   if pl.JetFuel > 0 then
 673   begin
 674     if g_Texture_Get('TEXTURE_PLAYER_HUDAIR', ID) then
 675       e_Draw(ID, X+2, Y+116, 0, True, False);
 676     if g_Texture_Get('TEXTURE_PLAYER_HUDJET', ID) then
 677       e_Draw(ID, X+2, Y+126, 0, True, False);
 678     e_DrawLine(4, X+16, Y+122, X+16+Trunc(168*IfThen(pl.Air > 0, pl.Air, 0)/AIR_MAX), Y+122, 0, 0, 196);
 679     e_DrawLine(4, X+16, Y+132, X+16+Trunc(168*pl.JetFuel/JET_MAX), Y+132, 208, 0, 0);
 680   end
 681   else
 682   begin
 683     if g_Texture_Get('TEXTURE_PLAYER_HUDAIR', ID) then
 684       e_Draw(ID, X+2, Y+124, 0, True, False);
 685     e_DrawLine(4, X+16, Y+130, X+16+Trunc(168*IfThen(pl.Air > 0, pl.Air, 0)/AIR_MAX), Y+130, 0, 0, 196);
 686   end;
 687
 688   if gShowPing and g_Game_IsClient then
 689   begin
 690     s := _lc[I_GAME_PING_HUD] + IntToStr(NetPeer.lastRoundTripTime) + _lc[I_NET_SLIST_PING_MS];
 691     e_TextureFontPrint(X + 4, Y + 242, s, gStdFont);
 692     Y := Y + 16;
 693   end;
 694
 695   if pl.Spectator then
 696   begin
 697     e_TextureFontPrint(X + 4, Y + 242, _lc[I_PLAYER_SPECT], gStdFont);
 698     e_TextureFontPrint(X + 4, Y + 258, _lc[I_PLAYER_SPECT2], gStdFont);
 699     e_TextureFontPrint(X + 4, Y + 274, _lc[I_PLAYER_SPECT1], gStdFont);
 700     if pl.NoRespawn then
 701     begin
 702       e_TextureFontGetSize(gStdFont, cw, ch);
 703       s := _lc[I_PLAYER_SPECT4];
 704       e_TextureFontPrintEx(gScreenWidth div 2 - cw*(Length(s) div 2),
 705                          gScreenHeight-4-ch, s, gStdFont, 255, 255, 255, 1, True);
 706       e_TextureFontPrint(X + 4, Y + 290, _lc[I_PLAYER_SPECT1S], gStdFont);
 707     end;
 708
 709   end;
 710 end;
 711
 712 procedure r_Player_DrawRulez (p: TPlayer);
 713 var
 714   dr: Boolean;
 715 begin
 716   // При взятии неуязвимости рисуется инверсионный белый фон
 717   if (p.FMegaRulez[MR_INVUL] >= gTime) and (p.SpawnInvul < gTime) then
 718   begin
 719     if (p.FMegaRulez[MR_INVUL]-gTime) <= 2100 then
 720       dr := not Odd((p.FMegaRulez[MR_INVUL]-gTime) div 300)
 721     else
 722       dr := True;
 723
 724     if dr then
 725       e_DrawFillQuad(0, 0, gPlayerScreenSize.X-1, gPlayerScreenSize.Y-1,
 726                      191, 191, 191, 0, TBlending.Invert);
 727   end;
 728
 729   // При взятии защитного костюма рисуется зеленоватый фон
 730   if p.FMegaRulez[MR_SUIT] >= gTime then
 731   begin
 732     if (p.FMegaRulez[MR_SUIT]-gTime) <= 2100 then
 733       dr := not Odd((p.FMegaRulez[MR_SUIT]-gTime) div 300)
 734     else
 735       dr := True;
 736
 737     if dr then
 738       e_DrawFillQuad(0, 0, gPlayerScreenSize.X-1, gPlayerScreenSize.Y-1,
 739                      0, 96, 0, 200, TBlending.None);
 740   end;
 741
 742   // При взятии берсерка рисуется красноватый фон
 743   if (p.Berserk >= 0) and (LongWord(p.Berserk) >= gTime) and (gFlash = 2) then
 744   begin
 745     e_DrawFillQuad(0, 0, gPlayerScreenSize.X-1, gPlayerScreenSize.Y-1,
 746                      255, 0, 0, 200, TBlending.None);
 747   end;
 748 end;
 749
 750 procedure r_Player_DrawPain (p: TPlayer);
 751 var
 752   a, h: Integer;
 753 begin
 754   if p.Pain = 0 then Exit;
 755
 756   a := p.Pain;
 757
 758   if a < 15 then h := 0
 759   else if a < 35 then h := 1
 760   else if a < 55 then h := 2
 761   else if a < 75 then h := 3
 762   else if a < 95 then h := 4
 763   else h := 5;
 764
 765   //if a > 255 then a := 255;
 766
 767   e_DrawFillQuad(0, 0, gPlayerScreenSize.X-1, gPlayerScreenSize.Y-1, 255, 0, 0, 255-h*50);
 768   //e_DrawFillQuad(0, 0, gPlayerScreenSize.X-1, gPlayerScreenSize.Y-1, 255-min(128, a), 255-a, 255-a, 0, B_FILTER);
 769 end;
 770
 771 procedure r_Player_DrawPickup (p: TPlayer);
 772 var
 773   a, h: Integer;
 774 begin
 775   if p.Pickup = 0 then Exit;
 776
 777   a := p.Pickup;
 778
 779   if a < 15 then h := 1
 780   else if a < 35 then h := 2
 781   else if a < 55 then h := 3
 782   else if a < 75 then h := 4
 783   else h := 5;
 784
 785   e_DrawFillQuad(0, 0, gPlayerScreenSize.X-1, gPlayerScreenSize.Y-1, 150, 200, 150, 255-h*50);
 786 end;
 787
 788 procedure r_Player_DrawCorpse (p: TCorpse);
 789 var
 790   fX, fY: Integer;
 791 begin
 792   if p.State = CORPSE_STATE_REMOVEME then
 793     Exit;
 794
 795   p.Obj.lerp(gLerpFactor, fX, fY);
 796
 797   if p.Animation <> nil then
 798     r_Animation_Draw(p.Animation, fX, fY, TMirrorType.None);
 799
 800   if p.AnimationMask <> nil then
 801   begin
 802     e_Colors := p.Color;
 803     r_Animation_Draw(p.AnimationMask, fX, fY, TMirrorType.None);
 804     e_Colors.R := 255;
 805     e_Colors.G := 255;
 806     e_Colors.B := 255;
 807   end;
 808 end;
 809
 810 end.