src/game/opengl/r_textures.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_textures;
  17
  18 interface
  19
  20   function g_Texture_CreateWAD (var ID: LongWord; const Resource: AnsiString; filterHint: Boolean = False): Boolean;
  21   function g_Texture_CreateFile (var ID: LongWord; const FileName: AnsiString): Boolean;
  22   function g_Texture_CreateWADEx (const textureName, Resource: AnsiString; filterHint: Boolean = False): Boolean;
  23   function g_Texture_CreateFileEx (const textureName, FileName: AnsiString): Boolean;
  24   function g_Texture_Get (const textureName: AnsiString; var ID: LongWord): Boolean;
  25   function g_Texture_GetSize (const textureName: AnsiString; var w, h: Integer): Boolean; overload;
  26   function g_Texture_GetSize (ID: LongWord; var w, h: Integer): Boolean; overload;
  27   procedure g_Texture_Delete (const textureName: AnsiString);
  28   procedure g_Texture_DeleteAll;
  29
  30 implementation
  31
  32   uses
  33     SysUtils, Classes, Math,
  34     WadReader, utils,
  35     e_log,
  36     r_graphics,
  37     g_language, g_game
  38   ;
  39
  40   type
  41     _TTexture = record
  42       name: AnsiString;
  43       id: LongWord;
  44       width, height: Word;
  45       used: Boolean;
  46     end;
  47
  48   var
  49     texturesArray: array of _TTexture = nil;
  50
  51 function allocTextureSlot (): LongWord;
  52 var
  53   f: integer;
  54 begin
  55   for f := 0 to High(texturesArray) do
  56   begin
  57     if (not texturesArray[f].used) then
  58     begin
  59       result := f;
  60       exit;
  61     end;
  62   end;
  63
  64   result := Length(texturesArray);
  65   SetLength(texturesArray, result+64);
  66   for f := result to High(texturesArray) do
  67   begin
  68     with texturesArray[f] do
  69     begin
  70       name := '';
  71       id := 0;
  72       width := 0;
  73       height := 0;
  74       used := false;
  75     end;
  76   end;
  77 end;
  78
  79 function g_Texture_CreateWAD (var ID: LongWord; const Resource: AnsiString; filterHint: Boolean = False): Boolean;
  80 var
  81   WAD: TWADFile;
  82   FileName: AnsiString;
  83   TextureData: Pointer;
  84   ResourceLength: Integer;
  85 begin
  86   result := false;
  87   FileName := g_ExtractWadName(Resource);
  88
  89   WAD := TWADFile.Create;
  90   WAD.ReadFile(FileName);
  91
  92   if WAD.GetResource(g_ExtractFilePathName(Resource), TextureData, ResourceLength) then
  93   begin
  94     if e_CreateTextureMem(TextureData, ResourceLength, ID, filterHint) then
  95       result := true;
  96     FreeMem(TextureData)
  97   end
  98   else
  99   begin
 100     e_WriteLog(Format('Error loading texture %s', [Resource]), TMsgType.Warning);
 101     //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
 102   end;
 103   WAD.Free();
 104 end;
 105
 106
 107 function g_Texture_CreateFile (var ID: LongWord; const FileName: AnsiString): Boolean;
 108 begin
 109   result := true;
 110   if not e_CreateTexture(FileName, ID) then
 111   begin
 112     e_WriteLog(Format('Error loading texture %s', [FileName]), TMsgType.Warning);
 113     result := false;
 114   end;
 115 end;
 116
 117 function g_Texture_CreateWADEx (const textureName, Resource: AnsiString; filterHint: Boolean = False): Boolean;
 118 var
 119   WAD: TWADFile;
 120   FileName: AnsiString;
 121   TextureData: Pointer;
 122   find_id: LongWord;
 123   ResourceLength: Integer;
 124 begin
 125   FileName := g_ExtractWadName(Resource);
 126
 127   find_id := allocTextureSlot();
 128
 129   WAD := TWADFile.Create;
 130   WAD.ReadFile(FileName);
 131
 132   if WAD.GetResource(g_ExtractFilePathName(Resource), TextureData, ResourceLength) then
 133   begin
 134     result := e_CreateTextureMem(TextureData, ResourceLength, texturesArray[find_id].ID, filterHint);
 135     if result then
 136     begin
 137       e_GetTextureSize(texturesArray[find_id].ID, @texturesArray[find_id].width, @texturesArray[find_id].height);
 138       texturesArray[find_id].used := true;
 139       texturesArray[find_id].Name := textureName;
 140     end;
 141     FreeMem(TextureData)
 142   end
 143   else
 144   begin
 145     e_WriteLog(Format('Error loading texture %s', [Resource]), TMsgType.Warning);
 146     //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
 147     result := false;
 148   end;
 149   WAD.Free();
 150 end;
 151
 152
 153 function g_Texture_CreateFileEx (const textureName, FileName: AnsiString): Boolean;
 154 var
 155   find_id: LongWord;
 156 begin
 157   find_id := allocTextureSlot();
 158   result := e_CreateTexture(FileName, texturesArray[find_id].ID);
 159   if result then
 160   begin
 161     texturesArray[find_id].used := true;
 162     texturesArray[find_id].Name := textureName;
 163     e_GetTextureSize(texturesArray[find_id].ID, @texturesArray[find_id].width, @texturesArray[find_id].height);
 164   end
 165   else e_WriteLog(Format('Error loading texture %s', [FileName]), TMsgType.Warning);
 166 end;
 167
 168
 169 function g_Texture_Get (const textureName: AnsiString; var id: LongWord): Boolean;
 170 var
 171   a: Integer;
 172 begin
 173   result := false;
 174   if (Length(texturesArray) = 0) or (Length(textureName) = 0) then exit;
 175   for a := 0 to High(texturesArray) do
 176   begin
 177     if (StrEquCI1251(texturesArray[a].name, textureName)) then
 178     begin
 179       id := texturesArray[a].id;
 180       result := true;
 181       break;
 182     end;
 183   end;
 184   //if not Result then g_ConsoleAdd('Texture '+TextureName+' not found');
 185 end;
 186
 187 function g_Texture_GetSize (const textureName: AnsiString; var w, h: Integer): Boolean; overload;
 188 var
 189   a: Integer;
 190 begin
 191   result := false;
 192   w := 0;
 193   h := 0;
 194   if (Length(texturesArray) = 0) or (Length(textureName) = 0) then exit;
 195   for a := 0 to High(texturesArray) do
 196   begin
 197     if (StrEquCI1251(texturesArray[a].name, textureName)) then
 198     begin
 199       w := texturesArray[a].width;
 200       h := texturesArray[a].height;
 201       result := true;
 202       break;
 203     end;
 204   end;
 205 end;
 206
 207
 208 function g_Texture_GetSize (ID: LongWord; var w, h: Integer): Boolean; overload;
 209 var
 210   a: Integer;
 211 begin
 212   result := false;
 213   w := 0;
 214   h := 0;
 215   if (Length(texturesArray) = 0) then exit;
 216   for a := 0 to High(texturesArray) do
 217   begin
 218     if (texturesArray[a].id = ID) then
 219     begin
 220       w := texturesArray[a].width;
 221       h := texturesArray[a].height;
 222       result := true;
 223       break;
 224     end;
 225   end;
 226 end;
 227
 228
 229 procedure g_Texture_Delete (const textureName: AnsiString);
 230 var
 231   a: Integer;
 232 begin
 233   if (Length(texturesArray) = 0) or (Length(textureName) = 0) then exit;
 234   for a := 0 to High(texturesArray) do
 235   begin
 236     if (StrEquCI1251(texturesArray[a].name, textureName)) then
 237     begin
 238       e_DeleteTexture(texturesArray[a].ID);
 239       texturesArray[a].used := false;
 240       texturesArray[a].name := '';
 241       texturesArray[a].id := 0;
 242       texturesArray[a].width := 0;
 243       texturesArray[a].height := 0;
 244     end;
 245   end;
 246 end;
 247
 248 procedure g_Texture_DeleteAll ();
 249 var
 250   a: Integer;
 251 begin
 252   for a := 0 to High(texturesArray) do
 253   begin
 254     if (texturesArray[a].used) then e_DeleteTexture(texturesArray[a].ID);
 255   end;
 256   texturesArray := nil;
 257 end;
 258
 259 end.