DEADSOFTWARE

gl: properly free memory
[d2df-sdl.git] / src / game / renders / opengl / r_render.pas
index d445dcb6a3f5ada784171cc44353140ab4d3ba7c..4c1f097115acbf4a563cff0920db1970a0fc6225 100644 (file)
@@ -24,6 +24,9 @@ interface
     g_base // TRectWH
   ;
 
+  type
+    TProcedure = procedure;
+
   (* render startup *)
   procedure r_Render_Initialize;
   procedure r_Render_Finalize;
@@ -64,7 +67,11 @@ interface
     procedure r_Render_GetStringSize (BigFont: Boolean; str: String; out w, h: Integer);
   {$ENDIF}
 
-  procedure r_Render_DrawLoading (force: Boolean); // !!! remove it
+  procedure r_Render_SetProcessLoadingCallback (p: TProcedure);
+  procedure r_Render_ClearLoading;
+  procedure r_Render_SetLoading (const text: String; maxval: Integer);
+  procedure r_Render_StepLoading (incval: Integer);
+  procedure r_Render_DrawLoading (force: Boolean);
 
 implementation
 
@@ -82,15 +89,13 @@ implementation
     {$ENDIF}
     SysUtils, Classes, Math,
     g_basic,
-    e_log, utils, wadreader,
-    g_game, g_map, g_options, g_console, g_player, g_weapons, g_language, g_triggers,
+    e_log, utils, wadreader, mapdef,
+    g_game, g_map, g_panel, g_options, g_console, g_player, g_weapons, g_language, g_triggers, g_monsters,
     g_net, g_netmaster,
-    r_draw, r_textures, r_fonts, r_common, r_console, r_map
+    r_draw, r_textures, r_fonts, r_common, r_console, r_map, r_loadscreen
   ;
 
   var
-    BackgroundTexture: THereTexture;
-
     hud, hudbg: TGLTexture;
     hudhp: array [Boolean] of TGLTexture;
     hudap: TGLTexture;
@@ -101,6 +106,8 @@ implementation
     hudrflag, hudrflags, hudrflagd: TGLTexture;
     hudbflag, hudbflags, hudbflagd: TGLTexture;
 
+    FPS, FPSCounter, FPSTime: LongWord;
+
   procedure r_Render_LoadTextures;
   begin
     r_Map_LoadTextures;
@@ -117,26 +124,27 @@ implementation
     var
       i: Integer;
   begin
+    r_LoadScreen_Load;
     r_Common_Load;
-    BackgroundTexture := DEFAULT(THereTexture);
-    hud :=  r_Textures_LoadFromFile(GameWAD + ':TEXTURES/HUD');
-    hudbg :=  r_Textures_LoadFromFile(GameWAD + ':TEXTURES/HUDBG');
-    hudhp[false] := r_Textures_LoadFromFile(GameWAD + ':TEXTURES/MED2');
-    hudhp[true] := r_Textures_LoadFromFile(GameWAD + ':TEXTURES/BMED');
-    hudap := r_Textures_LoadFromFile(GameWAD + ':TEXTURES/ARMORHUD');
+    r_Common_SetLoading('HUD Textures', 5 + (WP_LAST + 1) + 11);
+    hud :=  r_Common_LoadTextureFromFile(GameWAD + ':TEXTURES/HUD');
+    hudbg :=  r_Common_LoadTextureFromFile(GameWAD + ':TEXTURES/HUDBG');
+    hudhp[false] := r_Common_LoadTextureFromFile(GameWAD + ':TEXTURES/MED2');
+    hudhp[true] := r_Common_LoadTextureFromFile(GameWAD + ':TEXTURES/BMED');
+    hudap := r_Common_LoadTextureFromFile(GameWAD + ':TEXTURES/ARMORHUD');
     for i := 0 to WP_LAST do
