I'll turn that into a class some day for easier use, when I get to the GUI part in my engine.
I'll turn that into a class some day for easier use, when I get to the GUI part in my engine.
If you develop an idiot proof system, the nature develops better idiots.
Thanks for the Code - I'm going to incorporate it into my libraries.
William Cairns
My Games: http://www.cairnsgames.co.za (Currently very inactive)
MyOnline Games: http://TheGameDeveloper.co.za (Currently very inactive)
Thanks vgo. I think I will convert your code, that it uses SDL_TTF instead of VCL (or LCL).
That would be nice, post the code here if possible.
If you develop an idiot proof system, the nature develops better idiots.
All right, here goes the SDL_TTF version of vgo's code. I also used some code from SDL_TTF glfont demo.
[pascal]
unit glFont;
interface
uses
SDL, SDL_TTF, GL;
const
white : TSDL_Color = ( r : $FF; g : $FF; b : $FF; unused : 0 );
type
TFontInfo = record
name : string;
size : integer;
bold,
italic : boolean;
end;
TTextureFont = record
S1, T1, S2, T2: Single;
Width, Height: Integer;
end;
function CreateGLTexture(surface : PSDL_Surface) : gluint;
function CreateFontSurface(info : TFontInfo) : PSDL_Surface;
function BuildFont : gluint;
procedure KillFont(list : gluint);
procedure KillTexture(tex : gluint);
var
TextureFont: array [32 .. 255] of TTextureFont;
implementation
uses
SysUtils;
function CreateFontSurface(info : TFontInfo) : PSDL_Surface;
var
font : PTTF_Font;
surface : PSDL_Surface;
glyphs : array[32..255] of PSDL_Surface;
i,style : integer;
charWidths : array[0..255] of integer;
fontHeight : integer;
textureSize : integer;
x, y, y2 : Integer;
minx,maxx, advance,w : integer;
maxy,miny : integer;
step : single;
r : TSDL_Rect;
begin
//load font
font := TTF_OpenFont(pchar(info.name),info.size);
//set font style
style := TTF_STYLE_NORMAL;
if info.bold then
style := style or TTF_STYLE_BOLD;
if info.italic then
style := style or TTF_STYLE_ITALIC;
TTF_SetFontStyle(font,style);
//set font height and texture size
//TTF_FontHeight returns the maximum height of font
fontHeight := TTF_FontHeight(font);
if fontHeight > 16 then
textureSize := 512
else
textureSize := 256;
writeln(FontHeight);
surface := SDL_CreateRGBSurface(
SDL_SWSURFACE,
textureSize, textureSize,
32,
{$IFDEF IA32} (* OpenGL RGBA masks *)
$000000FF,
$0000FF00,
$00FF0000,
$FF000000
{$ELSE}
$FF000000,
$00FF0000,
$0000FF00,
$000000FF
{$ENDIF}
);
x := 0;
y := textureSize - FontHeight;
y2 := 0;
Step := 1 / textureSize;
//blit char glyphs to the font texture.
for i := 32 to 255 do begin
TTF_GlyphMetrics(font, i,minx, maxx, miny,maxy, advance);
CharWidths[i] := advance;
w := advance;
if (x + w) > textureSize then begin
x := 0;
y := y - FontHeight;
y2 := y2 + FontHeight;
end;
TextureFont[i].S1 := x * Step;
TextureFont[i].T1 := y2 * Step;
TextureFont[i].Width := w;
TextureFont[i].S2 := (x + w) * Step;
TextureFont[i].T2 := (y2 + fontHeight) * Step;
TextureFont[i].Height := FontHeight;
//glyphs[i] := TTF_RenderGlyph_Blended(font,i,white);
glyphs[i] := TTF_RenderGlyph_Solid(font,i,white);
//SDL_SaveBMP(glyphs[i],pchar('glyph'+IntToStr(i)+'.bmp'));
r.x := x;
r.y := y2+(TTF_FontAscent(font)-maxy);
SDL_BlitSurface(glyphs[i],nil,surface,@r);
x := x + w;
end;
SDL_SaveBMP(surface, PChar(info.name+'.bmp'));
for i := 32 to 255 do
SDL_FreeSurface(glyphs[i]);
TTF_CloseFont(font);
Result := surface;
end;
function CreateGLTexture(Surface : PSDL_Surface) : gluint;
var
texture : GLuint;
w, h : integer;
begin
w := surface^.w;
h := surface^.h;
(* Create an OpenGL texture for the image *)
glGenTextures( 1, @texture );
glBindTexture( GL_TEXTURE_2D, texture );
glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST );
glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST );
glTexImage2D( GL_TEXTURE_2D,
0,
GL_RGBA,
w, h,
0,
GL_RGBA,
GL_UNSIGNED_BYTE,
surface^.pixels );
result := texture;
end;
//stores font in OpenGL display list
function BuildFont : gluint;
const
CHAR_SEP = 2;
var
base : gluint;
i : word;
begin
base := glGenLists(255);
for i := 32 to 255 do begin
glNewList(base+i,GL_COMPILE);
glBegin(GL_QUADS);
glTexCoord2f(textureFont[i].s1, textureFont[i].t1);
glVertex2i(0,0);
glTexCoord2f(textureFont[i].s2, textureFont[i].t1);
glVertex2i(textureFont[i].width,0);
glTexCoord2f(textureFont[i].s2, textureFont[i].t2);
glVertex2i(textureFont[i].width,textureFont[i].height);
glTexCoord2f(textureFont[i].s1, textureFont[i].t2);
glVertex2i(0,textureFont[i].height);
glEnd;
glTranslatef(textureFont[i].width+CHAR_SEP,0,0);
glEndList;
end;
Result := base;
end;
procedure KillFont(list : gluint);
begin
glDeleteLists(list,255);
end;
procedure KillTexture(tex : gluint);
begin
glDeleteTextures(1,@tex);
end;
end.
[/pascal]
And here is test app.
[pascal]
program test_font;
uses
SysUtils,
SDL,
SDL_ttf,GL, glfont;
const
SCREEN_WIDTH = 640;
SCREEN_HEIGHT = 480;
SCREEN_BPP = 0;
var
event : TSDL_Event;
done : boolean;
screen, fontSurface : PSDL_Surface;
fontInfo : TFontInfo = (name : 'freesansbold.ttf'; size : 24; bold : false; italic : false);
fontListBase : gluint;
fontTexture : glUint;
procedure printText(x,y : integer; txt : string);
begin
glPushMAtrix;
glTranslatef(x,y,0);
glPushAttrib(GL_LIST_BIT);
glListBase(fontListBase);
glCallLists(Length(txt),GL_UNSIGNED_BYTE,PChar(txt ));
glPopMatrix;
glPopAttrib;
end;
procedure ShutDownApplication( HaltStatus : integer );
begin
TTF_Quit;
SDL_Quit;
Halt( HaltStatus );
end;
begin
{ Initialize SDL }
if ( SDL_Init( SDL_INIT_VIDEO ) < 0 ) then
begin
SDL_Quit;
end;
if ( TTF_Init < 0 ) then
begin
//fprintf(stderr, 'Couldn't initialize TTF: %s',SDL_GetError);
SDL_Quit;
end;
{ Set a 640x480x8 video mode }
screen := SDL_SetVideoMode( SCREEN_WIDTH, SCREEN_HEIGHT, SCREEN_BPP, SDL_OPENGL );
if ( screen = nil ) then
begin
ShutDownApplication( 2 );
end;
// Set the window manager title bar
// SDL_WM_SetCaption( 'JEDI-SDL 3D TTF Demo', 'glfont' );
glViewport( 0, 0, screen_width, screen_height );
glMatrixMode( GL_PROJECTION );
glLoadIdentity;
glOrtho( 0.0, screen_width, screen_height, 0.0, -1.0, 1.0 );
glMatrixMode( GL_MODELVIEW );
glLoadIdentity;
glEnable(GL_TEXTURE_2D);
fontSurface := createFontSurface(fontInfo);
fontTexture := CreateGLTexture(fontSurface);
fontListBase := BuildFont;
SDL_FreeSurface(fontSurface);
done := false;
while ( not done ) do
begin
while ( SDL_PollEvent( @event ) <> 0 ) do
begin
case event.type_ of
SDL_KEYDOWN, SDL_QUITEV : done := true;
end;
end;
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
glLoadIdentity;
glBindTexture(GL_TEXTURE_2D,fontTexture);
printText(0,0, 'The quick brown fox jumps over the lazy dog.');
SDL_GL_SwapBuffers;
end;
KillFont(fontListBase);
KillTexture(fontTexture);
ShutDownApplication( 0 );
end.
[/pascal]
There are problems when font is bold and/or italic. It displays font but aved bmp looks weird. Same problem is when instead of TTF_GlyphRender_solid, TTF_GlyphRender_Blended is used.
Ok. Its time to get some sleep. I am starting to see to many quick brown foxes jumping over lazy dogs...
xiexie everybody!
Bookmarks