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, either version 3 of the License, or
6 * (at your option) any later version.
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
13 * You should have received a copy of the GNU General Public License
14 * along with this program. If not, see <http://www.gnu.org/licenses/>.
16 {$INCLUDE ../shared/a_modes.inc}
23 {$IFDEF USE_MEMPOOL}mempool
,{$ENDIF}
24 e_graphics
, MAPDEF
, ImagingTypes
, Imaging
, ImagingUtility
;
27 TLevelTexture
= record
28 textureName
: AnsiString;
31 false: (textureID
: LongWord);
32 true: (framesID
: LongWord; framesCount
: Byte; speed
: Byte);
35 TLevelTextureArray
= array of TLevelTexture
;
37 TAnimation
= class{$IFDEF USE_MEMPOOL}(TPoolObject
){$ENDIF}
42 mCounter
: Byte; // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè
43 mSpeed
: Byte; // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè
44 mCurrentFrame
: Integer; // Òåêóùèé êàäð (íà÷èíàÿ ñ 0)
45 mLoop
: Boolean; // Ïåðåõîäèòü íà ïåðâûé êàäð ïîñëå ïîñëåäíåãî?
46 mEnabled
: Boolean; // Ðàáîòà ðàçðåøåíà?
47 mPlayed
: Boolean; // Ïðîèãðàíà âñÿ õîòÿ áû ðàç?
50 mMinLength
: Byte; // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ
51 mRevert
: Boolean; // Ñìåíà êàäðîâ îáðàòíàÿ?
54 constructor Create (aframesID
: LongWord; aloop
: Boolean; aspeed
: Byte);
55 destructor Destroy (); override;
57 procedure draw (x
, y
: Integer; mirror
: TMirrorType
);
58 procedure drawEx (x
, y
: Integer; mirror
: TMirrorType
; rpoint
: TDFPoint
; angle
: SmallInt);
64 procedure revert (r
: Boolean);
66 procedure saveState (st
: TStream
);
67 procedure loadState (st
: TStream
);
69 function totalFrames (): Integer; inline;
72 property played
: Boolean read mPlayed
;
73 property enabled
: Boolean read mEnabled
;
74 property isReverse
: Boolean read mRevert
;
75 property loop
: Boolean read mLoop write mLoop
;
76 property speed
: Byte read mSpeed write mSpeed
;
77 property minLength
: Byte read mMinLength write mMinLength
;
78 property currentFrame
: Integer read mCurrentFrame write mCurrentFrame
;
79 property currentCounter
: Byte read mCounter write mCounter
;
80 property counter
: Byte read mCounter
;
81 property blending
: Boolean read mBlending write mBlending
;
82 property alpha
: Byte read mAlpha write mAlpha
;
83 property framesId
: LongWord read mId
;
84 property width
: Word read mWidth
;
85 property height
: Word read mHeight
;
89 function g_Texture_CreateWAD (var ID
: LongWord; const Resource
: AnsiString): Boolean;
90 function g_Texture_CreateFile (var ID
: LongWord; const FileName
: AnsiString): Boolean;
91 function g_Texture_CreateWADEx (const textureName
, Resource
: AnsiString; const altrsrc
: AnsiString=''): Boolean;
92 function g_Texture_CreateFileEx (const textureName
, FileName
: AnsiString): Boolean;
93 function g_Texture_Get (const textureName
: AnsiString; var ID
: LongWord): Boolean;
94 procedure g_Texture_Delete (const textureName
: AnsiString);
95 procedure g_Texture_DeleteAll ();
97 function g_CreateFramesImg (ia
: TDynImageDataArray
; ID
: PDWORD
; const Name
: AnsiString; BackAnimation
: Boolean=false): Boolean;
99 function g_Frames_CreateWAD (ID
: PDWORD
; const Name
, Resource
: AnsiString; mWidth
, mHeight
, mCount
: Word; BackAnimation
: Boolean=false): Boolean;
100 function g_Frames_CreateFile (ID
: PDWORD
; const Name
, FileName
: AnsiString; mWidth
, mHeight
, mCount
: Word; BackAnimation
: Boolean=false): Boolean;
101 function g_Frames_CreateMemory (ID
: PDWORD
; const Name
: AnsiString; pData
: Pointer; dataSize
: LongInt;
102 mWidth
, mHeight
, mCount
: Word; BackAnimation
: Boolean=false): Boolean;
103 function g_Frames_Dup (const NewName
, OldName
: AnsiString): Boolean;
104 //function g_Frames_CreateRevert(ID: PDWORD; Name: ShortString; Frames: string): Boolean;
105 function g_Frames_Get (out ID
: LongWord; const FramesName
: AnsiString): Boolean;
106 function g_Frames_GetTexture (out ID
: LongWord; const FramesName
: AnsiString; Frame
: Word): Boolean;
107 function g_Frames_Exists (const FramesName
: AnsiString): Boolean;
108 procedure g_Frames_DeleteByName (const FramesName
: AnsiString);
109 procedure g_Frames_DeleteByID (ID
: LongWord);
110 procedure g_Frames_DeleteAll ();
112 procedure DumpTextureNames ();
114 function g_Texture_Light (): Integer;
120 g_game
, e_log
, g_basic
, g_console
, wadreader
,
121 g_language
, GL
, utils
, xstreams
;
132 texturesID
: array of LongWord;
134 frameWidth
, frameHeight
: Word;
139 texturesArray
: array of _TTexture
= nil;
140 framesArray
: array of TFrames
= nil;
144 ANIM_SIGNATURE
= $4D494E41; // 'ANIM'
147 function allocTextureSlot (): LongWord;
151 for f
:= 0 to High(texturesArray
) do
153 if (not texturesArray
[f
].used
) then
160 result
:= Length(texturesArray
);
161 SetLength(texturesArray
, result
+64);
162 for f
:= result
to High(texturesArray
) do
164 with texturesArray
[f
] do
176 function allocFrameSlot (): LongWord;
180 for f
:= 0 to High(framesArray
) do
182 if (not framesArray
[f
].used
) then
189 result
:= Length(framesArray
);
190 SetLength(framesArray
, result
+64);
191 for f
:= result
to High(framesArray
) do
193 with framesArray
[f
] do
205 // ////////////////////////////////////////////////////////////////////////// //
206 function g_Texture_CreateWAD (var ID
: LongWord; const Resource
: AnsiString): Boolean;
209 FileName
: AnsiString;
210 TextureData
: Pointer;
211 ResourceLength
: Integer;
214 FileName
:= g_ExtractWadName(Resource
);
216 WAD
:= TWADFile
.Create
;
217 WAD
.ReadFile(FileName
);
219 if WAD
.GetResource(g_ExtractFilePathName(Resource
), TextureData
, ResourceLength
) then
221 if e_CreateTextureMem(TextureData
, ResourceLength
, ID
) then
227 FreeMem(TextureData
);
232 e_WriteLog(Format('Error loading texture %s', [Resource
]), TMsgType
.Warning
);
233 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
239 function g_Texture_CreateFile (var ID
: LongWord; const FileName
: AnsiString): Boolean;
242 if not e_CreateTexture(FileName
, ID
) then
244 e_WriteLog(Format('Error loading texture %s', [FileName
]), TMsgType
.Warning
);
250 function texture_CreateWADExInternal (const textureName
, Resource
: AnsiString; showmsg
: Boolean): Boolean;
253 FileName
: AnsiString;
254 TextureData
: Pointer;
256 ResourceLength
: Integer;
258 FileName
:= g_ExtractWadName(Resource
);
260 find_id
:= allocTextureSlot();
262 WAD
:= TWADFile
.Create
;
263 WAD
.ReadFile(FileName
);
265 if WAD
.GetResource(g_ExtractFilePathName(Resource
), TextureData
, ResourceLength
) then
267 result
:= e_CreateTextureMem(TextureData
, ResourceLength
, texturesArray
[find_id
].ID
);
270 e_GetTextureSize(texturesArray
[find_id
].ID
, @texturesArray
[find_id
].width
, @texturesArray
[find_id
].height
);
271 texturesArray
[find_id
].used
:= true;
272 texturesArray
[find_id
].Name
:= textureName
;
276 FreeMem(TextureData
);
283 e_WriteLog(Format('Error loading texture %s', [Resource
]), TMsgType
.Warning
);
285 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
292 function g_Texture_CreateWADEx (const textureName
, Resource
: AnsiString; const altrsrc
: AnsiString=''): Boolean;
294 if (Length(altrsrc
) > 0) then
296 result
:= texture_CreateWADExInternal(textureName
, altrsrc
, false);
299 result
:= texture_CreateWADExInternal(textureName
, Resource
, true);
303 function g_Texture_CreateFileEx (const textureName
, FileName
: AnsiString): Boolean;
307 find_id
:= allocTextureSlot();
308 result
:= e_CreateTexture(FileName
, texturesArray
[find_id
].ID
);
311 texturesArray
[find_id
].used
:= true;
312 texturesArray
[find_id
].Name
:= textureName
;
313 e_GetTextureSize(texturesArray
[find_id
].ID
, @texturesArray
[find_id
].width
, @texturesArray
[find_id
].height
);
315 else e_WriteLog(Format('Error loading texture %s', [FileName
]), TMsgType
.Warning
);
319 function g_Texture_Get (const textureName
: AnsiString; var id
: LongWord): Boolean;
324 if (Length(texturesArray
) = 0) or (Length(textureName
) = 0) then exit
;
325 for a
:= 0 to High(texturesArray
) do
327 if (StrEquCI1251(texturesArray
[a
].name
, textureName
)) then
329 id
:= texturesArray
[a
].id
;
334 //if not Result then g_ConsoleAdd('Texture '+TextureName+' not found');
338 procedure g_Texture_Delete (const textureName
: AnsiString);
342 if (Length(texturesArray
) = 0) or (Length(textureName
) = 0) then exit
;
343 for a
:= 0 to High(texturesArray
) do
345 if (StrEquCI1251(texturesArray
[a
].name
, textureName
)) then
347 e_DeleteTexture(texturesArray
[a
].ID
);
348 texturesArray
[a
].used
:= false;
349 texturesArray
[a
].name
:= '';
350 texturesArray
[a
].id
:= 0;
351 texturesArray
[a
].width
:= 0;
352 texturesArray
[a
].height
:= 0;
358 procedure g_Texture_DeleteAll ();
362 for a
:= 0 to High(texturesArray
) do
364 if (texturesArray
[a
].used
) then e_DeleteTexture(texturesArray
[a
].ID
);
366 texturesArray
:= nil;
370 function g_Frames_CreateFile (ID
: PDWORD
; const Name
, FileName
: AnsiString;
371 mWidth
, mHeight
, mCount
: Word; BackAnimation
: Boolean = false): Boolean;
378 find_id
:= allocFrameSlot();
380 if (mCount
<= 2) then BackAnimation
:= false;
382 if BackAnimation
then SetLength(framesArray
[find_id
].TexturesID
, mCount
+mCount
-2)
383 else SetLength(framesArray
[find_id
].TexturesID
, mCount
);
385 for a
:= 0 to mCount
-1 do
387 if not e_CreateTextureEx(FileName
, framesArray
[find_id
].TexturesID
[a
], a
*mWidth
, 0, mWidth
, mHeight
) then exit
;
390 if BackAnimation
then
392 for a
:= 1 to mCount
-2 do framesArray
[find_id
].TexturesID
[mCount
+mCount
-2-a
] := framesArray
[find_id
].TexturesID
[a
];
395 framesArray
[find_id
].used
:= true;
396 framesArray
[find_id
].FrameWidth
:= mWidth
;
397 framesArray
[find_id
].FrameHeight
:= mHeight
;
398 if (Name
<> '') then framesArray
[find_id
].Name
:= Name
else framesArray
[find_id
].Name
:= '<noname>';
400 if (ID
<> nil) then ID
^ := find_id
;
406 function CreateFramesMem (pData
: Pointer; dataSize
: LongInt; ID
: PDWORD
; Name
: AnsiString;
407 mWidth
, mHeight
, mCount
: Word; BackAnimation
: Boolean = false): Boolean;
414 find_id
:= allocFrameSlot();
416 if (mCount
<= 2) then BackAnimation
:= false;
418 if BackAnimation
then SetLength(framesArray
[find_id
].TexturesID
, mCount
+mCount
-2)
419 else SetLength(framesArray
[find_id
].TexturesID
, mCount
);
421 for a
:= 0 to mCount
-1 do
422 if not e_CreateTextureMemEx(pData
, dataSize
, framesArray
[find_id
].TexturesID
[a
], a
*mWidth
, 0, mWidth
, mHeight
) then
428 if BackAnimation
then
430 for a
:= 1 to mCount
-2 do framesArray
[find_id
].TexturesID
[mCount
+mCount
-2-a
] := framesArray
[find_id
].TexturesID
[a
];
433 framesArray
[find_id
].used
:= true;
434 framesArray
[find_id
].FrameWidth
:= mWidth
;
435 framesArray
[find_id
].FrameHeight
:= mHeight
;
436 if (Name
<> '') then framesArray
[find_id
].Name
:= Name
else framesArray
[find_id
].Name
:= '<noname>';
438 if (ID
<> nil) then ID
^ := find_id
;
444 function g_CreateFramesImg (ia
: TDynImageDataArray
; ID
: PDWORD
; const Name
: AnsiString; BackAnimation
: Boolean = false): Boolean;
450 find_id
:= allocFrameSlot();
452 mCount
:= Length(ia
);
454 //e_WriteLog(Format('+++ creating %d frames [%s]', [FCount, Name]), MSG_NOTIFY);
456 if (mCount
< 1) then exit
;
457 if (mCount
<= 2) then BackAnimation
:= false;
459 if BackAnimation
then SetLength(framesArray
[find_id
].TexturesID
, mCount
+mCount
-2)
460 else SetLength(framesArray
[find_id
].TexturesID
, mCount
);
462 //e_WriteLog(Format('+++ creating %d frames, %dx%d', [FCount, ia[0].width, ia[0].height]), MSG_NOTIFY);
464 for a
:= 0 to mCount
-1 do
466 if not e_CreateTextureImg(ia
[a
], framesArray
[find_id
].TexturesID
[a
]) then exit
;
467 //e_WriteLog(Format('+++ frame %d, %dx%d', [a, ia[a].width, ia[a].height]), MSG_NOTIFY);
470 if BackAnimation
then
472 for a
:= 1 to mCount
-2 do framesArray
[find_id
].TexturesID
[mCount
+mCount
-2-a
] := framesArray
[find_id
].TexturesID
[a
];
475 framesArray
[find_id
].used
:= true;
476 framesArray
[find_id
].FrameWidth
:= ia
[0].width
;
477 framesArray
[find_id
].FrameHeight
:= ia
[0].height
;
478 if (Name
<> '') then framesArray
[find_id
].Name
:= Name
else framesArray
[find_id
].Name
:= '<noname>';
480 if (ID
<> nil) then ID
^ := find_id
;
486 function g_Frames_CreateWAD (ID
: PDWORD
; const Name
, Resource
: AnsiString;
487 mWidth
, mHeight
, mCount
: Word; BackAnimation
: Boolean=false): Boolean;
490 FileName
: AnsiString;
491 TextureData
: Pointer;
492 ResourceLength
: Integer;
496 // models without "advanced" animations asks for "nothing" like this; don't spam log
497 if (Length(Resource
) > 0) and ((Resource
[Length(Resource
)] = '/') or (Resource
[Length(Resource
)] = '\')) then exit
;
499 FileName
:= g_ExtractWadName(Resource
);
501 WAD
:= TWADFile
.Create();
502 WAD
.ReadFile(FileName
);
504 if not WAD
.GetResource(g_ExtractFilePathName(Resource
), TextureData
, ResourceLength
) then
507 e_WriteLog(Format('Error loading texture %s', [Resource
]), TMsgType
.Warning
);
508 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
512 if not CreateFramesMem(TextureData
, ResourceLength
, ID
, Name
, mWidth
, mHeight
, mCount
, BackAnimation
) then
524 function g_Frames_CreateMemory (ID
: PDWORD
; const Name
: AnsiString; pData
: Pointer; dataSize
: LongInt;
525 mWidth
, mHeight
, mCount
: Word; BackAnimation
: Boolean = false): Boolean;
527 result
:= CreateFramesMem(pData
, dataSize
, ID
, Name
, mWidth
, mHeight
, mCount
, BackAnimation
);
531 {function g_Frames_CreateRevert(ID: PDWORD; Name: ShortString; Frames: string): Boolean;
538 if not g_Frames_Get(b, Frames) then Exit;
540 find_id := FindFrame();
542 FramesArray[find_id].Name := Name;
543 FramesArray[find_id].FrameWidth := FramesArray[b].FrameWidth;
544 FramesArray[find_id].FrameHeight := FramesArray[b].FrameHeight;
546 c := High(FramesArray[find_id].TexturesID);
549 FramesArray[find_id].TexturesID[a] := FramesArray[b].TexturesID[c-a];
555 function g_Frames_Dup (const NewName
, OldName
: AnsiString): Boolean;
557 find_id
, b
: LongWord;
562 if not g_Frames_Get(b
, OldName
) then exit
;
564 find_id
:= allocFrameSlot();
566 framesArray
[find_id
].used
:= true;
567 framesArray
[find_id
].Name
:= NewName
;
568 framesArray
[find_id
].FrameWidth
:= framesArray
[b
].FrameWidth
;
569 framesArray
[find_id
].FrameHeight
:= framesArray
[b
].FrameHeight
;
571 c
:= High(framesArray
[b
].TexturesID
);
572 SetLength(framesArray
[find_id
].TexturesID
, c
+1);
574 for a
:= 0 to c
do framesArray
[find_id
].TexturesID
[a
] := framesArray
[b
].TexturesID
[a
];
580 procedure g_Frames_DeleteByName (const FramesName
: AnsiString);
584 if (Length(framesArray
) = 0) then exit
;
585 for a
:= 0 to High(framesArray
) do
587 if (StrEquCI1251(framesArray
[a
].Name
, FramesName
)) then
589 if framesArray
[a
].TexturesID
<> nil then
591 for b
:= 0 to High(framesArray
[a
].TexturesID
) do e_DeleteTexture(framesArray
[a
].TexturesID
[b
]);
593 framesArray
[a
].used
:= false;
594 framesArray
[a
].TexturesID
:= nil;
595 framesArray
[a
].Name
:= '';
596 framesArray
[a
].FrameWidth
:= 0;
597 framesArray
[a
].FrameHeight
:= 0;
603 procedure g_Frames_DeleteByID (ID
: LongWord);
607 if (Length(framesArray
) = 0) then exit
;
608 if (framesArray
[ID
].TexturesID
<> nil) then
610 for b
:= 0 to High(framesArray
[ID
].TexturesID
) do e_DeleteTexture(framesArray
[ID
].TexturesID
[b
]);
612 framesArray
[ID
].used
:= false;
613 framesArray
[ID
].TexturesID
:= nil;
614 framesArray
[ID
].Name
:= '';
615 framesArray
[ID
].FrameWidth
:= 0;
616 framesArray
[ID
].FrameHeight
:= 0;
620 procedure g_Frames_DeleteAll ();
624 for a
:= 0 to High(framesArray
) do
626 if (framesArray
[a
].used
) then
628 for b
:= 0 to High(framesArray
[a
].TexturesID
) do e_DeleteTexture(framesArray
[a
].TexturesID
[b
]);
630 framesArray
[a
].used
:= false;
631 framesArray
[a
].TexturesID
:= nil;
632 framesArray
[a
].Name
:= '';
633 framesArray
[a
].FrameWidth
:= 0;
634 framesArray
[a
].FrameHeight
:= 0;
640 function g_Frames_Get (out ID
: LongWord; const FramesName
: AnsiString): Boolean;
645 if (Length(framesArray
) = 0) then exit
;
646 for a
:= 0 to High(framesArray
) do
648 if (StrEquCI1251(framesArray
[a
].Name
, FramesName
)) then
655 if not result
then g_FatalError(Format(_lc
[I_GAME_ERROR_FRAMES
], [FramesName
]));
659 function g_Frames_GetTexture (out ID
: LongWord; const FramesName
: AnsiString; Frame
: Word): Boolean;
664 if (Length(framesArray
) = 0) then exit
;
665 for a
:= 0 to High(framesArray
) do
667 if (StrEquCI1251(framesArray
[a
].Name
, FramesName
)) then
669 if (Frame
< Length(framesArray
[a
].TexturesID
)) then
671 ID
:= framesArray
[a
].TexturesID
[Frame
];
677 if not result
then g_FatalError(Format(_lc
[I_GAME_ERROR_FRAMES
], [FramesName
]));
681 function g_Frames_Exists (const FramesName
: AnsiString): Boolean;
686 if (Length(framesArray
) = 0) then exit
;
687 for a
:= 0 to High(framesArray
) do
689 if (StrEquCI1251(framesArray
[a
].Name
, FramesName
)) then
698 procedure DumpTextureNames ();
702 e_WriteLog('BEGIN Textures:', TMsgType
.Notify
);
703 for i
:= 0 to High(texturesArray
) do e_WriteLog(' '+IntToStr(i
)+'. '+texturesArray
[i
].Name
, TMsgType
.Notify
);
704 e_WriteLog('END Textures.', TMsgType
.Notify
);
706 e_WriteLog('BEGIN Frames:', TMsgType
.Notify
);
707 for i
:= 0 to High(framesArray
) do e_WriteLog(' '+IntToStr(i
)+'. '+framesArray
[i
].Name
, TMsgType
.Notify
);
708 e_WriteLog('END Frames.', TMsgType
.Notify
);
714 constructor TAnimation
.Create (aframesID
: LongWord; aloop
: Boolean; aspeed
: Byte);
716 if (aframesID
>= Length(framesArray
)) then raise Exception
.Create('trying to create inexisting frame: something is very wrong here');
725 mWidth
:= framesArray
[mId
].FrameWidth
;
726 mHeight
:= framesArray
[mId
].FrameHeight
;
730 destructor TAnimation
.Destroy ();
736 procedure TAnimation
.draw (x
, y
: Integer; mirror
: TMirrorType
);
738 if (not mEnabled
) then exit
;
739 e_DrawAdv(framesArray
[mId
].TexturesID
[mCurrentFrame
], x
, y
, mAlpha
, true, mBlending
, 0, nil, mirror
);
740 //e_DrawQuad(X, Y, X+FramesArray[ID].FrameWidth-1, Y+FramesArray[ID].FrameHeight-1, 0, 255, 0);
744 procedure TAnimation
.update ();
746 if (not mEnabled
) then exit
;
750 if (mCounter
>= mSpeed
) then
752 // Îæèäàíèå ìåæäó êàäðàìè çàêîí÷èëîñü
753 // Îáðàòíûé ïîðÿäîê êàäðîâ?
756 // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå
757 if (mCurrentFrame
= 0) then
759 if (Length(framesArray
[mId
].TexturesID
)*mSpeed
+mCounter
< mMinLength
) then exit
;
763 mPlayed
:= (mCurrentFrame
< 0);
765 // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó?
768 if mLoop
then mCurrentFrame
:= High(framesArray
[mId
].TexturesID
) else mCurrentFrame
+= 1;
775 // Ïðÿìîé ïîðÿäîê êàäðîâ
776 // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå
777 if (mCurrentFrame
= High(framesArray
[mId
].TexturesID
)) then
779 if (Length(framesArray
[mId
].TexturesID
)*mSpeed
+mCounter
< mMinLength
) then exit
;
783 mPlayed
:= (mCurrentFrame
> High(framesArray
[mId
].TexturesID
));
785 // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó?
788 if mLoop
then mCurrentFrame
:= 0 else mCurrentFrame
-= 1;
797 procedure TAnimation
.reset ();
799 if mRevert
then mCurrentFrame
:= High(framesArray
[mId
].TexturesID
) else mCurrentFrame
:= 0;
805 procedure TAnimation
.disable (); begin mEnabled
:= false; end;
806 procedure TAnimation
.enable (); begin mEnabled
:= true; end;
809 procedure TAnimation
.drawEx (x
, y
: Integer; mirror
: TMirrorType
; rpoint
: TDFPoint
; angle
: SmallInt);
811 if (not mEnabled
) then exit
;
812 e_DrawAdv(framesArray
[mId
].TexturesID
[mCurrentFrame
], x
, y
, mAlpha
, true, mBlending
, angle
, @rpoint
, mirror
);
816 function TAnimation
.totalFrames (): Integer; inline; begin result
:= Length(framesArray
[mId
].TexturesID
); end;
819 procedure TAnimation
.revert (r
: Boolean);
826 procedure TAnimation
.saveState (st
: TStream
);
828 if (st
= nil) then exit
;
830 utils
.writeSign(st
, 'ANIM');
831 utils
.writeInt(st
, Byte(0)); // version
832 // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè
833 utils
.writeInt(st
, Byte(mCounter
));
835 utils
.writeInt(st
, LongInt(mCurrentFrame
));
836 // Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì
837 utils
.writeBool(st
, mPlayed
);
838 // Alpha-êàíàë âñåé òåêñòóðû
839 utils
.writeInt(st
, Byte(mAlpha
));
841 utils
.writeInt(st
, Byte(mBlending
));
842 // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè
843 utils
.writeInt(st
, Byte(mSpeed
));
844 // Çàöèêëåíà ëè àíèìàöèÿ
845 utils
.writeBool(st
, mLoop
);
847 utils
.writeBool(st
, mEnabled
);
848 // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ
849 utils
.writeInt(st
, Byte(mMinLength
));
850 // Îáðàòíûé ëè ïîðÿäîê êàäðîâ
851 utils
.writeBool(st
, mRevert
);
855 procedure TAnimation
.loadState (st
: TStream
);
857 if (st
= nil) then exit
;
859 if not utils
.checkSign(st
, 'ANIM') then raise XStreamError
.Create('animation chunk expected');
860 if (utils
.readByte(st
) <> 0) then raise XStreamError
.Create('invalid animation chunk version');
861 // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè
862 mCounter
:= utils
.readByte(st
);
864 mCurrentFrame
:= utils
.readLongInt(st
);
865 // Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì
866 mPlayed
:= utils
.readBool(st
);
867 // Alpha-êàíàë âñåé òåêñòóðû
868 mAlpha
:= utils
.readByte(st
);
870 mBlending
:= utils
.readBool(st
);
871 // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè
872 mSpeed
:= utils
.readByte(st
);
873 // Çàöèêëåíà ëè àíèìàöèÿ
874 mLoop
:= utils
.readBool(st
);
876 mEnabled
:= utils
.readBool(st
);
877 // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ
878 mMinLength
:= utils
.readByte(st
);
879 // Îáðàòíûé ëè ïîðÿäîê êàäðîâ
880 mRevert
:= utils
.readBool(st
);
884 // ////////////////////////////////////////////////////////////////////////// //
888 function g_Texture_Light (): Integer;
890 Radius
: Integer = 128;
898 GetMem(tex
, (Radius
*2)*(Radius
*2)*4);
900 for y
:= 0 to Radius
*2-1 do
902 for x
:= 0 to Radius
*2-1 do
904 dist
:= 1.0-sqrt((x
-Radius
)*(x
-Radius
)+(y
-Radius
)*(y
-Radius
))/Radius
;
914 //tc.setPixel(x, y, Color(cast(int)(dist*255), cast(int)(dist*255), cast(int)(dist*255)));
915 if (dist
> 0.5) then dist
:= 0.5;
916 a
:= round(dist
*255);
917 if (a
< 0) then a
:= 0 else if (a
> 255) then a
:= 255;
918 tpp
^ := 255; Inc(tpp
);
919 tpp
^ := 255; Inc(tpp
);
920 tpp
^ := 255; Inc(tpp
);
921 tpp
^ := Byte(a
); Inc(tpp
);
926 glGenTextures(1, @ltexid
);
927 //if (tid == 0) assert(0, "VGL: can't create screen texture");
929 glBindTexture(GL_TEXTURE_2D
, ltexid
);
930 glTexParameterf(GL_TEXTURE_2D
, GL_TEXTURE_WRAP_S
, GL_REPEAT
);
931 glTexParameterf(GL_TEXTURE_2D
, GL_TEXTURE_WRAP_T
, GL_REPEAT
);
932 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MIN_FILTER
, GL_LINEAR
);
933 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MAG_FILTER
, GL_LINEAR
);
935 //GLfloat[4] bclr = 0.0;
936 //glTexParameterfv(GL_TEXTURE_2D, GL_TEXTURE_BORDER_COLOR, bclr.ptr);
938 glTexImage2D(GL_TEXTURE_2D
, 0, GL_RGBA
, Radius
*2, Radius
*2, 0, GL_RGBA
{gltt}, GL_UNSIGNED_BYTE
, tex
);