aboutsummaryrefslogtreecommitdiffstats
path: root/Game/Code/Classes/TextGL.pas
diff options
context:
space:
mode:
Diffstat (limited to 'Game/Code/Classes/TextGL.pas')
-rw-r--r--Game/Code/Classes/TextGL.pas1170
1 files changed, 585 insertions, 585 deletions
diff --git a/Game/Code/Classes/TextGL.pas b/Game/Code/Classes/TextGL.pas
index 1396ae1b..2c29af59 100644
--- a/Game/Code/Classes/TextGL.pas
+++ b/Game/Code/Classes/TextGL.pas
@@ -1,585 +1,585 @@
-unit TextGL;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-{$IFDEF FPC}
- {$ASMMODE Intel}
-{$ENDIF}
-
-uses
- gl,
- SDL,
- UTexture,
- Classes,
- SDL_ttf,
- ULog;
-
-procedure BuildFont; // build our bitmap font
-procedure KillFont; // delete the font
-function glTextWidth(text: pchar): real; // returns text width
-procedure glPrintDone(text: pchar; Done: real; ColR, ColG, ColB: real);
-procedure glPrintLetter(letter: char);
-procedure glPrintLetterCut(letter: char; Start, Finish: real);
-procedure glPrint(text: pchar); // custom GL "Print" routine
-procedure glPrintCut(text: pchar);
-procedure SetFontPos(X, Y: real); // sets X and Y
-procedure SetFontSize(Size: real);
-procedure SetFontStyle(Style: integer); // sets active font style (normal, bold, etc)
-procedure SetFontItalic(Enable: boolean); // sets italic type letter (works for all fonts)
-procedure SetFontAspectW(Aspect: real);
-procedure SetFontReflection(Enable:boolean;Spacing: real); // Enables/Disables text reflection
-
-// Start of SDL_ttf
-function NextPowerOfTwo(Value: integer): integer;
-// Checks if the ttf exists, if yes then a SDL_ttf is returned
-function LoadFont(FileName: PAnsiChar; PointSize: integer):PTTF_Font;
-
-// Does the renderstuff, color is in $ffeecc style
-function RenderText(font: PTTF_Font; Text:PAnsiChar; Color: Cardinal):PSDL_Surface;
-procedure printrandomtext();
-// End of SDL_ttf
-
-type
- TTextGL = record
- X: real;
- Y: real;
- Text: string;
- Size: real;
- ColR: real;
- ColG: real;
- ColB: real;
- end;
-
- TFont = record
- Tex: TTexture;
- Width: array[0..255] of byte;
- AspectW: real;
- Centered: boolean;
- Done: real;
- Outline: real;
- Italic: boolean;
- Reflection: boolean;
- ReflectionSpacing: real;
- end;
-
-
-var
- base: GLuint; // base display list for the font set
- Fonts: array of TFont;
- ActFont: integer;
- PColR: real; // temps for glPrintDone
- PColG: real;
- PColB: real;
-
- // Colours for the reflection
- TempColor: array[0..3] of GLfloat;
- PTempColor: PGLfloat;
-
-implementation
-
-uses
- UMain,
- UCommon,
- SysUtils,
- UGraphic;
-
-procedure LoadBitmapFontInfo(aID : integer; const aType, aResourceName: string);
-var
- stream: TStream;
-begin
- stream := GetResourceStream(aResourceName, aType);
- if (not assigned(stream)) then
- begin
- Log.LogError('Unknown font['+ inttostr(aID) +': '+aType+']', 'loadfont');
- Exit;
- end;
- try
- stream.Read(Fonts[ aID ].Width, 256);
- except
- Log.LogError('Error while reading font['+ inttostr(aID) +': '+aType+']', 'loadfont');
- end;
- stream.Free;
-end;
-
-// Builds bitmap fonts
-procedure BuildFont;
-var
- Count: integer;
-begin
- ActFont := 0;
-
- //Log.LogStatus( '' , '---------------------------');
-
- //Log.LogStatus( 'Font' , '---------------------------');
- SetLength(Fonts, 5);
- Fonts[0].Tex := Texture.LoadTexture(true, 'Font', TEXTURE_TYPE_TRANSPARENT, 0);
- Fonts[0].Tex.H := 30;
- Fonts[0].AspectW := 0.9;
- Fonts[0].Done := -1;
- Fonts[0].Outline := 0;
-
- //Log.LogStatus( 'FontB' , '---------------------------');
-
- Fonts[1].Tex := Texture.LoadTexture(true, 'FontB', TEXTURE_TYPE_TRANSPARENT, 0);
- Fonts[1].Tex.H := 30;
- Fonts[1].AspectW := 1;
- Fonts[1].Done := -1;
- Fonts[1].Outline := 0;
-
- //Log.LogStatus( 'FontO' , '---------------------------');
- Fonts[2].Tex := Texture.LoadTexture(true, 'FontO', TEXTURE_TYPE_TRANSPARENT, 0);
- Fonts[2].Tex.H := 30;
- Fonts[2].AspectW := 0.95;
- Fonts[2].Done := -1;
- Fonts[2].Outline := 5;
-
- //Log.LogStatus( 'FontO2' , '---------------------------');
- Fonts[3].Tex := Texture.LoadTexture(true, 'FontO2', TEXTURE_TYPE_TRANSPARENT, 0);
- Fonts[3].Tex.H := 30;
- Fonts[3].AspectW := 0.95;
- Fonts[3].Done := -1;
- Fonts[3].Outline := 4;
-
-{ Fonts[4].Tex := Texture.LoadTexture('FontO', TEXTURE_TYPE_TRANSPARENT, 0); // for score screen
- Fonts[4].Tex.H := 30;
- Fonts[4].AspectW := 0.95;
- Fonts[4].Done := -1;
- Fonts[4].Outline := 5;}
-
- // load font info
- LoadBitmapFontInfo( 0, 'FNT', 'Font' );
- LoadBitmapFontInfo( 1, 'FNT', 'FontB' );
- LoadBitmapFontInfo( 2, 'FNT', 'FontO' );
- LoadBitmapFontInfo( 3, 'FNT', 'FontO2' );
-
- for Count := 0 to 255 do
- Fonts[1].Width[Count] := Fonts[1].Width[Count] div 2;
-
- for Count := 0 to 255 do
- Fonts[2].Width[Count] := Fonts[2].Width[Count] div 2 + 2;
-
- for Count := 0 to 255 do
- Fonts[3].Width[Count] := Fonts[3].Width[Count] + 1;
-
-{ for Count := 0 to 255 do
- Fonts[4].Width[Count] := Fonts[4].Width[Count] div 2 + 2;}
-
-end;
-
-// Deletes the font
-procedure KillFont;
-begin
- // delete all characters
- //glDeleteLists(base, 256);
-end;
-
-function glTextWidth(text: pchar): real;
-var
- Letter: char;
- i: integer;
-begin
- Result := 0;
- for i := 0 to Length(text) -1 do
- begin
- Letter := Text[i];
- Result := Result + Fonts[ActFont].Width[Ord(Letter)] * Fonts[ActFont].Tex.H / 30 * Fonts[ActFont].AspectW;
- end;
-end;
-
-procedure glPrintDone(text: pchar; Done: real; ColR, ColG, ColB: real);
-begin
- Fonts[ActFont].Done := Done;
- PColR := ColR;
- PColG := ColG;
- PColB := ColB;
- glPrintCut(text);
- Fonts[ActFont].Done := -1;
-end;
-
-procedure glPrintLetter(Letter: char);
-var
- TexX, TexY: real;
- TexR, TexB: real;
- TexHeight: real;
- FWidth: real;
- PL, PT: real;
- PR, PB: real;
- XItal: real; // X shift for italic type letter
- ReflectionSpacing: real; // Distance of the reflection
-begin
- with Fonts[ActFont].Tex do
- begin
- FWidth := Fonts[ActFont].Width[Ord(Letter)];
-
- W := FWidth * (H/30) * Fonts[ActFont].AspectW;
-
- // set texture positions
- TexX := (ord(Letter) mod 16) * 1/16 + 1/32 - FWidth/1024 - Fonts[ActFont].Outline/1024;
- TexY := (ord(Letter) div 16) * 1/16 + 2/1024;
- TexR := (ord(Letter) mod 16) * 1/16 + 1/32 + FWidth/1024 + Fonts[ActFont].Outline/1024;
- TexB := (1 + ord(Letter) div 16) * 1/16 - 2/1024;
-
- TexHeight := TexB - TexY;
-
- // set vector positions
- PL := X - Fonts[ActFont].Outline * (H/30) * Fonts[ActFont].AspectW /2;
- PT := Y;
- PR := PL + W + Fonts[ActFont].Outline * (H/30) * Fonts[ActFont].AspectW;
- PB := PT + H;
-
- if Fonts[ActFont].Italic = false then
- XItal := 0
- else
- XItal := 12;
-
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glBindTexture(GL_TEXTURE_2D, TexNum);
-
- glBegin(GL_QUADS);
- try
- glTexCoord2f(TexX, TexY); glVertex2f(PL+XItal, PT);
- glTexCoord2f(TexX, TexB); glVertex2f(PL, PB);
- glTexCoord2f(TexR, TexB); glVertex2f(PR, PB);
- glTexCoord2f(TexR, TexY); glVertex2f(PR+XItal, PT);
- finally
- glEnd;
- end;
-
- // <mog> Reflection
- // Yes it would make sense to put this in an extra procedure,
- // but this works, doesn't take much lines, and is almost lightweight
- if Fonts[ActFont].Reflection = true then
- begin
- ReflectionSpacing := Fonts[ActFont].ReflectionSpacing + H/2;
-
- glDepthRange(0, 10);
- glDepthFunc(GL_LEQUAL);
- glEnable(GL_DEPTH_TEST);
-
- glBegin(GL_QUADS);
- try
- glColor4f(TempColor[0], TempColor[1], TempColor[2], 0);
- glTexCoord2f(TexX, TexY + TexHeight/2);
- glVertex3f(PL, PB + ReflectionSpacing - H/2, z);
-
- glColor4f(TempColor[0], TempColor[1], TempColor[2], Alpha-0.3);
- glTexCoord2f(TexX, TexB );
- glVertex3f(PL + XItal, PT + ReflectionSpacing, z);
-
- glTexCoord2f(TexR, TexB );
- glVertex3f(PR + XItal, PT + ReflectionSpacing, z);
-
- glColor4f(TempColor[0], TempColor[1], TempColor[2], 0);
- glTexCoord2f(TexR, TexY + TexHeight/2);
- glVertex3f(PR, PB + ReflectionSpacing - H/2, z);
- finally
- glEnd;
- end;
- glDisable(GL_DEPTH_TEST);
- end; // reflection
-
- glDisable(GL_TEXTURE_2D);
- glDisable(GL_BLEND);
-
- X := X + W;
- end; // with
-
- //write the colour back
- glColor4fv(PTempColor);
-end;
-
-procedure glPrintLetterCut(letter: char; Start, Finish: real);
-var
- TexX, TexY: real;
- TexR, TexB: real;
- TexTemp: real;
- FWidth: real;
- PL, PT: real;
- PR, PB: real;
- OutTemp: real;
- XItal: real;
-begin
- with Fonts[ActFont].Tex do
- begin
- FWidth := Fonts[ActFont].Width[Ord(Letter)];
-
- W := FWidth * (H/30) * Fonts[ActFont].AspectW;
- //H := 30;
- OutTemp := Fonts[ActFont].Outline * (H/30) * Fonts[ActFont].AspectW;
-
- // set texture positions
- TexX := (ord(Letter) mod 16) * 1/16 + 1/32 - FWidth/1024 - Fonts[ActFont].Outline/1024;
- TexY := (ord(Letter) div 16) * 1/16 + 2/1024; // 2/1024
- TexR := (ord(Letter) mod 16) * 1/16 + 1/32 + FWidth/1024 + Fonts[ActFont].Outline/1024;
- TexB := (1 + ord(Letter) div 16) * 1/16 - 2/1024;
-
- TexTemp := TexX + Start * (TexR - TexX);
- TexR := TexX + Finish * (TexR - TexX);
- TexX := TexTemp;
-
- // set vector positions
- PL := X - OutTemp / 2 + OutTemp * Start;
- PT := Y;
- PR := PL + (W + OutTemp) * (Finish - Start);
- PB := PT + H;
- if Fonts[ActFont].Italic = false then
- XItal := 0
- else
- XItal := 12;
-
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glBindTexture(GL_TEXTURE_2D, TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(TexX, TexY); glVertex2f(PL+XItal, PT);
- glTexCoord2f(TexX, TexB); glVertex2f(PL, PB);
- glTexCoord2f(TexR, TexB); glVertex2f(PR, PB);
- glTexCoord2f(TexR, TexY); glVertex2f(PR+XItal, PT); // not tested with XItal
- glEnd;
- X := X + W * (Finish - Start);
- glDisable(GL_BLEND);
- glDisable(GL_TEXTURE_2D);
- end; // with
-
-end;
-
-// Custom GL "Print" Routine
-procedure glPrint(text: pchar);
-var
- //Letter : char;
- iPos : integer;
-begin
- if (Text = '') then // If There's No Text
- Exit; // Do Nothing
-
-(*
- while (length(text) > 0) do
- begin
- // cut
- Letter := Text[0];
- Text := pchar(Copy(Text, 2, Length(Text)-1));
-
- // print
- glPrintLetter(Letter);
- end; // while
-*)
-
- //Save the actual color and alpha (for reflection)
- PTempColor:= @TempColor;
- //I've read that glGetFloat is quite slow, but it seems that there is no alternative
- glGetFloatv(GL_CURRENT_COLOR, PTempColor);
-
- // This code is better, because doing a Copy of for every
- // letter in a string is a waste of CPU & Memory resources.
- // Copy operations are quite memory intensive, and this simple
- // code achieves the same result.
- for iPos := 0 to length( text ) - 1 do
- begin
- glPrintLetter( Text[iPos] );
- end;
-
-end;
-
-// tyty to Asphyre
-// FIXME: check if the non-asm version is fast enough and use it by default if so
-function NextPowerOfTwo(Value: integer): integer;
-begin
- Result:= 1;
-{$IF Defined(CPUX86_64)}
- asm
- mov rcx, -1
- bsr rcx, Value
- inc rcx
- shl Result, cl
- end;
-{$ELSEIF Defined(CPU386) or Defined(CPUI386)}
- asm
- mov ecx, -1
- bsr ecx, Value
- inc ecx
- shl Result, cl
- end;
-{$ELSE}
- while (Result <= Value) do
- Result := 2 * Result;
-{$IFEND}
-end;
-
-function LoadFont(FileName: PAnsiChar; PointSize: integer):PTTF_Font;
-begin
- if (FileExists(FileName)) then
- begin
- Result := TTF_OpenFont( FileName, PointSize );
- end
- else
- begin
- Log.LogStatus('ERROR Could not find font in ' + FileName , '');
- ShowMessage( 'ERROR Could not find font in ' + FileName );
- Result := nil;
- end;
-end;
-
-function RenderText(font: PTTF_Font; Text:PAnsiChar; Color: Cardinal): PSDL_Surface;
-var
- clr : TSDL_color;
-begin
- clr.r := ((Color and $ff0000) shr 16 ) div 255;
- clr.g := ((Color and $ff00 ) shr 8 ) div 255;
- clr.b := ( Color and $ff ) div 255 ;
-
- result := TTF_RenderText_Blended( font, text, cLr);
-end;
-
-procedure printrandomtext();
-var
- stext,intermediary : PSDL_surface;
- clrFg, clrBG : TSDL_color;
- texture : Gluint;
- font : PTTF_Font;
- w,h : integer;
-begin
-
- font := LoadFont('fonts\comicbd.ttf', 42);
-
- clrFg.r := 255;
- clrFg.g := 255;
- clrFg.b := 255;
- clrFg.unused := 255;
-
- clrBg.r := 255;
- clrbg.g := 0;
- clrbg.b := 255;
- clrbg.unused := 0;
-
- sText := RenderText(font, 'katzeeeeeee', $fe198e);
- //sText := TTF_RenderText_Blended( font, 'huuuuuuuuuund', clrFG);
-
- // Convert the rendered text to a known format
- w := nextpoweroftwo(sText.w);
- h := nextpoweroftwo(sText.h);
-
- intermediary := SDL_CreateRGBSurface(0, w, h, 32,
- $000000ff, $0000ff00, $00ff0000, $ff000000);
-
- SDL_SetAlpha(intermediary, 0, 255);
- SDL_SetAlpha(sText, 0, 255);
- SDL_BlitSurface(sText, nil, intermediary, nil);
-
- glGenTextures(1, @texture);
-
- glBindTexture(GL_TEXTURE_2D, texture);
-
- glTexImage2D(GL_TEXTURE_2D, 0, 4, w, h, 0, GL_RGBA, GL_UNSIGNED_BYTE, intermediary.pixels);
-
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
-
- glEnable(GL_TEXTURE_2D);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glEnable(GL_BLEND);
- glBindTexture(GL_TEXTURE_2D, texture);
- glColor4f(1, 0, 1, 1);
-
- glbegin(gl_quads);
- glTexCoord2f(0, 0); glVertex2f(200 , 300 );
- glTexCoord2f(0, sText.h/h); glVertex2f(200 , 300 + sText.h);
- glTexCoord2f(sText.w/w, sText.h/h); glVertex2f(200 + sText.w, 300 + sText.h);
- glTexCoord2f(sText.w/w, 0); glVertex2f(200 + sText.w, 300 );
- glEnd;
- glfinish();
- glDisable(GL_BLEND);
- gldisable(gl_texture_2d);
-
- SDL_FreeSurface(sText);
- SDL_FreeSurface(intermediary);
- glDeleteTextures(1, @texture);
- TTF_CloseFont(font);
-
-end;
-
-procedure glPrintCut(text: pchar);
-var
- Letter: char;
- PToDo: real;
- PTotWidth: real;
- PDoingNow: real;
- S: string;
-begin
- if (Text = '') then // If There's No Text
- Exit; // Do Nothing
-
- PTotWidth := glTextWidth(Text);
- PToDo := Fonts[ActFont].Done;
-
- while (length(text) > 0) do
- begin
- // cut
- Letter := Text[0];
- Text := pchar(Copy(Text, 2, Length(Text)-1));
-
- // analyze
- S := Letter;
- PDoingNow := glTextWidth(pchar(S)) / PTotWidth;
-
- // drawing
- if (PToDo > 0) and (PDoingNow <= PToDo) then
- glPrintLetter(Letter);
-
- if (PToDo > 0) and (PDoingNow > PToDo) then
- begin
- glPrintLetterCut(Letter, 0, PToDo / PDoingNow);
- glColor3f(PColR, PColG, PColB);
- glPrintLetterCut(Letter, PToDo / PDoingNow, 1);
- end;
-
- if (PToDo <= 0) then
- glPrintLetter(Letter);
-
- PToDo := PToDo - PDoingNow;
-
- end; // while
-end;
-
-
-procedure SetFontPos(X, Y: real);
-begin
- Fonts[ActFont].Tex.X := X;
- Fonts[ActFont].Tex.Y := Y;
-end;
-
-procedure SetFontSize(Size: real);
-begin
- Fonts[ActFont].Tex.H := 30 * (Size/10);
-end;
-
-procedure SetFontStyle(Style: integer);
-begin
- ActFont := Style;
-end;
-
-procedure SetFontItalic(Enable: boolean);
-begin
- Fonts[ActFont].Italic := Enable;
-end;
-
-procedure SetFontAspectW(Aspect: real);
-begin
- Fonts[ActFont].AspectW := Aspect;
-end;
-
-procedure SetFontReflection(Enable: boolean; Spacing: real);
-begin
- Fonts[ActFont].Reflection := Enable;
- Fonts[ActFont].ReflectionSpacing := Spacing;
-end;
-
-end.
+unit TextGL;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+{$IFDEF FPC}
+ {$ASMMODE Intel}
+{$ENDIF}
+
+uses
+ gl,
+ SDL,
+ UTexture,
+ Classes,
+ SDL_ttf,
+ ULog;
+
+procedure BuildFont; // build our bitmap font
+procedure KillFont; // delete the font
+function glTextWidth(text: pchar): real; // returns text width
+procedure glPrintDone(text: pchar; Done: real; ColR, ColG, ColB: real);
+procedure glPrintLetter(letter: char);
+procedure glPrintLetterCut(letter: char; Start, Finish: real);
+procedure glPrint(text: pchar); // custom GL "Print" routine
+procedure glPrintCut(text: pchar);
+procedure SetFontPos(X, Y: real); // sets X and Y
+procedure SetFontSize(Size: real);
+procedure SetFontStyle(Style: integer); // sets active font style (normal, bold, etc)
+procedure SetFontItalic(Enable: boolean); // sets italic type letter (works for all fonts)
+procedure SetFontAspectW(Aspect: real);
+procedure SetFontReflection(Enable:boolean;Spacing: real); // Enables/Disables text reflection
+
+// Start of SDL_ttf
+function NextPowerOfTwo(Value: integer): integer;
+// Checks if the ttf exists, if yes then a SDL_ttf is returned
+function LoadFont(FileName: PAnsiChar; PointSize: integer):PTTF_Font;
+
+// Does the renderstuff, color is in $ffeecc style
+function RenderText(font: PTTF_Font; Text:PAnsiChar; Color: Cardinal):PSDL_Surface;
+procedure printrandomtext();
+// End of SDL_ttf
+
+type
+ TTextGL = record
+ X: real;
+ Y: real;
+ Text: string;
+ Size: real;
+ ColR: real;
+ ColG: real;
+ ColB: real;
+ end;
+
+ TFont = record
+ Tex: TTexture;
+ Width: array[0..255] of byte;
+ AspectW: real;
+ Centered: boolean;
+ Done: real;
+ Outline: real;
+ Italic: boolean;
+ Reflection: boolean;
+ ReflectionSpacing: real;
+ end;
+
+
+var
+ base: GLuint; // base display list for the font set
+ Fonts: array of TFont;
+ ActFont: integer;
+ PColR: real; // temps for glPrintDone
+ PColG: real;
+ PColB: real;
+
+ // Colours for the reflection
+ TempColor: array[0..3] of GLfloat;
+ PTempColor: PGLfloat;
+
+implementation
+
+uses
+ UMain,
+ UCommon,
+ SysUtils,
+ UGraphic;
+
+procedure LoadBitmapFontInfo(aID : integer; const aType, aResourceName: string);
+var
+ stream: TStream;
+begin
+ stream := GetResourceStream(aResourceName, aType);
+ if (not assigned(stream)) then
+ begin
+ Log.LogError('Unknown font['+ inttostr(aID) +': '+aType+']', 'loadfont');
+ Exit;
+ end;
+ try
+ stream.Read(Fonts[ aID ].Width, 256);
+ except
+ Log.LogError('Error while reading font['+ inttostr(aID) +': '+aType+']', 'loadfont');
+ end;
+ stream.Free;
+end;
+
+// Builds bitmap fonts
+procedure BuildFont;
+var
+ Count: integer;
+begin
+ ActFont := 0;
+
+ //Log.LogStatus( '' , '---------------------------');
+
+ //Log.LogStatus( 'Font' , '---------------------------');
+ SetLength(Fonts, 5);
+ Fonts[0].Tex := Texture.LoadTexture(true, 'Font', TEXTURE_TYPE_TRANSPARENT, 0);
+ Fonts[0].Tex.H := 30;
+ Fonts[0].AspectW := 0.9;
+ Fonts[0].Done := -1;
+ Fonts[0].Outline := 0;
+
+ //Log.LogStatus( 'FontB' , '---------------------------');
+
+ Fonts[1].Tex := Texture.LoadTexture(true, 'FontB', TEXTURE_TYPE_TRANSPARENT, 0);
+ Fonts[1].Tex.H := 30;
+ Fonts[1].AspectW := 1;
+ Fonts[1].Done := -1;
+ Fonts[1].Outline := 0;
+
+ //Log.LogStatus( 'FontO' , '---------------------------');
+ Fonts[2].Tex := Texture.LoadTexture(true, 'FontO', TEXTURE_TYPE_TRANSPARENT, 0);
+ Fonts[2].Tex.H := 30;
+ Fonts[2].AspectW := 0.95;
+ Fonts[2].Done := -1;
+ Fonts[2].Outline := 5;
+
+ //Log.LogStatus( 'FontO2' , '---------------------------');
+ Fonts[3].Tex := Texture.LoadTexture(true, 'FontO2', TEXTURE_TYPE_TRANSPARENT, 0);
+ Fonts[3].Tex.H := 30;
+ Fonts[3].AspectW := 0.95;
+ Fonts[3].Done := -1;
+ Fonts[3].Outline := 4;
+
+{ Fonts[4].Tex := Texture.LoadTexture('FontO', TEXTURE_TYPE_TRANSPARENT, 0); // for score screen
+ Fonts[4].Tex.H := 30;
+ Fonts[4].AspectW := 0.95;
+ Fonts[4].Done := -1;
+ Fonts[4].Outline := 5;}
+
+ // load font info
+ LoadBitmapFontInfo( 0, 'FNT', 'Font' );
+ LoadBitmapFontInfo( 1, 'FNT', 'FontB' );
+ LoadBitmapFontInfo( 2, 'FNT', 'FontO' );
+ LoadBitmapFontInfo( 3, 'FNT', 'FontO2' );
+
+ for Count := 0 to 255 do
+ Fonts[1].Width[Count] := Fonts[1].Width[Count] div 2;
+
+ for Count := 0 to 255 do
+ Fonts[2].Width[Count] := Fonts[2].Width[Count] div 2 + 2;
+
+ for Count := 0 to 255 do
+ Fonts[3].Width[Count] := Fonts[3].Width[Count] + 1;
+
+{ for Count := 0 to 255 do
+ Fonts[4].Width[Count] := Fonts[4].Width[Count] div 2 + 2;}
+
+end;
+
+// Deletes the font
+procedure KillFont;
+begin
+ // delete all characters
+ //glDeleteLists(base, 256);
+end;
+
+function glTextWidth(text: pchar): real;
+var
+ Letter: char;
+ i: integer;
+begin
+ Result := 0;
+ for i := 0 to Length(text) -1 do
+ begin
+ Letter := Text[i];
+ Result := Result + Fonts[ActFont].Width[Ord(Letter)] * Fonts[ActFont].Tex.H / 30 * Fonts[ActFont].AspectW;
+ end;
+end;
+
+procedure glPrintDone(text: pchar; Done: real; ColR, ColG, ColB: real);
+begin
+ Fonts[ActFont].Done := Done;
+ PColR := ColR;
+ PColG := ColG;
+ PColB := ColB;
+ glPrintCut(text);
+ Fonts[ActFont].Done := -1;
+end;
+
+procedure glPrintLetter(Letter: char);
+var
+ TexX, TexY: real;
+ TexR, TexB: real;
+ TexHeight: real;
+ FWidth: real;
+ PL, PT: real;
+ PR, PB: real;
+ XItal: real; // X shift for italic type letter
+ ReflectionSpacing: real; // Distance of the reflection
+begin
+ with Fonts[ActFont].Tex do
+ begin
+ FWidth := Fonts[ActFont].Width[Ord(Letter)];
+
+ W := FWidth * (H/30) * Fonts[ActFont].AspectW;
+
+ // set texture positions
+ TexX := (ord(Letter) mod 16) * 1/16 + 1/32 - FWidth/1024 - Fonts[ActFont].Outline/1024;
+ TexY := (ord(Letter) div 16) * 1/16 + 2/1024;
+ TexR := (ord(Letter) mod 16) * 1/16 + 1/32 + FWidth/1024 + Fonts[ActFont].Outline/1024;
+ TexB := (1 + ord(Letter) div 16) * 1/16 - 2/1024;
+
+ TexHeight := TexB - TexY;
+
+ // set vector positions
+ PL := X - Fonts[ActFont].Outline * (H/30) * Fonts[ActFont].AspectW /2;
+ PT := Y;
+ PR := PL + W + Fonts[ActFont].Outline * (H/30) * Fonts[ActFont].AspectW;
+ PB := PT + H;
+
+ if Fonts[ActFont].Italic = false then
+ XItal := 0
+ else
+ XItal := 12;
+
+ glEnable(GL_TEXTURE_2D);
+ glEnable(GL_BLEND);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+ glBindTexture(GL_TEXTURE_2D, TexNum);
+
+ glBegin(GL_QUADS);
+ try
+ glTexCoord2f(TexX, TexY); glVertex2f(PL+XItal, PT);
+ glTexCoord2f(TexX, TexB); glVertex2f(PL, PB);
+ glTexCoord2f(TexR, TexB); glVertex2f(PR, PB);
+ glTexCoord2f(TexR, TexY); glVertex2f(PR+XItal, PT);
+ finally
+ glEnd;
+ end;
+
+ // <mog> Reflection
+ // Yes it would make sense to put this in an extra procedure,
+ // but this works, doesn't take much lines, and is almost lightweight
+ if Fonts[ActFont].Reflection = true then
+ begin
+ ReflectionSpacing := Fonts[ActFont].ReflectionSpacing + H/2;
+
+ glDepthRange(0, 10);
+ glDepthFunc(GL_LEQUAL);
+ glEnable(GL_DEPTH_TEST);
+
+ glBegin(GL_QUADS);
+ try
+ glColor4f(TempColor[0], TempColor[1], TempColor[2], 0);
+ glTexCoord2f(TexX, TexY + TexHeight/2);
+ glVertex3f(PL, PB + ReflectionSpacing - H/2, z);
+
+ glColor4f(TempColor[0], TempColor[1], TempColor[2], Alpha-0.3);
+ glTexCoord2f(TexX, TexB );
+ glVertex3f(PL + XItal, PT + ReflectionSpacing, z);
+
+ glTexCoord2f(TexR, TexB );
+ glVertex3f(PR + XItal, PT + ReflectionSpacing, z);
+
+ glColor4f(TempColor[0], TempColor[1], TempColor[2], 0);
+ glTexCoord2f(TexR, TexY + TexHeight/2);
+ glVertex3f(PR, PB + ReflectionSpacing - H/2, z);
+ finally
+ glEnd;
+ end;
+ glDisable(GL_DEPTH_TEST);
+ end; // reflection
+
+ glDisable(GL_TEXTURE_2D);
+ glDisable(GL_BLEND);
+
+ X := X + W;
+ end; // with
+
+ //write the colour back
+ glColor4fv(PTempColor);
+end;
+
+procedure glPrintLetterCut(letter: char; Start, Finish: real);
+var
+ TexX, TexY: real;
+ TexR, TexB: real;
+ TexTemp: real;
+ FWidth: real;
+ PL, PT: real;
+ PR, PB: real;
+ OutTemp: real;
+ XItal: real;
+begin
+ with Fonts[ActFont].Tex do
+ begin
+ FWidth := Fonts[ActFont].Width[Ord(Letter)];
+
+ W := FWidth * (H/30) * Fonts[ActFont].AspectW;
+ //H := 30;
+ OutTemp := Fonts[ActFont].Outline * (H/30) * Fonts[ActFont].AspectW;
+
+ // set texture positions
+ TexX := (ord(Letter) mod 16) * 1/16 + 1/32 - FWidth/1024 - Fonts[ActFont].Outline/1024;
+ TexY := (ord(Letter) div 16) * 1/16 + 2/1024; // 2/1024
+ TexR := (ord(Letter) mod 16) * 1/16 + 1/32 + FWidth/1024 + Fonts[ActFont].Outline/1024;
+ TexB := (1 + ord(Letter) div 16) * 1/16 - 2/1024;
+
+ TexTemp := TexX + Start * (TexR - TexX);
+ TexR := TexX + Finish * (TexR - TexX);
+ TexX := TexTemp;
+
+ // set vector positions
+ PL := X - OutTemp / 2 + OutTemp * Start;
+ PT := Y;
+ PR := PL + (W + OutTemp) * (Finish - Start);
+ PB := PT + H;
+ if Fonts[ActFont].Italic = false then
+ XItal := 0
+ else
+ XItal := 12;
+
+ glEnable(GL_TEXTURE_2D);
+ glEnable(GL_BLEND);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+ glBindTexture(GL_TEXTURE_2D, TexNum);
+ glBegin(GL_QUADS);
+ glTexCoord2f(TexX, TexY); glVertex2f(PL+XItal, PT);
+ glTexCoord2f(TexX, TexB); glVertex2f(PL, PB);
+ glTexCoord2f(TexR, TexB); glVertex2f(PR, PB);
+ glTexCoord2f(TexR, TexY); glVertex2f(PR+XItal, PT); // not tested with XItal
+ glEnd;
+ X := X + W * (Finish - Start);
+ glDisable(GL_BLEND);
+ glDisable(GL_TEXTURE_2D);
+ end; // with
+
+end;
+
+// Custom GL "Print" Routine
+procedure glPrint(text: pchar);
+var
+ //Letter : char;
+ iPos : integer;
+begin
+ if (Text = '') then // If There's No Text
+ Exit; // Do Nothing
+
+(*
+ while (length(text) > 0) do
+ begin
+ // cut
+ Letter := Text[0];
+ Text := pchar(Copy(Text, 2, Length(Text)-1));
+
+ // print
+ glPrintLetter(Letter);
+ end; // while
+*)
+
+ //Save the actual color and alpha (for reflection)
+ PTempColor:= @TempColor;
+ //I've read that glGetFloat is quite slow, but it seems that there is no alternative
+ glGetFloatv(GL_CURRENT_COLOR, PTempColor);
+
+ // This code is better, because doing a Copy of for every
+ // letter in a string is a waste of CPU & Memory resources.
+ // Copy operations are quite memory intensive, and this simple
+ // code achieves the same result.
+ for iPos := 0 to length( text ) - 1 do
+ begin
+ glPrintLetter( Text[iPos] );
+ end;
+
+end;
+
+// tyty to Asphyre
+// FIXME: check if the non-asm version is fast enough and use it by default if so
+function NextPowerOfTwo(Value: integer): integer;
+begin
+ Result:= 1;
+{$IF Defined(CPUX86_64)}
+ asm
+ mov rcx, -1
+ bsr rcx, Value
+ inc rcx
+ shl Result, cl
+ end;
+{$ELSEIF Defined(CPU386) or Defined(CPUI386)}
+ asm
+ mov ecx, -1
+ bsr ecx, Value
+ inc ecx
+ shl Result, cl
+ end;
+{$ELSE}
+ while (Result <= Value) do
+ Result := 2 * Result;
+{$IFEND}
+end;
+
+function LoadFont(FileName: PAnsiChar; PointSize: integer):PTTF_Font;
+begin
+ if (FileExists(FileName)) then
+ begin
+ Result := TTF_OpenFont( FileName, PointSize );
+ end
+ else
+ begin
+ Log.LogStatus('ERROR Could not find font in ' + FileName , '');
+ ShowMessage( 'ERROR Could not find font in ' + FileName );
+ Result := nil;
+ end;
+end;
+
+function RenderText(font: PTTF_Font; Text:PAnsiChar; Color: Cardinal): PSDL_Surface;
+var
+ clr : TSDL_color;
+begin
+ clr.r := ((Color and $ff0000) shr 16 ) div 255;
+ clr.g := ((Color and $ff00 ) shr 8 ) div 255;
+ clr.b := ( Color and $ff ) div 255 ;
+
+ result := TTF_RenderText_Blended( font, text, cLr);
+end;
+
+procedure printrandomtext();
+var
+ stext,intermediary : PSDL_surface;
+ clrFg, clrBG : TSDL_color;
+ texture : Gluint;
+ font : PTTF_Font;
+ w,h : integer;
+begin
+
+ font := LoadFont('fonts\comicbd.ttf', 42);
+
+ clrFg.r := 255;
+ clrFg.g := 255;
+ clrFg.b := 255;
+ clrFg.unused := 255;
+
+ clrBg.r := 255;
+ clrbg.g := 0;
+ clrbg.b := 255;
+ clrbg.unused := 0;
+
+ sText := RenderText(font, 'katzeeeeeee', $fe198e);
+ //sText := TTF_RenderText_Blended( font, 'huuuuuuuuuund', clrFG);
+
+ // Convert the rendered text to a known format
+ w := nextpoweroftwo(sText.w);
+ h := nextpoweroftwo(sText.h);
+
+ intermediary := SDL_CreateRGBSurface(0, w, h, 32,
+ $000000ff, $0000ff00, $00ff0000, $ff000000);
+
+ SDL_SetAlpha(intermediary, 0, 255);
+ SDL_SetAlpha(sText, 0, 255);
+ SDL_BlitSurface(sText, nil, intermediary, nil);
+
+ glGenTextures(1, @texture);
+
+ glBindTexture(GL_TEXTURE_2D, texture);
+
+ glTexImage2D(GL_TEXTURE_2D, 0, 4, w, h, 0, GL_RGBA, GL_UNSIGNED_BYTE, intermediary.pixels);
+
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
+
+ glEnable(GL_TEXTURE_2D);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+ glEnable(GL_BLEND);
+ glBindTexture(GL_TEXTURE_2D, texture);
+ glColor4f(1, 0, 1, 1);
+
+ glbegin(gl_quads);
+ glTexCoord2f(0, 0); glVertex2f(200 , 300 );
+ glTexCoord2f(0, sText.h/h); glVertex2f(200 , 300 + sText.h);
+ glTexCoord2f(sText.w/w, sText.h/h); glVertex2f(200 + sText.w, 300 + sText.h);
+ glTexCoord2f(sText.w/w, 0); glVertex2f(200 + sText.w, 300 );
+ glEnd;
+ glfinish();
+ glDisable(GL_BLEND);
+ gldisable(gl_texture_2d);
+
+ SDL_FreeSurface(sText);
+ SDL_FreeSurface(intermediary);
+ glDeleteTextures(1, @texture);
+ TTF_CloseFont(font);
+
+end;
+
+procedure glPrintCut(text: pchar);
+var
+ Letter: char;
+ PToDo: real;
+ PTotWidth: real;
+ PDoingNow: real;
+ S: string;
+begin
+ if (Text = '') then // If There's No Text
+ Exit; // Do Nothing
+
+ PTotWidth := glTextWidth(Text);
+ PToDo := Fonts[ActFont].Done;
+
+ while (length(text) > 0) do
+ begin
+ // cut
+ Letter := Text[0];
+ Text := pchar(Copy(Text, 2, Length(Text)-1));
+
+ // analyze
+ S := Letter;
+ PDoingNow := glTextWidth(pchar(S)) / PTotWidth;
+
+ // drawing
+ if (PToDo > 0) and (PDoingNow <= PToDo) then
+ glPrintLetter(Letter);
+
+ if (PToDo > 0) and (PDoingNow > PToDo) then
+ begin
+ glPrintLetterCut(Letter, 0, PToDo / PDoingNow);
+ glColor3f(PColR, PColG, PColB);
+ glPrintLetterCut(Letter, PToDo / PDoingNow, 1);
+ end;
+
+ if (PToDo <= 0) then
+ glPrintLetter(Letter);
+
+ PToDo := PToDo - PDoingNow;
+
+ end; // while
+end;
+
+
+procedure SetFontPos(X, Y: real);
+begin
+ Fonts[ActFont].Tex.X := X;
+ Fonts[ActFont].Tex.Y := Y;
+end;
+
+procedure SetFontSize(Size: real);
+begin
+ Fonts[ActFont].Tex.H := 30 * (Size/10);
+end;
+
+procedure SetFontStyle(Style: integer);
+begin
+ ActFont := Style;
+end;
+
+procedure SetFontItalic(Enable: boolean);
+begin
+ Fonts[ActFont].Italic := Enable;
+end;
+
+procedure SetFontAspectW(Aspect: real);
+begin
+ Fonts[ActFont].AspectW := Aspect;
+end;
+
+procedure SetFontReflection(Enable: boolean; Spacing: real);
+begin
+ Fonts[ActFont].Reflection := Enable;
+ Fonts[ActFont].ReflectionSpacing := Spacing;
+end;
+
+end.
generated by cgit v1.2.3 (git 2.25.1) at 2024-06-28 21:05:16 +0000