src/game/renders/opengl/r_loadscreen.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_loadscreen;
  17
  18 interface
  19
  20   procedure r_LoadScreen_Initialize;
  21   procedure r_LoadScreen_Finalize;
  22
  23   procedure r_LoadScreen_Load;
  24   procedure r_LoadScreen_Free;
  25
  26   procedure r_LoadScreen_Clear;
  27   procedure r_LoadScreen_Set (const text: AnsiString; maxval: Integer);
  28   procedure r_LoadScreen_Step (incval: Integer);
  29   procedure r_LoadScreen_Draw (force: Boolean);
  30
  31 implementation
  32
  33   uses
  34     {$IFDEF USE_GLES1}
  35       GLES11,
  36     {$ELSE}
  37       GL, GLEXT,
  38     {$ENDIF}
  39     {$IFDEF ENABLE_SYSTEM}
  40       g_system,
  41     {$ENDIF}
  42     SysUtils, Classes, Math,
  43     e_log, utils, g_language, g_options, g_console, g_game,
  44     r_draw, r_textures, r_fonts, r_common, r_console
  45   ;
  46
  47   var
  48     FPSTime: LongWord = 0;
  49     r_loadscreen_fps: WORD = 0;
  50     BarL, BarM, BarR, BarF: TGLTexture;
  51     LoadingScreen: array of record
  52       msg: AnsiString;
  53       val, maxval: Integer;
  54     end = nil;
  55
  56   procedure r_LoadScreen_Initialize;
  57   begin
  58   end;
  59
  60   procedure r_LoadScreen_Finalize;
  61   begin
  62   end;
  63
  64   procedure r_LoadScreen_Load;
  65   begin
  66     BarL := r_Textures_LoadFromFile(GameWAD + ':TEXTURES/LLEFT');
  67     BarM := r_Textures_LoadFromFile(GameWAD + ':TEXTURES/LMIDDLE');
  68     BarR := r_Textures_LoadFromFile(GameWAD + ':TEXTURES/LRIGHT');
  69     BarF := r_Textures_LoadFromFile(GameWAD + ':TEXTURES/LMARKER');
  70   end;
  71
  72   procedure r_LoadScreen_Free;
  73   begin
  74     BarL.Free;
  75     BarM.Free;
  76     BarR.Free;
  77     BarF.Free;
  78   end;
  79
  80   procedure r_LoadScreen_DrawLoadingBar (x0, x1, y, val, maxval: Integer);
  81     var l, t, r, b, minw, reqw, midw, fillw, curw, x: Integer;
  82   begin
  83     if (BarL <> nil) and (BarM <> nil) and (BarR <> nil) and (BarF <> nil) and (maxval > 0) then
  84     begin
  85       minw := BarL.width + BarM.width + BarR.width;
  86       reqw := x1 - x0;
  87       if reqw >= minw then
  88       begin
  89         midw := (reqw - BarL.width - BarR.width) div BarM.width * BarM.width;
  90         x := x0 - (reqw - (BarL.width + midw + BarR.width)) div 2;
  91         fillw := midw + 2;
  92         curw := MIN(val * fillw div maxval, fillw);
  93         r_Draw_TextureRepeat(BarL, x, y, BarL.width, BarL.height, false, 255, 255, 255, 255, false);
  94         r_Draw_TextureRepeat(BarM, x + BarL.width, y, midw, BarM.height, false, 255, 255, 255, 255, false);
  95         r_Draw_TextureRepeat(BarR, x + BarL.width + midw, y, BarR.width, BarR.height, false, 255, 255, 255, 255, false);
  96         if curw > 0 then
  97         begin
  98           r_Draw_GetRect(l, t, r, b);
  99           r_Draw_SetRect(x + BarL.width - 1, y, x + BarL.width - 1 + curw - 1, y + BarF.height - 1);
 100           r_Draw_TextureRepeat(BarF, x + BarL.width - 1, y, curw, BarF.height, false, 255, 255, 255, 255, false);
 101           r_Draw_SetRect(l, t, r, b);
 102         end;
 103       end;
 104     end;
 105   end;
 106
 107   procedure r_LoadScreen_Clear;
 108   begin
 109     LoadingScreen := nil;
 110   end;
 111
 112   procedure r_LoadScreen_Set (const text: String; maxval: Integer);
 113     var i: Integer;
 114   begin
 115     if LoadingScreen = nil then i := 0 else i := Length(LoadingScreen);
 116     SetLength(LoadingScreen, i + 1);
 117     LoadingScreen[i].msg := text;
 118     LoadingScreen[i].val := 0;
 119     LoadingScreen[i].maxval := MAX(0, maxval);
 120   end;
 121
 122   procedure r_LoadScreen_Step (incval: Integer);
 123     var i: Integer;
 124   begin
 125     if LoadingScreen <> nil then
 126     begin
 127       i := HIGH(LoadingScreen);
 128       INC(LoadingScreen[i].val, MAX(0, incval));
 129     end;
 130   end;
 131
 132   procedure r_LoadScreen_Draw (force: Boolean);
 133     const LOADING_INTERLINE = 20;
 134     var xx, yy, hh, i, n: Integer; s: AnsiString; time, delay: LongWord;
 135   begin
 136     time := GetTickCount64();
 137     if r_loadscreen_fps <= 0 then delay := 1000 div GAME_TICK else delay := 1000 div r_loadscreen_fps;
 138     if force or (time - FPSTime >= delay) then
 139     begin
 140       FPSTime := time;
 141
 142       xx := gScreenWidth div 3;
 143       yy := gScreenHeight div 3;
 144       hh := gScreenHeight - yy - 96;
 145       r_Draw_Setup(gScreenWidth, gScreenHeight);
 146       glClearColor(0.0, 0.0, 0.0, 0.0);
 147       glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
 148       r_Common_DrawBackground(GameWad + ':TEXTURES/INTER');
 149       r_Draw_FillRect(0, 0, gScreenWidth - 1, gScreenHeight - 1, 0, 0, 0, 105);
 150       if menufont <> nil then
 151       begin
 152         r_Common_DrawText(_lc[I_MENU_LOADING], gScreenWidth div 2, yy - 32, 255, 255, 255, 255, menufont, TBasePoint.BP_DOWN);
 153       end;
 154       if (smallfont <> nil) and (LoadingScreen <> nil) then
 155       begin
 156         n := hh div LOADING_INTERLINE - 1;
 157         for i := MAX(0, Length(LoadingScreen) - n) to HIGH(LoadingScreen) do
 158         begin
 159           if LoadingScreen[i].maxval > 1 then
 160             s := LoadingScreen[i].msg + '  ' + IntToStr(LoadingScreen[i].val) + '/' + IntToStr(LoadingScreen[i].maxval)
 161           else
 162             s := LoadingScreen[i].msg;
 163           r_Common_DrawText(s, xx, yy, 255, 0, 0, 255, smallfont, TBasePoint.BP_LEFTUP);
 164           INC(yy, LOADING_INTERLINE);
 165         end;
 166       end;
 167       if (BarF <> nil) and (LoadingScreen <> nil) then
 168       begin
 169         i := HIGH(LoadingScreen);
 170         if LoadingScreen[i].maxval > 1 then
 171           r_LoadScreen_DrawLoadingBar(64, gScreenWidth - 64, gScreenHeight - 64, LoadingScreen[i].val, LoadingScreen[i].maxval);
 172       end;
 173       if stdfont <> nil then
 174       begin
 175         r_Console_Draw(true);
 176       end;
 177       sys_Repaint;
 178     end;
 179   end;
 180
 181 initialization
 182   conRegVar('r_loadscreen_fps', @r_loadscreen_fps, '', '');
 183   r_loadscreen_fps := 0; // auto
 184 end.