-      hudwp[i] := r_Textures_LoadFromFile(GameWAD + ':TEXTURES/' + WeapName[i]);
-    hudkey[0] := r_Textures_LoadFromFile(GameWAD + ':TEXTURES/KEYR');
-    hudkey[1] := r_Textures_LoadFromFile(GameWAD + ':TEXTURES/KEYG');
-    hudkey[2] := r_Textures_LoadFromFile(GameWAD + ':TEXTURES/KEYB');
-    hudair := r_Textures_LoadFromFile(GameWAD + ':TEXTURES/AIRBAR');
-    hudjet := r_Textures_LoadFromFile(GameWAD + ':TEXTURES/JETBAR');
-    hudrflag := r_Textures_LoadFromFile(GameWAD + ':TEXTURES/FLAGHUD_R_BASE');
-    hudrflags := r_Textures_LoadFromFile(GameWAD + ':TEXTURES/FLAGHUD_R_STOLEN');
-    hudrflagd := r_Textures_LoadFromFile(GameWAD + ':TEXTURES/FLAGHUD_R_DROP');
-    hudbflag := r_Textures_LoadFromFile(GameWAD + ':TEXTURES/FLAGHUD_B_BASE');
-    hudbflags := r_Textures_LoadFromFile(GameWAD + ':TEXTURES/FLAGHUD_B_STOLEN');
-    hudbflagd := r_Textures_LoadFromFile(GameWAD + ':TEXTURES/FLAGHUD_B_DROP');
+      hudwp[i] := r_Common_LoadTextureFromFile(GameWAD + ':TEXTURES/' + WeapName[i]);
+    hudkey[0] := r_Common_LoadTextureFromFile(GameWAD + ':TEXTURES/KEYR');
+    hudkey[1] := r_Common_LoadTextureFromFile(GameWAD + ':TEXTURES/KEYG');
+    hudkey[2] := r_Common_LoadTextureFromFile(GameWAD + ':TEXTURES/KEYB');
+    hudair := r_Common_LoadTextureFromFile(GameWAD + ':TEXTURES/AIRBAR');
+    hudjet := r_Common_LoadTextureFromFile(GameWAD + ':TEXTURES/JETBAR');
+    hudrflag := r_Common_LoadTextureFromFile(GameWAD + ':TEXTURES/FLAGHUD_R_BASE');
+    hudrflags := r_Common_LoadTextureFromFile(GameWAD + ':TEXTURES/FLAGHUD_R_STOLEN');
+    hudrflagd := r_Common_LoadTextureFromFile(GameWAD + ':TEXTURES/FLAGHUD_R_DROP');
+    hudbflag := r_Common_LoadTextureFromFile(GameWAD + ':TEXTURES/FLAGHUD_B_BASE');
+    hudbflags := r_Common_LoadTextureFromFile(GameWAD + ':TEXTURES/FLAGHUD_B_STOLEN');
+    hudbflagd := r_Common_LoadTextureFromFile(GameWAD + ':TEXTURES/FLAGHUD_B_DROP');
     r_Console_Load;
     r_Map_Load;
     {$IFDEF ENABLE_MENU}
@@ -152,29 +160,24 @@ implementation
     {$ENDIF}
     r_Map_Free;
     r_Console_Free;
-    hudbflagd.Free;
-    hudbflags.Free;
-    hudbflag.Free;
-    hudrflagd.Free;
-    hudrflags.Free;
-    hudrflag.Free;
-    hudjet.Free;
-    hudair.Free;
-    hudkey[0].Free;
-    hudkey[1].Free;
-    hudkey[2].Free;
+    r_Common_FreeAndNil(hudbflagd);
+    r_Common_FreeAndNil(hudbflags);
+    r_Common_FreeAndNil(hudbflag);
+    r_Common_FreeAndNil(hudrflagd);
+    r_Common_FreeAndNil(hudrflags);
+    r_Common_FreeAndNil(hudrflag);
+    r_Common_FreeAndNil(hudjet);
+    r_Common_FreeAndNil(hudair);
+    r_Common_FreeAndNil(hudkey[0]);
+    r_Common_FreeAndNil(hudkey[1]);
+    r_Common_FreeAndNil(hudkey[2]);
     for i := 0 to WP_LAST do
