DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-editor.git / blob


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