DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-sdl.git / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
load extended model animations if present
[d2df-sdl.git] / src / game / g_textures.pas
1 (* Copyright (C) DooM 2D:Forever Developers
2 *
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.
7 *
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.
12 *
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/>.
15 *)
16 {$INCLUDE ../shared/a_modes.inc}
17 unit g_textures;
18
19 interface
20
21 uses
22 e_graphics, BinEditor, ImagingTypes, Imaging, ImagingUtility;
23
24 Type
25 TLevelTexture = record
26 TextureName: String;
27 Width,
28 Height: Word;
29 case Anim: Boolean of
30 False: (TextureID: DWORD;);
31 True: (FramesID: DWORD;
32 FramesCount: Byte;
33 Speed: Byte);
34 end;
35
36 TLevelTextureArray = Array of TLevelTexture;
37
38 TAnimation = class(TObject)
39 private
40 ID: DWORD;
41 FAlpha: Byte;
42 FBlending: Boolean;
43 FCounter: Byte; // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè
44 FSpeed: Byte; // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè
45 FCurrentFrame: Integer; // Òåêóùèé êàäð (íà÷èíàÿ ñ 0)
46 FLoop: Boolean; // Ïåðåõîäèòü íà ïåðâûé êàäð ïîñëå ïîñëåäíåãî?
47 FEnabled: Boolean; // Ðàáîòà ðàçðåøåíà?
48 FPlayed: Boolean; // Ïðîèãðàíà âñÿ õîòÿ áû ðàç?
49 FHeight: Word;
50 FWidth: Word;
51 FMinLength: Byte; // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ
52 FRevert: Boolean; // Ñìåíà êàäðîâ îáðàòíàÿ?
53
54 public
55 constructor Create(FramesID: DWORD; Loop: Boolean; Speed: Byte);
56 destructor Destroy(); override;
57 procedure Draw(X, Y: Integer; Mirror: TMirrorType);
58 procedure DrawEx(X, Y: Integer; Mirror: TMirrorType; RPoint: TPoint;
59 Angle: SmallInt);
60 procedure Reset();
61 procedure Update();
62 procedure Enable();
63 procedure Disable();
64 procedure Revert(r: Boolean);
65 procedure SaveState(Var Mem: TBinMemoryWriter);
66 procedure LoadState(Var Mem: TBinMemoryReader);
67 function TotalFrames(): Integer;
68
69 property Played: Boolean read FPlayed;
70 property Enabled: Boolean read FEnabled;
71 property IsReverse: Boolean read FRevert;
72 property Loop: Boolean read FLoop write FLoop;
73 property Speed: Byte read FSpeed write FSpeed;
74 property MinLength: Byte read FMinLength write FMinLength;
75 property CurrentFrame: Integer read FCurrentFrame write FCurrentFrame;
76 property CurrentCounter: Byte read FCounter write FCounter;
77 property Counter: Byte read FCounter;
78 property Blending: Boolean read FBlending write FBlending;
79 property Alpha: Byte read FAlpha write FAlpha;
80 property FramesID: DWORD read ID;
81 property Width: Word read FWidth;
82 property Height: Word read FHeight;
83 end;
84
85 function g_Texture_CreateWAD(var ID: DWORD; Resource: String): Boolean;
86 function g_Texture_CreateFile(var ID: DWORD; FileName: String): Boolean;
87 function g_Texture_CreateWADEx(TextureName: ShortString; Resource: String): Boolean;
88 function g_Texture_CreateFileEx(TextureName: ShortString; FileName: String): Boolean;
89 function g_Texture_Get(TextureName: ShortString; var ID: DWORD): Boolean;
90 procedure g_Texture_Delete(TextureName: ShortString);
91 procedure g_Texture_DeleteAll();
92
93 function g_CreateFramesImg (ia: TDynImageDataArray; ID: PDWORD; Name: ShortString; BackAnimation: Boolean = False): Boolean;
94
95 function g_Frames_CreateWAD(ID: PDWORD; Name: ShortString; Resource: String;
96 FWidth, FHeight, FCount: Word; BackAnimation: Boolean = False): Boolean;
97 function g_Frames_CreateFile(ID: PDWORD; Name: ShortString; FileName: String;
98 FWidth, FHeight, FCount: Word; BackAnimation: Boolean = False): Boolean;
99 function g_Frames_CreateMemory(ID: PDWORD; Name: ShortString; pData: Pointer; dataSize: LongInt;
100 FWidth, FHeight, FCount: Word; BackAnimation: Boolean = False): Boolean;
101 function g_Frames_Dup(NewName, OldName: ShortString): Boolean;
102 //function g_Frames_CreateRevert(ID: PDWORD; Name: ShortString; Frames: string): Boolean;
103 function g_Frames_Get(out ID: DWORD; FramesName: ShortString): Boolean;
104 function g_Frames_GetTexture(out ID: DWORD; FramesName: ShortString; Frame: Word): Boolean;
105 function g_Frames_Exists(FramesName: String): Boolean;
106 procedure g_Frames_DeleteByName(FramesName: ShortString);
107 procedure g_Frames_DeleteByID(ID: DWORD);
108 procedure g_Frames_DeleteAll();
109
110 procedure DumpTextureNames();
111
112 function g_Texture_Light(): Integer;
113
114 implementation
115
116 uses
117 g_game, e_log, g_basic, SysUtils, g_console, wadreader,
118 g_language, GL;
119
120 type
121 _TTexture = record
122 Name: ShortString;
123 ID: DWORD;
124 Width, Height: Word;
125 end;
126
127 TFrames = record
128 TexturesID: Array of DWORD;
129 Name: ShortString;
130 FrameWidth,
131 FrameHeight: Word;
132 end;
133
134 var
135 TexturesArray: Array of _TTexture = nil;
136 FramesArray: Array of TFrames = nil;
137
138 const
139 ANIM_SIGNATURE = $4D494E41; // 'ANIM'
140
141 function FindTexture(): DWORD;
142 var
143 i: integer;
144 begin
145 if TexturesArray <> nil then
146 for i := 0 to High(TexturesArray) do
147 if TexturesArray[i].Name = '' then
148 begin
149 Result := i;
150 Exit;
151 end;
152
153 if TexturesArray = nil then
154 begin
155 SetLength(TexturesArray, 8);
156 Result := 0;
157 end
158 else
159 begin
160 Result := High(TexturesArray) + 1;
161 SetLength(TexturesArray, Length(TexturesArray) + 8);
162 end;
163 end;
164
165 function g_Texture_CreateWAD(var ID: DWORD; Resource: String): Boolean;
166 var
167 WAD: TWADFile;
168 FileName: String;
169 TextureData: Pointer;
170 ResourceLength: Integer;
171 begin
172 Result := False;
173 FileName := g_ExtractWadName(Resource);
174
175 WAD := TWADFile.Create;
176 WAD.ReadFile(FileName);
177
178 if WAD.GetResource(g_ExtractFilePathName(Resource), TextureData, ResourceLength) then
179 begin
180 if e_CreateTextureMem(TextureData, ResourceLength, ID) then
181 Result := True
182 else
183 FreeMem(TextureData);
184 end
185 else
186 begin
187 e_WriteLog(Format('Error loading texture %s', [Resource]), MSG_WARNING);
188 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
189 end;
190 WAD.Free();
191 end;
192
193 function g_Texture_CreateFile(var ID: DWORD; FileName: String): Boolean;
194 begin
195 Result := True;
196 if not e_CreateTexture(FileName, ID) then
197 begin
198 e_WriteLog(Format('Error loading texture %s', [FileName]), MSG_WARNING);
199 Result := False;
200 end;
201 end;
202
203 function g_Texture_CreateWADEx(TextureName: ShortString; Resource: String): Boolean;
204 var
205 WAD: TWADFile;
206 FileName: String;
207 TextureData: Pointer;
208 find_id: DWORD;
209 ResourceLength: Integer;
210 begin
211 FileName := g_ExtractWadName(Resource);
212
213 find_id := FindTexture();
214
215 WAD := TWADFile.Create;
216 WAD.ReadFile(FileName);
217
218 if WAD.GetResource(g_ExtractFilePathName(Resource), TextureData, ResourceLength) then
219 begin
220 Result := e_CreateTextureMem(TextureData, ResourceLength, TexturesArray[find_id].ID);
221 if Result then
222 begin
223 e_GetTextureSize(TexturesArray[find_id].ID, @TexturesArray[find_id].Width,
224 @TexturesArray[find_id].Height);
225 TexturesArray[find_id].Name := LowerCase(TextureName);
226 end
227 else
228 FreeMem(TextureData);
229 end
230 else
231 begin
232 e_WriteLog(Format('Error loading texture %s', [Resource]), MSG_WARNING);
233 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
234 Result := False;
235 end;
236 WAD.Free();
237 end;
238
239 function g_Texture_CreateFileEx(TextureName: ShortString; FileName: String): Boolean;
240 var
241 find_id: DWORD;
242 begin
243 find_id := FindTexture;
244
245 Result := e_CreateTexture(FileName, TexturesArray[find_id].ID);
246 if Result then
247 begin
248 TexturesArray[find_id].Name := LowerCase(TextureName);
249 e_GetTextureSize(TexturesArray[find_id].ID, @TexturesArray[find_id].Width,
250 @TexturesArray[find_id].Height);
251 end
252 else e_WriteLog(Format('Error loading texture %s', [FileName]), MSG_WARNING);
253 end;
254
255 function g_Texture_Get(TextureName: ShortString; var ID: DWORD): Boolean;
256 var
257 a: DWORD;
258 begin
259 Result := False;
260
261 if TexturesArray = nil then Exit;
262
263 if TextureName = '' then Exit;
264
265 TextureName := LowerCase(TextureName);
266
267 for a := 0 to High(TexturesArray) do
268 if TexturesArray[a].Name = TextureName then
269 begin
270 ID := TexturesArray[a].ID;
271 Result := True;
272 Break;
273 end;
274
275 //if not Result then g_ConsoleAdd('Texture '+TextureName+' not found');
276 end;
277
278 procedure g_Texture_Delete(TextureName: ShortString);
279 var
280 a: DWORD;
281 begin
282 if TexturesArray = nil then Exit;
283
284 TextureName := LowerCase(TextureName);
285
286 for a := 0 to High(TexturesArray) do
287 if TexturesArray[a].Name = TextureName then
288 begin
289 e_DeleteTexture(TexturesArray[a].ID);
290 TexturesArray[a].Name := '';
291 TexturesArray[a].ID := 0;
292 TexturesArray[a].Width := 0;
293 TexturesArray[a].Height := 0;
294 end;
295 end;
296
297 procedure g_Texture_DeleteAll();
298 var
299 a: DWORD;
300 begin
301 if TexturesArray = nil then Exit;
302
303 for a := 0 to High(TexturesArray) do
304 if TexturesArray[a].Name <> '' then
305 e_DeleteTexture(TexturesArray[a].ID);
306
307 TexturesArray := nil;
308 end;
309
310 function FindFrame(): DWORD;
311 var
312 i: integer;
313 begin
314 if FramesArray <> nil then
315 for i := 0 to High(FramesArray) do
316 if FramesArray[i].TexturesID = nil then
317 begin
318 Result := i;
319 Exit;
320 end;
321
322 if FramesArray = nil then
323 begin
324 SetLength(FramesArray, 64);
325 Result := 0;
326 end
327 else
328 begin
329 Result := High(FramesArray) + 1;
330 SetLength(FramesArray, Length(FramesArray) + 64);
331 end;
332 end;
333
334 function g_Frames_CreateFile(ID: PDWORD; Name: ShortString; FileName: String;
335 FWidth, FHeight, FCount: Word; BackAnimation: Boolean = False): Boolean;
336 var
337 a: Integer;
338 find_id: DWORD;
339 begin
340 Result := False;
341
342 find_id := FindFrame;
343
344 if FCount <= 2 then BackAnimation := False;
345
346 if BackAnimation then SetLength(FramesArray[find_id].TexturesID, FCount+FCount-2)
347 else SetLength(FramesArray[find_id].TexturesID, FCount);
348
349 for a := 0 to FCount-1 do
350 if not e_CreateTextureEx(FileName, FramesArray[find_id].TexturesID[a],
351 a*FWidth, 0, FWidth, FHeight) then Exit;
352
353 if BackAnimation then
354 for a := 1 to FCount-2 do
355 FramesArray[find_id].TexturesID[FCount+FCount-2-a] := FramesArray[find_id].TexturesID[a];
356
357 FramesArray[find_id].FrameWidth := FWidth;
358 FramesArray[find_id].FrameHeight := FHeight;
359 if Name <> '' then
360 FramesArray[find_id].Name := LowerCase(Name)
361 else
362 FramesArray[find_id].Name := '<noname>';
363
364 if ID <> nil then ID^ := find_id;
365
366 Result := True;
367 end;
368
369 function CreateFramesMem(pData: Pointer; dataSize: LongInt; ID: PDWORD; Name: ShortString;
370 FWidth, FHeight, FCount: Word; BackAnimation: Boolean = False): Boolean;
371 var
372 find_id: DWORD;
373 a: Integer;
374 begin
375 Result := False;
376
377 find_id := FindFrame();
378
379 if FCount <= 2 then BackAnimation := False;
380
381 if BackAnimation then SetLength(FramesArray[find_id].TexturesID, FCount+FCount-2)
382 else SetLength(FramesArray[find_id].TexturesID, FCount);
383
384 for a := 0 to FCount-1 do
385 if not e_CreateTextureMemEx(pData, dataSize, FramesArray[find_id].TexturesID[a],
386 a*FWidth, 0, FWidth, FHeight) then
387 begin
388 //!!!FreeMem(pData);
389 Exit;
390 end;
391
392 if BackAnimation then
393 for a := 1 to FCount-2 do
394 FramesArray[find_id].TexturesID[FCount+FCount-2-a] := FramesArray[find_id].TexturesID[a];
395
396 FramesArray[find_id].FrameWidth := FWidth;
397 FramesArray[find_id].FrameHeight := FHeight;
398 if Name <> '' then
399 FramesArray[find_id].Name := LowerCase(Name)
400 else
401 FramesArray[find_id].Name := '<noname>';
402
403 if ID <> nil then ID^ := find_id;
404
405 Result := True;
406 end;
407
408 function g_CreateFramesImg (ia: TDynImageDataArray; ID: PDWORD; Name: ShortString; BackAnimation: Boolean = False): Boolean;
409 var
410 find_id: DWORD;
411 a, FCount: Integer;
412 begin
413 result := false;
414 find_id := FindFrame();
415
416 FCount := length(ia);
417
418 //e_WriteLog(Format('+++ creating %d frames [%s]', [FCount, Name]), MSG_NOTIFY);
419
420 if FCount < 1 then exit;
421 if FCount <= 2 then BackAnimation := False;
422 if BackAnimation then
423 SetLength(FramesArray[find_id].TexturesID, FCount+FCount-2)
424 else
425 SetLength(FramesArray[find_id].TexturesID, FCount);
426
427 //e_WriteLog(Format('+++ creating %d frames, %dx%d', [FCount, ia[0].width, ia[0].height]), MSG_NOTIFY);
428
429 for a := 0 to FCount-1 do
430 begin
431 if not e_CreateTextureImg(ia[a], FramesArray[find_id].TexturesID[a]) then exit;
432 //e_WriteLog(Format('+++ frame %d, %dx%d', [a, ia[a].width, ia[a].height]), MSG_NOTIFY);
433 end;
434
435 if BackAnimation then
436 begin
437 for a := 1 to FCount-2 do
438 begin
439 FramesArray[find_id].TexturesID[FCount+FCount-2-a] := FramesArray[find_id].TexturesID[a];
440 end;
441 end;
442
443 FramesArray[find_id].FrameWidth := ia[0].width;
444 FramesArray[find_id].FrameHeight := ia[0].height;
445 if Name <> '' then
446 FramesArray[find_id].Name := LowerCase(Name)
447 else
448 FramesArray[find_id].Name := '<noname>';
449
450 if ID <> nil then ID^ := find_id;
451
452 result := true;
453 end;
454
455 function g_Frames_CreateWAD(ID: PDWORD; Name: ShortString; Resource: string;
456 FWidth, FHeight, FCount: Word; BackAnimation: Boolean = False): Boolean;
457 var
458 WAD: TWADFile;
459 FileName: string;
460 TextureData: Pointer;
461 ResourceLength: Integer;
462 begin
463 Result := False;
464
465 FileName := g_ExtractWadName(Resource);
466
467 WAD := TWADFile.Create();
468 WAD.ReadFile(FileName);
469
470 if not WAD.GetResource(g_ExtractFilePathName(Resource), TextureData, ResourceLength) then
471 begin
472 WAD.Free();
473 e_WriteLog(Format('Error loading texture %s', [Resource]), MSG_WARNING);
474 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
475 Exit;
476 end;
477
478 if not CreateFramesMem(TextureData, ResourceLength, ID, Name, FWidth, FHeight, FCount, BackAnimation) then
479 begin
480 WAD.Free();
481 Exit;
482 end;
483
484 WAD.Free();
485
486 Result := True;
487 end;
488
489 function g_Frames_CreateMemory(ID: PDWORD; Name: ShortString; pData: Pointer; dataSize: LongInt;
490 FWidth, FHeight, FCount: Word; BackAnimation: Boolean = False): Boolean;
491 begin
492 Result := CreateFramesMem(pData, dataSize, ID, Name, FWidth, FHeight, FCount, BackAnimation);
493 end;
494
495 {function g_Frames_CreateRevert(ID: PDWORD; Name: ShortString; Frames: string): Boolean;
496 var
497 find_id, b: DWORD;
498 a, c: Integer;
499 begin
500 Result := False;
501
502 if not g_Frames_Get(b, Frames) then Exit;
503
504 find_id := FindFrame();
505
506 FramesArray[find_id].Name := Name;
507 FramesArray[find_id].FrameWidth := FramesArray[b].FrameWidth;
508 FramesArray[find_id].FrameHeight := FramesArray[b].FrameHeight;
509
510 c := High(FramesArray[find_id].TexturesID);
511
512 for a := 0 to c do
513 FramesArray[find_id].TexturesID[a] := FramesArray[b].TexturesID[c-a];
514
515 Result := True;
516 end;}
517
518 function g_Frames_Dup(NewName, OldName: ShortString): Boolean;
519 var
520 find_id, b: DWORD;
521 a, c: Integer;
522 begin
523 Result := False;
524
525 if not g_Frames_Get(b, OldName) then Exit;
526
527 find_id := FindFrame();
528
529 FramesArray[find_id].Name := LowerCase(NewName);
530 FramesArray[find_id].FrameWidth := FramesArray[b].FrameWidth;
531 FramesArray[find_id].FrameHeight := FramesArray[b].FrameHeight;
532
533 c := High(FramesArray[b].TexturesID);
534 SetLength(FramesArray[find_id].TexturesID, c+1);
535
536 for a := 0 to c do
537 FramesArray[find_id].TexturesID[a] := FramesArray[b].TexturesID[a];
538
539 Result := True;
540 end;
541
542 procedure g_Frames_DeleteByName(FramesName: ShortString);
543 var
544 a: DWORD;
545 b: Integer;
546 begin
547 if FramesArray = nil then Exit;
548
549 FramesName := LowerCase(FramesName);
550
551 for a := 0 to High(FramesArray) do
552 if FramesArray[a].Name = FramesName then
553 begin
554 if FramesArray[a].TexturesID <> nil then
555 for b := 0 to High(FramesArray[a].TexturesID) do
556 e_DeleteTexture(FramesArray[a].TexturesID[b]);
557 FramesArray[a].TexturesID := nil;
558 FramesArray[a].Name := '';
559 FramesArray[a].FrameWidth := 0;
560 FramesArray[a].FrameHeight := 0;
561 end;
562 end;
563
564 procedure g_Frames_DeleteByID(ID: DWORD);
565 var
566 b: Integer;
567 begin
568 if FramesArray = nil then Exit;
569
570 if FramesArray[ID].TexturesID <> nil then
571 for b := 0 to High(FramesArray[ID].TexturesID) do
572 e_DeleteTexture(FramesArray[ID].TexturesID[b]);
573 FramesArray[ID].TexturesID := nil;
574 FramesArray[ID].Name := '';
575 FramesArray[ID].FrameWidth := 0;
576 FramesArray[ID].FrameHeight := 0;
577 end;
578
579 procedure g_Frames_DeleteAll;
580 var
581 a: DWORD;
582 b: DWORD;
583 begin
584 if FramesArray = nil then Exit;
585
586 for a := 0 to High(FramesArray) do
587 if FramesArray[a].TexturesID <> nil then
588 begin
589 for b := 0 to High(FramesArray[a].TexturesID) do
590 e_DeleteTexture(FramesArray[a].TexturesID[b]);
591 FramesArray[a].TexturesID := nil;
592 FramesArray[a].Name := '';
593 FramesArray[a].FrameWidth := 0;
594 FramesArray[a].FrameHeight := 0;
595 end;
596
597 FramesArray := nil;
598 end;
599
600 function g_Frames_Get(out ID: DWORD; FramesName: ShortString): Boolean;
601 var
602 a: DWORD;
603 begin
604 Result := False;
605
606 if FramesArray = nil then
607 Exit;
608
609 FramesName := LowerCase(FramesName);
610
611 for a := 0 to High(FramesArray) do
612 if FramesArray[a].Name = FramesName then
613 begin
614 ID := a;
615 Result := True;
616 Break;
617 end;
618
619 if not Result then
620 g_FatalError(Format(_lc[I_GAME_ERROR_FRAMES], [FramesName]));
621 end;
622
623 function g_Frames_GetTexture(out ID: DWORD; FramesName: ShortString; Frame: Word): Boolean;
624 var
625 a: DWORD;
626 begin
627 Result := False;
628
629 if FramesArray = nil then
630 Exit;
631
632 FramesName := LowerCase(FramesName);
633
634 for a := 0 to High(FramesArray) do
635 if FramesArray[a].Name = FramesName then
636 if Frame <= High(FramesArray[a].TexturesID) then
637 begin
638 ID := FramesArray[a].TexturesID[Frame];
639 Result := True;
640 Break;
641 end;
642
643 if not Result then
644 g_FatalError(Format(_lc[I_GAME_ERROR_FRAMES], [FramesName]));
645 end;
646
647 function g_Frames_Exists(FramesName: string): Boolean;
648 var
649 a: DWORD;
650 begin
651 Result := False;
652
653 if FramesArray = nil then Exit;
654
655 FramesName := LowerCase(FramesName);
656
657 for a := 0 to High(FramesArray) do
658 if FramesArray[a].Name = FramesName then
659 begin
660 Result := True;
661 Exit;
662 end;
663 end;
664
665 procedure DumpTextureNames();
666 var
667 i: Integer;
668 begin
669 e_WriteLog('BEGIN Textures:', MSG_NOTIFY);
670 for i := 0 to High(TexturesArray) do
671 e_WriteLog(' '+IntToStr(i)+'. '+TexturesArray[i].Name, MSG_NOTIFY);
672 e_WriteLog('END Textures.', MSG_NOTIFY);
673
674 e_WriteLog('BEGIN Frames:', MSG_NOTIFY);
675 for i := 0 to High(FramesArray) do
676 e_WriteLog(' '+IntToStr(i)+'. '+FramesArray[i].Name, MSG_NOTIFY);
677 e_WriteLog('END Frames.', MSG_NOTIFY);
678 end;
679
680 { TAnimation }
681
682 constructor TAnimation.Create(FramesID: DWORD; Loop: Boolean; Speed: Byte);
683 begin
684 ID := FramesID;
685
686 FMinLength := 0;
687 FLoop := Loop;
688 FSpeed := Speed;
689 FEnabled := True;
690 FCurrentFrame := 0;
691 FPlayed := False;
692 FAlpha := 0;
693 FWidth := FramesArray[ID].FrameWidth;
694 FHeight := FramesArray[ID].FrameHeight;
695 end;
696
697 destructor TAnimation.Destroy;
698 begin
699 inherited;
700 end;
701
702 procedure TAnimation.Draw(X, Y: Integer; Mirror: TMirrorType);
703 begin
704 if not FEnabled then
705 Exit;
706
707 e_DrawAdv(FramesArray[ID].TexturesID[FCurrentFrame], X, Y, FAlpha,
708 True, FBlending, 0, nil, Mirror);
709 //e_DrawQuad(X, Y, X+FramesArray[ID].FrameWidth-1, Y+FramesArray[ID].FrameHeight-1, 0, 255, 0);
710 end;
711
712 procedure TAnimation.Update();
713 begin
714 if not FEnabled then
715 Exit;
716
717 FCounter := FCounter + 1;
718
719 if FCounter >= FSpeed then
720 begin // Îæèäàíèå ìåæäó êàäðàìè çàêîí÷èëîñü
721 if FRevert then
722 begin // Îáðàòíûé ïîðÿäîê êàäðîâ
723 // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå:
724 if FCurrentFrame = 0 then
725 if Length(FramesArray[ID].TexturesID) * FSpeed +
726 FCounter < FMinLength then
727 Exit;
728
729 FCurrentFrame := FCurrentFrame - 1;
730 FPlayed := FCurrentFrame < 0;
731
732 // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó:
733 if FPlayed then
734 if FLoop then
735 FCurrentFrame := High(FramesArray[ID].TexturesID)
736 else
737 FCurrentFrame := FCurrentFrame + 1;
738
739 FCounter := 0;
740 end
741 else
742 begin // Ïðÿìîé ïîðÿäîê êàäðîâ
743 // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå:
744 if FCurrentFrame = High(FramesArray[ID].TexturesID) then
745 if Length(FramesArray[ID].TexturesID) * FSpeed +
746 FCounter < FMinLength then
747 Exit;
748
749 FCurrentFrame := FCurrentFrame + 1;
750 FPlayed := (FCurrentFrame > High(FramesArray[ID].TexturesID));
751
752 // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó:
753 if FPlayed then
754 if FLoop then
755 FCurrentFrame := 0
756 else
757 FCurrentFrame := FCurrentFrame - 1;
758
759 FCounter := 0;
760 end;
761 end;
762 end;
763
764 procedure TAnimation.Reset();
765 begin
766 if FRevert then
767 FCurrentFrame := High(FramesArray[ID].TexturesID)
768 else
769 FCurrentFrame := 0;
770
771 FCounter := 0;
772 FPlayed := False;
773 end;
774
775 procedure TAnimation.Disable;
776 begin
777 FEnabled := False;
778 end;
779
780 procedure TAnimation.Enable;
781 begin
782 FEnabled := True;
783 end;
784
785 procedure TAnimation.DrawEx(X, Y: Integer; Mirror: TMirrorType; RPoint: TPoint;
786 Angle: SmallInt);
787 begin
788 if not FEnabled then
789 Exit;
790
791 e_DrawAdv(FramesArray[ID].TexturesID[FCurrentFrame], X, Y, FAlpha,
792 True, FBlending, Angle, @RPoint, Mirror);
793 end;
794
795 function TAnimation.TotalFrames(): Integer;
796 begin
797 Result := Length(FramesArray[ID].TexturesID);
798 end;
799
800 procedure TAnimation.Revert(r: Boolean);
801 begin
802 FRevert := r;
803 Reset();
804 end;
805
806 procedure TAnimation.SaveState(Var Mem: TBinMemoryWriter);
807 var
808 sig: DWORD;
809 begin
810 if Mem = nil then
811 Exit;
812
813 // Ñèãíàòóðà àíèìàöèè:
814 sig := ANIM_SIGNATURE; // 'ANIM'
815 Mem.WriteDWORD(sig);
816 // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè:
817 Mem.WriteByte(FCounter);
818 // Òåêóùèé êàäð:
819 Mem.WriteInt(FCurrentFrame);
820 // Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì:
821 Mem.WriteBoolean(FPlayed);
822 // Alpha-êàíàë âñåé òåêñòóðû:
823 Mem.WriteByte(FAlpha);
824 // Ðàçìûòèå òåêñòóðû:
825 Mem.WriteBoolean(FBlending);
826 // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè:
827 Mem.WriteByte(FSpeed);
828 // Çàöèêëåíà ëè àíèìàöèÿ:
829 Mem.WriteBoolean(FLoop);
830 // Âêëþ÷åíà ëè:
831 Mem.WriteBoolean(FEnabled);
832 // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ:
833 Mem.WriteByte(FMinLength);
834 // Îáðàòíûé ëè ïîðÿäîê êàäðîâ:
835 Mem.WriteBoolean(FRevert);
836 end;
837
838 procedure TAnimation.LoadState(Var Mem: TBinMemoryReader);
839 var
840 sig: DWORD;
841 begin
842 if Mem = nil then
843 Exit;
844
845 // Ñèãíàòóðà àíèìàöèè:
846 Mem.ReadDWORD(sig);
847 if sig <> ANIM_SIGNATURE then // 'ANIM'
848 begin
849 raise EBinSizeError.Create('TAnimation.LoadState: Wrong Animation Signature');
850 end;
851 // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè:
852 Mem.ReadByte(FCounter);
853 // Òåêóùèé êàäð:
854 Mem.ReadInt(FCurrentFrame);
855 // Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì:
856 Mem.ReadBoolean(FPlayed);
857 // Alpha-êàíàë âñåé òåêñòóðû:
858 Mem.ReadByte(FAlpha);
859 // Ðàçìûòèå òåêñòóðû:
860 Mem.ReadBoolean(FBlending);
861 // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè:
862 Mem.ReadByte(FSpeed);
863 // Çàöèêëåíà ëè àíèìàöèÿ:
864 Mem.ReadBoolean(FLoop);
865 // Âêëþ÷åíà ëè:
866 Mem.ReadBoolean(FEnabled);
867 // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ:
868 Mem.ReadByte(FMinLength);
869 // Îáðàòíûé ëè ïîðÿäîê êàäðîâ:
870 Mem.ReadBoolean(FRevert);
871 end;
872
873
874 var
875 ltexid: GLuint = 0;
876
877 function g_Texture_Light(): Integer;
878 const
879 Radius: Integer = 128;
880 var
881 tex, tpp: PByte;
882 x, y, a: Integer;
883 dist: Double;
884 begin
885 if ltexid = 0 then
886 begin
887 GetMem(tex, (Radius*2)*(Radius*2)*4);
888 tpp := tex;
889 for y := 0 to Radius*2-1 do
890 begin
891 for x := 0 to Radius*2-1 do
892 begin
893 dist := 1.0-sqrt((x-Radius)*(x-Radius)+(y-Radius)*(y-Radius))/Radius;
894 if (dist < 0) then
895 begin
896 tpp^ := 0; Inc(tpp);
897 tpp^ := 0; Inc(tpp);
898 tpp^ := 0; Inc(tpp);
899 tpp^ := 0; Inc(tpp);
900 end
901 else
902 begin
903 //tc.setPixel(x, y, Color(cast(int)(dist*255), cast(int)(dist*255), cast(int)(dist*255)));
904 if (dist > 0.5) then dist := 0.5;
905 a := round(dist*255);
906 if (a < 0) then a := 0 else if (a > 255) then a := 255;
907 tpp^ := 255; Inc(tpp);
908 tpp^ := 255; Inc(tpp);
909 tpp^ := 255; Inc(tpp);
910 tpp^ := Byte(a); Inc(tpp);
911 end;
912 end;
913 end;
914
915 glGenTextures(1, @ltexid);
916 //if (tid == 0) assert(0, "VGL: can't create screen texture");
917
918 glBindTexture(GL_TEXTURE_2D, ltexid);
919 glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT);
920 glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT);
921 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
922 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
923
924 //GLfloat[4] bclr = 0.0;
925 //glTexParameterfv(GL_TEXTURE_2D, GL_TEXTURE_BORDER_COLOR, bclr.ptr);
926
927 glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, Radius*2, Radius*2, 0, GL_RGBA{gltt}, GL_UNSIGNED_BYTE, tex);
928 end;
929
930 result := ltexid;
931 end;
932
933 end.
[MIRROR] a port of Doom 2D Forever to FPC/SDL
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024