-    begin
-      if hudwp[i] <> nil then
-        hudwp[i].Free;
-      hudwp[i] := nil;
-    end;
-    hudap.Free;
-    hudhp[true].Free;
-    hudhp[false].Free;
-    hudbg.Free;
-    hud.Free;
-    r_Common_FreeThis(BackgroundTexture);
+      r_Common_FreeAndNil(hudwp[i]);
+    r_Common_FreeAndNil(hudap);
+    r_Common_FreeAndNil(hudhp[true]);
+    r_Common_FreeAndNil(hudhp[false]);
+    r_Common_FreeAndNil(hudbg);
+    r_Common_FreeAndNil(hud);
     r_Common_Free;
   end;
 
@@ -202,6 +205,7 @@ implementation
         raise Exception.Create('Failed to set videomode on startup.');
       sys_EnableVSync(gVSync);
     {$ENDIF}
+    r_LoadScreen_Initialize;
     r_Textures_Initialize;
     r_Console_Initialize;
     r_Map_Initialize;
@@ -212,6 +216,7 @@ implementation
     r_Map_Finalize;
     r_Console_Finalize;
     r_Textures_Finalize;
+    r_LoadScreen_Finalize;
   end;
 
   procedure r_Render_Update;
@@ -378,21 +383,22 @@ implementation
   end;
 
   procedure r_Render_DrawView (x, y, w, h: Integer; p: TPlayer);
-    var l, t, r, b: Integer;
+    var l, t, r, b, xx, yy: Integer;
   begin
     r_Draw_GetRect(l, t, r, b);
     r_Draw_SetRect(x, y, x + w, y + h);
 
+    r_Common_GetCameraPos(p, true, xx, yy);
     if p <> nil then
     begin
-      r_Map_Draw(x, y, w, h, p.obj.x + PLAYER_RECT_CX, p.obj.y + PLAYER_RECT_CY, p);
+      r_Map_Draw(x, y, w, h, xx, yy, p);
       r_Render_DrawStatsView(x, y, w, h, p);
       if p.Spectator and p.NoRespawn then
         r_Common_DrawText(_lc[I_PLAYER_SPECT4], x div 2 + w div 2, y div 2 + h div 2, 255, 255, 255, 255, stdfont, TBasePoint.BP_CENTER);
     end
     else
     begin
-      r_Map_Draw(x, y, w, h, 0, 0, nil);
+      r_Map_Draw(x, y, w, h, xx, yy, nil);
     end;
 
     r_Draw_SetRect(l, t, r, b);
@@ -417,24 +423,6 @@ implementation
     r_Draw_SetRect(l, t, r, b);
   end;
 
-  procedure r_Render_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_Render_DrawBackground (const name: AnsiString);
-  begin
-    if r_Common_LoadThis(name, BackgroundTexture) then
-      r_Render_DrawBackgroundImage(BackgroundTexture.id)
-  end;
-
   procedure r_Render_DrawServerList (var SL: TNetServerList; var ST: TNetServerTable);
     var ip: AnsiString; ww, hh, cw, ch, mw, mh, motdh, scrx, scry, i, mx, y: Integer; msg: SSArray; Srv: TNetServer;
   begin
@@ -456,7 +444,7 @@ implementation
     begin
       r_Draw_FillRect(16, motdh, gScreenWidth - 16, gScreenHeight - 44, 64, 64, 64, 110);
       r_Draw_Rect(16, motdh, gScreenWidth - 16, gScreenHeight - 44, 255, 127, 0, 255);
-      r_Common_DrawFormatText(slMOTD, 20, motdh + 3 + ch * i, 255, stdfont, TBasePoint.BP_LEFTUP);
+      r_Common_DrawFormatText(slMOTD, 20, motdh + 3, 255, stdfont, TBasePoint.BP_LEFTUP);
     end;
 
     if not slReadUrgent and (slUrgent <> '') then
@@ -466,7 +454,7 @@ implementation
       r_Draw_Rect(scrx - 256, scry - 60, scrx + 256, scry + 60, 255, 127, 0, 255);
       r_Draw_FillRect(scrx - 256, scry - 40, scrx + 256, scry - 40, 255, 127, 0, 255);
       r_Common_DrawText(_lc[I_NET_SLIST_URGENT], scrx, scry - 58, 255, 255, 255, 255, stdfont, TBasePoint.BP_UP);
