DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-sdl.git / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
fixed some warnings
[d2df-sdl.git] / src / engine / e_graphics.pas
1 unit e_graphics;
2
3 interface
4
5 uses
6 SysUtils, Math, e_log, e_textures, SDL2, GL, GLExt, MAPDEF;
7
8 type
9 TMirrorType=(M_NONE, M_HORIZONTAL, M_VERTICAL);
10 TBlending=(B_NONE, B_BLEND, B_FILTER, B_INVERT);
11
12 TPoint2i = record
13 X, Y: Integer;
14 end;
15
16 TPoint = MAPDEF.TPoint; // TODO: create an utiltypes.pas or something
17 // for other types like rect as well
18
19 TPoint2f = record
20 X, Y: Double;
21 end;
22
23 TRect = record
24 Left, Top, Right, Bottom: Integer;
25 end;
26
27 TRectWH = record
28 X, Y: Integer;
29 Width, Height: Word;
30 end;
31
32 TRGB = packed record
33 R, G, B: Byte;
34 end;
35
36 PPoint = ^TPoint;
37 PPoint2f = ^TPoint2f;
38 PRect = ^TRect;
39 PRectWH = ^TRectWH;
40
41
42 //------------------------------------------------------------------
43 // ïðîòîòèïû ôóíêöèé
44 //------------------------------------------------------------------
45 procedure e_InitGL();
46 procedure e_SetViewPort(X, Y, Width, Height: Word);
47 procedure e_ResizeWindow(Width, Height: Integer);
48
49 procedure e_Draw(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
50 Blending: Boolean; Mirror: TMirrorType = M_NONE);
51 procedure e_DrawAdv(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
52 Blending: Boolean; Angle: Single; RC: PPoint; Mirror: TMirrorType = M_NONE);
53 procedure e_DrawSize(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
54 Blending: Boolean; Width, Height: Word; Mirror: TMirrorType = M_NONE);
55 procedure e_DrawSizeMirror(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
56 Blending: Boolean; Width, Height: Word; Mirror: TMirrorType = M_NONE);
57 procedure e_DrawFill(ID: DWORD; X, Y: Integer; XCount, YCount: Word; Alpha: Integer;
58 AlphaChannel: Boolean; Blending: Boolean);
59 procedure e_DrawPoint(Size: Byte; X, Y: Integer; Red, Green, Blue: Byte);
60 procedure e_DrawLine(Width: Byte; X1, Y1, X2, Y2: Integer; Red, Green, Blue: Byte; Alpha: Byte = 0);
61 procedure e_DrawQuad(X1, Y1, X2, Y2: Integer; Red, Green, Blue: Byte; Alpha: Byte = 0);
62 procedure e_DrawFillQuad(X1, Y1, X2, Y2: Integer; Red, Green, Blue, Alpha: Byte;
63 Blending: TBlending = B_NONE);
64
65 function e_CreateTexture(FileName: string; var ID: DWORD): Boolean;
66 function e_CreateTextureEx(FileName: string; var ID: DWORD; fX, fY, fWidth, fHeight: Word): Boolean;
67 function e_CreateTextureMem(pData: Pointer; var ID: DWORD): Boolean;
68 function e_CreateTextureMemEx(pData: Pointer; var ID: DWORD; fX, fY, fWidth, fHeight: Word): Boolean;
69 procedure e_GetTextureSize(ID: DWORD; Width, Height: PWord);
70 function e_GetTextureSize2(ID: DWORD): TRectWH;
71 procedure e_DeleteTexture(ID: DWORD);
72 procedure e_RemoveAllTextures();
73
74 // CharFont
75 function e_CharFont_Create(sp: ShortInt=0): DWORD;
76 procedure e_CharFont_AddChar(FontID: DWORD; Texture: Integer; c: Char; w: Byte);
77 procedure e_CharFont_Print(FontID: DWORD; X, Y: Integer; Text: string);
78 procedure e_CharFont_PrintEx(FontID: DWORD; X, Y: Integer; Text: string;
79 Color: TRGB; Scale: Single = 1.0);
80 procedure e_CharFont_PrintFmt(FontID: DWORD; X, Y: Integer; Text: string);
81 procedure e_CharFont_GetSize(FontID: DWORD; Text: string; var w, h: Word);
82 procedure e_CharFont_GetSizeFmt(FontID: DWORD; Text: string; var w, h: Word);
83 function e_CharFont_GetMaxWidth(FontID: DWORD): Word;
84 function e_CharFont_GetMaxHeight(FontID: DWORD): Word;
85 procedure e_CharFont_Remove(FontID: DWORD);
86 procedure e_CharFont_RemoveAll();
87
88 // TextureFont
89 procedure e_TextureFontBuild(Tex: DWORD; var FontID: DWORD; XCount, YCount: Word;
90 Space: ShortInt=0);
91 procedure e_TextureFontKill(FontID: DWORD);
92 procedure e_TextureFontPrint(X, Y: GLint; Text: string; FontID: DWORD);
93 procedure e_TextureFontPrintEx(X, Y: GLint; Text: string; FontID: DWORD; Red, Green,
94 Blue: Byte; Scale: Single; Shadow: Boolean = False);
95 procedure e_TextureFontPrintFmt(X, Y: GLint; Text: string; FontID: DWORD; Shadow: Boolean = False);
96 procedure e_TextureFontGetSize(ID: DWORD; var CharWidth, CharHeight: Byte);
97 procedure e_RemoveAllTextureFont();
98
99 procedure e_ReleaseEngine();
100 procedure e_BeginRender();
101 procedure e_Clear(Mask: TGLbitfield; Red, Green, Blue: Single); overload;
102 procedure e_Clear(); overload;
103 procedure e_EndRender();
104
105 procedure e_SaveGLContext();
106 procedure e_RestoreGLContext();
107
108 function e_GetGamma(win: PSDL_Window): Byte;
109 procedure e_SetGamma(win: PSDL_Window;Gamma: Byte);
110
111 procedure e_MakeScreenshot(FileName: string; Width, Height: Word);
112
113 function _RGB(Red, Green, Blue: Byte): TRGB;
114 function _Point(X, Y: Integer): TPoint2i;
115 function _Rect(X, Y: Integer; Width, Height: Word): TRectWH;
116 function _TRect(L, T, R, B: LongInt): TRect;
117
118
119 var
120 e_Colors: TRGB;
121
122 implementation
123
124 type
125 TTexture = record
126 //ID: DWORD;
127 tx: GLTexture;
128 Width: Word;
129 Height: Word;
130 Fmt: Word;
131 end;
132
133 TTextureFont = record
134 Texture: DWORD;
135 TextureID: DWORD;
136 Base: Uint32;
137 CharWidth: Byte;
138 CharHeight: Byte;
139 XC, YC, SPC: Word;
140 end;
141
142 TCharFont = record
143 Chars: array[0..255] of
144 record
145 TextureID: Integer;
146 Width: Byte;
147 end;
148 Space: ShortInt;
149 Height: ShortInt;
150 Live: Boolean;
151 end;
152
153 TSavedTexture = record
154 TexID: DWORD;
155 OldID: DWORD;
156 Pixels: Pointer;
157 end;
158
159 var
160 e_Textures: array of TTexture = nil;
161 e_TextureFonts: array of TTextureFont = nil;
162 e_CharFonts: array of TCharFont;
163 e_SavedTextures: array of TSavedTexture;
164
165 //------------------------------------------------------------------
166 // Èíèöèàëèçèðóåò OpenGL
167 //------------------------------------------------------------------
168 procedure e_InitGL();
169 begin
170 glDisable(GL_DEPTH_TEST);
171 glEnable(GL_SCISSOR_TEST);
172 e_Colors.R := 255;
173 e_Colors.G := 255;
174 e_Colors.B := 255;
175 glClearColor(0, 0, 0, 0);
176 end;
177
178 procedure e_SetViewPort(X, Y, Width, Height: Word);
179 var
180 mat: Array [0..15] of GLDouble;
181
182 begin
183 glLoadIdentity();
184 glScissor(X, Y, Width, Height);
185 glViewport(X, Y, Width, Height);
186 //gluOrtho2D(0, Width, Height, 0);
187
188 glMatrixMode(GL_PROJECTION);
189
190 mat[ 0] := 2.0 / Width;
191 mat[ 1] := 0.0;
192 mat[ 2] := 0.0;
193 mat[ 3] := 0.0;
194
195 mat[ 4] := 0.0;
196 mat[ 5] := -2.0 / Height;
197 mat[ 6] := 0.0;
198 mat[ 7] := 0.0;
199
200 mat[ 8] := 0.0;
201 mat[ 9] := 0.0;
202 mat[10] := 1.0;
203 mat[11] := 0.0;
204
205 mat[12] := -1.0;
206 mat[13] := 1.0;
207 mat[14] := 0.0;
208 mat[15] := 1.0;
209
210 glLoadMatrixd(@mat[0]);
211
212 glMatrixMode(GL_MODELVIEW);
213 glLoadIdentity();
214 end;
215
216 //------------------------------------------------------------------
217 // Èùåò ñâîáîäíûé ýëåìåíò â ìàññèâå òåêñòóð
218 //------------------------------------------------------------------
219 function FindTexture(): DWORD;
220 var
221 i: integer;
222 begin
223 if e_Textures <> nil then
224 for i := 0 to High(e_Textures) do
225 if e_Textures[i].Width = 0 then
226 begin
227 Result := i;
228 Exit;
229 end;
230
231 if e_Textures = nil then
232 begin
233 SetLength(e_Textures, 32);
234 Result := 0;
235 end
236 else
237 begin
238 Result := High(e_Textures) + 1;
239 SetLength(e_Textures, Length(e_Textures) + 32);
240 end;
241 end;
242
243 //------------------------------------------------------------------
244 // Ñîçäàåò òåêñòóðó
245 //------------------------------------------------------------------
246 function e_CreateTexture(FileName: String; var ID: DWORD): Boolean;
247 var
248 find_id: DWORD;
249 fmt: Word;
250 begin
251 Result := False;
252
253 e_WriteLog('Loading texture from '+FileName, MSG_NOTIFY);
254
255 find_id := FindTexture();
256
257 if not LoadTexture(FileName, e_Textures[find_id].tx, e_Textures[find_id].Width,
258 e_Textures[find_id].Height, @fmt) then Exit;
259
260 ID := find_id;
261 e_Textures[ID].Fmt := fmt;
262
263 Result := True;
264 end;
265
266 function e_CreateTextureEx(FileName: String; var ID: DWORD; fX, fY, fWidth, fHeight: Word): Boolean;
267 var
268 find_id: DWORD;
269 fmt: Word;
270 begin
271 Result := False;
272
273 find_id := FindTexture();
274
275 if not LoadTextureEx(FileName, e_Textures[find_id].tx, fX, fY, fWidth, fHeight, @fmt) then exit;
276
277 e_Textures[find_id].Width := fWidth;
278 e_Textures[find_id].Height := fHeight;
279 e_Textures[find_id].Fmt := fmt;
280
281 ID := find_id;
282
283 Result := True;
284 end;
285
286 function e_CreateTextureMem(pData: Pointer; var ID: DWORD): Boolean;
287 var
288 find_id: DWORD;
289 fmt: Word;
290 begin
291 Result := False;
292
293 find_id := FindTexture;
294
295 if not LoadTextureMem(pData, e_Textures[find_id].tx, e_Textures[find_id].Width,
296 e_Textures[find_id].Height, @fmt) then exit;
297
298 id := find_id;
299 e_Textures[id].Fmt := fmt;
300
301 Result := True;
302 end;
303
304 function e_CreateTextureMemEx(pData: Pointer; var ID: DWORD; fX, fY, fWidth, fHeight: Word): Boolean;
305 var
306 find_id: DWORD;
307 fmt: Word;
308 begin
309 Result := False;
310
311 find_id := FindTexture();
312
313 if not LoadTextureMemEx(pData, e_Textures[find_id].tx, fX, fY, fWidth, fHeight, @fmt) then exit;
314
315 e_Textures[find_id].Width := fWidth;
316 e_Textures[find_id].Height := fHeight;
317 e_Textures[find_id].Fmt := fmt;
318
319 ID := find_id;
320
321 Result := True;
322 end;
323
324 procedure e_GetTextureSize(ID: DWORD; Width, Height: PWord);
325 begin
326 if Width <> nil then Width^ := e_Textures[ID].Width;
327 if Height <> nil then Height^ := e_Textures[ID].Height;
328 end;
329
330 function e_GetTextureSize2(ID: DWORD): TRectWH;
331 var
332 data: PChar;
333 x, y: Integer;
334 w, h: Word;
335 a: Boolean;
336 lastline: Integer;
337 begin
338 w := e_Textures[ID].Width;
339 h := e_Textures[ID].Height;
340 data := GetMemory(w*h*4);
341 glEnable(GL_TEXTURE_2D);
342 glBindTexture(GL_TEXTURE_2D, e_Textures[ID].tx.id);
343 glGetTexImage(GL_TEXTURE_2D, 0, GL_RGBA, GL_UNSIGNED_BYTE, data);
344
345 Result.Y := 0;
346 Result.X := 0;
347 Result.Width := w;
348 Result.Height := h;
349
350 for y := h-1 downto 0 do
351 begin
352 lastline := y;
353 a := True;
354
355 for x := 1 to w-4 do
356 begin
357 a := Byte((data+y*w*4+x*4+3)^) <> 0;
358 if a then Break;
359 end;
360
361 if a then
362 begin
363 Result.Y := h-lastline;
364 Break;
365 end;
366 end;
367
368 for y := 0 to h-1 do
369 begin
370 lastline := y;
371 a := True;
372
373 for x := 1 to w-4 do
374 begin
375 a := Byte((data+y*w*4+x*4+3)^) <> 0;
376 if a then Break;
377 end;
378
379 if a then
380 begin
381 Result.Height := h-lastline-Result.Y;
382 Break;
383 end;
384 end;
385
386 for x := 0 to w-1 do
387 begin
388 lastline := x;
389 a := True;
390
391 for y := 1 to h-4 do
392 begin
393 a := Byte((data+y*w*4+x*4+3)^) <> 0;
394 if a then Break;
395 end;
396
397 if a then
398 begin
399 Result.X := lastline+1;
400 Break;
401 end;
402 end;
403
404 for x := w-1 downto 0 do
405 begin
406 lastline := x;
407 a := True;
408
409 for y := 1 to h-4 do
410 begin
411 a := Byte((data+y*w*4+x*4+3)^) <> 0;
412 if a then Break;
413 end;
414
415 if a then
416 begin
417 Result.Width := lastline-Result.X+1;
418 Break;
419 end;
420 end;
421
422 FreeMemory(data);
423 end;
424
425 procedure e_ResizeWindow(Width, Height: Integer);
426 begin
427 if Height = 0 then
428 Height := 1;
429 e_SetViewPort(0, 0, Width, Height);
430 end;
431
432 procedure e_Draw(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
433 Blending: Boolean; Mirror: TMirrorType = M_NONE);
434 var
435 u, v: Single;
436 begin
437 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
438
439 if (Alpha > 0) or (AlphaChannel) or (Blending) then
440 glEnable(GL_BLEND)
441 else
442 glDisable(GL_BLEND);
443
444 if (AlphaChannel) or (Alpha > 0) then
445 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
446
447 if Alpha > 0 then
448 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255-Alpha);
449
450 if Blending then
451 glBlendFunc(GL_SRC_ALPHA, GL_ONE);
452
453 glEnable(GL_TEXTURE_2D);
454 glBindTexture(GL_TEXTURE_2D, e_Textures[ID].tx.id);
455 glBegin(GL_QUADS);
456
457 u := e_Textures[ID].tx.u;
458 v := e_Textures[ID].tx.v;
459
460 if Mirror = M_NONE then
461 begin
462 glTexCoord2f(u, 0); glVertex2i(X + e_Textures[id].Width, Y);
463 glTexCoord2f(0, 0); glVertex2i(X, Y);
464 glTexCoord2f(0, -v); glVertex2i(X, Y + e_Textures[id].Height);
465 glTexCoord2f(u, -v); glVertex2i(X + e_Textures[id].Width, Y + e_Textures[id].Height);
466 end
467 else
468 if Mirror = M_HORIZONTAL then
469 begin
470 glTexCoord2f(u, 0); glVertex2i(X, Y);
471 glTexCoord2f(0, 0); glVertex2i(X + e_Textures[id].Width, Y);
472 glTexCoord2f(0, -v); glVertex2i(X + e_Textures[id].Width, Y + e_Textures[id].Height);
473 glTexCoord2f(u, -v); glVertex2i(X, Y + e_Textures[id].Height);
474 end
475 else
476 if Mirror = M_VERTICAL then
477 begin
478 glTexCoord2f(u, -v); glVertex2i(X + e_Textures[id].Width, Y);
479 glTexCoord2f(0, -v); glVertex2i(X, Y);
480 glTexCoord2f(0, 0); glVertex2i(X, Y + e_Textures[id].Height);
481 glTexCoord2f(u, 0); glVertex2i(X + e_Textures[id].Width, Y + e_Textures[id].Height);
482 end;
483
484 glEnd();
485
486 glDisable(GL_BLEND);
487 end;
488
489 procedure e_DrawSize(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
490 Blending: Boolean; Width, Height: Word; Mirror: TMirrorType = M_NONE);
491 var
492 u, v: Single;
493 begin
494 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
495
496 if (Alpha > 0) or (AlphaChannel) or (Blending) then
497 glEnable(GL_BLEND)
498 else
499 glDisable(GL_BLEND);
500
501 if (AlphaChannel) or (Alpha > 0) then
502 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
503
504 if Alpha > 0 then
505 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255-Alpha);
506
507 if Blending then
508 glBlendFunc(GL_SRC_ALPHA, GL_ONE);
509
510 glEnable(GL_TEXTURE_2D);
511 glBindTexture(GL_TEXTURE_2D, e_Textures[ID].tx.id);
512
513 u := e_Textures[ID].tx.u;
514 v := e_Textures[ID].tx.v;
515
516 glBegin(GL_QUADS);
517 glTexCoord2f(0, v); glVertex2i(X, Y);
518 glTexCoord2f(u, v); glVertex2i(X + Width, Y);
519 glTexCoord2f(u, 0); glVertex2i(X + Width, Y + Height);
520 glTexCoord2f(0, 0); glVertex2i(X, Y + Height);
521 glEnd();
522
523 glDisable(GL_BLEND);
524 end;
525
526 procedure e_DrawSizeMirror(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
527 Blending: Boolean; Width, Height: Word; Mirror: TMirrorType = M_NONE);
528 var
529 u, v: Single;
530 begin
531 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
532
533 if (Alpha > 0) or (AlphaChannel) or (Blending) then
534 glEnable(GL_BLEND)
535 else
536 glDisable(GL_BLEND);
537
538 if (AlphaChannel) or (Alpha > 0) then
539 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
540
541 if Alpha > 0 then
542 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255-Alpha);
543
544 if Blending then
545 glBlendFunc(GL_SRC_ALPHA, GL_ONE);
546
547 glEnable(GL_TEXTURE_2D);
548 glBindTexture(GL_TEXTURE_2D, e_Textures[ID].tx.id);
549 glBegin(GL_QUADS);
550
551 u := e_Textures[ID].tx.u;
552 v := e_Textures[ID].tx.v;
553
554 if Mirror = M_NONE then
555 begin
556 glTexCoord2f(u, 0); glVertex2i(X + Width, Y);
557 glTexCoord2f(0, 0); glVertex2i(X, Y);
558 glTexCoord2f(0, -v); glVertex2i(X, Y + Height);
559 glTexCoord2f(u, -v); glVertex2i(X + Width, Y + Height);
560 end
561 else
562 if Mirror = M_HORIZONTAL then
563 begin
564 glTexCoord2f(u, 0); glVertex2i(X, Y);
565 glTexCoord2f(0, 0); glVertex2i(X + Width, Y);
566 glTexCoord2f(0, -v); glVertex2i(X + Width, Y + Height);
567 glTexCoord2f(u, -v); glVertex2i(X, Y + Height);
568 end
569 else
570 if Mirror = M_VERTICAL then
571 begin
572 glTexCoord2f(u, -v); glVertex2i(X + Width, Y);
573 glTexCoord2f(0, -v); glVertex2i(X, Y);
574 glTexCoord2f(0, 0); glVertex2i(X, Y + Height);
575 glTexCoord2f(u, 0); glVertex2i(X + Width, Y + Height);
576 end;
577
578 glEnd();
579
580 glDisable(GL_BLEND);
581 end;
582
583 procedure e_DrawFill(ID: DWORD; X, Y: Integer; XCount, YCount: Word; Alpha: Integer;
584 AlphaChannel: Boolean; Blending: Boolean);
585 var
586 X2, Y2, dx, w, h: Integer;
587 u, v: Single;
588 begin
589 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
590
591 if (Alpha > 0) or (AlphaChannel) or (Blending) then
592 glEnable(GL_BLEND)
593 else
594 glDisable(GL_BLEND);
595
596 if (AlphaChannel) or (Alpha > 0) then
597 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
598
599 if Alpha > 0 then
600 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255-Alpha);
601
602 if Blending then
603 glBlendFunc(GL_SRC_ALPHA, GL_ONE);
604
605 if XCount = 0 then
606 XCount := 1;
607
608 if YCount = 0 then
609 YCount := 1;
610
611 glEnable(GL_TEXTURE_2D);
612 glBindTexture(GL_TEXTURE_2D, e_Textures[ID].tx.id);
613
614 X2 := X + e_Textures[ID].Width * XCount;
615 Y2 := Y + e_Textures[ID].Height * YCount;
616
617 //k8: this SHOULD work... i hope
618 if (e_Textures[ID].tx.width = e_Textures[ID].tx.glwidth) and (e_Textures[ID].tx.height = e_Textures[ID].tx.glheight) then
619 begin
620 glBegin(GL_QUADS);
621 glTexCoord2i(0, YCount); glVertex2i(X, Y);
622 glTexCoord2i(XCount, YCount); glVertex2i(X2, Y);
623 glTexCoord2i(XCount, 0); glVertex2i(X2, Y2);
624 glTexCoord2i(0, 0); glVertex2i(X, Y2);
625 glEnd();
626 end
627 else
628 begin
629 glBegin(GL_QUADS);
630 // hard day's night
631 u := e_Textures[ID].tx.u;
632 v := e_Textures[ID].tx.v;
633 w := e_Textures[ID].tx.width;
634 h := e_Textures[ID].tx.height;
635 while YCount > 0 do
636 begin
637 dx := XCount;
638 x2 := X;
639 while dx > 0 do
640 begin
641 glTexCoord2f(0, v); glVertex2i(X, Y);
642 glTexCoord2f(u, v); glVertex2i(X+w, Y);
643 glTexCoord2f(u, 0); glVertex2i(X+w, Y+h);
644 glTexCoord2f(0, 0); glVertex2i(X, Y+h);
645 Inc(X, w);
646 Dec(dx);
647 end;
648 X := x2;
649 Inc(Y, h);
650 Dec(YCount);
651 end;
652 glEnd();
653 end;
654
655 glDisable(GL_BLEND);
656 end;
657
658 procedure e_DrawAdv(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
659 Blending: Boolean; Angle: Single; RC: PPoint; Mirror: TMirrorType = M_NONE);
660 var
661 u, v: Single;
662 begin
663 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
664
665 if (Alpha > 0) or (AlphaChannel) or (Blending) then
666 glEnable(GL_BLEND)
667 else
668 glDisable(GL_BLEND);
669
670 if (AlphaChannel) or (Alpha > 0) then
671 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
672
673 if Alpha > 0 then
674 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255-Alpha);
675
676 if Blending then
677 glBlendFunc(GL_SRC_ALPHA, GL_ONE);
678
679 if (Angle <> 0) and (RC <> nil) then
680 begin
681 glPushMatrix();
682 glTranslatef(X+RC.X, Y+RC.Y, 0);
683 glRotatef(Angle, 0, 0, 1);
684 glTranslatef(-(X+RC.X), -(Y+RC.Y), 0);
685 end;
686
687 glEnable(GL_TEXTURE_2D);
688 glBindTexture(GL_TEXTURE_2D, e_Textures[id].tx.id);
689 glBegin(GL_QUADS); //0-1 1-1
690 //00 10
691
692 u := e_Textures[ID].tx.u;
693 v := e_Textures[ID].tx.v;
694
695 if Mirror = M_NONE then
696 begin
697 glTexCoord2f(u, 0); glVertex2i(X + e_Textures[id].Width, Y);
698 glTexCoord2f(0, 0); glVertex2i(X, Y);
699 glTexCoord2f(0, -v); glVertex2i(X, Y + e_Textures[id].Height);
700 glTexCoord2f(u, -v); glVertex2i(X + e_Textures[id].Width, Y + e_Textures[id].Height);
701 end
702 else
703 if Mirror = M_HORIZONTAL then
704 begin
705 glTexCoord2f(u, 0); glVertex2i(X, Y);
706 glTexCoord2f(0, 0); glVertex2i(X + e_Textures[id].Width, Y);
707 glTexCoord2f(0, -v); glVertex2i(X + e_Textures[id].Width, Y + e_Textures[id].Height);
708 glTexCoord2f(u, -v); glVertex2i(X, Y + e_Textures[id].Height);
709 end
710 else
711 if Mirror = M_VERTICAL then
712 begin
713 glTexCoord2f(u, -v); glVertex2i(X + e_Textures[id].Width, Y);
714 glTexCoord2f(0, -v); glVertex2i(X, Y);
715 glTexCoord2f(0, 0); glVertex2i(X, Y + e_Textures[id].Height);
716 glTexCoord2f(u, 0); glVertex2i(X + e_Textures[id].Width, Y + e_Textures[id].Height);
717 end;
718
719 glEnd();
720
721 if Angle <> 0 then
722 glPopMatrix();
723
724 glDisable(GL_BLEND);
725 end;
726
727 procedure e_DrawPoint(Size: Byte; X, Y: Integer; Red, Green, Blue: Byte);
728 begin
729 glDisable(GL_TEXTURE_2D);
730 glColor3ub(Red, Green, Blue);
731 glPointSize(Size);
732
733 if (Size = 2) or (Size = 4) then
734 X := X + 1;
735
736 glBegin(GL_POINTS);
737 glVertex2f(X+0.3, Y+1.0);
738 glEnd();
739
740 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
741 end;
742
743 procedure e_LineCorrection(var X1, Y1, X2, Y2: Integer);
744 begin
745 // Make lines only top-left/bottom-right and top-right/bottom-left
746 if Y2 < Y1 then
747 begin
748 X1 := X1 xor X2;
749 X2 := X1 xor X2;
750 X1 := X1 xor X2;
751
752 Y1 := Y1 xor Y2;
753 Y2 := Y1 xor Y2;
754 Y1 := Y1 xor Y2;
755 end;
756
757 // Pixel-perfect hack
758 if X1 < X2 then
759 Inc(X2)
760 else
761 Inc(X1);
762 Inc(Y2);
763 end;
764
765 procedure e_DrawQuad(X1, Y1, X2, Y2: Integer; Red, Green, Blue: Byte; Alpha: Byte = 0);
766 var
767 nX1, nY1, nX2, nY2: Integer;
768 begin
769 // Only top-left/bottom-right quad
770 if X1 > X2 then
771 begin
772 X1 := X1 xor X2;
773 X2 := X1 xor X2;
774 X1 := X1 xor X2;
775 end;
776 if Y1 > Y2 then
777 begin
778 Y1 := Y1 xor Y2;
779 Y2 := Y1 xor Y2;
780 Y1 := Y1 xor Y2;
781 end;
782
783 if Alpha > 0 then
784 begin
785 glEnable(GL_BLEND);
786 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
787 end else
788 glDisable(GL_BLEND);
789
790 glDisable(GL_TEXTURE_2D);
791 glColor4ub(Red, Green, Blue, 255-Alpha);
792 glLineWidth(1);
793
794 glBegin(GL_LINES);
795 nX1 := X1; nY1 := Y1;
796 nX2 := X2; nY2 := Y1;
797 e_LineCorrection(nX1, nY1, nX2, nY2); // Pixel-perfect lines
798 glVertex2i(nX1, nY1);
799 glVertex2i(nX2, nY2);
800
801 nX1 := X2; nY1 := Y1;
802 nX2 := X2; nY2 := Y2;
803 e_LineCorrection(nX1, nY1, nX2, nY2);
804 glVertex2i(nX1, nY1);
805 glVertex2i(nX2, nY2);
806
807 nX1 := X2; nY1 := Y2;
808 nX2 := X1; nY2 := Y2;
809 e_LineCorrection(nX1, nY1, nX2, nY2);
810 glVertex2i(nX1, nY1);
811 glVertex2i(nX2, nY2);
812
813 nX1 := X1; nY1 := Y2;
814 nX2 := X1; nY2 := Y1;
815 e_LineCorrection(nX1, nY1, nX2, nY2);
816 glVertex2i(nX1, nY1);
817 glVertex2i(nX2, nY2);
818 glEnd();
819
820 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
821
822 glDisable(GL_BLEND);
823 end;
824
825 procedure e_DrawFillQuad(X1, Y1, X2, Y2: Integer; Red, Green, Blue, Alpha: Byte;
826 Blending: TBlending = B_NONE);
827 begin
828 if (Alpha > 0) or (Blending <> B_NONE) then
829 glEnable(GL_BLEND)
830 else
831 glDisable(GL_BLEND);
832
833 if Blending = B_BLEND then
834 glBlendFunc(GL_SRC_ALPHA, GL_ONE)
835 else
836 if Blending = B_FILTER then
837 glBlendFunc(GL_DST_COLOR, GL_SRC_COLOR)
838 else
839 if Blending = B_INVERT then
840 glBlendFunc(GL_ONE_MINUS_DST_COLOR, GL_ZERO)
841 else
842 if Alpha > 0 then
843 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
844
845 glDisable(GL_TEXTURE_2D);
846 glColor4ub(Red, Green, Blue, 255-Alpha);
847
848 X2 := X2 + 1;
849 Y2 := Y2 + 1;
850
851 glBegin(GL_QUADS);
852 glVertex2i(X1, Y1);
853 glVertex2i(X2, Y1);
854 glVertex2i(X2, Y2);
855 glVertex2i(X1, Y2);
856 glEnd();
857
858 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
859
860 glDisable(GL_BLEND);
861 end;
862
863 procedure e_DrawLine(Width: Byte; X1, Y1, X2, Y2: Integer; Red, Green, Blue: Byte; Alpha: Byte = 0);
864 begin
865 // Pixel-perfect lines
866 if Width = 1 then
867 e_LineCorrection(X1, Y1, X2, Y2);
868
869 if Alpha > 0 then
870 begin
871 glEnable(GL_BLEND);
872 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
873 end else
874 glDisable(GL_BLEND);
875
876 glDisable(GL_TEXTURE_2D);
877 glColor4ub(Red, Green, Blue, 255-Alpha);
878 glLineWidth(Width);
879
880 glBegin(GL_LINES);
881 glVertex2i(X1, Y1);
882 glVertex2i(X2, Y2);
883 glEnd();
884
885 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
886
887 glDisable(GL_BLEND);
888 end;
889
890 //------------------------------------------------------------------
891 // Óäàëÿåò òåêñòóðó èç ìàññèâà
892 //------------------------------------------------------------------
893 procedure e_DeleteTexture(ID: DWORD);
894 begin
895 glDeleteTextures(1, @e_Textures[ID].tx.id);
896 e_Textures[ID].tx.id := 0;
897 e_Textures[ID].Width := 0;
898 e_Textures[ID].Height := 0;
899 end;
900
901 //------------------------------------------------------------------
902 // Óäàëÿåò âñå òåêñòóðû
903 //------------------------------------------------------------------
904 procedure e_RemoveAllTextures();
905 var
906 i: integer;
907 begin
908 if e_Textures = nil then Exit;
909
910 for i := 0 to High(e_Textures) do
911 if e_Textures[i].Width <> 0 then e_DeleteTexture(i);
912 e_Textures := nil;
913 end;
914
915 //------------------------------------------------------------------
916 // Óäàëÿåò äâèæîê
917 //------------------------------------------------------------------
918 procedure e_ReleaseEngine();
919 begin
920 e_RemoveAllTextures;
921 e_RemoveAllTextureFont;
922 end;
923
924 procedure e_BeginRender();
925 begin
926 glEnable(GL_ALPHA_TEST);
927 glAlphaFunc(GL_GREATER, 0.0);
928 end;
929
930 procedure e_Clear(Mask: TGLbitfield; Red, Green, Blue: Single); overload;
931 begin
932 glClearColor(Red, Green, Blue, 0);
933 glClear(Mask);
934 end;
935
936 procedure e_Clear(); overload;
937 begin
938 glClearColor(0, 0, 0, 0);
939 glClear(GL_COLOR_BUFFER_BIT);
940 end;
941
942 procedure e_EndRender();
943 begin
944 glPopMatrix();
945 end;
946
947 procedure e_MakeScreenshot(FileName: String; Width, Height: Word);
948 begin
949 end;
950
951 {type
952 aRGB = Array [0..1] of TRGB;
953 PaRGB = ^aRGB;
954
955 TByteArray = Array [0..1] of Byte;
956 PByteArray = ^TByteArray;
957
958 var
959 FILEHEADER: BITMAPFILEHEADER;
960 INFOHEADER: BITMAPINFOHEADER;
961 pixels: PByteArray;
962 tmp: Byte;
963 i: Integer;
964 F: File of Byte;
965
966 begin
967 if (Width mod 4) > 0 then
968 Width := Width + 4 - (Width mod 4);
969
970 GetMem(pixels, Width*Height*3);
971 glReadPixels(0, 0, Width, Height, GL_RGB, GL_UNSIGNED_BYTE, pixels);
972
973 for i := 0 to Width * Height - 1 do
974 with PaRGB(pixels)[i] do
975 begin
976 tmp := R;
977 R := B;
978 B := tmp;
979 end;
980
981 with FILEHEADER do
982 begin
983 bfType := $4D42; // "BM"
984 bfSize := Width*Height*3 + SizeOf(BITMAPFILEHEADER) + SizeOf(BITMAPINFOHEADER);
985 bfReserved1 := 0;
986 bfReserved2 := 0;
987 bfOffBits := SizeOf(BITMAPFILEHEADER) + SizeOf(BITMAPINFOHEADER);
988 end;
989
990 with INFOHEADER do
991 begin
992 biSize := SizeOf(BITMAPINFOHEADER);
993 biWidth := Width;
994 biHeight := Height;
995 biPlanes := 1;
996 biBitCount := 24;
997 biCompression := 0;
998 biSizeImage := Width*Height*3;
999 biXPelsPerMeter := 0;
1000 biYPelsPerMeter := 0;
1001 biClrUsed := 0;
1002 biClrImportant := 0;
1003 end;
1004
1005 AssignFile(F, FileName);
1006 Rewrite(F);
1007
1008 BlockWrite(F, FILEHEADER, SizeOf(FILEHEADER));
1009 BlockWrite(F, INFOHEADER, SizeOf(INFOHEADER));
1010 BlockWrite(F, pixels[0], Width*Height*3);
1011
1012 CloseFile(F);
1013
1014 FreeMem(pixels);
1015 end;}
1016
1017 function e_GetGamma(win: PSDL_Window): Byte;
1018 var
1019 ramp: array [0..256*3-1] of Word;
1020 rgb: array [0..2] of Double;
1021 sum: double;
1022 count: integer;
1023 min: integer;
1024 max: integer;
1025 A, B: double;
1026 i, j: integer;
1027 begin
1028 rgb[0] := 1.0;
1029 rgb[1] := 1.0;
1030 rgb[2] := 1.0;
1031
1032 SDL_GetWindowGammaRamp(win, @ramp[0], @ramp[256], @ramp[512]);
1033
1034 for i := 0 to 2 do
1035 begin
1036 sum := 0;
1037 count := 0;
1038 min := 256 * i;
1039 max := min + 256;
1040
1041 for j := min to max - 1 do
1042 if ramp[j] > 0 then
1043 begin
1044 B := (j mod 256)/256;
1045 A := ramp[j]/65536;
1046 sum := sum + ln(A)/ln(B);
1047 inc(count);
1048 end;
1049 rgb[i] := sum / count;
1050 end;
1051
1052 Result := 100 - Trunc(((rgb[0] + rgb[1] + rgb[2])/3 - 0.23) * 100/(2.7 - 0.23));
1053 end;
1054
1055 procedure e_SetGamma(win: PSDL_Window; Gamma: Byte);
1056 var
1057 ramp: array [0..256*3-1] of Word;
1058 i: integer;
1059 r: double;
1060 g: double;
1061 begin
1062 g := (100 - Gamma)*(2.7 - 0.23)/100 + 0.23;
1063
1064 for i := 0 to 255 do
1065 begin
1066 r := Exp(g * ln(i/256))*65536;
1067 if r < 0 then r := 0
1068 else if r > 65535 then r := 65535;
1069 ramp[i] := trunc(r);
1070 ramp[i + 256] := trunc(r);
1071 ramp[i + 512] := trunc(r);
1072 end;
1073
1074 SDL_SetWindowGammaRamp(win, @ramp[0], @ramp[256], @ramp[512]);
1075 end;
1076
1077 function e_CharFont_Create(sp: ShortInt=0): DWORD;
1078 var
1079 i, id: DWORD;
1080 begin
1081 e_WriteLog('Creating CharFont...', MSG_NOTIFY);
1082
1083 id := DWORD(-1);
1084
1085 if e_CharFonts <> nil then
1086 for i := 0 to High(e_CharFonts) do
1087 if not e_CharFonts[i].Live then
1088 begin
1089 id := i;
1090 Break;
1091 end;
1092
1093 if id = DWORD(-1) then
1094 begin
1095 SetLength(e_CharFonts, Length(e_CharFonts) + 1);
1096 id := High(e_CharFonts);
1097 end;
1098
1099 with e_CharFonts[id] do
1100 begin
1101 for i := 0 to High(Chars) do
1102 with Chars[i] do
1103 begin
1104 TextureID := -1;
1105 Width := 0;
1106 end;
1107
1108 Space := sp;
1109 Live := True;
1110 end;
1111
1112 Result := id;
1113 end;
1114
1115 procedure e_CharFont_AddChar(FontID: DWORD; Texture: Integer; c: Char; w: Byte);
1116 begin
1117 with e_CharFonts[FontID].Chars[Ord(c)] do
1118 begin
1119 TextureID := Texture;
1120 Width := w;
1121 end;
1122 end;
1123
1124 procedure e_CharFont_Print(FontID: DWORD; X, Y: Integer; Text: string);
1125 var
1126 a: Integer;
1127 begin
1128 if Text = '' then Exit;
1129 if e_CharFonts = nil then Exit;
1130 if Integer(FontID) > High(e_CharFonts) then Exit;
1131
1132 with e_CharFonts[FontID] do
1133 begin
1134 for a := 1 to Length(Text) do
1135 with Chars[Ord(Text[a])] do
1136 if TextureID <> -1 then
1137 begin
1138 e_Draw(TextureID, X, Y, 0, True, False);
1139 X := X+Width+IfThen(a = Length(Text), 0, Space);
1140 end;
1141 end;
1142 end;
1143
1144 procedure e_CharFont_PrintEx(FontID: DWORD; X, Y: Integer; Text: string;
1145 Color: TRGB; Scale: Single = 1.0);
1146 var
1147 a: Integer;
1148 c: TRGB;
1149 begin
1150 if Text = '' then Exit;
1151 if e_CharFonts = nil then Exit;
1152 if Integer(FontID) > High(e_CharFonts) then Exit;
1153
1154 with e_CharFonts[FontID] do
1155 begin
1156 for a := 1 to Length(Text) do
1157 with Chars[Ord(Text[a])] do
1158 if TextureID <> -1 then
1159 begin
1160 if Scale <> 1.0 then
1161 begin
1162 glPushMatrix;
1163 glScalef(Scale, Scale, 0);
1164 end;
1165
1166 c := e_Colors;
1167 e_Colors := Color;
1168 e_Draw(TextureID, X, Y, 0, True, False);
1169 e_Colors := c;
1170
1171 if Scale <> 1.0 then glPopMatrix;
1172
1173 X := X+Width+IfThen(a = Length(Text), 0, Space);
1174 end;
1175 end;
1176 end;
1177
1178 procedure e_CharFont_PrintFmt(FontID: DWORD; X, Y: Integer; Text: string);
1179 var
1180 a, TX, TY, len: Integer;
1181 tc, c: TRGB;
1182 w, h: Word;
1183 begin
1184 if Text = '' then Exit;
1185 if e_CharFonts = nil then Exit;
1186 if Integer(FontID) > High(e_CharFonts) then Exit;
1187
1188 c.R := 255;
1189 c.G := 255;
1190 c.B := 255;
1191
1192 TX := X;
1193 TY := Y;
1194 len := Length(Text);
1195
1196 e_CharFont_GetSize(FontID, 'A', w, h);
1197
1198 with e_CharFonts[FontID] do
1199 begin
1200 for a := 1 to len do
1201 begin
1202 case Text[a] of
1203 #10: // line feed
1204 begin
1205 TX := X;
1206 TY := TY + h;
1207 continue;
1208 end;
1209 #1: // black
1210 begin
1211 c.R := 0; c.G := 0; c.B := 0;
1212 continue;
1213 end;
1214 #2: // white
1215 begin
1216 c.R := 255; c.G := 255; c.B := 255;
1217 continue;
1218 end;
1219 #3: // darker
1220 begin
1221 c.R := c.R div 2; c.G := c.G div 2; c.B := c.B div 2;
1222 continue;
1223 end;
1224 #4: // lighter
1225 begin
1226 c.R := Min(c.R * 2, 255); c.G := Min(c.G * 2, 255); c.B := Min(c.B * 2, 255);
1227 continue;
1228 end;
1229 #18: // red
1230 begin
1231 c.R := 255; c.G := 0; c.B := 0;
1232 continue;
1233 end;
1234 #19: // green
1235 begin
1236 c.R := 0; c.G := 255; c.B := 0;
1237 continue;
1238 end;
1239 #20: // blue
1240 begin
1241 c.R := 0; c.G := 0; c.B := 255;
1242 continue;
1243 end;
1244 #21: // yellow
1245 begin
1246 c.R := 255; c.G := 255; c.B := 0;
1247 continue;
1248 end;
1249 end;
1250
1251 with Chars[Ord(Text[a])] do
1252 if TextureID <> -1 then
1253 begin
1254 tc := e_Colors;
1255 e_Colors := c;
1256 e_Draw(TextureID, TX, TY, 0, True, False);
1257 e_Colors := tc;
1258
1259 TX := TX+Width+IfThen(a = Length(Text), 0, Space);
1260 end;
1261 end;
1262 end;
1263 end;
1264
1265 procedure e_CharFont_GetSize(FontID: DWORD; Text: string; var w, h: Word);
1266 var
1267 a: Integer;
1268 h2: Word;
1269 begin
1270 w := 0;
1271 h := 0;
1272
1273 if Text = '' then Exit;
1274 if e_CharFonts = nil then Exit;
1275 if Integer(FontID) > High(e_CharFonts) then Exit;
1276
1277 with e_CharFonts[FontID] do
1278 begin
1279 for a := 1 to Length(Text) do
1280 with Chars[Ord(Text[a])] do
1281 if TextureID <> -1 then
1282 begin
1283 w := w+Width+IfThen(a = Length(Text), 0, Space);
1284 e_GetTextureSize(TextureID, nil, @h2);
1285 if h2 > h then h := h2;
1286 end;
1287 end;
1288 end;
1289
1290 procedure e_CharFont_GetSizeFmt(FontID: DWORD; Text: string; var w, h: Word);
1291 var
1292 a, lines, len: Integer;
1293 h2, w2: Word;
1294 begin
1295 w2 := 0;
1296 w := 0;
1297 h := 0;
1298
1299 if Text = '' then Exit;
1300 if e_CharFonts = nil then Exit;
1301 if Integer(FontID) > High(e_CharFonts) then Exit;
1302
1303 lines := 1;
1304 len := Length(Text);
1305
1306 with e_CharFonts[FontID] do
1307 begin
1308 for a := 1 to len do
1309 begin
1310 if Text[a] = #10 then
1311 begin
1312 Inc(lines);
1313 if w2 > w then
1314 begin
1315 w := w2;
1316 w2 := 0;
1317 end;
1318 continue;
1319 end
1320 else if Text[a] in [#1, #2, #3, #4, #18, #19, #20, #21] then
1321 continue;
1322
1323 with Chars[Ord(Text[a])] do
1324 if TextureID <> -1 then
1325 begin
1326 w2 := w2 + Width + IfThen(a = len, 0, Space);
1327 e_GetTextureSize(TextureID, nil, @h2);
1328 if h2 > h then h := h2;
1329 end;
1330 end;
1331 end;
1332
1333 if w2 > w then
1334 w := w2;
1335 h := h * lines;
1336 end;
1337
1338 function e_CharFont_GetMaxWidth(FontID: DWORD): Word;
1339 var
1340 a: Integer;
1341 begin
1342 Result := 0;
1343
1344 if e_CharFonts = nil then Exit;
1345 if Integer(FontID) > High(e_CharFonts) then Exit;
1346
1347 for a := 0 to High(e_CharFonts[FontID].Chars) do
1348 Result := Max(Result, e_CharFonts[FontID].Chars[a].Width);
1349 end;
1350
1351 function e_CharFont_GetMaxHeight(FontID: DWORD): Word;
1352 var
1353 a: Integer;
1354 h2: Word;
1355 begin
1356 Result := 0;
1357
1358 if e_CharFonts = nil then Exit;
1359 if Integer(FontID) > High(e_CharFonts) then Exit;
1360
1361 for a := 0 to High(e_CharFonts[FontID].Chars) do
1362 begin
1363 if e_CharFonts[FontID].Chars[a].TextureID <> -1 then
1364 e_GetTextureSize(e_CharFonts[FontID].Chars[a].TextureID, nil, @h2)
1365 else h2 := 0;
1366 if h2 > Result then Result := h2;
1367 end;
1368 end;
1369
1370 procedure e_CharFont_Remove(FontID: DWORD);
1371 var
1372 a: Integer;
1373 begin
1374 with e_CharFonts[FontID] do
1375 for a := 0 to High(Chars) do
1376 if Chars[a].TextureID <> -1 then e_DeleteTexture(Chars[a].TextureID);
1377
1378 e_CharFonts[FontID].Live := False;
1379 end;
1380
1381 procedure e_CharFont_RemoveAll();
1382 var
1383 a: Integer;
1384 begin
1385 if e_CharFonts = nil then Exit;
1386
1387 for a := 0 to High(e_CharFonts) do
1388 e_CharFont_Remove(a);
1389
1390 e_CharFonts := nil;
1391 end;
1392
1393 procedure e_TextureFontBuild(Tex: DWORD; var FontID: DWORD; XCount, YCount: Word;
1394 Space: ShortInt=0);
1395 var
1396 loop1 : GLuint;
1397 cx, cy : real;
1398 i, id: DWORD;
1399 begin
1400 e_WriteLog('Creating texture font...', MSG_NOTIFY);
1401
1402 id := DWORD(-1);
1403
1404 if e_TextureFonts <> nil then
1405 for i := 0 to High(e_TextureFonts) do
1406 if e_TextureFonts[i].Base = 0 then
1407 begin
1408 id := i;
1409 Break;
1410 end;
1411
1412 if id = DWORD(-1) then
1413 begin
1414 SetLength(e_TextureFonts, Length(e_TextureFonts) + 1);
1415 id := High(e_TextureFonts);
1416 end;
1417
1418 with e_TextureFonts[id] do
1419 begin
1420 Base := glGenLists(XCount*YCount);
1421 TextureID := e_Textures[Tex].tx.id;
1422 CharWidth := (e_Textures[Tex].Width div XCount)+Space;
1423 CharHeight := e_Textures[Tex].Height div YCount;
1424 XC := XCount;
1425 YC := YCount;
1426 Texture := Tex;
1427 SPC := Space;
1428 end;
1429
1430 glBindTexture(GL_TEXTURE_2D, e_Textures[Tex].tx.id);
1431 for loop1 := 0 to XCount*YCount-1 do
1432 begin
1433 cx := (loop1 mod XCount)/XCount;
1434 cy := (loop1 div YCount)/YCount;
1435
1436 glNewList(e_TextureFonts[id].Base+loop1, GL_COMPILE);
1437 glBegin(GL_QUADS);
1438 glTexCoord2f(cx, 1.0-cy-1/YCount);
1439 glVertex2d(0, e_Textures[Tex].Height div YCount);
1440
1441 glTexCoord2f(cx+1/XCount, 1.0-cy-1/YCount);
1442 glVertex2i(e_Textures[Tex].Width div XCount, e_Textures[Tex].Height div YCount);
1443
1444 glTexCoord2f(cx+1/XCount, 1.0-cy);
1445 glVertex2i(e_Textures[Tex].Width div XCount, 0);
1446
1447 glTexCoord2f(cx, 1.0-cy);
1448 glVertex2i(0, 0);
1449 glEnd();
1450 glTranslated((e_Textures[Tex].Width div XCount)+Space, 0, 0);
1451 glEndList();
1452 end;
1453
1454 FontID := id;
1455 end;
1456
1457 procedure e_TextureFontBuildInPlace(id: DWORD);
1458 var
1459 loop1 : GLuint;
1460 cx, cy : real;
1461 XCount, YCount, Space: Integer;
1462 {i,} Tex: DWORD;
1463 begin
1464 with e_TextureFonts[id] do
1465 begin
1466 Base := glGenLists(XC*YC);
1467 TextureID := e_Textures[Texture].tx.id;
1468 XCount := XC;
1469 YCount := YC;
1470 Space := SPC;
1471 Tex := Texture;
1472 end;
1473
1474 glBindTexture(GL_TEXTURE_2D, e_Textures[Tex].tx.id);
1475 for loop1 := 0 to XCount*YCount-1 do
1476 begin
1477 cx := (loop1 mod XCount)/XCount;
1478 cy := (loop1 div YCount)/YCount;
1479
1480 glNewList(e_TextureFonts[id].Base+loop1, GL_COMPILE);
1481 glBegin(GL_QUADS);
1482 glTexCoord2f(cx, 1.0-cy-1/YCount);
1483 glVertex2d(0, e_Textures[Tex].Height div YCount);
1484
1485 glTexCoord2f(cx+1/XCount, 1.0-cy-1/YCount);
1486 glVertex2i(e_Textures[Tex].Width div XCount, e_Textures[Tex].Height div YCount);
1487
1488 glTexCoord2f(cx+1/XCount, 1.0-cy);
1489 glVertex2i(e_Textures[Tex].Width div XCount, 0);
1490
1491 glTexCoord2f(cx, 1.0-cy);
1492 glVertex2i(0, 0);
1493 glEnd();
1494 glTranslated((e_Textures[Tex].Width div XCount)+Space, 0, 0);
1495 glEndList();
1496 end;
1497 end;
1498
1499 procedure e_TextureFontKill(FontID: DWORD);
1500 begin
1501 glDeleteLists(e_TextureFonts[FontID].Base, 256);
1502 e_TextureFonts[FontID].Base := 0;
1503 end;
1504
1505 procedure e_TextureFontPrint(X, Y: GLint; Text: string; FontID: DWORD);
1506 begin
1507 if Integer(FontID) > High(e_TextureFonts) then Exit;
1508 if Text = '' then Exit;
1509
1510 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1511 glEnable(GL_BLEND);
1512
1513 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
1514
1515 glPushMatrix;
1516 glBindTexture(GL_TEXTURE_2D, e_TextureFonts[FontID].TextureID);
1517 glEnable(GL_TEXTURE_2D);
1518 glTranslated(x, y, 0);
1519 glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1520 glCallLists(Length(Text), GL_UNSIGNED_BYTE, PChar(Text));
1521 glDisable(GL_TEXTURE_2D);
1522 glPopMatrix;
1523
1524 glDisable(GL_BLEND);
1525 end;
1526
1527 // god forgive me for this, but i cannot figure out how to do it without lists
1528 procedure e_TextureFontPrintChar(X, Y: Integer; Ch: Char; FontID: DWORD; Shadow: Boolean = False);
1529 begin
1530 glPushMatrix;
1531
1532 if Shadow then
1533 begin
1534 glColor4ub(0, 0, 0, 128);
1535 glTranslated(X+1, Y+1, 0);
1536 glCallLists(1, GL_UNSIGNED_BYTE, @Ch);
1537 glPopMatrix;
1538 glPushMatrix;
1539 end;
1540
1541 glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
1542 glTranslated(X, Y, 0);
1543 glCallLists(1, GL_UNSIGNED_BYTE, @Ch);
1544
1545 glPopMatrix;
1546 end;
1547
1548 procedure e_TextureFontPrintFmt(X, Y: Integer; Text: string; FontID: DWORD; Shadow: Boolean = False);
1549 var
1550 a, TX, TY, len: Integer;
1551 tc, c: TRGB;
1552 w: Word;
1553 begin
1554 if Text = '' then Exit;
1555 if e_TextureFonts = nil then Exit;
1556 if Integer(FontID) > High(e_TextureFonts) then Exit;
1557
1558 c.R := 255;
1559 c.G := 255;
1560 c.B := 255;
1561
1562 TX := X;
1563 TY := Y;
1564 len := Length(Text);
1565
1566 w := e_TextureFonts[FontID].CharWidth;
1567
1568 with e_TextureFonts[FontID] do
1569 begin
1570 glBindTexture(GL_TEXTURE_2D, e_TextureFonts[FontID].TextureID);
1571 glEnable(GL_TEXTURE_2D);
1572 glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1573
1574 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1575 glEnable(GL_BLEND);
1576
1577 for a := 1 to len do
1578 begin
1579 case Text[a] of
1580 {#10: // line feed
1581 begin
1582 TX := X;
1583 TY := TY + h;
1584 continue;
1585 end;}
1586 #1: // black
1587 begin
1588 c.R := 0; c.G := 0; c.B := 0;
1589 continue;
1590 end;
1591 #2: // white
1592 begin
1593 c.R := 255; c.G := 255; c.B := 255;
1594 continue;
1595 end;
1596 #3: // darker
1597 begin
1598 c.R := c.R div 2; c.G := c.G div 2; c.B := c.B div 2;
1599 continue;
1600 end;
1601 #4: // lighter
1602 begin
1603 c.R := Min(c.R * 2, 255); c.G := Min(c.G * 2, 255); c.B := Min(c.B * 2, 255);
1604 continue;
1605 end;
1606 #18: // red
1607 begin
1608 c.R := 255; c.G := 0; c.B := 0;
1609 continue;
1610 end;
1611 #19: // green
1612 begin
1613 c.R := 0; c.G := 255; c.B := 0;
1614 continue;
1615 end;
1616 #20: // blue
1617 begin
1618 c.R := 0; c.G := 0; c.B := 255;
1619 continue;
1620 end;
1621 #21: // yellow
1622 begin
1623 c.R := 255; c.G := 255; c.B := 0;
1624 continue;
1625 end;
1626 end;
1627
1628 tc := e_Colors;
1629 e_Colors := c;
1630 e_TextureFontPrintChar(TX, TY, Text[a], FontID, Shadow);
1631 e_Colors := tc;
1632
1633 TX := TX+w;
1634 end;
1635 glDisable(GL_TEXTURE_2D);
1636 glDisable(GL_BLEND);
1637 end;
1638 end;
1639
1640 procedure e_TextureFontPrintEx(X, Y: GLint; Text: string; FontID: DWORD; Red, Green,
1641 Blue: Byte; Scale: Single; Shadow: Boolean = False);
1642 begin
1643 if Text = '' then Exit;
1644
1645 glPushMatrix;
1646 glBindTexture(GL_TEXTURE_2D, e_TextureFonts[FontID].TextureID);
1647 glEnable(GL_TEXTURE_2D);
1648 glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1649
1650 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1651 glEnable(GL_BLEND);
1652
1653 if Shadow then
1654 begin
1655 glColor4ub(0, 0, 0, 128);
1656 glTranslated(x+1, y+1, 0);
1657 glScalef(Scale, Scale, 0);
1658 glCallLists(Length(Text), GL_UNSIGNED_BYTE, PChar(Text));
1659 glPopMatrix;
1660 glPushMatrix;
1661 end;
1662
1663 glColor4ub(Red, Green, Blue, 255);
1664 glTranslated(x, y, 0);
1665 glScalef(Scale, Scale, 0);
1666 glCallLists(Length(Text), GL_UNSIGNED_BYTE, PChar(Text));
1667
1668 glDisable(GL_TEXTURE_2D);
1669 glPopMatrix;
1670 glColor3ub(e_Colors.R, e_Colors.G, e_Colors.B);
1671 glDisable(GL_BLEND);
1672 end;
1673
1674 procedure e_TextureFontGetSize(ID: DWORD; var CharWidth, CharHeight: Byte);
1675 begin
1676 if Integer(ID) > High(e_TextureFonts) then
1677 Exit;
1678 CharWidth := e_TextureFonts[ID].CharWidth;
1679 CharHeight := e_TextureFonts[ID].CharHeight;
1680 end;
1681
1682 procedure e_RemoveAllTextureFont();
1683 var
1684 i: integer;
1685 begin
1686 if e_TextureFonts = nil then Exit;
1687
1688 for i := 0 to High(e_TextureFonts) do
1689 if e_TextureFonts[i].Base <> 0 then
1690 begin
1691 glDeleteLists(e_TextureFonts[i].Base, 256);
1692 e_TextureFonts[i].Base := 0;
1693 end;
1694
1695 e_TextureFonts := nil;
1696 end;
1697
1698 procedure e_SaveGLContext();
1699 var
1700 PxLen: Cardinal;
1701 i: Integer;
1702 begin
1703 e_WriteLog('Backing up GL context:', MSG_NOTIFY);
1704
1705 glPushAttrib(GL_ALL_ATTRIB_BITS);
1706 glPushClientAttrib(GL_CLIENT_ALL_ATTRIB_BITS);
1707
1708 if e_Textures <> nil then
1709 begin
1710 e_WriteLog(' Backing up textures...', MSG_NOTIFY);
1711 SetLength(e_SavedTextures, Length(e_Textures));
1712 for i := Low(e_Textures) to High(e_Textures) do
1713 begin
1714 e_SavedTextures[i].Pixels := nil;
1715 if e_Textures[i].Width > 0 then
1716 begin
1717 with e_SavedTextures[i] do
1718 begin
1719 PxLen := 3;
1720 if e_Textures[i].Fmt = GL_RGBA then Inc(PxLen);
1721 Pixels := GetMem(PxLen * e_Textures[i].Width * e_Textures[i].Height);
1722 glBindTexture(GL_TEXTURE_2D, e_Textures[i].tx.id);
1723 glGetTexImage(GL_TEXTURE_2D, 0, e_Textures[i].Fmt, GL_UNSIGNED_BYTE, Pixels);
1724 glBindTexture(GL_TEXTURE_2D, 0);
1725 OldID := e_Textures[i].tx.id;
1726 TexId := i;
1727 end;
1728 end;
1729 end;
1730 end;
1731
1732 if e_TextureFonts <> nil then
1733 begin
1734 e_WriteLog(' Releasing texturefonts...', MSG_NOTIFY);
1735 for i := 0 to High(e_TextureFonts) do
1736 if e_TextureFonts[i].Base <> 0 then
1737 begin
1738 glDeleteLists(e_TextureFonts[i].Base, 256);
1739 e_TextureFonts[i].Base := 0;
1740 end;
1741 end;
1742 end;
1743
1744 procedure e_RestoreGLContext();
1745 var
1746 //GLID: GLuint;
1747 i: Integer;
1748 begin
1749 e_WriteLog('Restoring GL context:', MSG_NOTIFY);
1750
1751 glPopClientAttrib();
1752 glPopAttrib();
1753
1754 if e_SavedTextures <> nil then
1755 begin
1756 e_WriteLog(' Regenerating textures...', MSG_NOTIFY);
1757 for i := Low(e_SavedTextures) to High(e_SavedTextures) do
1758 begin
1759 if e_SavedTextures[i].Pixels <> nil then
1760 with e_SavedTextures[i] do
1761 begin
1762 CreateTexture(e_Textures[TexID].tx, e_Textures[TexID].Width, e_Textures[TexID].Height, e_Textures[TexID].Fmt, Pixels);
1763 //GLID := CreateTexture(e_Textures[TexID].Width, e_Textures[TexID].Height, e_Textures[TexID].Fmt, Pixels);
1764 //e_Textures[TexID].tx := GLID;
1765 FreeMem(Pixels);
1766 end;
1767 end;
1768 end;
1769
1770 if e_TextureFonts <> nil then
1771 begin
1772 e_WriteLog(' Regenerating texturefonts...', MSG_NOTIFY);
1773 for i := Low(e_TextureFonts) to High(e_TextureFonts) do
1774 with e_TextureFonts[i] do
1775 begin
1776 TextureID := e_Textures[Texture].tx.id;
1777 Base := 0;
1778 e_TextureFontBuildInPlace(i);
1779 end;
1780 end;
1781
1782 SetLength(e_SavedTextures, 0);
1783 end;
1784
1785
1786 function _RGB(Red, Green, Blue: Byte): TRGB;
1787 begin
1788 Result.R := Red;
1789 Result.G := Green;
1790 Result.B := Blue;
1791 end;
1792
1793 function _Point(X, Y: Integer): TPoint2i;
1794 begin
1795 Result.X := X;
1796 Result.Y := Y;
1797 end;
1798
1799 function _Rect(X, Y: Integer; Width, Height: Word): TRectWH;
1800 begin
1801 Result.X := X;
1802 Result.Y := Y;
1803 Result.Width := Width;
1804 Result.Height := Height;
1805 end;
1806
1807 function _TRect(L, T, R, B: LongInt): TRect;
1808 begin
1809 Result.Top := T;
1810 Result.Left := L;
1811 Result.Right := R;
1812 Result.Bottom := B;
1813 end;
1814
1815 end.
[MIRROR] a port of Doom 2D Forever to FPC/SDL
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024