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