In case it might be usefull to some one, here's a FreeType api I've written. It still needs cleaning up, isn't documented, and lacks some functionality, such as a unicode string type (print_char supports unicode, though), but it may be of interest to people who want to use the FreeType library.
Needs the FreeType and ZLib libraries.
Code: Select all
#Include "freetype2/freetype.bi"
Type truetype
'original structure
Dim ErrorMsg As FT_Error
Dim Library As FT_Library
'extended
Dim Face As FT_Face
Dim string_width As integer
Dim render_mode As Integer
Dim scr_width As Integer
Dim scr_height As Integer
Dim bmp_dat As UInteger
Dim font_size As Integer
'from printft_char
Dim GlyphIndex As FT_UInt
'from drawglyph
Dim BitmapFT As FT_Bitmap
Dim BitmapPtr As UByte Ptr
Dim DestPtr As UInteger Ptr
Dim BitmapHgt As Integer
Dim BitmapWid As Integer
Dim BitmapPitch As Integer
Dim src_rb As UInteger
Dim src_g As UInteger
Dim src_color As UInteger
Dim dst_rb As UInteger
Dim dst_g As UInteger
Dim dst_color As UInteger
'extended
Dim As UInteger rb,g
'methods
Declare Function init As ft_error
Declare Function get_font(FontName As String) As Integer
Declare Sub set_render_mode(rm As Integer)
Declare Sub set_screen_size(scr_width As Integer, scr_height As Integer)
Declare Function set_size(size As Integer) As Integer
Declare Sub set_color(clr As UInteger)
Declare Sub set_back_color(clr As UInteger)
Declare Function print_char(x As Integer, y As Integer, char As ft_ulong) As Integer
Declare Function get_text_width(txt As String) As Integer
Declare Function print_text(x As Integer, y As Integer, txt As String) As Integer
End Type
Function truetype.init As ft_error
Return FT_Init_FreeType(@library)
End Function
Function truetype.get_font(FontName As String) As Integer
ErrorMsg = FT_New_Face(Library, FontName, 0, @Face )
If ErrorMsg Then
Return 0
Else
Return 1
EndIf
End Function
Sub truetype.set_render_mode(rm As Integer)
render_mode=rm
End Sub
Sub truetype.set_screen_size(w As Integer, h As Integer)
scr_width=w
scr_height=h
End Sub
Function truetype.set_size(size As Integer) As Integer
FT_Set_Pixel_Sizes(face, size, size)
font_size=size
End Function
Sub truetype.set_color(clr As UInteger)
src_color=clr
src_rb=clr And &h00ff00ff
src_g=clr And &h0000ff00
End Sub
Sub truetype.set_back_color(clr As UInteger)
dst_color=clr
dst_rb=clr And &h00ff00ff
dst_g=clr And &h0000ff00
End Sub
Function truetype.get_text_width(txt As String) As Integer
string_width=0
For t As Integer=0 To Len(txt)-1
GlyphIndex = FT_Get_Char_Index(face, txt[t])
string_width=string_width+face->glyph->advance.x Shr 6
Next
Return string_width
End Function
Function truetype.print_char(x As Integer, y As Integer, char As ft_ulong) As Integer
' Load character index
GlyphIndex = FT_Get_Char_Index(face, char)
' Load character glyph
ErrorMsg = FT_Load_Glyph(face, GlyphIndex, FT_LOAD_DEFAULT)
If ErrorMsg Then Return 0
' Render glyph if it's an outline glyph.
ErrorMsg = FT_Render_Glyph(face->Glyph, render_mode)
If ErrorMsg Then Return 0
' Check clipping
If (X + face->Glyph->Bitmap_Left + face->Glyph->Bitmap.Width) > scr_width Then Return 0
If (Y - face->Glyph->Bitmap_Top + face->Glyph->Bitmap.Rows) > scr_height Then Return 0
If (X + face->Glyph->Bitmap_Left) < 0 Then Return 0
If (Y - face->Glyph->Bitmap_Top) < 0 Then Return 0
' Set draw character
x=X + face->Glyph->Bitmap_Left
y=Y - face->Glyph->Bitmap_Top
BitmapFT = face->Glyph->Bitmap
BitmapPtr = BitmapFT.Buffer
BitmapWid = BitmapFT.Width
BitmapHgt = BitmapFT.Rows
BitmapPitch = scr_width - BitmapFT.Width
If render_mode=FT_RENDER_MODE_NORMAL Then 'Render anti aliased glyph.
DestPtr = Cast(UInteger Ptr, ScreenPtr) + (y * scr_width) + x
Do While BitmapHgt
Do While BitmapWid
If *bitmapptr<>0 Then 'optional optimization
'
' For rendering glyphs over existing background
'
' Dst_RB = *DestPtr And &h00ff00ff
' Dst_G = *DestPtr And &h0000ff00
RB = ((Src_RB - Dst_RB) * *BitmapPtr) Shr 8
G = ((Src_G - Dst_G) * *BitmapPtr) Shr 8
*DestPtr = ((Dst_RB + RB) And &h00ff00ff) Or ((Dst_G + G) And &h0000ff00)
EndIf
DestPtr += 1
BitmapPtr += 1
BitmapWid -= 1
Loop
BitmapWid = BitmapFT.Width
BitmapHgt -= 1
DestPtr += BitmapPitch
Loop
Else 'Render one bit per pixel glyph.
BitmapPitch = scr_width - BitmapFT.pitch Shl 3
DestPtr = Cast(UInteger Ptr, ScreenPtr)+(y * scr_width) + x
For yy As Integer=0 To Bitmapft.rows-1
For tt As Integer=0 To bitmapft.pitch-1
bmp_dat=*bitmapptr
For t As Integer=0 To 7
If (bmp_dat And 128)=128 Then
*destptr=src_color
Else
*destptr=dst_color
EndIf
bmp_dat=bmp_dat Shl 1
DestPtr += 1
Next
bitmapptr += 1
Next
DestPtr = destptr+bitmappitch
Next
End If
Return face->glyph->advance.x Shr 6
End Function
Function truetype.print_text(x As Integer, y As Integer, txt As String) As Integer
Dim As Integer xx
For t As Integer=0 To Len(txt)-1
xx=xx+print_char(x+xx,y,txt[t])
Next
Return xx
End Function
'
' Main
'
ScreenRes 800,600,32,,0
Dim As truetype simsun
If simsun.init Then Stop
If simsun.get_font("c:\windows\fonts\arial.ttf")=0 Then Stop
simsun.set_render_mode(FT_RENDER_MODE_NORMAL)
simsun.set_screen_size(800,600)
simsun.set_size(64)
simsun.set_color(RGB(0,0,0))
simsun.set_back_color(RGB(255,255,255))
Dim As Integer c=&h20'4e00
Dim As Double t
Dim As Integer Inc,x1,xx
Dim As String txt="Hello world!"
ScreenLock
Line(0,0)-(799,599),RGB(255,255,255),bf
xx=simsun.get_text_width(txt)
simsun.print_text(100,400,txt)
Line(100,0)-(100,599),RGB(0,0,0)
Line(100+xx,0)-(100+xx,599),RGB(0,0,0)
Line(0,400)-(799,400),RGB(0,0,0)
ScreenUnlock
Sleep