-      r_Common_DrawFormatText(slUrgent, scrx - 253, scry - 38 + ch * i, 255, stdfont, TBasePoint.BP_LEFTUP);
+      r_Common_DrawFormatText(slUrgent, scrx - 253, scry - 38, 255, stdfont, TBasePoint.BP_LEFTUP);
       r_Common_DrawText(_lc[I_NET_SLIST_URGENT_CONT], scrx, scry + 41, 255, 255, 255, 255, stdfont, TBasePoint.BP_UP);
       r_Draw_FillRect(scrx - 256, scry + 40, scrx + 256, scry + 40, 255, 127, 0, 255);
     end
@@ -934,23 +922,129 @@ implementation
     result := p;
   end;
 
+  procedure r_Render_DrawMinimap (x, y: Integer; alpha: Byte);
+    const scale = 16;
+
+    function IsMinimapPanel (const p: TPanel): Boolean;
+    begin
+      result := (p <> nil) and p.Enabled;
+      if result then
+      begin
+        case p.PanelType of
+          PANEL_WALL, PANEL_WATER, PANEL_ACID1, PANEL_ACID2,
+          PANEL_STEP, PANEL_OPENDOOR, PANEL_CLOSEDOOR,
+          PANEL_LIFTUP, PANEL_LIFTDOWN, PANEL_LIFTLEFT, PANEL_LIFTRIGHT:
+            result := true;
+          otherwise
+            result := false;
+        end;
+      end;
+    end;
+
+    procedure DrawObject (xx, yy, ww, hh: Integer; r, g, b: Byte);
+      var x0, y0, x1, y1: Integer;
+    begin
+      x0 := x + xx div scale;
+      y0 := y + yy div scale;
+      x1 := x + (xx + ww - 1) div scale;
+      y1 := y + (yy + hh - 1) div scale;
+      r_Draw_FillRect(x0, y0, x1, y1, r, g, b, alpha);
+    end;
+
+    procedure DrawPanels (const a: TPanelArray);
+      var i: Integer; p: TPanel; c: TRGB;
+    begin
+      if a <> nil then
+      begin
+        for i := 0 to HIGH(a) do
+        begin
+          p := a[i];
+          if IsMinimapPanel(p) then
+          begin
+            case p.PanelType of
+              PANEL_WALL:       c := _RGB(208, 208, 208);
+              PANEL_OPENDOOR:   c := _RGB(160, 160, 160);
+              PANEL_CLOSEDOOR:  c := _RGB(160, 160, 160);
+              PANEL_STEP:       c := _RGB(128, 128, 128);
+              PANEL_LIFTUP, PANEL_LIFTDOWN, PANEL_LIFTLEFT, PANEL_LIFTRIGHT:
+              case p.LiftType of
+                LIFTTYPE_UP:    c := _RGB(116, 72, 36);
+                LIFTTYPE_DOWN:  c := _RGB(116, 124, 96);
+                LIFTTYPE_LEFT:  c := _RGB(116, 200, 80);
+                LIFTTYPE_RIGHT: c := _RGB(116, 252, 140);
+                otherwise       c := _RGB(255, 0, 0);
+              end;
+              PANEL_WATER:      c := _RGB(0, 0, 192);
+              PANEL_ACID1:      c := _RGB(0, 176, 0);
+              PANEL_ACID2:      c := _RGB(176, 0, 0);
+              otherwise         c := _RGB(255, 0, 0);
+            end;
+            DrawObject(p.x, p.y, p.width, p.height, c.r, c.g, c.b);
+          end;
+        end;
+      end;
+    end;
+
+    procedure DrawPlayers;
+      var i: Integer; p: TPlayer; c: TRGB;
+    begin
+      if gPlayers <> nil then
+      begin
+        for i := 0 to HIGH(gPlayers) do
+        begin
+          p := gPlayers[i];
+          if p.Alive then
+          begin
+            case p.Team of
+              TEAM_RED:  c := _RGB(255, 0, 0);
+              TEAM_BLUE: c := _RGB(0, 0, 255);
+              otherwise  c := _RGB(255, 128, 0);
+            end;
+            DrawObject(p.obj.x, p.obj.y, p.obj.rect.width, p.obj.rect.height, c.r, c.g, c.b);
+          end;
+        end;
+      end;
+    end;
+
+    function DrawMonster (m: TMonster): Boolean;
+    begin
+      result := false; // don't stop
+      if m.alive then
+        DrawObject(m.obj.x, m.obj.y, m.obj.rect.width, m.obj.rect.height, 255, 255, 0);
+    end;
+
+  begin
+    r_Draw_FillRect(x, y, (x + gMapInfo.Width - 1) div scale, (y + gMapInfo.Height - 1) div scale, 0, 0, 0, alpha);
+    DrawPanels(gSteps);
+    DrawPanels(gLifts);
+    DrawPanels(gWater);
+    DrawPanels(gAcid1);
+    DrawPanels(gAcid2);
+    DrawPanels(gWalls);
+    g_Mons_ForEach(DrawMonster);
+    DrawPlayers;
+  end;
+
   procedure r_Render_Draw;
