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; X, Y, Width, Height: Word): Boolean;
 162 var
 163   WAD: TWADEditor_1;
 164   FileName,
 165   SectionName,
 166   ResourceName: String;
 167   TextureData: Pointer;
 168   ResourceLength: Integer;
 169 begin
 170  Result := False;
 171  g_ProcessResourceStr(Resource, FileName, SectionName, ResourceName);
 172
 173  WAD := TWADEditor_1.Create;
 174  WAD.ReadFile(FileName);
 175
 176  if WAD.GetResource(utf2win(SectionName), utf2win(ResourceName), TextureData, ResourceLength) then
 177  begin
 178   if e_CreateTextureMemEx(TextureData, ResourceLength, ID, X, Y, Width, Height) then Result := True;
 179   FreeMem(TextureData);
 180  end
 181   else
 182  begin
 183   e_WriteLog(Format('Error loading texture %s', [Resource]), MSG_WARNING);
 184   e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
 185  end;
 186  WAD.Destroy;
 187 end;
 188
 189 function g_CreateTextureWADSize(TextureName: ShortString; Resource: string;
 190                                 X, Y, Width, Height: Word; flag: Byte = 0): Boolean;
 191 var
 192   WAD: TWADEditor_1;
 193   FileName,
 194   SectionName,
 195   ResourceName: String;
 196   TextureData: Pointer;
 197   find_id: DWORD;
 198   ResourceLength: Integer;
 199 begin
 200  g_ProcessResourceStr(Resource, FileName, SectionName, ResourceName);
 201
 202  find_id := FindTexture;
 203
 204  WAD := TWADEditor_1.Create;
 205  WAD.ReadFile(FileName);
 206
 207  if WAD.GetResource(utf2win(SectionName), utf2win(ResourceName), TextureData, ResourceLength) then
 208  begin
 209   Result := e_CreateTextureMemEx(TextureData, ResourceLength, TexturesArray[find_id].ID, X, Y, Width, Height);
 210   FreeMem(TextureData);
 211   if Result then
 212   begin
 213    TexturesArray[find_id].Width := Width;
 214    TexturesArray[find_id].Height := Height;
 215    TexturesArray[find_id].Name := TextureName;
 216    TexturesArray[find_id].flag := flag;
 217   end;
 218  end
 219   else
 220  begin
 221   e_WriteLog(Format('Error loading texture %s', [Resource]), MSG_WARNING);
 222   e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
 223   Result := False;
 224  end;
 225  WAD.Destroy;
 226 end;
 227
 228 function g_GetTexture(TextureName: ShortString; var ID: DWORD): Boolean;
 229 var
 230   a: DWORD;
 231 begin
 232  Result := False;
 233
 234  if TexturesArray = nil then Exit;
 235
 236  if TextureName = '' then Exit;
 237
 238  for a := 0 to High(TexturesArray) do
 239   if TexturesArray[a].Name = TextureName then
 240   begin
 241    ID := TexturesArray[a].ID;
 242    Result := True;
 243    Break;
 244   end;
 245 end;
 246
 247 function g_GetTextureFlagByName(TextureName: ShortString): Byte;
 248 var
 249   ID: DWORD;
 250 begin
 251  Result := 0;
 252
 253  if not g_GetTexture(TextureName, ID) then Exit;
 254
 255  Result := TexturesArray[ID].flag;
 256 end;
 257
 258 function g_GetTextureFlagByID(ID: DWORD): Byte;
 259 begin
 260  Result := TexturesArray[ID].flag;
 261 end;
 262
 263 procedure g_GetTextureSizeByName(TextureName: ShortString; var Width, Height: Word);
 264 var
 265   ID: DWORD;
 266 begin
 267  Width := 0;
 268  Height := 0;
 269
 270  if not g_GetTexture(TextureName, ID) then Exit;
 271
 272  e_GetTextureSize(ID, @Width, @Height);
 273 end;
 274
 275 procedure g_GetTextureSizeByID(ID: DWORD; var Width, Height: Word);
 276 begin
 277  e_GetTextureSize(ID, @Width, @Height);
 278 end;
 279
 280 procedure g_DeleteTexture(TextureName: ShortString);
 281 var
 282   a: DWORD;
 283 begin
 284  if TexturesArray = nil then Exit;
 285
 286  for a := 0 to High(TexturesArray) do
 287   if TexturesArray[a].Name = TextureName then
 288   begin
 289    e_DeleteTexture(TexturesArray[a].ID);
 290    TexturesArray[a].Name := '';
 291    TexturesArray[a].ID := 0;
 292    TexturesArray[a].Width := 0;
 293    TexturesArray[a].Height := 0;
 294   end;
 295 end;
 296
 297 procedure g_DeleteAllTextures;
 298 var
 299   a: DWORD;
 300 begin
 301  if TexturesArray = nil then Exit;
 302
 303  for a := 0 to High(TexturesArray) do
 304   if TexturesArray[a].Name <> '' then
 305    e_DeleteTexture(TexturesArray[a].ID);
 306
 307  TexturesArray := nil;
 308 end;
 309
 310 end.