10 TLevelTexture
= record
15 False: (TextureID
: DWORD
;);
16 True: (FramesID
: DWORD
;
21 TLevelTextureArray
= Array of TLevelTexture
;
23 TAnimation
= class(TObject
)
28 FCounter
: Byte; // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè
29 FSpeed
: Byte; // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè
30 FCurrentFrame
: Integer; // Òåêóùèé êàäð (íà÷èíàÿ ñ 0)
31 FLoop
: Boolean; // Ïåðåõîäèòü íà ïåðâûé êàäð ïîñëå ïîñëåäíåãî?
32 FEnabled
: Boolean; // Ðàáîòà ðàçðåøåíà?
33 FPlayed
: Boolean; // Ïðîèãðàíà âñÿ õîòÿ áû ðàç?
36 FMinLength
: Byte; // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ
37 FRevert
: Boolean; // Ñìåíà êàäðîâ îáðàòíàÿ?
40 constructor Create(FramesID
: DWORD
; Loop
: Boolean; Speed
: Byte);
41 destructor Destroy(); override;
42 procedure Draw(X
, Y
: Integer; Mirror
: TMirrorType
);
43 procedure DrawEx(X
, Y
: Integer; Mirror
: TMirrorType
; RPoint
: TPoint
;
49 procedure Revert(r
: Boolean);
50 procedure SaveState(Var Mem
: TBinMemoryWriter
);
51 procedure LoadState(Var Mem
: TBinMemoryReader
);
52 function TotalFrames(): Integer;
54 property Played
: Boolean read FPlayed
;
55 property Enabled
: Boolean read FEnabled
;
56 property IsReverse
: Boolean read FRevert
;
57 property Loop
: Boolean read FLoop write FLoop
;
58 property Speed
: Byte read FSpeed write FSpeed
;
59 property MinLength
: Byte read FMinLength write FMinLength
;
60 property CurrentFrame
: Integer read FCurrentFrame write FCurrentFrame
;
61 property CurrentCounter
: Byte read FCounter write FCounter
;
62 property Counter
: Byte read FCounter
;
63 property Blending
: Boolean read FBlending write FBlending
;
64 property Alpha
: Byte read FAlpha write FAlpha
;
65 property FramesID
: DWORD read ID
;
66 property Width
: Word read FWidth
;
67 property Height
: Word read FHeight
;
70 function g_Texture_CreateWAD(var ID
: DWORD
; Resource
: String): Boolean;
71 function g_Texture_CreateFile(var ID
: DWORD
; FileName
: String): Boolean;
72 function g_Texture_CreateWADEx(TextureName
: ShortString; Resource
: String): Boolean;
73 function g_Texture_CreateFileEx(TextureName
: ShortString; FileName
: String): Boolean;
74 function g_Texture_Get(TextureName
: ShortString; var ID
: DWORD
): Boolean;
75 procedure g_Texture_Delete(TextureName
: ShortString);
76 procedure g_Texture_DeleteAll();
78 function g_Frames_CreateWAD(ID
: PDWORD
; Name
: ShortString; Resource
: String;
79 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
80 function g_Frames_CreateFile(ID
: PDWORD
; Name
: ShortString; FileName
: String;
81 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
82 function g_Frames_CreateMemory(ID
: PDWORD
; Name
: ShortString; pData
: Pointer; dataSize
: LongInt;
83 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
84 //function g_Frames_CreateRevert(ID: PDWORD; Name: ShortString; Frames: string): Boolean;
85 function g_Frames_Get(var ID
: DWORD
; FramesName
: ShortString): Boolean;
86 function g_Frames_GetTexture(var ID
: DWORD
; FramesName
: ShortString; Frame
: Word): Boolean;
87 function g_Frames_Exists(FramesName
: String): Boolean;
88 procedure g_Frames_DeleteByName(FramesName
: ShortString);
89 procedure g_Frames_DeleteByID(ID
: DWORD
);
90 procedure g_Frames_DeleteAll();
92 procedure DumpTextureNames();
97 g_game
, e_log
, g_basic
, SysUtils
, g_console
, wadreader
,
108 TexturesID
: Array of DWORD
;
115 TexturesArray
: Array of _TTexture
= nil;
116 FramesArray
: Array of TFrames
= nil;
119 ANIM_SIGNATURE
= $4D494E41; // 'ANIM'
121 function FindTexture(): DWORD
;
125 if TexturesArray
<> nil then
126 for i
:= 0 to High(TexturesArray
) do
127 if TexturesArray
[i
].Name
= '' then
133 if TexturesArray
= nil then
135 SetLength(TexturesArray
, 8);
140 Result
:= High(TexturesArray
) + 1;
141 SetLength(TexturesArray
, Length(TexturesArray
) + 8);
145 function g_Texture_CreateWAD(var ID
: DWORD
; Resource
: String): Boolean;
150 ResourceName
: String;
151 TextureData
: Pointer;
152 ResourceLength
: Integer;
155 g_ProcessResourceStr(Resource
, FileName
, SectionName
, ResourceName
);
157 WAD
:= TWADFile
.Create
;
158 WAD
.ReadFile(FileName
);
160 if WAD
.GetResource(SectionName
, ResourceName
, TextureData
, ResourceLength
) then
162 if e_CreateTextureMem(TextureData
, ResourceLength
, ID
) then
165 FreeMem(TextureData
);
169 e_WriteLog(Format('Error loading texture %s', [Resource
]), MSG_WARNING
);
170 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
175 function g_Texture_CreateFile(var ID
: DWORD
; FileName
: String): Boolean;
178 if not e_CreateTexture(FileName
, ID
) then
180 e_WriteLog(Format('Error loading texture %s', [FileName
]), MSG_WARNING
);
185 function g_Texture_CreateWADEx(TextureName
: ShortString; Resource
: String): Boolean;
190 ResourceName
: String;
191 TextureData
: Pointer;
193 ResourceLength
: Integer;
195 g_ProcessResourceStr(Resource
, FileName
, SectionName
, ResourceName
);
197 find_id
:= FindTexture();
199 WAD
:= TWADFile
.Create
;
200 WAD
.ReadFile(FileName
);
202 if WAD
.GetResource(SectionName
, ResourceName
, TextureData
, ResourceLength
) then
204 Result
:= e_CreateTextureMem(TextureData
, ResourceLength
, TexturesArray
[find_id
].ID
);
207 e_GetTextureSize(TexturesArray
[find_id
].ID
, @TexturesArray
[find_id
].Width
,
208 @TexturesArray
[find_id
].Height
);
209 TexturesArray
[find_id
].Name
:= LowerCase(TextureName
);
212 FreeMem(TextureData
);
216 e_WriteLog(Format('Error loading texture %s', [Resource
]), MSG_WARNING
);
217 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
223 function g_Texture_CreateFileEx(TextureName
: ShortString; FileName
: String): Boolean;
227 find_id
:= FindTexture
;
229 Result
:= e_CreateTexture(FileName
, TexturesArray
[find_id
].ID
);
232 TexturesArray
[find_id
].Name
:= LowerCase(TextureName
);
233 e_GetTextureSize(TexturesArray
[find_id
].ID
, @TexturesArray
[find_id
].Width
,
234 @TexturesArray
[find_id
].Height
);
236 else e_WriteLog(Format('Error loading texture %s', [FileName
]), MSG_WARNING
);
239 function g_Texture_Get(TextureName
: ShortString; var ID
: DWORD
): Boolean;
245 if TexturesArray
= nil then Exit
;
247 if TextureName
= '' then Exit
;
249 TextureName
:= LowerCase(TextureName
);
251 for a
:= 0 to High(TexturesArray
) do
252 if TexturesArray
[a
].Name
= TextureName
then
254 ID
:= TexturesArray
[a
].ID
;
259 //if not Result then g_ConsoleAdd('Texture '+TextureName+' not found');
262 procedure g_Texture_Delete(TextureName
: ShortString);
266 if TexturesArray
= nil then Exit
;
268 TextureName
:= LowerCase(TextureName
);
270 for a
:= 0 to High(TexturesArray
) do
271 if TexturesArray
[a
].Name
= TextureName
then
273 e_DeleteTexture(TexturesArray
[a
].ID
);
274 TexturesArray
[a
].Name
:= '';
275 TexturesArray
[a
].ID
:= 0;
276 TexturesArray
[a
].Width
:= 0;
277 TexturesArray
[a
].Height
:= 0;
281 procedure g_Texture_DeleteAll();
285 if TexturesArray
= nil then Exit
;
287 for a
:= 0 to High(TexturesArray
) do
288 if TexturesArray
[a
].Name
<> '' then
289 e_DeleteTexture(TexturesArray
[a
].ID
);
291 TexturesArray
:= nil;
294 function FindFrame(): DWORD
;
298 if FramesArray
<> nil then
299 for i
:= 0 to High(FramesArray
) do
300 if FramesArray
[i
].TexturesID
= nil then
306 if FramesArray
= nil then
308 SetLength(FramesArray
, 64);
313 Result
:= High(FramesArray
) + 1;
314 SetLength(FramesArray
, Length(FramesArray
) + 64);
318 function g_Frames_CreateFile(ID
: PDWORD
; Name
: ShortString; FileName
: String;
319 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
326 find_id
:= FindFrame
;
328 if FCount
<= 2 then BackAnimation
:= False;
330 if BackAnimation
then SetLength(FramesArray
[find_id
].TexturesID
, FCount
+FCount
-2)
331 else SetLength(FramesArray
[find_id
].TexturesID
, FCount
);
333 for a
:= 0 to FCount
-1 do
334 if not e_CreateTextureEx(FileName
, FramesArray
[find_id
].TexturesID
[a
],
335 a
*FWidth
, 0, FWidth
, FHeight
) then Exit
;
337 if BackAnimation
then
338 for a
:= 1 to FCount
-2 do
339 FramesArray
[find_id
].TexturesID
[FCount
+FCount
-2-a
] := FramesArray
[find_id
].TexturesID
[a
];
341 FramesArray
[find_id
].FrameWidth
:= FWidth
;
342 FramesArray
[find_id
].FrameHeight
:= FHeight
;
344 FramesArray
[find_id
].Name
:= LowerCase(Name
)
346 FramesArray
[find_id
].Name
:= '<noname>';
348 if ID
<> nil then ID
^ := find_id
;
353 function CreateFramesMem(pData
: Pointer; dataSize
: LongInt; ID
: PDWORD
; Name
: ShortString;
354 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
361 find_id
:= FindFrame();
363 if FCount
<= 2 then BackAnimation
:= False;
365 if BackAnimation
then SetLength(FramesArray
[find_id
].TexturesID
, FCount
+FCount
-2)
366 else SetLength(FramesArray
[find_id
].TexturesID
, FCount
);
368 for a
:= 0 to FCount
-1 do
369 if not e_CreateTextureMemEx(pData
, dataSize
, FramesArray
[find_id
].TexturesID
[a
],
370 a
*FWidth
, 0, FWidth
, FHeight
) then
376 if BackAnimation
then
377 for a
:= 1 to FCount
-2 do
378 FramesArray
[find_id
].TexturesID
[FCount
+FCount
-2-a
] := FramesArray
[find_id
].TexturesID
[a
];
380 FramesArray
[find_id
].FrameWidth
:= FWidth
;
381 FramesArray
[find_id
].FrameHeight
:= FHeight
;
383 FramesArray
[find_id
].Name
:= LowerCase(Name
)
385 FramesArray
[find_id
].Name
:= '<noname>';
387 if ID
<> nil then ID
^ := find_id
;
392 function g_Frames_CreateWAD(ID
: PDWORD
; Name
: ShortString; Resource
: string;
393 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
398 ResourceName
: string;
399 TextureData
: Pointer;
400 ResourceLength
: Integer;
404 g_ProcessResourceStr(Resource
, FileName
, SectionName
, ResourceName
);
406 WAD
:= TWADFile
.Create();
407 WAD
.ReadFile(FileName
);
409 if not WAD
.GetResource(SectionName
, ResourceName
, TextureData
, ResourceLength
) then
412 e_WriteLog(Format('Error loading texture %s', [Resource
]), MSG_WARNING
);
413 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
417 if not CreateFramesMem(TextureData
, ResourceLength
, ID
, Name
, FWidth
, FHeight
, FCount
, BackAnimation
) then
428 function g_Frames_CreateMemory(ID
: PDWORD
; Name
: ShortString; pData
: Pointer; dataSize
: LongInt;
429 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
431 Result
:= CreateFramesMem(pData
, dataSize
, ID
, Name
, FWidth
, FHeight
, FCount
, BackAnimation
);
434 {function g_Frames_CreateRevert(ID: PDWORD; Name: ShortString; Frames: string): Boolean;
441 if not g_Frames_Get(b, Frames) then Exit;
443 find_id := FindFrame();
445 FramesArray[find_id].Name := Name;
446 FramesArray[find_id].FrameWidth := FramesArray[b].FrameWidth;
447 FramesArray[find_id].FrameHeight := FramesArray[b].FrameHeight;
449 c := High(FramesArray[find_id].TexturesID);
452 FramesArray[find_id].TexturesID[a] := FramesArray[b].TexturesID[c-a];
457 procedure g_Frames_DeleteByName(FramesName
: ShortString);
462 if FramesArray
= nil then Exit
;
464 FramesName
:= LowerCase(FramesName
);
466 for a
:= 0 to High(FramesArray
) do
467 if FramesArray
[a
].Name
= FramesName
then
469 if FramesArray
[a
].TexturesID
<> nil then
470 for b
:= 0 to High(FramesArray
[a
].TexturesID
) do
471 e_DeleteTexture(FramesArray
[a
].TexturesID
[b
]);
472 FramesArray
[a
].TexturesID
:= nil;
473 FramesArray
[a
].Name
:= '';
474 FramesArray
[a
].FrameWidth
:= 0;
475 FramesArray
[a
].FrameHeight
:= 0;
479 procedure g_Frames_DeleteByID(ID
: DWORD
);
483 if FramesArray
= nil then Exit
;
485 if FramesArray
[ID
].TexturesID
<> nil then
486 for b
:= 0 to High(FramesArray
[ID
].TexturesID
) do
487 e_DeleteTexture(FramesArray
[ID
].TexturesID
[b
]);
488 FramesArray
[ID
].TexturesID
:= nil;
489 FramesArray
[ID
].Name
:= '';
490 FramesArray
[ID
].FrameWidth
:= 0;
491 FramesArray
[ID
].FrameHeight
:= 0;
494 procedure g_Frames_DeleteAll
;
499 if FramesArray
= nil then Exit
;
501 for a
:= 0 to High(FramesArray
) do
502 if FramesArray
[a
].TexturesID
<> nil then
504 for b
:= 0 to High(FramesArray
[a
].TexturesID
) do
505 e_DeleteTexture(FramesArray
[a
].TexturesID
[b
]);
506 FramesArray
[a
].TexturesID
:= nil;
507 FramesArray
[a
].Name
:= '';
508 FramesArray
[a
].FrameWidth
:= 0;
509 FramesArray
[a
].FrameHeight
:= 0;
515 function g_Frames_Get(var ID
: DWORD
; FramesName
: ShortString): Boolean;
521 if FramesArray
= nil then
524 FramesName
:= LowerCase(FramesName
);
526 for a
:= 0 to High(FramesArray
) do
527 if FramesArray
[a
].Name
= FramesName
then
535 g_FatalError(Format(_lc
[I_GAME_ERROR_FRAMES
], [FramesName
]));
538 function g_Frames_GetTexture(var ID
: DWORD
; FramesName
: ShortString; Frame
: Word): Boolean;
544 if FramesArray
= nil then
547 FramesName
:= LowerCase(FramesName
);
549 for a
:= 0 to High(FramesArray
) do
550 if FramesArray
[a
].Name
= FramesName
then
551 if Frame
<= High(FramesArray
[a
].TexturesID
) then
553 ID
:= FramesArray
[a
].TexturesID
[Frame
];
559 g_FatalError(Format(_lc
[I_GAME_ERROR_FRAMES
], [FramesName
]));
562 function g_Frames_Exists(FramesName
: string): Boolean;
568 if FramesArray
= nil then Exit
;
570 FramesName
:= LowerCase(FramesName
);
572 for a
:= 0 to High(FramesArray
) do
573 if FramesArray
[a
].Name
= FramesName
then
580 procedure DumpTextureNames();
584 e_WriteLog('BEGIN Textures:', MSG_NOTIFY
);
585 for i
:= 0 to High(TexturesArray
) do
586 e_WriteLog(' '+IntToStr(i
)+'. '+TexturesArray
[i
].Name
, MSG_NOTIFY
);
587 e_WriteLog('END Textures.', MSG_NOTIFY
);
589 e_WriteLog('BEGIN Frames:', MSG_NOTIFY
);
590 for i
:= 0 to High(FramesArray
) do
591 e_WriteLog(' '+IntToStr(i
)+'. '+FramesArray
[i
].Name
, MSG_NOTIFY
);
592 e_WriteLog('END Frames.', MSG_NOTIFY
);
597 constructor TAnimation
.Create(FramesID
: DWORD
; Loop
: Boolean; Speed
: Byte);
608 FWidth
:= FramesArray
[ID
].FrameWidth
;
609 FHeight
:= FramesArray
[ID
].FrameHeight
;
612 destructor TAnimation
.Destroy
;
617 procedure TAnimation
.Draw(X
, Y
: Integer; Mirror
: TMirrorType
);
622 e_DrawAdv(FramesArray
[ID
].TexturesID
[FCurrentFrame
], X
, Y
, FAlpha
,
623 True, FBlending
, 0, nil, Mirror
);
624 //e_DrawQuad(X, Y, X+FramesArray[ID].FrameWidth-1, Y+FramesArray[ID].FrameHeight-1, 0, 255, 0);
627 procedure TAnimation
.Update();
632 FCounter
:= FCounter
+ 1;
634 if FCounter
>= FSpeed
then
635 begin // Îæèäàíèå ìåæäó êàäðàìè çàêîí÷èëîñü
637 begin // Îáðàòíûé ïîðÿäîê êàäðîâ
638 // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå:
639 if FCurrentFrame
= 0 then
640 if Length(FramesArray
[ID
].TexturesID
) * FSpeed
+
641 FCounter
< FMinLength
then
644 FCurrentFrame
:= FCurrentFrame
- 1;
645 FPlayed
:= FCurrentFrame
< 0;
647 // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó:
650 FCurrentFrame
:= High(FramesArray
[ID
].TexturesID
)
652 FCurrentFrame
:= FCurrentFrame
+ 1;
657 begin // Ïðÿìîé ïîðÿäîê êàäðîâ
658 // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå:
659 if FCurrentFrame
= High(FramesArray
[ID
].TexturesID
) then
660 if Length(FramesArray
[ID
].TexturesID
) * FSpeed
+
661 FCounter
< FMinLength
then
664 FCurrentFrame
:= FCurrentFrame
+ 1;
665 FPlayed
:= (FCurrentFrame
> High(FramesArray
[ID
].TexturesID
));
667 // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó:
672 FCurrentFrame
:= FCurrentFrame
- 1;
679 procedure TAnimation
.Reset();
682 FCurrentFrame
:= High(FramesArray
[ID
].TexturesID
)
690 procedure TAnimation
.Disable
;
695 procedure TAnimation
.Enable
;
700 procedure TAnimation
.DrawEx(X
, Y
: Integer; Mirror
: TMirrorType
; RPoint
: TPoint
;
706 e_DrawAdv(FramesArray
[ID
].TexturesID
[FCurrentFrame
], X
, Y
, FAlpha
,
707 True, FBlending
, Angle
, @RPoint
, Mirror
);
710 function TAnimation
.TotalFrames(): Integer;
712 Result
:= Length(FramesArray
[ID
].TexturesID
);
715 procedure TAnimation
.Revert(r
: Boolean);
721 procedure TAnimation
.SaveState(Var Mem
: TBinMemoryWriter
);
728 // Ñèãíàòóðà àíèìàöèè:
729 sig
:= ANIM_SIGNATURE
; // 'ANIM'
731 // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè:
732 Mem
.WriteByte(FCounter
);
734 Mem
.WriteInt(FCurrentFrame
);
735 // Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì:
736 Mem
.WriteBoolean(FPlayed
);
737 // Alpha-êàíàë âñåé òåêñòóðû:
738 Mem
.WriteByte(FAlpha
);
739 // Ðàçìûòèå òåêñòóðû:
740 Mem
.WriteBoolean(FBlending
);
741 // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè:
742 Mem
.WriteByte(FSpeed
);
743 // Çàöèêëåíà ëè àíèìàöèÿ:
744 Mem
.WriteBoolean(FLoop
);
746 Mem
.WriteBoolean(FEnabled
);
747 // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ:
748 Mem
.WriteByte(FMinLength
);
749 // Îáðàòíûé ëè ïîðÿäîê êàäðîâ:
750 Mem
.WriteBoolean(FRevert
);
753 procedure TAnimation
.LoadState(Var Mem
: TBinMemoryReader
);
760 // Ñèãíàòóðà àíèìàöèè:
762 if sig
<> ANIM_SIGNATURE
then // 'ANIM'
764 raise EBinSizeError
.Create('TAnimation.LoadState: Wrong Animation Signature');
766 // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè:
767 Mem
.ReadByte(FCounter
);
769 Mem
.ReadInt(FCurrentFrame
);
770 // Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì:
771 Mem
.ReadBoolean(FPlayed
);
772 // Alpha-êàíàë âñåé òåêñòóðû:
773 Mem
.ReadByte(FAlpha
);
774 // Ðàçìûòèå òåêñòóðû:
775 Mem
.ReadBoolean(FBlending
);
776 // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè:
777 Mem
.ReadByte(FSpeed
);
778 // Çàöèêëåíà ëè àíèìàöèÿ:
779 Mem
.ReadBoolean(FLoop
);
781 Mem
.ReadBoolean(FEnabled
);
782 // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ:
783 Mem
.ReadByte(FMinLength
);
784 // Îáðàòíûé ëè ïîðÿäîê êàäðîâ:
785 Mem
.ReadBoolean(FRevert
);