X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fgame%2Frenders%2Fopengl%2Fr_common.pas;h=331988249b287a83355b7df4e07a522875e6ef15;hb=b4e158834e92ec5c007a8af5a116855b8062c82d;hp=99f46d1468c3ef3e5a2d39897178b750b9e2c48c;hpb=592951a4048e48d2239ed64bb0f5743dc8df03d7;p=d2df-sdl.git

diff --git a/src/game/renders/opengl/r_common.pas b/src/game/renders/opengl/r_common.pas
index 99f46d1..3319882 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, g_player, g_phys;
+  uses r_textures, r_fonts, g_player, g_phys;
 
   type
     TBasePoint = (
@@ -36,6 +36,12 @@ interface
     smallfont: TGLFont;
     menufont: TGLFont;
 
+  var
+    r_Common_ProcessLoadingCallback: TProcedure;
+
+  procedure r_Common_FreeAndNil (var obj);
+  procedure r_Common_FreeMemAndNil (var p);
+
   function  r_Common_LoadThis (const name: AnsiString; var here: THereTexture): Boolean;
   procedure r_Common_FreeThis (var here: THereTexture);
 
@@ -54,6 +60,21 @@ interface
   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; hints: TGLHintsSet; log: Boolean = True): TGLTexture;
+  function r_Common_LoadTextureMultiFromFile (const filename: AnsiString; hints: TGLHintsSet; log: Boolean = True): TGLMultiTexture;
+  function r_Common_LoadTextureMultiFromFileAndInfo (const filename: AnsiString; w, h, count: Integer; hints: TGLHintsSet; log: Boolean = True): TGLMultiTexture;
+  function r_Common_LoadTextureMultiTextFromFile (const filename: AnsiString; var txt: TAnimTextInfo; hints: TGLHintsSet; log: Boolean = True): TGLMultiTexture;
+  function r_Common_LoadTextureStreamFromFile (const filename: AnsiString; w, h, count, cw: Integer; st: TGLTextureArray; rs: TRectArray; hints: TGLHintsSet; 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;
 
@@ -66,9 +87,30 @@ implementation
     {$IFDEF ENABLE_CORPSES}
       g_corpses,
     {$ENDIF}
-    r_draw, r_fonts
+    r_draw, r_loadscreen
   ;
 
+  var
+    BackgroundTexture: THereTexture;
+
+  procedure r_Common_FreeAndNil (var obj);
+    var temp: TObject;
+  begin
+    temp := TObject(obj);
+    Pointer(obj) := nil;
+    if temp <> nil then
+      temp.Free;
+  end;
+
+  procedure r_Common_FreeMemAndNil (var p);
+    var temp: Pointer;
+  begin
+    temp := Pointer(p);
+    Pointer(p) := nil;
+    if temp <> nil then
+      FreeMem(temp)
+  end;
+
   procedure r_Common_GetObjectPos (const obj: TObj; out x, y: Integer);
     var fx, fy: Integer;
   begin
@@ -278,9 +320,7 @@ implementation
   procedure r_Common_FreeThis (var here: THereTexture);
   begin
     here.name := '';
-    if here.id <> nil then
-      here.id.Free;
-    here.id := nil;
+    r_Common_FreeAndNil(here.id);
   end;
 
   function r_Common_LoadThis (const name: AnsiString; var here: THereTexture): Boolean;
@@ -288,7 +328,7 @@ implementation
     if name <> here.name then
       r_Common_FreeThis(here);
     if (name <> '') and (here.name <> name) then
-      here.id := r_Textures_LoadFromFile(name);
+      here.id := r_Textures_LoadFromFile(name, []); // !!!
 
     result := here.id <> nil;
 
@@ -310,29 +350,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
-    menufont.Free;
-    smallfont.Free;
-    stdfont.Free;
+    r_Common_FreeThis(BackgroundTexture);
+    FreeAndNil(menufont);
+    FreeAndNil(smallfont);
+    FreeAndNil(stdfont);
+  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; hints: TGLHintsSet; log: Boolean = True): TGLTexture;
+  begin
+    result := r_Textures_LoadFromFile(filename, hints, log);
+    r_Common_StepLoading(1);
+  end;
+
+  function r_Common_LoadTextureMultiFromFile (const filename: AnsiString; hints: TGLHintsSet; log: Boolean = True): TGLMultiTexture;
+  begin
+    result := r_Textures_LoadMultiFromFile(filename, hints, log);
+    r_Common_StepLoading(1);
+  end;
+
+  function r_Common_LoadTextureMultiFromFileAndInfo (const filename: AnsiString; w, h, count: Integer; hints: TGLHintsSet; log: Boolean = True): TGLMultiTexture;
+  begin
+    result := r_Textures_LoadMultiFromFileAndInfo(filename, w, h, count, hints, log);
+    r_Common_StepLoading(1);
+  end;
+
+  function r_Common_LoadTextureMultiTextFromFile (const filename: AnsiString; var txt: TAnimTextInfo; hints: TGLHintsSet; log: Boolean = True): TGLMultiTexture;
+  begin
+    result := r_Textures_LoadMultiTextFromFile(filename, txt, hints, log);
+    r_Common_StepLoading(1);
+  end;
+
+  function r_Common_LoadTextureStreamFromFile (const filename: AnsiString; w, h, count, cw: Integer; st: TGLTextureArray; rs: TRectArray; hints: TGLHintsSet; log: Boolean = True): Boolean;
+  begin
+    result := r_Textures_LoadStreamFromFile(filename, w, h, count, cw, st, rs, hints, 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.