X-Git-Url: https://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fgame%2Frenders%2Fopengl%2Fr_common.pas;h=174769b68f578edcece9a7b3f17964a8328df372;hb=0592c8529428165e2523e0cb054bff29e297777a;hp=565aa65a86fd9b8785fe7947770395ff6f02dab5;hpb=1c7ee44e1a322dcb170a94d39b3a37f36a9a17bd;p=d2df-sdl.git

diff --git a/src/game/renders/opengl/r_common.pas b/src/game/renders/opengl/r_common.pas
index 565aa65..174769b 100644
--- a/src/game/renders/opengl/r_common.pas
+++ b/src/game/renders/opengl/r_common.pas
@@ -17,7 +17,7 @@ unit r_common;
 
 interface
 
-  uses r_textures;
+  uses r_textures, r_fonts, g_player, g_phys;
 
   type
     TBasePoint = (
@@ -36,6 +36,9 @@ interface
     smallfont: TGLFont;
     menufont: TGLFont;
 
+  var
+    r_Common_ProcessLoadingCallback: TProcedure;
+
   function  r_Common_LoadThis (const name: AnsiString; var here: THereTexture): Boolean;
   procedure r_Common_FreeThis (var here: THereTexture);
 
@@ -49,12 +52,133 @@ interface
 
   function r_Common_TimeToStr (t: LongWord): AnsiString;
 
+  procedure r_Common_GetObjectPos (const obj: TObj; out x, y: Integer);
+  procedure r_Common_GetPlayerPos (const p: TPlayer; out x, y: Integer);
+  procedure r_Common_GetCameraPos (const p: TPlayer; center: Boolean; out x, y: Integer);
+  function  r_Common_GetPosByUID (uid: WORD; out obj: TObj; out x, y: Integer): Boolean;
+
+  procedure r_Common_DrawBackgroundImage (img: TGLTexture);
+  procedure r_Common_DrawBackground (const name: AnsiString);
+
+  procedure r_Common_ClearLoading;
+  procedure r_Common_SetLoading (const text: String; maxval: Integer);
+  procedure r_Common_StepLoading (incval: Integer);
+  procedure r_Common_DrawLoading (force: Boolean);
+
+  function r_Common_LoadTextureFromFile (const filename: AnsiString; log: Boolean = True): TGLTexture;
+  function r_Common_LoadTextureMultiFromFile (const filename: AnsiString; log: Boolean = True): TGLMultiTexture;
+  function r_Common_LoadTextureMultiFromFileAndInfo (const filename: AnsiString; w, h, count: Integer; log: Boolean = True): TGLMultiTexture;
+  function r_Common_LoadTextureMultiTextFromFile (const filename: AnsiString; var txt: TAnimTextInfo; log: Boolean = True): TGLMultiTexture;
+  function r_Common_LoadTextureStreamFromFile (const filename: AnsiString; w, h, count, cw: Integer; st: TGLTextureArray; rs: TRectArray; log: Boolean = True): Boolean;
+  function r_Common_LoadTextureFontFromFile (const filename: AnsiString; constref f: TFontInfo; font2enc: TConvProc; log: Boolean = true): TGLFont;
+
   procedure r_Common_Load;
   procedure r_Common_Free;
 
 implementation
 
-  uses Math, SysUtils, g_base, e_log, utils, r_draw, r_fonts, g_options;
+  uses
+    Math, SysUtils,
+    e_log, utils,
+    g_base, g_basic, g_options, g_game, g_map,
+    {$IFDEF ENABLE_CORPSES}
+      g_corpses,
+    {$ENDIF}
+    r_draw, r_loadscreen
+  ;
+
+  var
+    BackgroundTexture: THereTexture;
+
+  procedure r_Common_GetObjectPos (const obj: TObj; out x, y: Integer);
+    var fx, fy: Integer;
+  begin
+    obj.Lerp(gLerpFactor, fx, fy);
+    x := fx;
+    y := fy + obj.slopeUpLeft;
+  end;
+
+  procedure r_Common_GetPlayerPos (const p: TPlayer; out x, y: Integer);
+    var fx, fy, fSlope: Integer;
+  begin
+    ASSERT(p <> nil);
+    p.obj.Lerp(gLerpFactor, fx, fy);
+    fSlope := nlerp(p.SlopeOld, p.obj.slopeUpLeft, gLerpFactor);
+    x := fx;
+    y := fy + fSlope;
+  end;
+
+{$IFDEF ENABLE_CORPSES}
+  function r_Common_GetPlayerCorpse (const p: TPlayer): TCorpse;
+  begin
+    result := nil;
+    if (p <> nil) and (p.Alive = false) and (p.Spectator = false) and (p.Corpse >= 0) then
+      if (gCorpses <> nil) and (gCorpses[p.Corpse] <> nil) and (gCorpses[p.Corpse].PlayerUID = p.UID) then
+        result := gCorpses[p.Corpse];
+  end;
+{$ENDIF}
+
+  procedure r_Common_GetCameraPos (const p: TPlayer; center: Boolean; out x, y: Integer);
+    {$IFDEF ENABLE_CORPSES}
+      var corpse: TCorpse;
+    {$ENDIF}
+  begin
+{$IFDEF ENABLE_CORPSES}
+    corpse := r_Common_GetPlayerCorpse(p);
+    if corpse <> nil then
+    begin
+      r_Common_GetObjectPos(corpse.obj, x, y);
+      if center then
+      begin
+        x := x + corpse.obj.rect.width div 2;
+        y := y + corpse.obj.rect.height div 2;
+      end;
+    end
+    else
+{$ENDIF}
+    if p <> nil then
+    begin
+      r_Common_GetPlayerPos(p, x, y);
+      y := y - nlerp(p.IncCamOld, p.IncCam, gLerpFactor);
+      if center then
+      begin
+        x := x + p.obj.rect.width div 2;
+        y := y + p.obj.rect.height div 2;
+      end;
+    end
+    else
+    begin
+      x := 0;
+      y := 0;
+      if center then
+      begin
+        x := x + gMapInfo.Width div 2;
+        y := y + gMapInfo.Height div 2;
+      end;
+    end;
+  end;
+
+  function r_Common_GetPosByUID (uid: WORD; out obj: TObj; out x, y: Integer): Boolean;
+    var p: TPlayer; found: Boolean;
+  begin
+    found := false;
+    if g_GetUIDType(uid) = UID_PLAYER then
+    begin
+      p := g_Player_Get(uid);
+      found := p <> nil;
+      if found then
+      begin
+        r_Common_GetPlayerPos(p, x, y);
+        obj := p.obj;
+      end;
+    end
+    else if GetPos(uid, @obj) then
+    begin
+      found := true;
+      r_Common_GetObjectPos(obj, x, y);
+    end;
+    result := found;
+  end;
 
   procedure r_Common_GetBasePoint (x, y, w, h: Integer; p: TBasePoint; out xx, yy: Integer);
   begin
@@ -207,29 +331,127 @@ implementation
     end;
   end;
 
+  procedure r_Common_DrawBackgroundImage (img: TGLTexture);
+    var fw, w, h: LongInt;
+  begin
+    if img <> nil then
+    begin
+      img := BackgroundTexture.id;
+      if img.width = img.height then fw := img.width * 4 div 3 else fw := img.width; // fix aspect 4:3
+      r_Common_CalcAspect(fw, img.height, gScreenWidth, gScreenHeight, false, w, h);
+      r_Draw_Texture(img, gScreenWidth div 2 - w div 2, 0, w, h, false, 255, 255, 255, 255, false);
+    end
+  end;
+
+  procedure r_Common_DrawBackground (const name: AnsiString);
+  begin
+    if r_Common_LoadThis(name, BackgroundTexture) then
+      r_Common_DrawBackgroundImage(BackgroundTexture.id)
+  end;
+
+  function r_Common_Std2Win (i: Integer): Integer;
+  begin
+    case i of
+      0..223:   result := i + 32;
+      224..255: result := i - 224;
+      otherwise result := -1;
+    end
+  end;
+
   function r_Common_LoadFont (const name: AnsiString): TGLFont;
-    var info: TFontInfo; skiphack: Integer;
+    var info: TFontInfo; p: TConvProc;
   begin
     result := nil;
-    if name = 'STD' then skiphack := 144 else skiphack := 0;
+    if name = 'STD' then p := @r_Common_Std2Win else p := nil;
     if r_Font_LoadInfoFromFile(GameWad + ':FONTS/' + name + 'TXT', info) then
-      result := r_Textures_LoadFontFromFile(GameWad + ':FONTS/' + name + 'FONT', info, skiphack, true);
+      result := r_Common_LoadTextureFontFromFile(GameWad + ':FONTS/' + name + 'FONT', info, p, true);
     if result = nil then
       e_logwritefln('failed to load font %s', [name]);
   end;
 
   procedure r_Common_Load;
   begin
-    stdfont := r_Common_LoadFont('STD');
-    smallfont := r_Common_LoadFont('SMALL');
+    r_Common_SetLoading('Fonts', 3);
     menufont := r_Common_LoadFont('MENU');
+    smallfont := r_Common_LoadFont('SMALL');
+    stdfont := r_Common_LoadFont('STD');
+    BackgroundTexture := DEFAULT(THereTexture);
   end;
 
   procedure r_Common_Free;
   begin
+    r_Common_FreeThis(BackgroundTexture);
     menufont.Free;
     smallfont.Free;
     stdfont.Free;
   end;
 
+  (* --------- Loading screen helpers --------- *)
+
+  procedure r_Common_ProcessLoading;
+  begin
+    if @r_Common_ProcessLoadingCallback <> nil then
+      r_Common_ProcessLoadingCallback;
+  end;
+
+  procedure r_Common_DrawLoading (force: Boolean);
+  begin
+    r_LoadScreen_Draw(force);
+    r_Common_ProcessLoading;
+  end;
+
+  procedure r_Common_ClearLoading;
+  begin
+    r_LoadScreen_Clear;
+    r_Common_DrawLoading(true);
+  end;
+
+  procedure r_Common_SetLoading (const text: String; maxval: Integer);
+  begin
+    r_LoadScreen_Set(text, maxval);
+    r_Common_DrawLoading(true);
+  end;
+
+  procedure r_Common_StepLoading (incval: Integer);
+  begin
+    r_LoadScreen_Step(incval);
+    r_Common_DrawLoading(false);
+  end;
+
+  function r_Common_LoadTextureFromFile (const filename: AnsiString; log: Boolean = True): TGLTexture;
+  begin
+    result := r_Textures_LoadFromFile(filename, log);
+    r_Common_StepLoading(1);
+  end;
+
+  function r_Common_LoadTextureMultiFromFile (const filename: AnsiString; log: Boolean = True): TGLMultiTexture;
+  begin
+    result := r_Textures_LoadMultiFromFile(filename, log);
+    r_Common_StepLoading(1);
+  end;
+
+  function r_Common_LoadTextureMultiFromFileAndInfo (const filename: AnsiString; w, h, count: Integer; log: Boolean = True): TGLMultiTexture;
+  begin
+    result := r_Textures_LoadMultiFromFileAndInfo(filename, w, h, count, log);
+    r_Common_StepLoading(1);
+  end;
+
+  function r_Common_LoadTextureMultiTextFromFile (const filename: AnsiString; var txt: TAnimTextInfo; log: Boolean = True): TGLMultiTexture;
+  begin
+    result := r_Textures_LoadMultiTextFromFile(filename, txt, log);
+    r_Common_StepLoading(1);
+  end;
+
+  function r_Common_LoadTextureStreamFromFile (const filename: AnsiString; w, h, count, cw: Integer; st: TGLTextureArray; rs: TRectArray; log: Boolean = True): Boolean;
+  begin
+    r_Textures_LoadStreamFromFile(filename, w, h, count, cw, st, rs, log);
+    r_Common_StepLoading(1);
+  end;
+
+  function r_Common_LoadTextureFontFromFile (const filename: AnsiString; constref f: TFontInfo; font2enc: TConvProc; log: Boolean = true): TGLFont;
+  begin
+    result := r_Textures_LoadFontFromFile (filename, f, font2enc, log);
+    r_Common_StepLoading(1);
+  end;
+
 end.