DEADSOFTWARE

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