-    var p1, p2: TPlayer;
+    var p1, p2: TPlayer; time: LongWord;
   begin
     if gExit = EXIT_QUIT then
       exit;
 
+    INC(FPSCounter);
+    time := GetTickCount64();
+    if time - FPSTime >= 1000 then
+    begin
+      FPS := FPSCounter;
+      FPSCounter := 0;
+      FPSTime := time;
+    end;
+
     r_Draw_Setup(gScreenWidth, gScreenHeight);
 
     glClearColor(0.0, 0.0, 0.0, 0.0);
     glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
 
-    glColor4ub(255, 255, 255, 255);
-    glEnable(GL_SCISSOR_TEST);
-    r_Draw_SetRect(0, 0, gScreenWidth, gScreenHeight);
-
-    //e_LogWritefln('r_render_draw: %sx%s', [gScreenWidth, gScreenHeight]);
-
     p1 := nil;
     p2 := nil;
     if gGameOn or (gState = STATE_FOLD) then
@@ -992,8 +1086,6 @@ implementation
 
     if gGameOn or ((gState in [STATE_FOLD]) and (EndingGameCounter < 255)) then
     begin
-      // TODO setup player hear point
-
       if gSpectMode = SPECT_MAPVIEW then
       begin
         r_Render_DrawMapView(0, 0, gScreenWidth, gScreenHeight, gSpectX + gScreenWidth div 2, gSpectY + gScreenHeight div 2);
@@ -1012,6 +1104,9 @@ implementation
         r_Render_DrawPlayerView(0, 0, gScreenWidth, gScreenHeight, p2);
       end;
 
+      if gShowMap then
+        r_Render_DrawMiniMap(0, 0, 160);
+
       // TODO draw holmes inspector
 
       if MessageText <> '' then
@@ -1032,9 +1127,10 @@ implementation
 
     if not gGameOn then
     begin
+      // TODO F key handle
       case gState of
         STATE_NONE: (* do nothing *) ;
-        STATE_MENU: r_Render_DrawBackground(GameWad + ':TEXTURES/TITLE');
+        STATE_MENU: r_Common_DrawBackground(GameWad + ':TEXTURES/TITLE');
         STATE_FOLD:
         begin
           if EndingGameCounter > 0 then
@@ -1044,11 +1140,11 @@ implementation
         begin
           if gLastMap and (gGameSettings.GameMode = GM_COOP) then
             if EndPicPath <> '' then
-              r_Render_DrawBackground(EndPicPath)
+              r_Common_DrawBackground(EndPicPath)
             else
-              r_Render_DrawBackground(GameWad + ':TEXTURES/' + _lc[I_TEXTURE_ENDPIC])
+              r_Common_DrawBackground(GameWad + ':TEXTURES/' + _lc[I_TEXTURE_ENDPIC])
           else
-            r_Render_DrawBackground(GameWad + ':TEXTURES/INTER');
+            r_Common_DrawBackground(GameWad + ':TEXTURES/INTER');
 
           r_Render_DrawCustomStats;
 
