src/editor/g_textures.pas

   1 unit g_textures;
   2
   3 {$INCLUDE ../shared/a_modes.inc}
   4
   5 interface
   6
   7 uses LCLIntf, LCLType, LMessages, e_graphics, utils;
   8
   9 function g_SimpleCreateTextureWAD(var ID: DWORD; Resource: string): Boolean;
  10 function g_SimpleCreateTextureWADSize(var ID: DWORD; Resource: string;
  11                                       X, Y, Width, Height: Word): Boolean;
  12
  13 function g_CreateTextureWAD(TextureName: ShortString; Resource: string; flag: Byte = 0): Boolean;
  14 function g_CreateTextureWADSize(TextureName: ShortString; Resource: string;
  15                                 X, Y, Width, Height: Word; flag: Byte = 0): Boolean;
  16 function g_CreateTextureMemorySize(pData: Pointer; dataLen: Integer; Name: ShortString; X, Y,
  17                                    Width, Height: Word; flag: Byte = 0): Boolean;
  18
  19 function g_GetTexture(TextureName: ShortString; var ID: DWORD): Boolean;
  20 function g_GetTextureFlagByName(TextureName: ShortString): Byte;
  21 function g_GetTextureFlagByID(ID: DWORD): Byte;
  22 procedure g_GetTextureSizeByName(TextureName: ShortString; var Width, Height: Word);
  23 procedure g_GetTextureSizeByID(ID: DWORD; var Width, Height: Word);
  24
  25 procedure g_DeleteTexture(TextureName: ShortString);
  26 procedure g_DeleteAllTextures();
  27
  28 implementation
  29
  30 uses
  31   e_log, WADEDITOR, g_basic, SysUtils;
  32
  33 type
  34   _TTexture = record
  35    Name: ShortString;
  36    ID: DWORD;
  37    Width, Height: Word;
  38    flag: Byte;
  39   end;
  40
  41 var
  42   TexturesArray: array of _TTexture = nil;
  43
  44 function FindTexture: DWORD;
  45 var
  46   i: integer;
  47 begin
  48  if TexturesArray <> nil then
  49  for i := 0 to High(TexturesArray) do
  50   if TexturesArray[i].Name = '' then
  51   begin
  52    Result := i;
  53    Exit;
  54   end;
  55
  56  if TexturesArray = nil then
  57  begin
  58   SetLength(TexturesArray, 8);
  59   Result := 0;
  60  end
  61   else
  62  begin
  63   Result := High(TexturesArray) + 1;
  64   SetLength(TexturesArray, Length(TexturesArray) + 8);
  65  end;
  66 end;
  67
  68 function g_SimpleCreateTextureWAD(var ID: DWORD; Resource: string): Boolean;
  69 var
  70   WAD: TWADEditor_1;
  71   FileName,
  72   SectionName,
  73   ResourceName: string;
  74   TextureData: Pointer;
  75   ResourceLength: Integer;
  76 begin
  77  Result := False;
  78  g_ProcessResourceStr(Resource, FileName, SectionName, ResourceName);
  79
  80  WAD := TWADEditor_1.Create;
  81  WAD.ReadFile(FileName);
  82
  83  if WAD.GetResource(utf2win(SectionName), utf2win(ResourceName), TextureData, ResourceLength) then
  84  begin
  85   if e_CreateTextureMem(TextureData, ResourceLength, ID) then Result := True;
  86   FreeMem(TextureData);
  87  end
  88   else
  89  begin
  90   e_WriteLog(Format('Error loading texture %s', [Resource]), MSG_WARNING);
  91   e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
  92  end;
  93  WAD.Destroy;
  94 end;
  95
  96 function g_CreateTextureMemorySize(pData: Pointer; dataLen: Integer; Name: ShortString; X, Y,
  97                                    Width, Height: Word; flag: Byte = 0): Boolean;
  98 var
  99   find_id: DWORD;
 100 begin
 101   Result := False;
 102   if pData = nil then
 103     Exit;
 104
 105   find_id := FindTexture;
 106
 107   if not e_CreateTextureMemEx(pData, dataLen, TexturesArray[find_id].ID, X, Y, Width, Height) then
 108   begin
 109     FreeMem(pData);
 110     Exit;
 111   end;
 112
 113   TexturesArray[find_id].Width := Width;
 114   TexturesArray[find_id].Height := Height;
 115   TexturesArray[find_id].Name := Name;
 116   TexturesArray[find_id].flag := flag;
 117
 118   FreeMem(pData);
 119
 120   Result := True;
 121 end;
 122
 123 function g_CreateTextureWAD(TextureName: ShortString; Resource: string; flag: Byte = 0): Boolean;
 124 var
 125   WAD: TWADEditor_1;
 126   FileName,
 127   SectionName,
 128   ResourceName: string;
 129   TextureData: Pointer;
 130   find_id: DWORD;
 131   ResourceLength: Integer;
 132 begin
 133  g_ProcessResourceStr(Resource, FileName, SectionName, ResourceName);
 134
 135  find_id := FindTexture;
 136
 137  WAD := TWADEditor_1.Create;
 138  WAD.ReadFile(FileName);
 139
 140  if WAD.GetResource(utf2win(SectionName), utf2win(ResourceName), TextureData, ResourceLength) then
 141  begin
 142   Result := e_CreateTextureMem(TextureData, ResourceLength, TexturesArray[find_id].ID);
 143   FreeMem(TextureData);
 144   if Result then
 145   begin
 146    e_GetTextureSize(TexturesArray[find_id].ID, @TexturesArray[find_id].Width,
 147                     @TexturesArray[find_id].Height);
 148    TexturesArray[find_id].Name := TextureName;
 149    TexturesArray[find_id].flag := flag;
 150   end;
 151  end
 152   else
 153  begin
 154   e_WriteLog(Format('Error loading texture %s', [Resource]), MSG_WARNING);
 155   e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
 156   Result := False;
 157  end;
 158  WAD.Destroy;
 159 end;
 160
 161 function g_SimpleCreateTextureWADSize(var ID: DWORD; Resource: string;
 162                                       X, Y, Width, Height: Word): Boolean;
 163 var
 164   WAD: TWADEditor_1;
 165   FileName,
 166   SectionName,
 167   ResourceName: String;
 168   TextureData: Pointer;
 169   ResourceLength: Integer;
 170 begin
 171  Result := False;
 172  g_ProcessResourceStr(Resource, FileName, SectionName, ResourceName);
 173
 174  WAD := TWADEditor_1.Create;
 175  WAD.ReadFile(FileName);
 176
 177  if WAD.GetResource(utf2win(SectionName), utf2win(ResourceName), TextureData, ResourceLength) then
 178  begin
 179   if e_CreateTextureMemEx(TextureData, ResourceLength, ID, X, Y, Width, Height) then Result := True;
 180   FreeMem(TextureData);
 181  end
 182   else
 183  begin
 184   e_WriteLog(Format('Error loading texture %s', [Resource]), MSG_WARNING);
 185   e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
 186  end;
 187  WAD.Destroy;
 188 end;
 189
 190 function g_CreateTextureWADSize(TextureName: ShortString; Resource: string;
 191                                 X, Y, Width, Height: Word; flag: Byte = 0): Boolean;
 192 var
 193   WAD: TWADEditor_1;
 194   FileName,
 195   SectionName,
 196   ResourceName: String;
 197   TextureData: Pointer;
 198   find_id: DWORD;
 199   ResourceLength: Integer;
 200 begin
 201  g_ProcessResourceStr(Resource, FileName, SectionName, ResourceName);
 202
 203  find_id := FindTexture;
 204
 205  WAD := TWADEditor_1.Create;
 206  WAD.ReadFile(FileName);
 207
 208  if WAD.GetResource(utf2win(SectionName), utf2win(ResourceName), TextureData, ResourceLength) then
 209  begin
 210   Result := e_CreateTextureMemEx(TextureData, ResourceLength, TexturesArray[find_id].ID, X, Y, Width, Height);
 211   FreeMem(TextureData);
 212   if Result then
 213   begin
 214    TexturesArray[find_id].Width := Width;
 215    TexturesArray[find_id].Height := Height;
 216    TexturesArray[find_id].Name := TextureName;
 217    TexturesArray[find_id].flag := flag;
 218   end;
 219  end
 220   else
 221  begin
 222   e_WriteLog(Format('Error loading texture %s', [Resource]), MSG_WARNING);
 223   e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
 224   Result := False;
 225  end;
 226  WAD.Destroy;
 227 end;
 228
 229 function g_GetTexture(TextureName: ShortString; var ID: DWORD): Boolean;
 230 var
 231   a: DWORD;
 232 begin
 233  Result := False;
 234
 235  if TexturesArray = nil then Exit;
 236
 237  if TextureName = '' then Exit;
 238
 239  for a := 0 to High(TexturesArray) do
 240   if TexturesArray[a].Name = TextureName then
 241   begin
 242    ID := TexturesArray[a].ID;
 243    Result := True;
 244    Break;
 245   end;
 246 end;
 247
 248 function g_GetTextureFlagByName(TextureName: ShortString): Byte;
 249 var
 250   ID: DWORD;
 251 begin
 252  Result := 0;
 253
 254  if not g_GetTexture(TextureName, ID) then Exit;
 255
 256  Result := TexturesArray[ID].flag;
 257 end;
 258
 259 function g_GetTextureFlagByID(ID: DWORD): Byte;
 260 begin
 261  Result := TexturesArray[ID].flag;
 262 end;
 263
 264 procedure g_GetTextureSizeByName(TextureName: ShortString; var Width, Height: Word);
 265 var
 266   ID: DWORD;
 267 begin
 268  Width := 0;
 269  Height := 0;
 270
 271  if not g_GetTexture(TextureName, ID) then Exit;
 272
 273  e_GetTextureSize(ID, @Width, @Height);
 274 end;
 275
 276 procedure g_GetTextureSizeByID(ID: DWORD; var Width, Height: Word);
 277 begin
 278  e_GetTextureSize(ID, @Width, @Height);
 279 end;
 280
 281 procedure g_DeleteTexture(TextureName: ShortString);
 282 var
 283   a: DWORD;
 284 begin
 285  if TexturesArray = nil then Exit;
 286
 287  for a := 0 to High(TexturesArray) do
 288   if TexturesArray[a].Name = TextureName then
 289   begin
 290    e_DeleteTexture(TexturesArray[a].ID);
 291    TexturesArray[a].Name := '';
 292    TexturesArray[a].ID := 0;
 293    TexturesArray[a].Width := 0;
 294    TexturesArray[a].Height := 0;
 295   end;
 296 end;
 297
 298 procedure g_DeleteAllTextures;
 299 var
 300   a: DWORD;
 301 begin
 302  if TexturesArray = nil then Exit;
 303
 304  for a := 0 to High(TexturesArray) do
 305   if TexturesArray[a].Name <> '' then
 306    e_DeleteTexture(TexturesArray[a].ID);
 307
 308  TexturesArray := nil;
 309 end;
 310
 311 end.