1 (* Copyright (C) Doom 2D: Forever Developers
3 * This program is free software: you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation, version 3 of the License ONLY.
7 * This program is distributed in the hope that it will be useful,
8 * but WITHOUT ANY WARRANTY; without even the implied warranty of
9 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10 * GNU General Public License for more details.
12 * You should have received a copy of the GNU General Public License
13 * along with this program. If not, see <http://www.gnu.org/licenses/>.
15 {$INCLUDE ../shared/a_modes.inc}
22 {$IFDEF USE_MEMPOOL}mempool
,{$ENDIF}
23 e_graphics
, MAPDEF
, ImagingTypes
, Imaging
, ImagingUtility
;
26 TLevelTexture
= record
27 textureName
: AnsiString;
30 false: (textureID
: LongWord);
31 true: (framesID
: LongWord; framesCount
: Byte; speed
: Byte);
34 TLevelTextureArray
= array of TLevelTexture
;
36 TAnimation
= class{$IFDEF USE_MEMPOOL}(TPoolObject
){$ENDIF}
41 mCounter
: Byte; // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè
42 mSpeed
: Byte; // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè
43 mCurrentFrame
: Integer; // Òåêóùèé êàäð (íà÷èíàÿ ñ 0)
44 mLoop
: Boolean; // Ïåðåõîäèòü íà ïåðâûé êàäð ïîñëå ïîñëåäíåãî?
45 mEnabled
: Boolean; // Ðàáîòà ðàçðåøåíà?
46 mPlayed
: Boolean; // Ïðîèãðàíà âñÿ õîòÿ áû ðàç?
49 mMinLength
: Byte; // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ
50 mRevert
: Boolean; // Ñìåíà êàäðîâ îáðàòíàÿ?
53 constructor Create (aframesID
: LongWord; aloop
: Boolean; aspeed
: Byte);
54 destructor Destroy (); override;
56 procedure draw (x
, y
: Integer; mirror
: TMirrorType
);
57 procedure drawEx (x
, y
: Integer; mirror
: TMirrorType
; rpoint
: TDFPoint
; angle
: SmallInt);
63 procedure revert (r
: Boolean);
65 procedure saveState (st
: TStream
);
66 procedure loadState (st
: TStream
);
68 function totalFrames (): Integer; inline;
71 property played
: Boolean read mPlayed
;
72 property enabled
: Boolean read mEnabled
;
73 property isReverse
: Boolean read mRevert
;
74 property loop
: Boolean read mLoop write mLoop
;
75 property speed
: Byte read mSpeed write mSpeed
;
76 property minLength
: Byte read mMinLength write mMinLength
;
77 property currentFrame
: Integer read mCurrentFrame write mCurrentFrame
;
78 property currentCounter
: Byte read mCounter write mCounter
;
79 property counter
: Byte read mCounter
;
80 property blending
: Boolean read mBlending write mBlending
;
81 property alpha
: Byte read mAlpha write mAlpha
;
82 property framesId
: LongWord read mId
;
83 property width
: Word read mWidth
;
84 property height
: Word read mHeight
;
88 function g_Texture_CreateWAD (var ID
: LongWord; const Resource
: AnsiString): Boolean;
89 function g_Texture_CreateFile (var ID
: LongWord; const FileName
: AnsiString): Boolean;
90 function g_Texture_CreateWADEx (const textureName
, Resource
: AnsiString): Boolean;
91 function g_Texture_CreateFileEx (const textureName
, FileName
: AnsiString): Boolean;
92 function g_Texture_Get (const textureName
: AnsiString; var ID
: LongWord): Boolean;
93 function g_Texture_GetSize (const textureName
: AnsiString; var w
, h
: Integer): Boolean; overload
;
94 function g_Texture_GetSize (ID
: LongWord; var w
, h
: Integer): Boolean; overload
;
95 procedure g_Texture_Delete (const textureName
: AnsiString);
96 procedure g_Texture_DeleteAll ();
98 function g_CreateFramesImg (ia
: TDynImageDataArray
; ID
: PDWORD
; const Name
: AnsiString; BackAnimation
: Boolean=false): Boolean;
100 function g_Frames_CreateWAD (ID
: PDWORD
; const Name
, Resource
: AnsiString; mWidth
, mHeight
, mCount
: Word; BackAnimation
: Boolean=false): Boolean;
101 function g_Frames_CreateFile (ID
: PDWORD
; const Name
, FileName
: AnsiString; mWidth
, mHeight
, mCount
: Word; BackAnimation
: Boolean=false): Boolean;
102 function g_Frames_CreateMemory (ID
: PDWORD
; const Name
: AnsiString; pData
: Pointer; dataSize
: LongInt;
103 mWidth
, mHeight
, mCount
: Word; BackAnimation
: Boolean=false): Boolean;
104 function g_Frames_Dup (const NewName
, OldName
: AnsiString): Boolean;
105 //function g_Frames_CreateRevert(ID: PDWORD; Name: ShortString; Frames: string): Boolean;
106 function g_Frames_Get (out ID
: LongWord; const FramesName
: AnsiString): Boolean;
107 function g_Frames_GetTexture (out ID
: LongWord; const FramesName
: AnsiString; Frame
: Word): Boolean;
108 function g_Frames_Exists (const FramesName
: AnsiString): Boolean;
109 procedure g_Frames_DeleteByName (const FramesName
: AnsiString);
110 procedure g_Frames_DeleteByID (ID
: LongWord);
111 procedure g_Frames_DeleteAll ();
113 procedure DumpTextureNames ();
115 function g_Texture_Light (): Integer;
121 {$INCLUDE ../nogl/noGLuses.inc}
122 g_game
, e_log
, g_basic
, g_console
, wadreader
,
123 g_language
, utils
, xstreams
;
134 texturesID
: array of LongWord;
136 frameWidth
, frameHeight
: Word;
141 texturesArray
: array of _TTexture
= nil;
142 framesArray
: array of TFrames
= nil;
146 ANIM_SIGNATURE
= $4D494E41; // 'ANIM'
149 function allocTextureSlot (): LongWord;
153 for f
:= 0 to High(texturesArray
) do
155 if (not texturesArray
[f
].used
) then
162 result
:= Length(texturesArray
);
163 SetLength(texturesArray
, result
+64);
164 for f
:= result
to High(texturesArray
) do
166 with texturesArray
[f
] do
178 function allocFrameSlot (): LongWord;
182 for f
:= 0 to High(framesArray
) do
184 if (not framesArray
[f
].used
) then
191 result
:= Length(framesArray
);
192 SetLength(framesArray
, result
+64);
193 for f
:= result
to High(framesArray
) do
195 with framesArray
[f
] do
207 // ////////////////////////////////////////////////////////////////////////// //
208 function g_Texture_CreateWAD (var ID
: LongWord; const Resource
: AnsiString): Boolean;
211 FileName
: AnsiString;
212 TextureData
: Pointer;
213 ResourceLength
: Integer;
216 FileName
:= g_ExtractWadName(Resource
);
218 WAD
:= TWADFile
.Create
;
219 WAD
.ReadFile(FileName
);
221 if WAD
.GetResource(g_ExtractFilePathName(Resource
), TextureData
, ResourceLength
) then
223 if e_CreateTextureMem(TextureData
, ResourceLength
, ID
) then
229 e_WriteLog(Format('Error loading texture %s', [Resource
]), TMsgType
.Warning
);
230 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
236 function g_Texture_CreateFile (var ID
: LongWord; const FileName
: AnsiString): Boolean;
239 if not e_CreateTexture(FileName
, ID
) then
241 e_WriteLog(Format('Error loading texture %s', [FileName
]), TMsgType
.Warning
);
247 function g_Texture_CreateWADEx (const textureName
, Resource
: AnsiString): Boolean;
250 FileName
: AnsiString;
251 TextureData
: Pointer;
253 ResourceLength
: Integer;
255 FileName
:= g_ExtractWadName(Resource
);
257 find_id
:= allocTextureSlot();
259 WAD
:= TWADFile
.Create
;
260 WAD
.ReadFile(FileName
);
262 if WAD
.GetResource(g_ExtractFilePathName(Resource
), TextureData
, ResourceLength
) then
264 result
:= e_CreateTextureMem(TextureData
, ResourceLength
, texturesArray
[find_id
].ID
);
267 e_GetTextureSize(texturesArray
[find_id
].ID
, @texturesArray
[find_id
].width
, @texturesArray
[find_id
].height
);
268 texturesArray
[find_id
].used
:= true;
269 texturesArray
[find_id
].Name
:= textureName
;
275 e_WriteLog(Format('Error loading texture %s', [Resource
]), TMsgType
.Warning
);
276 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
283 function g_Texture_CreateFileEx (const textureName
, FileName
: AnsiString): Boolean;
287 find_id
:= allocTextureSlot();
288 result
:= e_CreateTexture(FileName
, texturesArray
[find_id
].ID
);
291 texturesArray
[find_id
].used
:= true;
292 texturesArray
[find_id
].Name
:= textureName
;
293 e_GetTextureSize(texturesArray
[find_id
].ID
, @texturesArray
[find_id
].width
, @texturesArray
[find_id
].height
);
295 else e_WriteLog(Format('Error loading texture %s', [FileName
]), TMsgType
.Warning
);
299 function g_Texture_Get (const textureName
: AnsiString; var id
: LongWord): Boolean;
304 if (Length(texturesArray
) = 0) or (Length(textureName
) = 0) then exit
;
305 for a
:= 0 to High(texturesArray
) do
307 if (StrEquCI1251(texturesArray
[a
].name
, textureName
)) then
309 id
:= texturesArray
[a
].id
;
314 //if not Result then g_ConsoleAdd('Texture '+TextureName+' not found');
318 function g_Texture_GetSize (const textureName
: AnsiString; var w
, h
: Integer): Boolean; overload
;
325 if (Length(texturesArray
) = 0) or (Length(textureName
) = 0) then exit
;
326 for a
:= 0 to High(texturesArray
) do
328 if (StrEquCI1251(texturesArray
[a
].name
, textureName
)) then
330 w
:= texturesArray
[a
].width
;
331 h
:= texturesArray
[a
].height
;
339 function g_Texture_GetSize (ID
: LongWord; var w
, h
: Integer): Boolean; overload
;
346 if (Length(texturesArray
) = 0) then exit
;
347 for a
:= 0 to High(texturesArray
) do
349 if (texturesArray
[a
].id
= ID
) then
351 w
:= texturesArray
[a
].width
;
352 h
:= texturesArray
[a
].height
;
360 procedure g_Texture_Delete (const textureName
: AnsiString);
364 if (Length(texturesArray
) = 0) or (Length(textureName
) = 0) then exit
;
365 for a
:= 0 to High(texturesArray
) do
367 if (StrEquCI1251(texturesArray
[a
].name
, textureName
)) then
369 e_DeleteTexture(texturesArray
[a
].ID
);
370 texturesArray
[a
].used
:= false;
371 texturesArray
[a
].name
:= '';
372 texturesArray
[a
].id
:= 0;
373 texturesArray
[a
].width
:= 0;
374 texturesArray
[a
].height
:= 0;
380 procedure g_Texture_DeleteAll ();
384 for a
:= 0 to High(texturesArray
) do
386 if (texturesArray
[a
].used
) then e_DeleteTexture(texturesArray
[a
].ID
);
388 texturesArray
:= nil;
392 function g_Frames_CreateFile (ID
: PDWORD
; const Name
, FileName
: AnsiString;
393 mWidth
, mHeight
, mCount
: Word; BackAnimation
: Boolean = false): Boolean;
400 find_id
:= allocFrameSlot();
402 if (mCount
<= 2) then BackAnimation
:= false;
404 if BackAnimation
then SetLength(framesArray
[find_id
].TexturesID
, mCount
+mCount
-2)
405 else SetLength(framesArray
[find_id
].TexturesID
, mCount
);
407 for a
:= 0 to mCount
-1 do
409 if not e_CreateTextureEx(FileName
, framesArray
[find_id
].TexturesID
[a
], a
*mWidth
, 0, mWidth
, mHeight
) then exit
;
412 if BackAnimation
then
414 for a
:= 1 to mCount
-2 do framesArray
[find_id
].TexturesID
[mCount
+mCount
-2-a
] := framesArray
[find_id
].TexturesID
[a
];
417 framesArray
[find_id
].used
:= true;
418 framesArray
[find_id
].FrameWidth
:= mWidth
;
419 framesArray
[find_id
].FrameHeight
:= mHeight
;
420 if (Name
<> '') then framesArray
[find_id
].Name
:= Name
else framesArray
[find_id
].Name
:= '<noname>';
422 if (ID
<> nil) then ID
^ := find_id
;
428 function CreateFramesMem (pData
: Pointer; dataSize
: LongInt; ID
: PDWORD
; Name
: AnsiString;
429 mWidth
, mHeight
, mCount
: Word; BackAnimation
: Boolean = false): Boolean;
436 find_id
:= allocFrameSlot();
438 if (mCount
<= 2) then BackAnimation
:= false;
440 if BackAnimation
then SetLength(framesArray
[find_id
].TexturesID
, mCount
+mCount
-2)
441 else SetLength(framesArray
[find_id
].TexturesID
, mCount
);
443 for a
:= 0 to mCount
-1 do
444 if not e_CreateTextureMemEx(pData
, dataSize
, framesArray
[find_id
].TexturesID
[a
], a
*mWidth
, 0, mWidth
, mHeight
) then
450 if BackAnimation
then
452 for a
:= 1 to mCount
-2 do framesArray
[find_id
].TexturesID
[mCount
+mCount
-2-a
] := framesArray
[find_id
].TexturesID
[a
];
455 framesArray
[find_id
].used
:= true;
456 framesArray
[find_id
].FrameWidth
:= mWidth
;
457 framesArray
[find_id
].FrameHeight
:= mHeight
;
458 if (Name
<> '') then framesArray
[find_id
].Name
:= Name
else framesArray
[find_id
].Name
:= '<noname>';
460 if (ID
<> nil) then ID
^ := find_id
;
466 function g_CreateFramesImg (ia
: TDynImageDataArray
; ID
: PDWORD
; const Name
: AnsiString; BackAnimation
: Boolean = false): Boolean;
472 find_id
:= allocFrameSlot();
474 mCount
:= Length(ia
);
476 //e_WriteLog(Format('+++ creating %d frames [%s]', [FCount, Name]), MSG_NOTIFY);
478 if (mCount
< 1) then exit
;
479 if (mCount
<= 2) then BackAnimation
:= false;
481 if BackAnimation
then SetLength(framesArray
[find_id
].TexturesID
, mCount
+mCount
-2)
482 else SetLength(framesArray
[find_id
].TexturesID
, mCount
);
484 //e_WriteLog(Format('+++ creating %d frames, %dx%d', [FCount, ia[0].width, ia[0].height]), MSG_NOTIFY);
486 for a
:= 0 to mCount
-1 do
488 if not e_CreateTextureImg(ia
[a
], framesArray
[find_id
].TexturesID
[a
]) then exit
;
489 //e_WriteLog(Format('+++ frame %d, %dx%d', [a, ia[a].width, ia[a].height]), MSG_NOTIFY);
492 if BackAnimation
then
494 for a
:= 1 to mCount
-2 do framesArray
[find_id
].TexturesID
[mCount
+mCount
-2-a
] := framesArray
[find_id
].TexturesID
[a
];
497 framesArray
[find_id
].used
:= true;
498 framesArray
[find_id
].FrameWidth
:= ia
[0].width
;
499 framesArray
[find_id
].FrameHeight
:= ia
[0].height
;
500 if (Name
<> '') then framesArray
[find_id
].Name
:= Name
else framesArray
[find_id
].Name
:= '<noname>';
502 if (ID
<> nil) then ID
^ := find_id
;
508 function g_Frames_CreateWAD (ID
: PDWORD
; const Name
, Resource
: AnsiString;
509 mWidth
, mHeight
, mCount
: Word; BackAnimation
: Boolean=false): Boolean;
512 FileName
: AnsiString;
513 TextureData
: Pointer;
514 ResourceLength
: Integer;
518 // models without "advanced" animations asks for "nothing" like this; don't spam log
519 if (Length(Resource
) > 0) and ((Resource
[Length(Resource
)] = '/') or (Resource
[Length(Resource
)] = '\')) then exit
;
521 FileName
:= g_ExtractWadName(Resource
);
523 WAD
:= TWADFile
.Create();
524 WAD
.ReadFile(FileName
);
526 if not WAD
.GetResource(g_ExtractFilePathName(Resource
), TextureData
, ResourceLength
) then
529 e_WriteLog(Format('Error loading texture %s', [Resource
]), TMsgType
.Warning
);
530 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
534 if not CreateFramesMem(TextureData
, ResourceLength
, ID
, Name
, mWidth
, mHeight
, mCount
, BackAnimation
) then
536 FreeMem(TextureData
);
541 FreeMem(TextureData
);
548 function g_Frames_CreateMemory (ID
: PDWORD
; const Name
: AnsiString; pData
: Pointer; dataSize
: LongInt;
549 mWidth
, mHeight
, mCount
: Word; BackAnimation
: Boolean = false): Boolean;
551 result
:= CreateFramesMem(pData
, dataSize
, ID
, Name
, mWidth
, mHeight
, mCount
, BackAnimation
);
555 {function g_Frames_CreateRevert(ID: PDWORD; Name: ShortString; Frames: string): Boolean;
562 if not g_Frames_Get(b, Frames) then Exit;
564 find_id := FindFrame();
566 FramesArray[find_id].Name := Name;
567 FramesArray[find_id].FrameWidth := FramesArray[b].FrameWidth;
568 FramesArray[find_id].FrameHeight := FramesArray[b].FrameHeight;
570 c := High(FramesArray[find_id].TexturesID);
573 FramesArray[find_id].TexturesID[a] := FramesArray[b].TexturesID[c-a];
579 function g_Frames_Dup (const NewName
, OldName
: AnsiString): Boolean;
581 find_id
, b
: LongWord;
586 if not g_Frames_Get(b
, OldName
) then exit
;
588 find_id
:= allocFrameSlot();
590 framesArray
[find_id
].used
:= true;
591 framesArray
[find_id
].Name
:= NewName
;
592 framesArray
[find_id
].FrameWidth
:= framesArray
[b
].FrameWidth
;
593 framesArray
[find_id
].FrameHeight
:= framesArray
[b
].FrameHeight
;
595 c
:= High(framesArray
[b
].TexturesID
);
596 SetLength(framesArray
[find_id
].TexturesID
, c
+1);
598 for a
:= 0 to c
do framesArray
[find_id
].TexturesID
[a
] := framesArray
[b
].TexturesID
[a
];
604 procedure g_Frames_DeleteByName (const FramesName
: AnsiString);
608 if (Length(framesArray
) = 0) then exit
;
609 for a
:= 0 to High(framesArray
) do
611 if (StrEquCI1251(framesArray
[a
].Name
, FramesName
)) then
613 if framesArray
[a
].TexturesID
<> nil then
615 for b
:= 0 to High(framesArray
[a
].TexturesID
) do e_DeleteTexture(framesArray
[a
].TexturesID
[b
]);
617 framesArray
[a
].used
:= false;
618 framesArray
[a
].TexturesID
:= nil;
619 framesArray
[a
].Name
:= '';
620 framesArray
[a
].FrameWidth
:= 0;
621 framesArray
[a
].FrameHeight
:= 0;
627 procedure g_Frames_DeleteByID (ID
: LongWord);
631 if (Length(framesArray
) = 0) then exit
;
632 if (framesArray
[ID
].TexturesID
<> nil) then
634 for b
:= 0 to High(framesArray
[ID
].TexturesID
) do e_DeleteTexture(framesArray
[ID
].TexturesID
[b
]);
636 framesArray
[ID
].used
:= false;
637 framesArray
[ID
].TexturesID
:= nil;
638 framesArray
[ID
].Name
:= '';
639 framesArray
[ID
].FrameWidth
:= 0;
640 framesArray
[ID
].FrameHeight
:= 0;
644 procedure g_Frames_DeleteAll ();
648 for a
:= 0 to High(framesArray
) do
650 if (framesArray
[a
].used
) then
652 for b
:= 0 to High(framesArray
[a
].TexturesID
) do e_DeleteTexture(framesArray
[a
].TexturesID
[b
]);
654 framesArray
[a
].used
:= false;
655 framesArray
[a
].TexturesID
:= nil;
656 framesArray
[a
].Name
:= '';
657 framesArray
[a
].FrameWidth
:= 0;
658 framesArray
[a
].FrameHeight
:= 0;
664 function g_Frames_Get (out ID
: LongWord; const FramesName
: AnsiString): Boolean;
669 if (Length(framesArray
) = 0) then exit
;
670 for a
:= 0 to High(framesArray
) do
672 if (StrEquCI1251(framesArray
[a
].Name
, FramesName
)) then
679 if not result
then g_FatalError(Format(_lc
[I_GAME_ERROR_FRAMES
], [FramesName
]));
683 function g_Frames_GetTexture (out ID
: LongWord; const FramesName
: AnsiString; Frame
: Word): Boolean;
688 if (Length(framesArray
) = 0) then exit
;
689 for a
:= 0 to High(framesArray
) do
691 if (StrEquCI1251(framesArray
[a
].Name
, FramesName
)) then
693 if (Frame
< Length(framesArray
[a
].TexturesID
)) then
695 ID
:= framesArray
[a
].TexturesID
[Frame
];
701 if not result
then g_FatalError(Format(_lc
[I_GAME_ERROR_FRAMES
], [FramesName
]));
705 function g_Frames_Exists (const FramesName
: AnsiString): Boolean;
710 if (Length(framesArray
) = 0) then exit
;
711 for a
:= 0 to High(framesArray
) do
713 if (StrEquCI1251(framesArray
[a
].Name
, FramesName
)) then
722 procedure DumpTextureNames ();
726 e_WriteLog('BEGIN Textures:', TMsgType
.Notify
);
727 for i
:= 0 to High(texturesArray
) do e_WriteLog(' '+IntToStr(i
)+'. '+texturesArray
[i
].Name
, TMsgType
.Notify
);
728 e_WriteLog('END Textures.', TMsgType
.Notify
);
730 e_WriteLog('BEGIN Frames:', TMsgType
.Notify
);
731 for i
:= 0 to High(framesArray
) do e_WriteLog(' '+IntToStr(i
)+'. '+framesArray
[i
].Name
, TMsgType
.Notify
);
732 e_WriteLog('END Frames.', TMsgType
.Notify
);
738 constructor TAnimation
.Create (aframesID
: LongWord; aloop
: Boolean; aspeed
: Byte);
740 if (aframesID
>= Length(framesArray
)) then
742 //raise Exception.Create('trying to create inexisting frame: something is very wrong here');
743 e_LogWritefln('trying to create inexisting frame %u of %u: something is very wrong here', [aframesID
, LongWord(Length(framesArray
))], TMsgType
.Warning
);
745 if (Length(framesArray
) = 0) then raise Exception
.Create('trying to create inexisting frame: something is very wrong here');
755 mWidth
:= framesArray
[mId
].FrameWidth
;
756 mHeight
:= framesArray
[mId
].FrameHeight
;
760 destructor TAnimation
.Destroy ();
766 procedure TAnimation
.draw (x
, y
: Integer; mirror
: TMirrorType
);
768 if (not mEnabled
) then exit
;
769 e_DrawAdv(framesArray
[mId
].TexturesID
[mCurrentFrame
], x
, y
, mAlpha
, true, mBlending
, 0, nil, mirror
);
770 //e_DrawQuad(X, Y, X+FramesArray[ID].FrameWidth-1, Y+FramesArray[ID].FrameHeight-1, 0, 255, 0);
774 procedure TAnimation
.update ();
776 if (not mEnabled
) then exit
;
780 if (mCounter
>= mSpeed
) then
782 // Îæèäàíèå ìåæäó êàäðàìè çàêîí÷èëîñü
783 // Îáðàòíûé ïîðÿäîê êàäðîâ?
786 // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå
787 if (mCurrentFrame
= 0) then
789 if (Length(framesArray
[mId
].TexturesID
)*mSpeed
+mCounter
< mMinLength
) then exit
;
793 mPlayed
:= (mCurrentFrame
< 0);
795 // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó?
798 if mLoop
then mCurrentFrame
:= High(framesArray
[mId
].TexturesID
) else mCurrentFrame
+= 1;
805 // Ïðÿìîé ïîðÿäîê êàäðîâ
806 // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå
807 if (mCurrentFrame
= High(framesArray
[mId
].TexturesID
)) then
809 if (Length(framesArray
[mId
].TexturesID
)*mSpeed
+mCounter
< mMinLength
) then exit
;
813 mPlayed
:= (mCurrentFrame
> High(framesArray
[mId
].TexturesID
));
815 // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó?
818 if mLoop
then mCurrentFrame
:= 0 else mCurrentFrame
-= 1;
827 procedure TAnimation
.reset ();
829 if mRevert
then mCurrentFrame
:= High(framesArray
[mId
].TexturesID
) else mCurrentFrame
:= 0;
835 procedure TAnimation
.disable (); begin mEnabled
:= false; end;
836 procedure TAnimation
.enable (); begin mEnabled
:= true; end;
839 procedure TAnimation
.drawEx (x
, y
: Integer; mirror
: TMirrorType
; rpoint
: TDFPoint
; angle
: SmallInt);
841 if (not mEnabled
) then exit
;
842 e_DrawAdv(framesArray
[mId
].TexturesID
[mCurrentFrame
], x
, y
, mAlpha
, true, mBlending
, angle
, @rpoint
, mirror
);
846 function TAnimation
.totalFrames (): Integer; inline; begin result
:= Length(framesArray
[mId
].TexturesID
); end;
849 procedure TAnimation
.revert (r
: Boolean);
856 procedure TAnimation
.saveState (st
: TStream
);
858 if (st
= nil) then exit
;
860 utils
.writeSign(st
, 'ANIM');
861 utils
.writeInt(st
, Byte(0)); // version
862 // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè
863 utils
.writeInt(st
, Byte(mCounter
));
865 utils
.writeInt(st
, LongInt(mCurrentFrame
));
866 // Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì
867 utils
.writeBool(st
, mPlayed
);
868 // Alpha-êàíàë âñåé òåêñòóðû
869 utils
.writeInt(st
, Byte(mAlpha
));
871 utils
.writeInt(st
, Byte(mBlending
));
872 // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè
873 utils
.writeInt(st
, Byte(mSpeed
));
874 // Çàöèêëåíà ëè àíèìàöèÿ
875 utils
.writeBool(st
, mLoop
);
877 utils
.writeBool(st
, mEnabled
);
878 // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ
879 utils
.writeInt(st
, Byte(mMinLength
));
880 // Îáðàòíûé ëè ïîðÿäîê êàäðîâ
881 utils
.writeBool(st
, mRevert
);
885 procedure TAnimation
.loadState (st
: TStream
);
887 if (st
= nil) then exit
;
889 if not utils
.checkSign(st
, 'ANIM') then raise XStreamError
.Create('animation chunk expected');
890 if (utils
.readByte(st
) <> 0) then raise XStreamError
.Create('invalid animation chunk version');
891 // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè
892 mCounter
:= utils
.readByte(st
);
894 mCurrentFrame
:= utils
.readLongInt(st
);
895 // Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì
896 mPlayed
:= utils
.readBool(st
);
897 // Alpha-êàíàë âñåé òåêñòóðû
898 mAlpha
:= utils
.readByte(st
);
900 mBlending
:= utils
.readBool(st
);
901 // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè
902 mSpeed
:= utils
.readByte(st
);
903 // Çàöèêëåíà ëè àíèìàöèÿ
904 mLoop
:= utils
.readBool(st
);
906 mEnabled
:= utils
.readBool(st
);
907 // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ
908 mMinLength
:= utils
.readByte(st
);
909 // Îáðàòíûé ëè ïîðÿäîê êàäðîâ
910 mRevert
:= utils
.readBool(st
);
914 // ////////////////////////////////////////////////////////////////////////// //
918 function g_Texture_Light (): Integer;
920 Radius
: Integer = 128;
928 GetMem(tex
, (Radius
*2)*(Radius
*2)*4);
930 for y
:= 0 to Radius
*2-1 do
932 for x
:= 0 to Radius
*2-1 do
934 dist
:= 1.0-sqrt((x
-Radius
)*(x
-Radius
)+(y
-Radius
)*(y
-Radius
))/Radius
;
944 //tc.setPixel(x, y, Color(cast(int)(dist*255), cast(int)(dist*255), cast(int)(dist*255)));
945 if (dist
> 0.5) then dist
:= 0.5;
946 a
:= round(dist
*255);
947 if (a
< 0) then a
:= 0 else if (a
> 255) then a
:= 255;
948 tpp
^ := 255; Inc(tpp
);
949 tpp
^ := 255; Inc(tpp
);
950 tpp
^ := 255; Inc(tpp
);
951 tpp
^ := Byte(a
); Inc(tpp
);
956 glGenTextures(1, @ltexid
);
957 //if (tid == 0) assert(0, "VGL: can't create screen texture");
959 glBindTexture(GL_TEXTURE_2D
, ltexid
);
960 glTexParameterf(GL_TEXTURE_2D
, GL_TEXTURE_WRAP_S
, GL_REPEAT
);
961 glTexParameterf(GL_TEXTURE_2D
, GL_TEXTURE_WRAP_T
, GL_REPEAT
);
962 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MIN_FILTER
, GL_LINEAR
);
963 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MAG_FILTER
, GL_LINEAR
);
965 //GLfloat[4] bclr = 0.0;
966 //glTexParameterfv(GL_TEXTURE_2D, GL_TEXTURE_BORDER_COLOR, bclr.ptr);
968 glTexImage2D(GL_TEXTURE_2D
, 0, GL_RGBA
, Radius
*2, Radius
*2, 0, GL_RGBA
{gltt}, GL_UNSIGNED_BYTE
, tex
);