DEADSOFTWARE

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