Simple OpenGL Bitmap fonts

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
pr0gger
Posts: 47
Joined: Oct 27, 2006 23:10

Simple OpenGL Bitmap fonts

Post by pr0gger »

Hey, folks -- I made a post in Skywriter's thread here, and I thought it could be useful in this section. This is my simple OpenGL font routine. As I stated there, it uses CreateFont, so it's Windows Only.

Library: FONTSIMPLE.BAS

To use it, simply include FONTSIMPLE.BAS at the top of your code.

I've added an example below.

fontsimple.bas

Code: Select all

#include Once "windows.bi"
#Include Once "win/windef.bi"
#Include Once "gl/gl.bi"
#Include Once "gl/glu.bi"
#Include Once "fbgfx.bi"

#Define FONT_ALIGN_BOTTOM 0
#Define FONT_ALIGN_TOP 1
#Define FONT_ALIGN_LEFT 0
#Define FONT_ALIGN_RIGHT 1
#Define FONT_ALIGN_CENTER 2

#define FONT_WT_DONTCARE 0 
#define FONT_WT_1 100
#define FONT_WT_2 200
#define FONT_WT_3 300
#define FONT_WT_4 400
#define FONT_WT_5 500
#define FONT_WT_6 600
#define FONT_WT_7 700
#define FONT_WT_8 800
#define FONT_WT_9 900

Type font_p As font_t ptr 

type Font_t
	fName As String * 256
	listbase As uinteger = 0
	averagewidth As integer = 0
	averageheight As integer = 0
	w As integer = 0
	h As integer = 0
	fstrength As integer = 0
	hfont As Any ptr = 0
	hdc As Any ptr = 0
	'metrics(0 To 255) As GLYPHMETRICSFLOAT
End Type

Sub fontBuild (newfont As font_p, fname As string, H As integer, W As integer = 0, fstr As uInteger = 0)
	Dim As Any ptr oldhfont, hfont

	Dim As uinteger hwin
	Dim As Any ptr hdc, hscrdc
	dim as integer retcode1, retcode2, errcode

	ScreenControl (FB.GET_WINDOW_HANDLE, (Hwin))
	hScrDC  = GetDC(Cast(Any ptr, hWin))
	
	With (*newfont)
		.hDC = CreateCompatibleDC(hScrDC)
		.fname = fname
		.w = w
		.h = h
		.fstrength = fstr
	
		.listbase = glGenLists(96)

		.hFont = CreateFont(H, W, 0, 0, fstr, FALSE, FALSE, FALSE, _
			ANSI_CHARSET, OUT_TT_PRECIS, CLIP_DEFAULT_PRECIS, _
			ANTIALIASED_QUALITY, FF_DONTCARE Or DEFAULT_PITCH, fname) 
		
		OldhFont = SelectObject(.hDC, .hfont)
		retcode1 = wglUseFontBitmaps(.hDC, 32, 96, .listbase)
		if retcode1 = 0 then
			' Sometimes this doesn't work the first time.  Don't know why.
			wglusefontbitmaps(.hDC, 32, 96, .listbase)
		end if 
		
		SelectObject (.hDC, .hFont)
		
		'	Compute an average character width.  Should be good enough for our purposes. 
		Dim As SIZE s
		Dim As String text = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890"
		GetTextExtentPoint32(.hdc, text, Len(text), @s)
		.AverageWidth = s.cx / Len(text)	
		.AverageHeight = s.cy
		
		deleteObject(.hfont)
					
	End with

End sub


Sub fontreset (f As font_p)
	If glislist(f->listbase) = GL_FALSE then return
	  
	glDeleteLists(f->listbase, 96)
	
	dim as font_t emptyfont
	(*f) = emptyfont
End sub
	
Sub fontWrite (f As font_p, text As string, x As Integer = 0, y As Integer = 0, halignment As Integer = FONT_ALIGN_LEFT, valignment As integer = FONT_ALIGN_BOTTOM)
	If f = 0 Then return
	Dim As single nx, ny
	Dim s As SIZE			' defined as the windows SIZE thing -- see windef.bi

	if glislist(f->listbase) = GL_FALSE then return
	
	SelectObject (f->hDC, f->hFont)
	GetTextExtentPoint32(f->hdc, text, Len(text), @s)


	Select Case halignment
		Case FONT_ALIGN_RIGHT
			nx = x - s.cx
		Case FONT_ALIGN_CENTER
			nx = x - s.cx / 2
		Case Else ' FONT_ALIGN_LEFT by default
			nx = x 
	End Select
	Select Case valignment
		Case FONT_ALIGN_TOP
			ny = y + s.cy
		Case FONT_ALIGN_CENTER
			ny = y + s.cy / 2
		Case Else ' FONT_ALIGN_BOTTOM by default
			ny = y
	End Select

	glPushAttrib (GL_LIST_BIT)
		glListBase(f->listbase - 32)
		glRasterPos2i (nx, ny)
		glCallLists(Len(Text), GL_BYTE, strptr(Text))
	glPopAttrib

end Sub
Here's an example: fonttest.bas

Code: Select all

#Include Once "gL/gl.bi"
#Include Once "gL/glu.bi"
#Include Once "fbgfx.bi"

#include "fontsimple.bas"

#Define XRES 800
#Define YRES 600

Declare Sub gfxEnable2D ()
Declare Sub gfxDisable2D ()

Screenres XRES, YRES, 32, , FB.GFX_OPENGL
glViewport 0, 0, XRES, YRES

glEnable GL_DEPTH_TEST

glColor3f 1,1,1
glMatrixMode GL_PROJECTION
glLoadIdentity

dim as font_t TestFont1, TestFont2, TestFont2Wide, TestFont2Bold