@@ -1065,7 +1161,7 @@ implementation
           end
           else
           begin
-            r_Render_DrawBackground(GameWad + ':TEXTURES/INTER');
+            r_Common_DrawBackground(GameWad + ':TEXTURES/INTER');
             r_Render_DrawSingleStats;
             {$IFDEF ENABLE_MENU}
               if g_ActiveWindow <> nil then
@@ -1076,9 +1172,9 @@ implementation
         STATE_ENDPIC:
         begin
           if EndPicPath <> '' then
-            r_Render_DrawBackground(EndPicPath)
+            r_Common_DrawBackground(EndPicPath)
           else
-            r_Render_DrawBackground(GameWad + ':TEXTURES/' + _lc[I_TEXTURE_ENDPIC]);
+            r_Common_DrawBackground(GameWad + ':TEXTURES/' + _lc[I_TEXTURE_ENDPIC]);
           {$IFDEF ENABLE_MENU}
             if g_ActiveWindow <> nil then
               r_Draw_FillRect(0, 0, gScreenWidth - 1, gScreenHeight - 1, 0, 0, 0, 105);
@@ -1086,7 +1182,7 @@ implementation
         end;
         STATE_SLIST:
         begin
-          r_Render_DrawBackground(GameWad + ':TEXTURES/TITLE');
+          r_Common_DrawBackground(GameWad + ':TEXTURES/TITLE');
           r_Draw_FillRect(0, 0, gScreenWidth - 1, gScreenHeight - 1, 0, 0, 0, 105);
           r_Render_DrawServerList(slCurrent, slTable);
         end;
@@ -1104,10 +1200,25 @@ implementation
 
     r_Console_Draw(false);
 
+    // TODO g_debug_Sounds
+
+    if gShowFPS then
+    begin
+      r_Common_DrawText('FPS: ' + IntToStr(FPS), 0, 0, 255, 255, 255, 255, stdfont, TBasePoint.BP_LEFTUP);
+      r_Common_DrawText('UPS: ' + IntToStr(UPS), 0, 16, 255, 255, 255, 255, stdfont, TBasePoint.BP_LEFTUP);
+    end;
+
+    if gGameOn and gShowTime then
+    begin
+      r_Common_DrawText(r_Common_TimeToStr(gTime), gScreenWidth - 4, gScreenHeight - 1, 255, 255, 255, 255, stdfont, TBasePoint.BP_RIGHTDOWN);
+    end;
+
+    // TODO draw profilers
+
     // TODO draw holmes interface
 
-    glFlush();
-    glFinish();
+    // TODO draw touch screen controls
+
     sys_Repaint;
   end;
 
@@ -1134,6 +1245,7 @@ implementation
 
   function r_Render_WriteScreenShot (filename: String): Boolean;
   begin
+    // TODO write screenshot file
     Result := False;
   end;
 
@@ -1154,6 +1266,7 @@ implementation
 {$IFDEF ENABLE_TOUCH}
   procedure r_Render_GetKeyRect (key: Integer; out x, y, w, h: Integer; out founded: Boolean);
   begin
+    // TODO implement touchscreen
     founded := False;
   end;
 {$ENDIF}
@@ -1180,9 +1293,29 @@ implementation
   end;
 {$ENDIF}
 
+  procedure r_Render_SetProcessLoadingCallback (p: TProcedure);
+  begin
+    r_Common_ProcessLoadingCallback := p;
+  end;
+
+  procedure r_Render_ClearLoading;
+  begin
+    r_Common_ClearLoading;
+  end;
+
+  procedure r_Render_SetLoading (const text: String; maxval: Integer);
+  begin
+    r_Common_SetLoading(text, maxval);
+  end;
+
+  procedure r_Render_StepLoading (incval: Integer);
+  begin
+    r_Common_StepLoading(incval);
+  end;
+
   procedure r_Render_DrawLoading (force: Boolean);
   begin
-    // TODO draw loading screen
+    r_Common_DrawLoading(force);
   end;
 
 end.