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, g_resources;
  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     TextureData: Pointer;
  71     ResourceLength: Integer;
  72     FileName, SectionName, ResourceName: string;
  73 begin
  74   Result := False;
  75   g_ProcessResourceStr(Resource, FileName, SectionName, ResourceName);
  76   g_ReadResource(FileName, SectionName, ResourceName, TextureData, ResourceLength);
  77   if TextureData <> nil then
  78   begin
  79     if e_CreateTextureMem(TextureData, ResourceLength, ID) then
  80       Result := True;
  81     FreeMem(TextureData)
  82   end
  83   else
  84   begin
  85     e_WriteLog(Format('Error loading texture %s', [Resource]), MSG_WARNING)
  86     //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
  87   end;
  88 end;
  89
  90 function g_CreateTextureMemorySize(pData: Pointer; dataLen: Integer; Name: ShortString; X, Y,
  91                                    Width, Height: Word; flag: Byte = 0): Boolean;
  92 var
  93   find_id: DWORD;
  94 begin
  95   Result := False;
  96   if pData = nil then
  97     Exit;
  98
  99   find_id := FindTexture;
 100
 101   if not e_CreateTextureMemEx(pData, dataLen, TexturesArray[find_id].ID, X, Y, Width, Height) then
 102   begin
 103     FreeMem(pData);
 104     Exit;
 105   end;
 106
 107   TexturesArray[find_id].Width := Width;
 108   TexturesArray[find_id].Height := Height;
 109   TexturesArray[find_id].Name := Name;
 110   TexturesArray[find_id].flag := flag;
 111
 112   FreeMem(pData);
 113
 114   Result := True;
 115 end;
 116
 117 function g_CreateTextureWAD(TextureName: ShortString; Resource: string; flag: Byte = 0): Boolean;
 118   var
 119     TextureData: Pointer;
 120     ResourceLength: Integer;
 121     FileName, SectionName, ResourceName: string;
 122     find_id: DWORD;
 123 begin
 124    find_id := FindTexture;
 125    g_ProcessResourceStr(Resource, FileName, SectionName, ResourceName);
 126    g_ReadResource(FileName, SectionName, ResourceName, TextureData, ResourceLength);
 127    if TextureData <> nil then
 128    begin
 129      Result := e_CreateTextureMem(TextureData, ResourceLength, TexturesArray[find_id].ID);
 130      FreeMem(TextureData);
 131      if Result then
 132      begin
 133        e_GetTextureSize(
 134          TexturesArray[find_id].ID,
 135          @TexturesArray[find_id].Width,
 136          @TexturesArray[find_id].Height
 137        );
 138        TexturesArray[find_id].Name := TextureName;
 139        TexturesArray[find_id].flag := flag
 140      end
 141    end
 142    else
 143    begin
 144      e_WriteLog(Format('Error loading texture %s', [Resource]), MSG_WARNING);
 145      //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
 146      Result := False
 147    end
 148 end;
 149
 150 function g_SimpleCreateTextureWADSize(var ID: DWORD; Resource: String; X, Y, Width, Height: Word): Boolean;
 151   var
 152     TextureData: Pointer;
 153     ResourceLength: Integer;
 154     FileName, SectionName, ResourceName: String;
 155 begin
 156    Result := False;
 157    g_ProcessResourceStr(Resource, FileName, SectionName, ResourceName);
 158    g_ReadResource(FileName, SectionName, ResourceName, TextureData, ResourceLength);
 159    if TextureData <> nil then
 160    begin
 161      if e_CreateTextureMemEx(TextureData, ResourceLength, ID, X, Y, Width, Height) then
 162        Result := True;
 163      FreeMem(TextureData)
 164    end
 165    else
 166    begin
 167      e_WriteLog(Format('Error loading texture %s', [Resource]), MSG_WARNING)
 168      //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING)
 169    end
 170 end;
 171
 172 function g_CreateTextureWADSize(TextureName: ShortString; Resource: String; X, Y, Width, Height: Word; flag: Byte = 0): Boolean;
 173   var
 174     TextureData: Pointer;
 175     ResourceLength: Integer;
 176     FileName, SectionName, ResourceName: String;
 177     find_id: DWORD;
 178 begin
 179   find_id := FindTexture;
 180   g_ProcessResourceStr(Resource, FileName, SectionName, ResourceName);
 181   g_ReadResource(FileName, SectionName, ResourceName, TextureData, ResourceLength);
 182   if TextureData <> nil then
 183   begin
 184     Result := e_CreateTextureMemEx(TextureData, ResourceLength, TexturesArray[find_id].ID, X, Y, Width, Height);
 185     FreeMem(TextureData);
 186     if Result then
 187     begin
 188       TexturesArray[find_id].Width := Width;
 189       TexturesArray[find_id].Height := Height;
 190       TexturesArray[find_id].Name := TextureName;
 191       TexturesArray[find_id].flag := flag
 192     end
 193   end
 194   else
 195   begin
 196     e_WriteLog(Format('Error loading texture %s', [Resource]), MSG_WARNING);
 197     //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
 198     Result := False
 199   end
 200 end;
 201
 202 function g_GetTexture(TextureName: ShortString; var ID: DWORD): Boolean;
 203 var
 204   a: DWORD;
 205 begin
 206  Result := False;
 207
 208  if TexturesArray = nil then Exit;
 209
 210  if TextureName = '' then Exit;
 211
 212  for a := 0 to High(TexturesArray) do
 213   if TexturesArray[a].Name = TextureName then
 214   begin
 215    ID := TexturesArray[a].ID;
 216    Result := True;
 217    Break;
 218   end;
 219 end;
 220
 221 function g_GetTextureFlagByName(TextureName: ShortString): Byte;
 222 var
 223   ID: DWORD;
 224 begin
 225  Result := 0;
 226
 227  if not g_GetTexture(TextureName, ID) then Exit;
 228
 229  Result := TexturesArray[ID].flag;
 230 end;
 231
 232 function g_GetTextureFlagByID(ID: DWORD): Byte;
 233 begin
 234  Result := TexturesArray[ID].flag;
 235 end;
 236
 237 procedure g_GetTextureSizeByName(TextureName: ShortString; var Width, Height: Word);
 238 var
 239   ID: DWORD;
 240 begin
 241  Width := 0;
 242  Height := 0;
 243
 244  if not g_GetTexture(TextureName, ID) then Exit;
 245
 246  e_GetTextureSize(ID, @Width, @Height);
 247 end;
 248
 249 procedure g_GetTextureSizeByID(ID: DWORD; var Width, Height: Word);
 250 begin
 251  e_GetTextureSize(ID, @Width, @Height);
 252 end;
 253
 254 procedure g_DeleteTexture(TextureName: ShortString);
 255 var
 256   a: DWORD;
 257 begin
 258  if TexturesArray = nil then Exit;
 259
 260  for a := 0 to High(TexturesArray) do
 261   if TexturesArray[a].Name = TextureName then
 262   begin
 263    e_DeleteTexture(TexturesArray[a].ID);
 264    TexturesArray[a].Name := '';
 265    TexturesArray[a].ID := 0;
 266    TexturesArray[a].Width := 0;
 267    TexturesArray[a].Height := 0;
 268   end;
 269 end;
 270
 271 procedure g_DeleteAllTextures;
 272 var
 273   a: DWORD;
 274 begin
 275  if TexturesArray = nil then Exit;
 276
 277  for a := 0 to High(TexturesArray) do
 278   if TexturesArray[a].Name <> '' then
 279    e_DeleteTexture(TexturesArray[a].ID);
 280
 281  TexturesArray := nil;
 282 end;
 283
 284 end.