' ***** Build a font, with as few as three parameters
fontbuild (@TestFont1, "Courier", 24)
fontbuild (@TestFont2, "Arial", 24)

'	Make a wide font
fontBuild (@TestFont2Wide, "Arial", 24, 24)


'	Make a bold font
fontBuild (@TestFont2Bold, "Arial", 24, ,FONT_WT_9)

'	Set up 2D projection
gfxenable2d

do Until multikey(FB.SC_ESCAPE)
	'	Clear the screen
	glclear GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT Or GL_ACCUM_BUFFER_BIT
	
	glloadidentity
	glColor3f 1,1,1

	' Set position with glTranslatef 
	gltranslatef 400,100,0

	' You can work with as little as two parameters	
	fontwrite(@TestFont1, "Courier")

	' And you can add some position offsets, if you want 
	fontwrite(@TestFont2, "Arial", 0, 50)
	
	'	Offsets are completely optional, of course, since we can also use glTranslatef
	gltranslatef 0,100,0	

	' You can also change the alignment of the text.
	fontwrite(@TestFont2Wide, "Wider Arial", , , FONT_ALIGN_RIGHT, FONT_ALIGN_CENTER)

	' Change the color!
	glColor3f 1,0,0
	gltranslatef 0,100,0	
	fontwrite(@TestFont2Bold, "Bolder Arial", , , FONT_ALIGN_CENTER, FONT_ALIGN_CENTER)
	
	'BUT, if parts of the text is offscreen, nothing is drawn.
	glloadidentity
	fontwrite(@TestFont1, "You won't see this", -10 , 500 )
	fontwrite(@TestFont1, "You will see this", 10 , 530 )
	
	flip
loop

gfxdisable2d

' ***	Don't forget to reset each font and remove it from memory!
fontreset(@TestFont1)
fontreset(@TestFont2)
fontreset(@TestFont2Wide)
fontreset(@TestFont2Bold)

End

sub gfxEnable2D ()

	Dim viewdata(0 To 3) as Integer
	
	glGetIntegerv(GL_VIEWPORT, @viewdata(0))
	
	glMatrixMode(GL_PROJECTION)
	glPushMatrix ()
	glLoadIdentity ()
	
	glOrtho (0, viewdata(2), viewdata(3), 0, -1, 1)

	glMatrixMode(GL_MODELVIEW)
	glPushMatrix ()
	glLoadIdentity ()

End Sub

Sub gfxDisable2D ()
	glMatrixMode(GL_MODELVIEW)
	glPopMatrix ()

	glMatrixMode(GL_PROJECTION)
	glPopMatrix ()
	
End Sub
JL35
Posts: 76
Joined: Oct 02, 2007 21:11
Location: France

Post by JL35 »

Hello,
When compiling FontSimple.bas I get the following error in GL\glu.bi:
Line 192 Error nr 6
Expected '(', found 'max'
declare function gluBuild1DMipmapLevels alias "gluBuild1DMipmapLevels"...
pr0gger
Posts: 47
Joined: Oct 27, 2006 23:10

Post by pr0gger »

Hmm -- I can't reproduce it. (Can another reader test it and see what happens?)

That may be an issue with your copy of glu.bi. In my version, that line (192) looks like this:

Code: Select all

declare function gluBuild1DMipmapLevels alias "gluBuild1DMipmapLevels" (byval target as GLenum, byval internalFormat as GLint, byval width as GLsizei, byval format as GLenum, byval type as GLenum, byval level as GLint, byval base as GLint, byval max as GLint, byval data as any ptr) as GLint
(Remember to make a backup of your original file if you try to replace it.)
JL35
Posts: 76
Joined: Oct 02, 2007 21:11
Location: France

Post by JL35 »

Sorry, I have exactly the same line in glu.bi, and replacing it by yours, obviously the same error... I must have omitted something somewhere...
Dr_D
Posts: 2451
Joined: May 27, 2005 4:59
Contact:

Post by Dr_D »

pr0gger, I testesd it and it works fine. Good job. ;)

JL3d, what version of FreeBASIC are you using?
pr0gger
Posts: 47
Joined: Oct 27, 2006 23:10

Post by pr0gger »

Dr_D wrote:pr0gger, I testesd it and it works fine. Good job. ;)

JL3d, what version of FreeBASIC are you using?
That was my next question. For the record, I'm currently using v0.20, but it was first written for v0.18.
JL35
Posts: 76
Joined: Oct 02, 2007 21:11
Location: France

Post by JL35 »

Effectively, my version of fb was too old, sorry.
But now I seem to have problem when charging external libraries, like:
Only valid in -lang deprecated of fblite or qb in '1 ''' and so on
(I compile under FBIde with implied parameters).

Excuse my approximate english (I am french).
h4tt3n
Posts: 698
Joined: Oct 22, 2005 21:12
Location: Denmark

Post by h4tt3n »

Works fine for me too. Nice job Pr0gger. (Only drawback is that it's win only.)

Cheers,
Mike
pr0gger
Posts: 47
Joined: Oct 27, 2006 23:10

Post by pr0gger »

JL35 wrote:Effectively, my version of fb was too old, sorry.
But now I seem to have problem when charging external libraries, like:
Only valid in -lang deprecated of fblite or qb in '1 ''' and so on
(I compile under FBIde with implied parameters).

Excuse my approximate english (I am french).
Your English is fine (:

Could you give us some more details about the errors you're getting (files and line numbers?)
JL35
Posts: 76
Joined: Oct 02, 2007 21:11
Location: France

Post by JL35 »

I recently came from qb and seem to have some problems with compiling options and use of libraries, and I have to study that much more.
Sorry for the trouble.
Post Reply