src/game/renders/opengl/r_common.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_common;
  17
  18 interface
  19
  20   uses r_textures;
  21
  22   type
  23     THereTexture = record
  24       name: AnsiString;
  25       id: TGLTexture;
  26     end;
  27
  28   var
  29     stdfont: TGLFont;
  30     smallfont: TGLFont;
  31     menufont: TGLFont;
  32
  33   function  r_Common_LoadThis (const name: AnsiString; var here: THereTexture): Boolean;
  34   procedure r_Common_FreeThis (var here: THereTexture);
  35
  36   procedure r_Common_CalcAspect (ow, oh, nw, nh: LongInt; horizontal: Boolean; out ww, hh: LongInt);
  37
  38   procedure r_Common_Load;
  39   procedure r_Common_Free;
  40
  41 implementation
  42
  43   uses e_log, r_fonts, g_options;
  44
  45   procedure r_Common_FreeThis (var here: THereTexture);
  46   begin
  47     here.name := '';
  48     if here.id <> nil then
  49       here.id.Free;
  50     here.id := nil;
  51   end;
  52
  53   function r_Common_LoadThis (const name: AnsiString; var here: THereTexture): Boolean;
  54   begin
  55     if name <> here.name then
  56       r_Common_FreeThis(here);
  57     if (name <> '') and (here.name <> name) then
  58       here.id := r_Textures_LoadFromFile(name);
  59
  60     result := here.id <> nil;
  61
  62     if result then
  63       here.name := name;
  64   end;
  65
  66   procedure r_Common_CalcAspect (ow, oh, nw, nh: LongInt; horizontal: Boolean; out ww, hh: LongInt);
  67   begin
  68     if horizontal then
  69     begin
  70       ww := nw;
  71       hh := nw * oh div ow;
  72     end
  73     else
  74     begin
  75       ww := nh * ow div oh;
  76       hh := nh;
  77     end;
  78   end;
  79
  80   function r_Common_LoadFont (const name: AnsiString): TGLFont;
  81     var info: TFontInfo; skiphack: Integer;
  82   begin
  83     result := nil;
  84     if name = 'STD' then skiphack := 144 else skiphack := 0;
  85     if r_Font_LoadInfoFromFile(GameWad + ':FONTS/' + name + 'TXT', info) then
  86       result := r_Textures_LoadFontFromFile(GameWad + ':FONTS/' + name + 'FONT', info, skiphack, true);
  87     if result = nil then
  88       e_logwritefln('failed to load font %s', [name]);
  89   end;
  90
  91   procedure r_Common_Load;
  92   begin
  93     stdfont := r_Common_LoadFont('STD');
  94     smallfont := r_Common_LoadFont('SMALL');
  95     menufont := r_Common_LoadFont('MENU');
  96   end;
  97
  98   procedure r_Common_Free;
  99   begin
 100     menufont.Free;
 101     smallfont.Free;
 102     stdfont.Free;
 103   end;
 104
 105 end.