[bb] Simple Proportional Font Routine by WildCat [ 1+ years ago ]

[BlitzBot]

Title : Simple Proportional Font Routine
Author : WildCat
Posted : 1+ years ago

Description : This routine was based on the proportional bitmap font format by Adreas Jonsson (www.AngelCode.com, as he reffers). Maybe I invented a bicycle, but this is really usable in many ways. It works in 2D modes and features string divisioning at space [aka chr$(32) ]. Global variable 'fontDir$' may be used to place your fonts somewhere else. This code needs optimization in a couple of places, so let's improve it together, 'cause as I said it's usable widely. One little example will be posted very soon...

Code :

Code (blitzbasic) Select Expand

Type WSymbol
Field x
Field y
Field w
Field h
Field ox
Field oy
Field xa
Field page
End Type

Type WFont
Field pages[10]
Field symbols[256]
Field name$
End Type

Function WSymbolNew.WSymbol (x, y, w, h, ox, oy, xa, page)
sym.WSymbol= New WSymbol
symx = x
symy = y
symw = w
symh = h
symox = ox
symoy = oy
symxa = xa
sympage = page

Return (sym)
End Function

Function WFontNew.WFont (filename$)
font.WFont = New WFont

font
ame$ = filename$

If fontDir$ <> "" Then
filename$ = fontDir$ + filename$
EndIf

file = ReadFile (filename$)
a$ = ReadLine (file)
a$ = ReadLine (file)


b = Instr (a$, "pages=")
pages = Mid (a$, b+6)

If Left$(filename$,2) = ".." Then
beginFrom = 3
Else
beginFrom = 1
EndIf

c = Instr (filename$, ".", beginfrom)
basename$ = Mid (filename$, 1, c-1)

For b = 1 To pages
nam$ = b-1
While Len(nam$) < 2
nam$ = "0"+nam$
Wend
nam$ = basename$+"_"+nam$+".png"

;If fontDir$ <> "" Then nam$ = fontDir$ + nam$

fontpages[b] = LoadImage (nam$)
DebLog("Page Load: "+nam$+": handle="+fontpages[b])
Next

While Eof (file) = 0
a$ = ReadLine (file)

sp = Instr (a$, " ")
If sp Then
fw$ = Mid (a$, 1, sp-1)
If fw$ = "kerning" Then Goto wfontcycend
If fw$ = "mask" Then
sp2 = Instr (a$, " ", sp+1)
sp3 = Instr (a$, " ", sp2+1)

red = Mid (a$, sp+1, sp2-sp)
green = Mid (a$, sp2+1, sp3-sp2)
blue = Mid (a$, sp3+1)

For b = 1 To pages
MaskImage (fontpages[b], red, green, blue)
Next

Goto wfontcycend
EndIf
EndIf

b = Instr (a$, "id=")
If b = 0 Then Goto wfontcycend

c = Instr (a$, " ", b)
id = Mid (a$, b+3, c-b-3)

b = Instr (a$, "x=",c)
c = Instr (a$, " ", b)
x = Mid (a$, b+2, c-b-2)

b = Instr (a$, "y=",c)
c = Instr (a$, " ", b)
y = Mid (a$, b+2, c-b-2)

b = Instr (a$, "width=",c)
c = Instr (a$, " ", b)
w = Mid (a$, b+6, c-b-6)

b = Instr (a$, "height=",c)
c = Instr (a$, " ", b)
h = Mid (a$, b+7, c-b-7)

b = Instr (a$, "xoffset=",c)
c = Instr (a$, " ", b)
ox = Mid (a$, b+8, c-b-8)

b = Instr (a$, "yoffset=",c)
c = Instr (a$, " ", b)
oy = Mid (a$, b+8, c-b-8)

b = Instr (a$, "xadvance=",c)
c = Instr (a$, " ", b)
xa = Mid (a$, b+9, c-b-9)

b = Instr (a$, "page=",c)
page = Mid (a$, b+5)

fontsymbols[id+1] = Handle (WSymbolNew(x, y, w, h, ox, oy, xa, page))

.wfontcycend
Wend

Return (font)
End Function

Function WFontText (font.WFont, s$, x, y)
For a = 1 To Len(s$)
b = Asc (Mid(s$, a, 1))
If fontsymbols[b+1] Then
sym.WSymbol = Object.WSymbol(fontsymbols[b+1])
DrawImageRect (fontpages[sympage+1], x+symox, y+symoy, symx, symy, symw, symh)
x = x + symxa
EndIf
Next
End Function

Function WFontWidth (font.WFont, s$)
w = 0
For a = 1 To Len(s$)
b = Asc (Mid(s$, a, 1))
If fontsymbols[b+1] Then
sym.WSymbol = Object.WSymbol(fontsymbols[b+1])
w = w + symxa
EndIf
Next
Return w
End Function

Function WFontHeight (font.WFont, s$)
h = 0
For a = 1 To Len(s$)
b = Asc (Mid(s$, a, 1))
If fontsymbols[b+1] Then
sym.WSymbol = Object.WSymbol(fontsymbols[b+1])
If symoy+symh > h Then h = symoy+symh
EndIf
Next
Return h
End Function

Function WFontByName.WFont (name$)
For font.WFont = Each WFont
If font
ame$ = name$ Then Return font
Next
Return Null
End Function

Function WFontSpare (font.WFont, s$, width, atSpace = True)
w = 0
For a = 1 To Len(s$)
b = Asc (Mid(s$, a, 1))
If fontsymbols[b+1] Then
sym.WSymbol = Object.WSymbol(fontsymbols[b+1])
wc = w + symox + symw + symxa ;strange formula, but everything is clear this way :)
w = w + symxa
If wc > width Then
If atSpace Then
b = a
Repeat
If Mid(s$, b, 1) = " " Then Return b+1
b = b - 1
If b = 0 Then Return WFontSpare (font, s$, width, False)
Forever
Return a
Else
Return a
EndIf
EndIf
EndIf
Next

Return 0
End Function

Function WFontFree (font.WFont)
For page = 1 To 10
If fontpages[page] Then FreeImage (fontpages[page])
Next

For a = 1 To 256
If fontsymbols[a] Then
sym.WSymbol = Object.WSymbol(fontsymbols[b+1])
Delete sym
EndIf
Next

Delete font
End Function

Function WFontsFree ()
For font.WFont = Each WFont
WFontFree(font)
Next
End Function

Comments :


WildCat(Posted 1+ years ago)

 Here goes the example:

Code Select Expand

Include "wfont.bb"

Function DebLog (s$)
;this belongs to 'service.bb', but cut out of there to reduce code
If debMode = 1 Then
fname$ = "debug.log"
If FileSize(fname$) = 0 Then
file = WriteFile (fname$)
Else
file = OpenFile (fname$)
EndIf
SeekFile (file, FileSize(fname$))
WriteLine (file, s$)
CloseFile (file)
DebugLog (s$)
Else
DebugLog (s$)
EndIf
End Function

Graphics 200,140,32,2
ClsColor 255, 255, 255
Cls

tahoma24black.WFont = WFontNew ("tahoma24black.fnt")
WFontText (tahoma24black, "Hello World!", 45, 55)

Flip
WaitKey
End
And here goes media: <a href="http://project-a.ru/files/tahoma24black.zip" target="_blank">http://project-a.ru/files/tahoma24black.zip</a> [/i]