7 uses LCLIntf
, LCLType
, LMessages
, e_graphics
;
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; 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
;
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;
75 ResourceLength
: Integer;
78 g_ProcessResourceStr(Resource
, FileName
, SectionName
, ResourceName
);
80 WAD
:= TWADEditor_1
.Create
;
81 WAD
.ReadFile(FileName
);
83 if WAD
.GetResource(SectionName
, ResourceName
, TextureData
, ResourceLength
) then
85 if e_CreateTextureMem(TextureData
, ID
) then Result
:= True;
90 e_WriteLog(Format('Error loading texture %s', [Resource
]), MSG_WARNING
);
91 e_WriteLog(Format('WAD Reader error: %s', [WAD
.GetLastErrorStr
]), MSG_WARNING
);
96 function g_CreateTextureMemorySize(pData
: Pointer; Name
: ShortString; X
, Y
,
97 Width
, Height
: Word; flag
: Byte = 0): Boolean;
105 find_id
:= FindTexture
;
107 if not e_CreateTextureMemEx(pData
, TexturesArray
[find_id
].ID
, X
, Y
, Width
, Height
) then
113 TexturesArray
[find_id
].Width
:= Width
;
114 TexturesArray
[find_id
].Height
:= Height
;
115 TexturesArray
[find_id
].Name
:= Name
;
116 TexturesArray
[find_id
].flag
:= flag
;
123 function g_CreateTextureWAD(TextureName
: ShortString; Resource
: string; flag
: Byte = 0): Boolean;
128 ResourceName
: string;
129 TextureData
: Pointer;
131 ResourceLength
: Integer;
133 g_ProcessResourceStr(Resource
, FileName
, SectionName
, ResourceName
);
135 find_id
:= FindTexture
;
137 WAD
:= TWADEditor_1
.Create
;
138 WAD
.ReadFile(FileName
);
140 if WAD
.GetResource(SectionName
, ResourceName
, TextureData
, ResourceLength
) then
142 Result
:= e_CreateTextureMem(TextureData
, TexturesArray
[find_id
].ID
);
143 FreeMem(TextureData
);
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
;
154 e_WriteLog(Format('Error loading texture %s', [Resource
]), MSG_WARNING
);
155 e_WriteLog(Format('WAD Reader error: %s', [WAD
.GetLastErrorStr
]), MSG_WARNING
);
161 function g_SimpleCreateTextureWADSize(var ID
: DWORD
; Resource
: string;
162 X
, Y
, Width
, Height
: Word): Boolean;
167 ResourceName
: String;
168 TextureData
: Pointer;
169 ResourceLength
: Integer;
172 g_ProcessResourceStr(Resource
, FileName
, SectionName
, ResourceName
);
174 WAD
:= TWADEditor_1
.Create
;
175 WAD
.ReadFile(FileName
);
177 if WAD
.GetResource(SectionName
, ResourceName
, TextureData
, ResourceLength
) then
179 if e_CreateTextureMemEx(TextureData
, ID
, X
, Y
, Width
, Height
) then Result
:= True;
180 FreeMem(TextureData
);
184 e_WriteLog(Format('Error loading texture %s', [Resource
]), MSG_WARNING
);
185 e_WriteLog(Format('WAD Reader error: %s', [WAD
.GetLastErrorStr
]), MSG_WARNING
);
190 function g_CreateTextureWADSize(TextureName
: ShortString; Resource
: string;
191 X
, Y
, Width
, Height
: Word; flag
: Byte = 0): Boolean;
196 ResourceName
: String;
197 TextureData
: Pointer;
199 ResourceLength
: Integer;
201 g_ProcessResourceStr(Resource
, FileName
, SectionName
, ResourceName
);
203 find_id
:= FindTexture
;
205 WAD
:= TWADEditor_1
.Create
;
206 WAD
.ReadFile(FileName
);
208 if WAD
.GetResource(SectionName
, ResourceName
, TextureData
, ResourceLength
) then
210 Result
:= e_CreateTextureMemEx(TextureData
, TexturesArray
[find_id
].ID
, X
, Y
, Width
, Height
);
211 FreeMem(TextureData
);
214 TexturesArray
[find_id
].Width
:= Width
;
215 TexturesArray
[find_id
].Height
:= Height
;
216 TexturesArray
[find_id
].Name
:= TextureName
;
217 TexturesArray
[find_id
].flag
:= flag
;
222 e_WriteLog(Format('Error loading texture %s', [Resource
]), MSG_WARNING
);
223 e_WriteLog(Format('WAD Reader error: %s', [WAD
.GetLastErrorStr
]), MSG_WARNING
);
229 function g_GetTexture(TextureName
: ShortString; var ID
: DWORD
): Boolean;
235 if TexturesArray
= nil then Exit
;
237 if TextureName
= '' then Exit
;
239 for a
:= 0 to High(TexturesArray
) do
240 if TexturesArray
[a
].Name
= TextureName
then
242 ID
:= TexturesArray
[a
].ID
;
248 function g_GetTextureFlagByName(TextureName
: ShortString): Byte;
254 if not g_GetTexture(TextureName
, ID
) then Exit
;
256 Result
:= TexturesArray
[ID
].flag
;
259 function g_GetTextureFlagByID(ID
: DWORD
): Byte;
261 Result
:= TexturesArray
[ID
].flag
;
264 procedure g_GetTextureSizeByName(TextureName
: ShortString; var Width
, Height
: Word);
271 if not g_GetTexture(TextureName
, ID
) then Exit
;
273 e_GetTextureSize(ID
, @Width
, @Height
);
276 procedure g_GetTextureSizeByID(ID
: DWORD
; var Width
, Height
: Word);
278 e_GetTextureSize(ID
, @Width
, @Height
);
281 procedure g_DeleteTexture(TextureName
: ShortString);
285 if TexturesArray
= nil then Exit
;
287 for a
:= 0 to High(TexturesArray
) do
288 if TexturesArray
[a
].Name
= TextureName
then
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;
298 procedure g_DeleteAllTextures
;
302 if TexturesArray
= nil then Exit
;
304 for a
:= 0 to High(TexturesArray
) do
305 if TexturesArray
[a
].Name
<> '' then
306 e_DeleteTexture(TexturesArray
[a
].ID
);
308 TexturesArray
:= nil;