DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-sdl.git / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
no more old mapreader: use textmap reader both for text and for binary maps
[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, MAPDEF, 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: TDFPoint;
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 // models without "advanced" animations asks for "nothing" like this; don't spam log
466 if (Length(Resource) > 0) and ((Resource[Length(Resource)] = '/') or (Resource[Length(Resource)] = '\')) then exit;
467
468 FileName := g_ExtractWadName(Resource);
469
470 WAD := TWADFile.Create();
471 WAD.ReadFile(FileName);
472
473 if not WAD.GetResource(g_ExtractFilePathName(Resource), TextureData, ResourceLength) then
474 begin
475 WAD.Free();
476 e_WriteLog(Format('Error loading texture %s', [Resource]), MSG_WARNING);
477 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
478 Exit;
479 end;
480
481 if not CreateFramesMem(TextureData, ResourceLength, ID, Name, FWidth, FHeight, FCount, BackAnimation) then
482 begin
483 WAD.Free();
484 Exit;
485 end;
486
487 WAD.Free();
488
489 Result := True;
490 end;
491
492 function g_Frames_CreateMemory(ID: PDWORD; Name: ShortString; pData: Pointer; dataSize: LongInt;
493 FWidth, FHeight, FCount: Word; BackAnimation: Boolean = False): Boolean;
494 begin
495 Result := CreateFramesMem(pData, dataSize, ID, Name, FWidth, FHeight, FCount, BackAnimation);
496 end;
497
498 {function g_Frames_CreateRevert(ID: PDWORD; Name: ShortString; Frames: string): Boolean;
499 var
500 find_id, b: DWORD;
501 a, c: Integer;
502 begin
503 Result := False;
504
505 if not g_Frames_Get(b, Frames) then Exit;
506
507 find_id := FindFrame();
508
509 FramesArray[find_id].Name := Name;
510 FramesArray[find_id].FrameWidth := FramesArray[b].FrameWidth;
511 FramesArray[find_id].FrameHeight := FramesArray[b].FrameHeight;
512
513 c := High(FramesArray[find_id].TexturesID);
514
515 for a := 0 to c do
516 FramesArray[find_id].TexturesID[a] := FramesArray[b].TexturesID[c-a];
517
518 Result := True;
519 end;}
520
521 function g_Frames_Dup(NewName, OldName: ShortString): Boolean;
522 var
523 find_id, b: DWORD;
524 a, c: Integer;
525 begin
526 Result := False;
527
528 if not g_Frames_Get(b, OldName) then Exit;
529
530 find_id := FindFrame();
531
532 FramesArray[find_id].Name := LowerCase(NewName);
533 FramesArray[find_id].FrameWidth := FramesArray[b].FrameWidth;
534 FramesArray[find_id].FrameHeight := FramesArray[b].FrameHeight;
535
536 c := High(FramesArray[b].TexturesID);
537 SetLength(FramesArray[find_id].TexturesID, c+1);
538
539 for a := 0 to c do
540 FramesArray[find_id].TexturesID[a] := FramesArray[b].TexturesID[a];
541
542 Result := True;
543 end;
544
545 procedure g_Frames_DeleteByName(FramesName: ShortString);
546 var
547 a: DWORD;
548 b: Integer;
549 begin
550 if FramesArray = nil then Exit;
551
552 FramesName := LowerCase(FramesName);
553
554 for a := 0 to High(FramesArray) do
555 if FramesArray[a].Name = FramesName then
556 begin
557 if FramesArray[a].TexturesID <> nil then
558 for b := 0 to High(FramesArray[a].TexturesID) do
559 e_DeleteTexture(FramesArray[a].TexturesID[b]);
560 FramesArray[a].TexturesID := nil;
561 FramesArray[a].Name := '';
562 FramesArray[a].FrameWidth := 0;
563 FramesArray[a].FrameHeight := 0;
564 end;
565 end;
566
567 procedure g_Frames_DeleteByID(ID: DWORD);
568 var
569 b: Integer;
570 begin
571 if FramesArray = nil then Exit;
572
573 if FramesArray[ID].TexturesID <> nil then
574 for b := 0 to High(FramesArray[ID].TexturesID) do
575 e_DeleteTexture(FramesArray[ID].TexturesID[b]);
576 FramesArray[ID].TexturesID := nil;
577 FramesArray[ID].Name := '';
578 FramesArray[ID].FrameWidth := 0;
579 FramesArray[ID].FrameHeight := 0;
580 end;
581
582 procedure g_Frames_DeleteAll;
583 var
584 a: DWORD;
585 b: DWORD;
586 begin
587 if FramesArray = nil then Exit;
588
589 for a := 0 to High(FramesArray) do
590 if FramesArray[a].TexturesID <> nil then
591 begin
592 for b := 0 to High(FramesArray[a].TexturesID) do
593 e_DeleteTexture(FramesArray[a].TexturesID[b]);
594 FramesArray[a].TexturesID := nil;
595 FramesArray[a].Name := '';
596 FramesArray[a].FrameWidth := 0;
597 FramesArray[a].FrameHeight := 0;
598 end;
599
600 FramesArray := nil;
601 end;
602
603 function g_Frames_Get(out ID: DWORD; FramesName: ShortString): Boolean;
604 var
605 a: DWORD;
606 begin
607 Result := False;
608
609 if FramesArray = nil then
610 Exit;
611
612 FramesName := LowerCase(FramesName);
613
614 for a := 0 to High(FramesArray) do
615 if FramesArray[a].Name = FramesName then
616 begin
617 ID := a;
618 Result := True;
619 Break;
620 end;
621
622 if not Result then
623 g_FatalError(Format(_lc[I_GAME_ERROR_FRAMES], [FramesName]));
624 end;
625
626 function g_Frames_GetTexture(out ID: DWORD; FramesName: ShortString; Frame: Word): Boolean;
627 var
628 a: DWORD;
629 begin
630 Result := False;
631
632 if FramesArray = nil then
633 Exit;
634
635 FramesName := LowerCase(FramesName);
636
637 for a := 0 to High(FramesArray) do
638 if FramesArray[a].Name = FramesName then
639 if Frame <= High(FramesArray[a].TexturesID) then
640 begin
641 ID := FramesArray[a].TexturesID[Frame];
642 Result := True;
643 Break;
644 end;
645
646 if not Result then
647 g_FatalError(Format(_lc[I_GAME_ERROR_FRAMES], [FramesName]));
648 end;
649
650 function g_Frames_Exists(FramesName: string): Boolean;
651 var
652 a: DWORD;
653 begin
654 Result := False;
655
656 if FramesArray = nil then Exit;
657
658 FramesName := LowerCase(FramesName);
659
660 for a := 0 to High(FramesArray) do
661 if FramesArray[a].Name = FramesName then
662 begin
663 Result := True;
664 Exit;
665 end;
666 end;
667
668 procedure DumpTextureNames();
669 var
670 i: Integer;
671 begin
672 e_WriteLog('BEGIN Textures:', MSG_NOTIFY);
673 for i := 0 to High(TexturesArray) do
674 e_WriteLog(' '+IntToStr(i)+'. '+TexturesArray[i].Name, MSG_NOTIFY);
675 e_WriteLog('END Textures.', MSG_NOTIFY);
676
677 e_WriteLog('BEGIN Frames:', MSG_NOTIFY);
678 for i := 0 to High(FramesArray) do
679 e_WriteLog(' '+IntToStr(i)+'. '+FramesArray[i].Name, MSG_NOTIFY);
680 e_WriteLog('END Frames.', MSG_NOTIFY);
681 end;
682
683 { TAnimation }
684
685 constructor TAnimation.Create(FramesID: DWORD; Loop: Boolean; Speed: Byte);
686 begin
687 ID := FramesID;
688
689 FMinLength := 0;
690 FLoop := Loop;
691 FSpeed := Speed;
692 FEnabled := True;
693 FCurrentFrame := 0;
694 FPlayed := False;
695 FAlpha := 0;
696 FWidth := FramesArray[ID].FrameWidth;
697 FHeight := FramesArray[ID].FrameHeight;
698 end;
699
700 destructor TAnimation.Destroy;
701 begin
702 inherited;
703 end;
704
705 procedure TAnimation.Draw(X, Y: Integer; Mirror: TMirrorType);
706 begin
707 if not FEnabled then
708 Exit;
709
710 e_DrawAdv(FramesArray[ID].TexturesID[FCurrentFrame], X, Y, FAlpha,
711 True, FBlending, 0, nil, Mirror);
712 //e_DrawQuad(X, Y, X+FramesArray[ID].FrameWidth-1, Y+FramesArray[ID].FrameHeight-1, 0, 255, 0);
713 end;
714
715 procedure TAnimation.Update();
716 begin
717 if not FEnabled then
718 Exit;
719
720 FCounter := FCounter + 1;
721
722 if FCounter >= FSpeed then
723 begin // Îæèäàíèå ìåæäó êàäðàìè çàêîí÷èëîñü
724 if FRevert then
725 begin // Îáðàòíûé ïîðÿäîê êàäðîâ
726 // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå:
727 if FCurrentFrame = 0 then
728 if Length(FramesArray[ID].TexturesID) * FSpeed +
729 FCounter < FMinLength then
730 Exit;
731
732 FCurrentFrame := FCurrentFrame - 1;
733 FPlayed := FCurrentFrame < 0;
734
735 // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó:
736 if FPlayed then
737 if FLoop then
738 FCurrentFrame := High(FramesArray[ID].TexturesID)
739 else
740 FCurrentFrame := FCurrentFrame + 1;
741
742 FCounter := 0;
743 end
744 else
745 begin // Ïðÿìîé ïîðÿäîê êàäðîâ
746 // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå:
747 if FCurrentFrame = High(FramesArray[ID].TexturesID) then
748 if Length(FramesArray[ID].TexturesID) * FSpeed +
749 FCounter < FMinLength then
750 Exit;
751
752 FCurrentFrame := FCurrentFrame + 1;
753 FPlayed := (FCurrentFrame > High(FramesArray[ID].TexturesID));
754
755 // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó:
756 if FPlayed then
757 if FLoop then
758 FCurrentFrame := 0
759 else
760 FCurrentFrame := FCurrentFrame - 1;
761
762 FCounter := 0;
763 end;
764 end;
765 end;
766
767 procedure TAnimation.Reset();
768 begin
769 if FRevert then
770 FCurrentFrame := High(FramesArray[ID].TexturesID)
771 else
772 FCurrentFrame := 0;
773
774 FCounter := 0;
775 FPlayed := False;
776 end;
777
778 procedure TAnimation.Disable;
779 begin
780 FEnabled := False;
781 end;
782
783 procedure TAnimation.Enable;
784 begin
785 FEnabled := True;
786 end;
787
788 procedure TAnimation.DrawEx(X, Y: Integer; Mirror: TMirrorType; RPoint: TDFPoint;
789 Angle: SmallInt);
790 begin
791 if not FEnabled then
792 Exit;
793
794 e_DrawAdv(FramesArray[ID].TexturesID[FCurrentFrame], X, Y, FAlpha,
795 True, FBlending, Angle, @RPoint, Mirror);
796 end;
797
798 function TAnimation.TotalFrames(): Integer;
799 begin
800 Result := Length(FramesArray[ID].TexturesID);
801 end;
802
803 procedure TAnimation.Revert(r: Boolean);
804 begin
805 FRevert := r;
806 Reset();
807 end;
808
809 procedure TAnimation.SaveState(Var Mem: TBinMemoryWriter);
810 var
811 sig: DWORD;
812 begin
813 if Mem = nil then
814 Exit;
815
816 // Ñèãíàòóðà àíèìàöèè:
817 sig := ANIM_SIGNATURE; // 'ANIM'
818 Mem.WriteDWORD(sig);
819 // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè:
820 Mem.WriteByte(FCounter);
821 // Òåêóùèé êàäð:
822 Mem.WriteInt(FCurrentFrame);
823 // Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì:
824 Mem.WriteBoolean(FPlayed);
825 // Alpha-êàíàë âñåé òåêñòóðû:
826 Mem.WriteByte(FAlpha);
827 // Ðàçìûòèå òåêñòóðû:
828 Mem.WriteBoolean(FBlending);
829 // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè:
830 Mem.WriteByte(FSpeed);
831 // Çàöèêëåíà ëè àíèìàöèÿ:
832 Mem.WriteBoolean(FLoop);
833 // Âêëþ÷åíà ëè:
834 Mem.WriteBoolean(FEnabled);
835 // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ:
836 Mem.WriteByte(FMinLength);
837 // Îáðàòíûé ëè ïîðÿäîê êàäðîâ:
838 Mem.WriteBoolean(FRevert);
839 end;
840
841 procedure TAnimation.LoadState(Var Mem: TBinMemoryReader);
842 var
843 sig: DWORD;
844 begin
845 if Mem = nil then
846 Exit;
847
848 // Ñèãíàòóðà àíèìàöèè:
849 Mem.ReadDWORD(sig);
850 if sig <> ANIM_SIGNATURE then // 'ANIM'
851 begin
852 raise EBinSizeError.Create('TAnimation.LoadState: Wrong Animation Signature');
853 end;
854 // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè:
855 Mem.ReadByte(FCounter);
856 // Òåêóùèé êàäð:
857 Mem.ReadInt(FCurrentFrame);
858 // Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì:
859 Mem.ReadBoolean(FPlayed);
860 // Alpha-êàíàë âñåé òåêñòóðû:
861 Mem.ReadByte(FAlpha);
862 // Ðàçìûòèå òåêñòóðû:
863 Mem.ReadBoolean(FBlending);
864 // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè:
865 Mem.ReadByte(FSpeed);
866 // Çàöèêëåíà ëè àíèìàöèÿ:
867 Mem.ReadBoolean(FLoop);
868 // Âêëþ÷åíà ëè:
869 Mem.ReadBoolean(FEnabled);
870 // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ:
871 Mem.ReadByte(FMinLength);
872 // Îáðàòíûé ëè ïîðÿäîê êàäðîâ:
873 Mem.ReadBoolean(FRevert);
874 end;
875
876
877 var
878 ltexid: GLuint = 0;
879
880 function g_Texture_Light(): Integer;
881 const
882 Radius: Integer = 128;
883 var
884 tex, tpp: PByte;
885 x, y, a: Integer;
886 dist: Double;
887 begin
888 if ltexid = 0 then
889 begin
890 GetMem(tex, (Radius*2)*(Radius*2)*4);
891 tpp := tex;
892 for y := 0 to Radius*2-1 do
893 begin
894 for x := 0 to Radius*2-1 do
895 begin
896 dist := 1.0-sqrt((x-Radius)*(x-Radius)+(y-Radius)*(y-Radius))/Radius;
897 if (dist < 0) then
898 begin
899 tpp^ := 0; Inc(tpp);
900 tpp^ := 0; Inc(tpp);
901 tpp^ := 0; Inc(tpp);
902 tpp^ := 0; Inc(tpp);
903 end
904 else
905 begin
906 //tc.setPixel(x, y, Color(cast(int)(dist*255), cast(int)(dist*255), cast(int)(dist*255)));
907 if (dist > 0.5) then dist := 0.5;
908 a := round(dist*255);
909 if (a < 0) then a := 0 else if (a > 255) then a := 255;
910 tpp^ := 255; Inc(tpp);
911 tpp^ := 255; Inc(tpp);
912 tpp^ := 255; Inc(tpp);
913 tpp^ := Byte(a); Inc(tpp);
914 end;
915 end;
916 end;
917
918 glGenTextures(1, @ltexid);
919 //if (tid == 0) assert(0, "VGL: can't create screen texture");
920
921 glBindTexture(GL_TEXTURE_2D, ltexid);
922 glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT);
923 glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT);
924 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
925 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
926
927 //GLfloat[4] bclr = 0.0;
928 //glTexParameterfv(GL_TEXTURE_2D, GL_TEXTURE_BORDER_COLOR, bclr.ptr);
929
930 glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, Radius*2, Radius*2, 0, GL_RGBA{gltt}, GL_UNSIGNED_BYTE, tex);
931 end;
932
933 result := ltexid;
934 end;
935
936 end.
[MIRROR] a port of Doom 2D Forever to FPC/SDL
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024