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