CentrED/Client/UGLFont.pas

206 lines
5.0 KiB
Plaintext
Raw Normal View History

(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UGLFont;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Math, ImagingClasses, ImagingTypes, ImagingOpenGL, GL;
type
TFontInfo = packed record
Character: Char;
LeftOffset: SmallInt;
CharWidth: Word;
Width: Word;
Height: Word;
X1: Single;
Y1: Single;
X2: Single;
Y2: Single;
end;
{ TGLFont }
TGLFont = class
constructor Create;
destructor Destroy; override;
protected
FFontImage: TSingleImage;
FFontTexture: TGLuint;
FSpaceWidth: Word;
FFontInfo: array of TFontInfo;
function FindCharInfo(AChar: Char): Integer;
public
function GetTextHeight(AText: String): Integer;
function GetTextWidth(AText: String): Integer;
procedure DrawText(AX, AY: Integer; AText: String);
procedure LoadImage(AImage: TStream);
procedure LoadFontInfo(AFontInfo: TStream);
procedure UpdateTexture;
end;
implementation
uses
Logging;
{ TGLFont }
constructor TGLFont.Create;
begin
FFontTexture := 0;
end;
destructor TGLFont.Destroy;
begin
FreeAndNil(FFontImage);
if FFontTexture <> 0 then
glDeleteTextures(1, @FFontTexture);
inherited Destroy;
end;
function TGLFont.FindCharInfo(AChar: Char): Integer;
var
i: Integer;
begin
Result := -1;
i := 0;
while (i < Length(FFontInfo)) and (Result = -1) do
begin
if FFontInfo[i].Character = AChar then
Result := i
else
Inc(i);
end;
end;
function TGLFont.GetTextHeight(AText: String): Integer;
var
i, charInfo: Integer;
begin
Result := 0;
for i := 1 to Length(AText) do
begin
if AText[i] <> ' ' then
begin
charInfo := FindCharInfo(AText[i]);
if charInfo > -1 then
Result := Max(Result, FFontInfo[charInfo].Height);
end;
end;
end;
function TGLFont.GetTextWidth(AText: String): Integer;
var
i, charInfo: Integer;
begin
Result := 0;
for i := 1 to Length(AText) do
begin
if AText[i] = ' ' then
Inc(Result, FSpaceWidth)
else
begin
charInfo := FindCharInfo(AText[i]);
if charInfo > -1 then
Result := Result + FFontInfo[charInfo].LeftOffset +
FFontInfo[charInfo].CharWidth;
end;
end;
end;
procedure TGLFont.DrawText(AX, AY: Integer; AText: String);
var
i, charInfo: Integer;
curX: Integer;
x1, y1, x2, y2: Single;
begin
if FFontTexture = 0 then UpdateTexture;
glBindTexture(GL_TEXTURE_2D, FFontTexture);
curX := AX;
for i := 1 to Length(AText) do
begin
if AText[i] = ' ' then
Inc(curX, FSpaceWidth)
else
begin
charInfo := FindCharInfo(AText[i]);
if charInfo > -1 then
begin
x1 := FFontInfo[charInfo].X1;
y1 := FFontInfo[charInfo].Y1;
x2 := FFontInfo[charInfo].X2;
y2 := FFontInfo[charInfo].Y2;
Inc(curX, FFontInfo[charInfo].LeftOffset);
glBegin(GL_QUADS);
glTexCoord2f(x1, y1); glVertex2i(curX, AY);
glTexCoord2f(x2, y1); glVertex2i(curX + FFontInfo[charInfo].Width, AY);
glTexCoord2f(x2, y2); glVertex2i(curX + FFontInfo[charInfo].Width,
AY + FFontInfo[charInfo].Height);
glTexCoord2f(x1, y2); glVertex2i(curX, AY + FFontInfo[charInfo].Height);
glEnd;
Inc(curX, FFontInfo[charInfo].CharWidth);
end;
end;
end;
end;
procedure TGLFont.LoadImage(AImage: TStream);
begin
FFontImage := TSingleImage.CreateFromStream(AImage);
end;
procedure TGLFont.LoadFontInfo(AFontInfo: TStream);
begin
AFontInfo.Read(FSpaceWidth, SizeOf(FSpaceWidth));
SetLength(FFontInfo, (AFontInfo.Size - AFontInfo.Position) div
SizeOf(TFontInfo));
AFontInfo.Read(FFontInfo[0], Length(FFontInfo) * SizeOf(TFontInfo));
end;
procedure TGLFont.UpdateTexture;
begin
Logger.Send('UpdateTexture');
if FFontTexture <> 0 then glDeleteTextures(1, @FFontTexture);
FFontTexture := CreateGLTextureFromImage(FFontImage.ImageDataPointer^, 0, 0,
True, ifUnknown);
glBindTexture(GL_TEXTURE_2D, FFontTexture);
glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR);
end;
end.