14 False: (TextureID
: DWORD
;);
15 True: (FramesID
: DWORD
;
20 TLevelTextureArray
= Array of TLevelTexture
;
22 TAnimation
= class(TObject
)
27 FCounter
: Byte; // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè
28 FSpeed
: Byte; // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè
29 FCurrentFrame
: Integer; // Òåêóùèé êàäð (íà÷èíàÿ ñ 0)
30 FLoop
: Boolean; // Ïåðåõîäèòü íà ïåðâûé êàäð ïîñëå ïîñëåäíåãî?
31 FEnabled
: Boolean; // Ðàáîòà ðàçðåøåíà?
32 FPlayed
: Boolean; // Ïðîèãðàíà âñÿ õîòÿ áû ðàç?
35 FMinLength
: Byte; // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ
36 FRevert
: Boolean; // Ñìåíà êàäðîâ îáðàòíàÿ?
39 constructor Create(FramesID
: DWORD
; Loop
: Boolean; Speed
: Byte);
40 destructor Destroy(); override;
41 procedure Draw(X
, Y
: Integer; Mirror
: TMirrorType
);
42 procedure DrawEx(X
, Y
: Integer; Mirror
: TMirrorType
; RPoint
: TPoint
;
48 procedure Revert(r
: Boolean);
49 procedure SaveState(Var Mem
: TBinMemoryWriter
);
50 procedure LoadState(Var Mem
: TBinMemoryReader
);
51 function TotalFrames(): Integer;
53 property Played
: Boolean read FPlayed
;
54 property Enabled
: Boolean read FEnabled
;
55 property IsReverse
: Boolean read FRevert
;
56 property Loop
: Boolean read FLoop write FLoop
;
57 property Speed
: Byte read FSpeed write FSpeed
;
58 property MinLength
: Byte read FMinLength write FMinLength
;
59 property CurrentFrame
: Integer read FCurrentFrame write FCurrentFrame
;
60 property CurrentCounter
: Byte read FCounter write FCounter
;
61 property Counter
: Byte read FCounter
;
62 property Blending
: Boolean read FBlending write FBlending
;
63 property Alpha
: Byte read FAlpha write FAlpha
;
64 property FramesID
: DWORD read ID
;
65 property Width
: Word read FWidth
;
66 property Height
: Word read FHeight
;
69 function g_Texture_CreateWAD(var ID
: DWORD
; Resource
: String): Boolean;
70 function g_Texture_CreateFile(var ID
: DWORD
; FileName
: String): Boolean;
71 function g_Texture_CreateWADEx(TextureName
: ShortString; Resource
: String): Boolean;
72 function g_Texture_CreateFileEx(TextureName
: ShortString; FileName
: String): Boolean;
73 function g_Texture_Get(TextureName
: ShortString; var ID
: DWORD
): Boolean;
74 procedure g_Texture_Delete(TextureName
: ShortString);
75 procedure g_Texture_DeleteAll();
77 function g_Frames_CreateWAD(ID
: PDWORD
; Name
: ShortString; Resource
: String;
78 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
79 function g_Frames_CreateFile(ID
: PDWORD
; Name
: ShortString; FileName
: String;
80 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
81 function g_Frames_CreateMemory(ID
: PDWORD
; Name
: ShortString; pData
: Pointer;
82 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
83 //function g_Frames_CreateRevert(ID: PDWORD; Name: ShortString; Frames: string): Boolean;
84 function g_Frames_Get(var ID
: DWORD
; FramesName
: ShortString): Boolean;
85 function g_Frames_GetTexture(var ID
: DWORD
; FramesName
: ShortString; Frame
: Word): Boolean;
86 function g_Frames_Exists(FramesName
: String): Boolean;
87 procedure g_Frames_DeleteByName(FramesName
: ShortString);
88 procedure g_Frames_DeleteByID(ID
: DWORD
);
89 procedure g_Frames_DeleteAll();
91 procedure DumpTextureNames();
96 g_game
, e_log
, g_basic
, SysUtils
, g_console
, WADEDITOR
,
107 TexturesID
: Array of DWORD
;
114 TexturesArray
: Array of _TTexture
= nil;
115 FramesArray
: Array of TFrames
= nil;
118 ANIM_SIGNATURE
= $4D494E41; // 'ANIM'
120 function FindTexture(): DWORD
;
124 if TexturesArray
<> nil then
125 for i
:= 0 to High(TexturesArray
) do
126 if TexturesArray
[i
].Name
= '' then
132 if TexturesArray
= nil then
134 SetLength(TexturesArray
, 8);
139 Result
:= High(TexturesArray
) + 1;
140 SetLength(TexturesArray
, Length(TexturesArray
) + 8);
144 function g_Texture_CreateWAD(var ID
: DWORD
; Resource
: String): Boolean;
149 ResourceName
: String;
150 TextureData
: Pointer;
151 ResourceLength
: Integer;
154 g_ProcessResourceStr(Resource
, FileName
, SectionName
, ResourceName
);
156 WAD
:= TWADEditor_1
.Create
;
157 WAD
.ReadFile(FileName
);
159 if WAD
.GetResource(SectionName
, ResourceName
, TextureData
, ResourceLength
) then
161 if e_CreateTextureMem(TextureData
, ID
) then
164 FreeMem(TextureData
);
168 e_WriteLog(Format('Error loading texture %s', [Resource
]), MSG_WARNING
);
169 e_WriteLog(Format('WAD Reader error: %s', [WAD
.GetLastErrorStr
]), MSG_WARNING
);
174 function g_Texture_CreateFile(var ID
: DWORD
; FileName
: String): Boolean;
177 if not e_CreateTexture(FileName
, ID
) then
179 e_WriteLog(Format('Error loading texture %s', [FileName
]), MSG_WARNING
);
184 function g_Texture_CreateWADEx(TextureName
: ShortString; Resource
: String): Boolean;
189 ResourceName
: String;
190 TextureData
: Pointer;
192 ResourceLength
: Integer;
194 g_ProcessResourceStr(Resource
, FileName
, SectionName
, ResourceName
);
196 find_id
:= FindTexture();
198 WAD
:= TWADEditor_1
.Create
;
199 WAD
.ReadFile(FileName
);
201 if WAD
.GetResource(SectionName
, ResourceName
, TextureData
, ResourceLength
) then
203 Result
:= e_CreateTextureMem(TextureData
, TexturesArray
[find_id
].ID
);
206 e_GetTextureSize(TexturesArray
[find_id
].ID
, @TexturesArray
[find_id
].Width
,
207 @TexturesArray
[find_id
].Height
);
208 TexturesArray
[find_id
].Name
:= LowerCase(TextureName
);
211 FreeMem(TextureData
);
215 e_WriteLog(Format('Error loading texture %s', [Resource
]), MSG_WARNING
);
216 e_WriteLog(Format('WAD Reader error: %s', [WAD
.GetLastErrorStr
]), MSG_WARNING
);
222 function g_Texture_CreateFileEx(TextureName
: ShortString; FileName
: String): Boolean;
226 find_id
:= FindTexture
;
228 Result
:= e_CreateTexture(FileName
, TexturesArray
[find_id
].ID
);
231 TexturesArray
[find_id
].Name
:= LowerCase(TextureName
);
232 e_GetTextureSize(TexturesArray
[find_id
].ID
, @TexturesArray
[find_id
].Width
,
233 @TexturesArray
[find_id
].Height
);
235 else e_WriteLog(Format('Error loading texture %s', [FileName
]), MSG_WARNING
);
238 function g_Texture_Get(TextureName
: ShortString; var ID
: DWORD
): Boolean;
244 if TexturesArray
= nil then Exit
;
246 if TextureName
= '' then Exit
;
248 TextureName
:= LowerCase(TextureName
);
250 for a
:= 0 to High(TexturesArray
) do
251 if TexturesArray
[a
].Name
= TextureName
then
253 ID
:= TexturesArray
[a
].ID
;
258 //if not Result then g_ConsoleAdd('Texture '+TextureName+' not found');
261 procedure g_Texture_Delete(TextureName
: ShortString);
265 if TexturesArray
= nil then Exit
;
267 TextureName
:= LowerCase(TextureName
);
269 for a
:= 0 to High(TexturesArray
) do
270 if TexturesArray
[a
].Name
= TextureName
then
272 e_DeleteTexture(TexturesArray
[a
].ID
);
273 TexturesArray
[a
].Name
:= '';
274 TexturesArray
[a
].ID
:= 0;
275 TexturesArray
[a
].Width
:= 0;
276 TexturesArray
[a
].Height
:= 0;
280 procedure g_Texture_DeleteAll();
284 if TexturesArray
= nil then Exit
;
286 for a
:= 0 to High(TexturesArray
) do
287 if TexturesArray
[a
].Name
<> '' then
288 e_DeleteTexture(TexturesArray
[a
].ID
);
290 TexturesArray
:= nil;
293 function FindFrame(): DWORD
;
297 if FramesArray
<> nil then
298 for i
:= 0 to High(FramesArray
) do
299 if FramesArray
[i
].TexturesID
= nil then
305 if FramesArray
= nil then
307 SetLength(FramesArray
, 64);
312 Result
:= High(FramesArray
) + 1;
313 SetLength(FramesArray
, Length(FramesArray
) + 64);
317 function g_Frames_CreateFile(ID
: PDWORD
; Name
: ShortString; FileName
: String;
318 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
325 find_id
:= FindFrame
;
327 if FCount
<= 2 then BackAnimation
:= False;
329 if BackAnimation
then SetLength(FramesArray
[find_id
].TexturesID
, FCount
+FCount
-2)
330 else SetLength(FramesArray
[find_id
].TexturesID
, FCount
);
332 for a
:= 0 to FCount
-1 do
333 if not e_CreateTextureEx(FileName
, FramesArray
[find_id
].TexturesID
[a
],
334 a
*FWidth
, 0, FWidth
, FHeight
) then Exit
;
336 if BackAnimation
then
337 for a
:= 1 to FCount
-2 do
338 FramesArray
[find_id
].TexturesID
[FCount
+FCount
-2-a
] := FramesArray
[find_id
].TexturesID
[a
];
340 FramesArray
[find_id
].FrameWidth
:= FWidth
;
341 FramesArray
[find_id
].FrameHeight
:= FHeight
;
343 FramesArray
[find_id
].Name
:= LowerCase(Name
)
345 FramesArray
[find_id
].Name
:= '<noname>';
347 if ID
<> nil then ID
^ := find_id
;
352 function CreateFramesMem(pData
: Pointer; ID
: PDWORD
; Name
: ShortString;
353 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
360 find_id
:= FindFrame();
362 if FCount
<= 2 then BackAnimation
:= False;
364 if BackAnimation
then SetLength(FramesArray
[find_id
].TexturesID
, FCount
+FCount
-2)
365 else SetLength(FramesArray
[find_id
].TexturesID
, FCount
);
367 for a
:= 0 to FCount
-1 do
368 if not e_CreateTextureMemEx(pData
, FramesArray
[find_id
].TexturesID
[a
],
369 a
*FWidth
, 0, FWidth
, FHeight
) then
375 if BackAnimation
then
376 for a
:= 1 to FCount
-2 do
377 FramesArray
[find_id
].TexturesID
[FCount
+FCount
-2-a
] := FramesArray
[find_id
].TexturesID
[a
];
379 FramesArray
[find_id
].FrameWidth
:= FWidth
;
380 FramesArray
[find_id
].FrameHeight
:= FHeight
;
382 FramesArray
[find_id
].Name
:= LowerCase(Name
)
384 FramesArray
[find_id
].Name
:= '<noname>';
386 if ID
<> nil then ID
^ := find_id
;
391 function g_Frames_CreateWAD(ID
: PDWORD
; Name
: ShortString; Resource
: string;
392 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
397 ResourceName
: string;
398 TextureData
: Pointer;
399 ResourceLength
: Integer;
403 g_ProcessResourceStr(Resource
, FileName
, SectionName
, ResourceName
);
405 WAD
:= TWADEditor_1
.Create();
406 WAD
.ReadFile(FileName
);
408 if not WAD
.GetResource(SectionName
, ResourceName
, TextureData
, ResourceLength
) then
411 e_WriteLog(Format('Error loading texture %s', [Resource
]), MSG_WARNING
);
412 e_WriteLog(Format('WAD Reader error: %s', [WAD
.GetLastErrorStr
]), MSG_WARNING
);
416 if not CreateFramesMem(TextureData
, ID
, Name
, FWidth
, FHeight
, FCount
, BackAnimation
) then
427 function g_Frames_CreateMemory(ID
: PDWORD
; Name
: ShortString; pData
: Pointer;
428 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
430 Result
:= CreateFramesMem(pData
, ID
, Name
, FWidth
, FHeight
, FCount
, BackAnimation
);
433 {function g_Frames_CreateRevert(ID: PDWORD; Name: ShortString; Frames: string): Boolean;
440 if not g_Frames_Get(b, Frames) then Exit;
442 find_id := FindFrame();
444 FramesArray[find_id].Name := Name;
445 FramesArray[find_id].FrameWidth := FramesArray[b].FrameWidth;
446 FramesArray[find_id].FrameHeight := FramesArray[b].FrameHeight;
448 c := High(FramesArray[find_id].TexturesID);
451 FramesArray[find_id].TexturesID[a] := FramesArray[b].TexturesID[c-a];
456 procedure g_Frames_DeleteByName(FramesName
: ShortString);
461 if FramesArray
= nil then Exit
;
463 FramesName
:= LowerCase(FramesName
);
465 for a
:= 0 to High(FramesArray
) do
466 if FramesArray
[a
].Name
= FramesName
then
468 if FramesArray
[a
].TexturesID
<> nil then
469 for b
:= 0 to High(FramesArray
[a
].TexturesID
) do
470 e_DeleteTexture(FramesArray
[a
].TexturesID
[b
]);
471 FramesArray
[a
].TexturesID
:= nil;
472 FramesArray
[a
].Name
:= '';
473 FramesArray
[a
].FrameWidth
:= 0;
474 FramesArray
[a
].FrameHeight
:= 0;
478 procedure g_Frames_DeleteByID(ID
: DWORD
);
482 if FramesArray
= nil then Exit
;
484 if FramesArray
[ID
].TexturesID
<> nil then
485 for b
:= 0 to High(FramesArray
[ID
].TexturesID
) do
486 e_DeleteTexture(FramesArray
[ID
].TexturesID
[b
]);
487 FramesArray
[ID
].TexturesID
:= nil;
488 FramesArray
[ID
].Name
:= '';
489 FramesArray
[ID
].FrameWidth
:= 0;
490 FramesArray
[ID
].FrameHeight
:= 0;
493 procedure g_Frames_DeleteAll
;
498 if FramesArray
= nil then Exit
;
500 for a
:= 0 to High(FramesArray
) do
501 if FramesArray
[a
].TexturesID
<> nil then
503 for b
:= 0 to High(FramesArray
[a
].TexturesID
) do
504 e_DeleteTexture(FramesArray
[a
].TexturesID
[b
]);
505 FramesArray
[a
].TexturesID
:= nil;
506 FramesArray
[a
].Name
:= '';
507 FramesArray
[a
].FrameWidth
:= 0;
508 FramesArray
[a
].FrameHeight
:= 0;
514 function g_Frames_Get(var ID
: DWORD
; FramesName
: ShortString): Boolean;
520 if FramesArray
= nil then
523 FramesName
:= LowerCase(FramesName
);
525 for a
:= 0 to High(FramesArray
) do
526 if FramesArray
[a
].Name
= FramesName
then
534 g_FatalError(Format(_lc
[I_GAME_ERROR_FRAMES
], [FramesName
]));
537 function g_Frames_GetTexture(var ID
: DWORD
; FramesName
: ShortString; Frame
: Word): Boolean;
543 if FramesArray
= nil then
546 FramesName
:= LowerCase(FramesName
);
548 for a
:= 0 to High(FramesArray
) do
549 if FramesArray
[a
].Name
= FramesName
then
550 if Frame
<= High(FramesArray
[a
].TexturesID
) then
552 ID
:= FramesArray
[a
].TexturesID
[Frame
];
558 g_FatalError(Format(_lc
[I_GAME_ERROR_FRAMES
], [FramesName
]));
561 function g_Frames_Exists(FramesName
: string): Boolean;
567 if FramesArray
= nil then Exit
;
569 FramesName
:= LowerCase(FramesName
);
571 for a
:= 0 to High(FramesArray
) do
572 if FramesArray
[a
].Name
= FramesName
then
579 procedure DumpTextureNames();
583 e_WriteLog('BEGIN Textures:', MSG_NOTIFY
);
584 for i
:= 0 to High(TexturesArray
) do
585 e_WriteLog(' '+IntToStr(i
)+'. '+TexturesArray
[i
].Name
, MSG_NOTIFY
);
586 e_WriteLog('END Textures.', MSG_NOTIFY
);
588 e_WriteLog('BEGIN Frames:', MSG_NOTIFY
);
589 for i
:= 0 to High(FramesArray
) do
590 e_WriteLog(' '+IntToStr(i
)+'. '+FramesArray
[i
].Name
, MSG_NOTIFY
);
591 e_WriteLog('END Frames.', MSG_NOTIFY
);
596 constructor TAnimation
.Create(FramesID
: DWORD
; Loop
: Boolean; Speed
: Byte);
607 FWidth
:= FramesArray
[ID
].FrameWidth
;
608 FHeight
:= FramesArray
[ID
].FrameHeight
;
611 destructor TAnimation
.Destroy
;
616 procedure TAnimation
.Draw(X
, Y
: Integer; Mirror
: TMirrorType
);
621 e_DrawAdv(FramesArray
[ID
].TexturesID
[FCurrentFrame
], X
, Y
, FAlpha
,
622 True, FBlending
, 0, nil, Mirror
);
623 //e_DrawQuad(X, Y, X+FramesArray[ID].FrameWidth-1, Y+FramesArray[ID].FrameHeight-1, 0, 255, 0);
626 procedure TAnimation
.Update();
631 FCounter
:= FCounter
+ 1;
633 if FCounter
>= FSpeed
then
634 begin // Îæèäàíèå ìåæäó êàäðàìè çàêîí÷èëîñü
636 begin // Îáðàòíûé ïîðÿäîê êàäðîâ
637 // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå:
638 if FCurrentFrame
= 0 then
639 if Length(FramesArray
[ID
].TexturesID
) * FSpeed
+
640 FCounter
< FMinLength
then
643 FCurrentFrame
:= FCurrentFrame
- 1;
644 FPlayed
:= FCurrentFrame
< 0;
646 // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó:
649 FCurrentFrame
:= High(FramesArray
[ID
].TexturesID
)
651 FCurrentFrame
:= FCurrentFrame
+ 1;
656 begin // Ïðÿìîé ïîðÿäîê êàäðîâ
657 // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå:
658 if FCurrentFrame
= High(FramesArray
[ID
].TexturesID
) then
659 if Length(FramesArray
[ID
].TexturesID
) * FSpeed
+
660 FCounter
< FMinLength
then
663 FCurrentFrame
:= FCurrentFrame
+ 1;
664 FPlayed
:= (FCurrentFrame
> High(FramesArray
[ID
].TexturesID
));
666 // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó:
671 FCurrentFrame
:= FCurrentFrame
- 1;
678 procedure TAnimation
.Reset();
681 FCurrentFrame
:= High(FramesArray
[ID
].TexturesID
)
689 procedure TAnimation
.Disable
;
694 procedure TAnimation
.Enable
;
699 procedure TAnimation
.DrawEx(X
, Y
: Integer; Mirror
: TMirrorType
; RPoint
: TPoint
;
705 e_DrawAdv(FramesArray
[ID
].TexturesID
[FCurrentFrame
], X
, Y
, FAlpha
,
706 True, FBlending
, Angle
, @RPoint
, Mirror
);
709 function TAnimation
.TotalFrames(): Integer;
711 Result
:= Length(FramesArray
[ID
].TexturesID
);
714 procedure TAnimation
.Revert(r
: Boolean);
720 procedure TAnimation
.SaveState(Var Mem
: TBinMemoryWriter
);
727 // Ñèãíàòóðà àíèìàöèè:
728 sig
:= ANIM_SIGNATURE
; // 'ANIM'
730 // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè:
731 Mem
.WriteByte(FCounter
);
733 Mem
.WriteInt(FCurrentFrame
);
734 // Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì:
735 Mem
.WriteBoolean(FPlayed
);
736 // Alpha-êàíàë âñåé òåêñòóðû:
737 Mem
.WriteByte(FAlpha
);
738 // Ðàçìûòèå òåêñòóðû:
739 Mem
.WriteBoolean(FBlending
);
740 // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè:
741 Mem
.WriteByte(FSpeed
);
742 // Çàöèêëåíà ëè àíèìàöèÿ:
743 Mem
.WriteBoolean(FLoop
);
745 Mem
.WriteBoolean(FEnabled
);
746 // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ:
747 Mem
.WriteByte(FMinLength
);
748 // Îáðàòíûé ëè ïîðÿäîê êàäðîâ:
749 Mem
.WriteBoolean(FRevert
);
752 procedure TAnimation
.LoadState(Var Mem
: TBinMemoryReader
);
759 // Ñèãíàòóðà àíèìàöèè:
761 if sig
<> ANIM_SIGNATURE
then // 'ANIM'
763 raise EBinSizeError
.Create('TAnimation.LoadState: Wrong Animation Signature');
765 // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè:
766 Mem
.ReadByte(FCounter
);
768 Mem
.ReadInt(FCurrentFrame
);
769 // Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì:
770 Mem
.ReadBoolean(FPlayed
);
771 // Alpha-êàíàë âñåé òåêñòóðû:
772 Mem
.ReadByte(FAlpha
);
773 // Ðàçìûòèå òåêñòóðû:
774 Mem
.ReadBoolean(FBlending
);
775 // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè:
776 Mem
.ReadByte(FSpeed
);
777 // Çàöèêëåíà ëè àíèìàöèÿ:
778 Mem
.ReadBoolean(FLoop
);
780 Mem
.ReadBoolean(FEnabled
);
781 // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ:
782 Mem
.ReadByte(FMinLength
);
783 // Îáðàòíûé ëè ïîðÿäîê êàäðîâ:
784 Mem
.ReadBoolean(FRevert
);