3 {$INCLUDE ../shared/a_modes.inc}
7 uses LCLIntf
, LCLType
, LMessages
, e_graphics
, utils
;
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;
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;
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);
25 procedure g_DeleteTexture(TextureName
: ShortString);
26 procedure g_DeleteAllTextures();
31 e_log
, WADEDITOR
, g_basic
, SysUtils
, g_resources
;
42 TexturesArray
: array of _TTexture
= nil;
44 function FindTexture
: DWORD
;
48 if TexturesArray
<> nil then
49 for i
:= 0 to High(TexturesArray
) do
50 if TexturesArray
[i
].Name
= '' then
56 if TexturesArray
= nil then
58 SetLength(TexturesArray
, 8);
63 Result
:= High(TexturesArray
) + 1;
64 SetLength(TexturesArray
, Length(TexturesArray
) + 8);
68 function g_SimpleCreateTextureWAD (var ID
: DWORD
; Resource
: string): Boolean;
71 ResourceLength
: Integer;
72 FileName
, SectionName
, ResourceName
: string;
75 g_ProcessResourceStr(Resource
, FileName
, SectionName
, ResourceName
);
76 g_ReadResource(FileName
, SectionName
, ResourceName
, TextureData
, ResourceLength
);
77 if TextureData
<> nil then
79 if e_CreateTextureMem(TextureData
, ResourceLength
, ID
) then
85 e_WriteLog(Format('Error loading texture %s', [Resource
]), MSG_WARNING
)
86 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
90 function g_CreateTextureMemorySize(pData
: Pointer; dataLen
: Integer; Name
: ShortString; X
, Y
,
91 Width
, Height
: Word; flag
: Byte = 0): Boolean;
99 find_id
:= FindTexture
;
101 if not e_CreateTextureMemEx(pData
, dataLen
, TexturesArray
[find_id
].ID
, X
, Y
, Width
, Height
) then
107 TexturesArray
[find_id
].Width
:= Width
;
108 TexturesArray
[find_id
].Height
:= Height
;
109 TexturesArray
[find_id
].Name
:= Name
;
110 TexturesArray
[find_id
].flag
:= flag
;
117 function g_CreateTextureWAD(TextureName
: ShortString; Resource
: string; flag
: Byte = 0): Boolean;
119 TextureData
: Pointer;
120 ResourceLength
: Integer;
121 FileName
, SectionName
, ResourceName
: string;
124 find_id
:= FindTexture
;
125 g_ProcessResourceStr(Resource
, FileName
, SectionName
, ResourceName
);
126 g_ReadResource(FileName
, SectionName
, ResourceName
, TextureData
, ResourceLength
);
127 if TextureData
<> nil then
129 Result
:= e_CreateTextureMem(TextureData
, ResourceLength
, TexturesArray
[find_id
].ID
);
130 FreeMem(TextureData
);
134 TexturesArray
[find_id
].ID
,
135 @TexturesArray
[find_id
].Width
,
136 @TexturesArray
[find_id
].Height
138 TexturesArray
[find_id
].Name
:= TextureName
;
139 TexturesArray
[find_id
].flag
:= flag
144 e_WriteLog(Format('Error loading texture %s', [Resource
]), MSG_WARNING
);
145 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
150 function g_SimpleCreateTextureWADSize(var ID
: DWORD
; Resource
: String; X
, Y
, Width
, Height
: Word): Boolean;
152 TextureData
: Pointer;
153 ResourceLength
: Integer;
154 FileName
, SectionName
, ResourceName
: String;
157 g_ProcessResourceStr(Resource
, FileName
, SectionName
, ResourceName
);
158 g_ReadResource(FileName
, SectionName
, ResourceName
, TextureData
, ResourceLength
);
159 if TextureData
<> nil then
161 if e_CreateTextureMemEx(TextureData
, ResourceLength
, ID
, X
, Y
, Width
, Height
) then
167 e_WriteLog(Format('Error loading texture %s', [Resource
]), MSG_WARNING
)
168 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING)
172 function g_CreateTextureWADSize(TextureName
: ShortString; Resource
: String; X
, Y
, Width
, Height
: Word; flag
: Byte = 0): Boolean;
174 TextureData
: Pointer;
175 ResourceLength
: Integer;
176 FileName
, SectionName
, ResourceName
: String;
179 find_id
:= FindTexture
;
180 g_ProcessResourceStr(Resource
, FileName
, SectionName
, ResourceName
);
181 g_ReadResource(FileName
, SectionName
, ResourceName
, TextureData
, ResourceLength
);
182 if TextureData
<> nil then
184 Result
:= e_CreateTextureMemEx(TextureData
, ResourceLength
, TexturesArray
[find_id
].ID
, X
, Y
, Width
, Height
);
185 FreeMem(TextureData
);
188 TexturesArray
[find_id
].Width
:= Width
;
189 TexturesArray
[find_id
].Height
:= Height
;
190 TexturesArray
[find_id
].Name
:= TextureName
;
191 TexturesArray
[find_id
].flag
:= flag
196 e_WriteLog(Format('Error loading texture %s', [Resource
]), MSG_WARNING
);
197 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
202 function g_GetTexture(TextureName
: ShortString; var ID
: DWORD
): Boolean;
208 if TexturesArray
= nil then Exit
;
210 if TextureName
= '' then Exit
;
212 for a
:= 0 to High(TexturesArray
) do
213 if TexturesArray
[a
].Name
= TextureName
then
215 ID
:= TexturesArray
[a
].ID
;
221 function g_GetTextureFlagByName(TextureName
: ShortString): Byte;
227 if not g_GetTexture(TextureName
, ID
) then Exit
;
229 Result
:= TexturesArray
[ID
].flag
;
232 function g_GetTextureFlagByID(ID
: DWORD
): Byte;
234 Result
:= TexturesArray
[ID
].flag
;
237 procedure g_GetTextureSizeByName(TextureName
: ShortString; var Width
, Height
: Word);
244 if not g_GetTexture(TextureName
, ID
) then Exit
;
246 e_GetTextureSize(ID
, @Width
, @Height
);
249 procedure g_GetTextureSizeByID(ID
: DWORD
; var Width
, Height
: Word);
251 e_GetTextureSize(ID
, @Width
, @Height
);
254 procedure g_DeleteTexture(TextureName
: ShortString);
258 if TexturesArray
= nil then Exit
;
260 for a
:= 0 to High(TexturesArray
) do
261 if TexturesArray
[a
].Name
= TextureName
then
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;
271 procedure g_DeleteAllTextures
;
275 if TexturesArray
= nil then Exit
;
277 for a
:= 0 to High(TexturesArray
) do
278 if TexturesArray
[a
].Name
<> '' then
279 e_DeleteTexture(TexturesArray
[a
].ID
);
281 TexturesArray
:= nil;