path: root/src/base/TextGL.pas

{* UltraStar Deluxe - Karaoke Game
 *
 * UltraStar Deluxe is the legal property of its developers, whose names
 * are too numerous to list here. Please refer to the COPYRIGHT
 * file distributed with this source distribution.
 *
 * This program is free software; you can redistribute it and/or
 * modify it under the terms of the GNU General Public License
 * as published by the Free Software Foundation; either version 2
 * of the License, or (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; see the file COPYING. If not, write to
 * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 * Boston, MA 02110-1301, USA.
 *
 * $URL$
 * $Id$
 *}

unit TextGL;

interface

{$IFDEF FPC}
  {$MODE Delphi}
{$ENDIF}

{$I switches.inc}

// as long as the transition to freetype is not finished
// use the old implementation
{$IFDEF UseFreetype}
  {$INCLUDE TextGLFreetype.pas}
{$ELSE}
uses
  gl,
  SDL,
  UTexture,
  ULog;

procedure BuildFont;                          // build our bitmap font
procedure KillFont;                           // delete the font
function  glTextWidth(const text: string): real; // returns text width
procedure glPrint(const text: string);        // custom GL "Print" routine
procedure ResetFont();                        // reset font settings of active font
procedure SetFontPos(X, Y: real);             // sets X and Y
procedure SetFontZ(Z: real);                  // sets Z
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

//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;

type
  TTextGL = record
    X:        real;
    Y:        real;
    Z:        real;
    Text:     string;
    Size:     real;
    ColR:     real;
    ColG:     real;
    ColB:     real;
  end;

  PFont = ^TFont;
  TFont = record
    Tex:      TTexture;
    Width:    array[0..255] of byte;
    AspectW:  real;
    Centered: boolean;
    Outline:  real;
    Italic:   boolean;
    Reflection: boolean;
    ReflectionSpacing: real;
  end;


var
  Fonts:      array of TFont;
  ActFont:    integer;


implementation

uses
  UMain,
  UCommon,
  SysUtils,
  IniFiles,
  Classes,
  UGraphic;

var
  // Colours for the reflection
  TempColor:    array[0..3] of GLfloat;

{**
 * Load font info.
 * FontFile is the name of the image (.png) not the data (.dat) file
 *}
procedure LoadFontInfo(FontID: integer; const FontFile: string);
var
  Stream:  TFileStream;
  DatFile: string;
begin
  DatFile := ChangeFileExt(FontFile, '.dat');
  FillChar(Fonts[FontID].Width[0], Length(Fonts[FontID].Width), 0);

  Stream := nil;
  try
    Stream := TFileStream.Create(DatFile, fmOpenRead);
    Stream.Read(Fonts[FontID].Width, 256);
  except
    Log.LogError('Error while reading font['+ inttostr(FontID) +']', 'LoadFontInfo');
  end;
  Stream.Free;
end;

// Builds bitmap fonts
procedure BuildFont;
var
  Count: integer;
  FontIni: TMemIniFile;
  FontFile: string;     // filename of the image (with .png/... ending)
begin
  ActFont := 0;

  SetLength(Fonts, 4);
  FontIni := TMemIniFile.Create(FontPath + 'fonts.ini');

  // Normal

  FontFile := FontPath + FontIni.ReadString('Normal', 'File', '');

  Fonts[0].Tex := Texture.LoadTexture(true, FontFile, TEXTURE_TYPE_TRANSPARENT, 0);
  Fonts[0].Tex.H := 30;
  Fonts[0].AspectW := 0.9;
  Fonts[0].Outline := 0;

  LoadFontInfo(0, FontFile);

  // Bold

  FontFile := FontPath + FontIni.ReadString('Bold', 'File', '');

  Fonts[1].Tex := Texture.LoadTexture(true, FontFile, TEXTURE_TYPE_TRANSPARENT, 0);
  Fonts[1].Tex.H := 30;
  Fonts[1].AspectW := 1;
  Fonts[1].Outline := 0;

  LoadFontInfo(1, FontFile);
  for Count := 0 to 255 do
    Fonts[1].Width[Count] := Fonts[1].Width[Count] div 2;

  // Outline1

  FontFile := FontPath + FontIni.ReadString('Outline1', 'File', '');

  Fonts[2].Tex := Texture.LoadTexture(true, FontFile, TEXTURE_TYPE_TRANSPARENT, 0);
  Fonts[2].Tex.H := 30;
  Fonts[2].AspectW := 0.95;
  Fonts[2].Outline := 5;

  LoadFontInfo(2, FontFile);
  for Count := 0 to 255 do
    Fonts[2].Width[Count] := Fonts[2].Width[Count] div 2 + 2;

  // Outline2

  FontFile := FontPath + FontIni.ReadString('Outline2', 'File', '');

  Fonts[3].Tex := Texture.LoadTexture(true, FontFile, TEXTURE_TYPE_TRANSPARENT, 0);
  Fonts[3].Tex.H := 30;
  Fonts[3].AspectW := 0.95;
  Fonts[3].Outline := 4;

  LoadFontInfo(3, FontFile);
  for Count := 0 to 255 do
    Fonts[3].Width[Count] := Fonts[3].Width[Count] + 1;


  // close ini-file
  FontIni.Free;
end;

// Deletes the font
procedure KillFont;
begin
  // delete all characters
  //glDeleteLists(..., 256);
end;

function glTextWidth(const text: string): real;
var
  Letter: char;
  i: integer;
  Font: PFont;
begin
  Result := 0;
  Font := @Fonts[ActFont];

  for i := 1 to Length(text) do
  begin
    Letter := Text[i];
    Result := Result + Font.Width[Ord(Letter)] * Font.Tex.H / 30 * Font.AspectW;
  end;

  if ((Result > 0) and Font.Italic) then
    Result := Result + 12 * Font.Tex.H / 60 * Font.AspectW;
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
  Font:              PFont;
  Tex:               PTexture;
begin
  Font := @Fonts[ActFont];
  Tex := @Font.Tex;

  FWidth := Font.Width[Ord(Letter)];

  Tex.W := FWidth * (Tex.H/30) * Font.AspectW;

  // set texture positions
  TexX := (ord(Letter) mod 16) * 1/16 + 1/32 - FWidth/1024 - Font.Outline/1024;
  TexY := (ord(Letter) div 16) * 1/16 + 2/1024;
  TexR := (ord(Letter) mod 16) * 1/16 + 1/32 + FWidth/1024 + Font.Outline/1024;
  TexB := (1 + ord(Letter) div 16) * 1/16 - 2/1024;

  TexHeight := TexB - TexY;

  // set vector positions
  PL := Tex.X - Font.Outline * (Tex.H/30) * Font.AspectW /2;
  PT := Tex.Y;
  PR := PL + Tex.W + Font.Outline * (Tex.H/30) * Font.AspectW;
  PB := PT + Tex.H;

  if (not Font.Italic) then
    XItal := 0
  else
    XItal := 12;

  glEnable(GL_BLEND);
  glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);

  glEnable(GL_TEXTURE_2D);
  glBindTexture(GL_TEXTURE_2D, Tex.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);
  glEnd;

  // <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 Font.Reflection then
  begin
    ReflectionSpacing := Font.ReflectionSpacing + Tex.H/2;

    glDepthRange(0, 10);
    glDepthFunc(GL_LEQUAL);
    glEnable(GL_DEPTH_TEST);

    glBegin(GL_QUADS);
      glColor4f(TempColor[0], TempColor[1], TempColor[2], 0);
      glTexCoord2f(TexX, TexY + TexHeight/2);
      glVertex3f(PL, PB + ReflectionSpacing - Tex.H/2, Tex.z);

      glColor4f(TempColor[0], TempColor[1], TempColor[2], Tex.Alpha-0.3);
      glTexCoord2f(TexX, TexB );
      glVertex3f(PL + XItal, PT + ReflectionSpacing, Tex.z);

      glTexCoord2f(TexR, TexB );
      glVertex3f(PR + XItal, PT + ReflectionSpacing, Tex.z);

      glColor4f(TempColor[0], TempColor[1], TempColor[2], 0);
      glTexCoord2f(TexR, TexY + TexHeight/2);
      glVertex3f(PR, PB + ReflectionSpacing - Tex.H/2, Tex.z);
    glEnd;

    glDisable(GL_DEPTH_TEST);
  end; // reflection

  glDisable(GL_TEXTURE_2D);
  glDisable(GL_BLEND);

  Tex.X := Tex.X + Tex.W;

  //write the colour back
  glColor4fv(@TempColor);
end;

// Custom GL "Print" Routine
procedure glPrint(const Text: string);
var
  Pos: integer;
begin
  // if there is no text do nothing
  if (Text = '') then
    Exit;

  //Save the actual color and alpha (for reflection)
  glGetFloatv(GL_CURRENT_COLOR, @TempColor);

  for Pos := 1 to Length(Text) do
  begin
    glPrintLetter(Text[Pos]);
  end;
end;

procedure ResetFont();
begin
  SetFontPos(0, 0);
  SetFontZ(0);
  SetFontItalic(False);
  SetFontReflection(False, 0);
end;

procedure SetFontPos(X, Y: real);
begin
  Fonts[ActFont].Tex.X := X;
  Fonts[ActFont].Tex.Y := Y;
end;

procedure SetFontZ(Z: real);
begin
  Fonts[ActFont].Tex.Z := Z;
end;

procedure SetFontSize(Size: real);
begin
  Fonts[ActFont].Tex.H := Size;
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.

{$ENDIF}