Simple FreeType api.

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Thorham
Posts: 73
Joined: Apr 16, 2008 21:25

Simple FreeType api.

Post by Thorham »

Hi coders,

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
BasicScience
Posts: 489
Joined: Apr 18, 2008 4:09
Location: Los Angeles, CA
Contact:

Post by BasicScience »

Thanks. This is terrific. Much more user-friendly than going through gfx.font.xxx functions in ext/graphics.bi. I especially like that the size and color of the font can easily be changed in your api, whereas gfx.font routines required the glyphs to be recreated as a revised FB.Image.

Also, the freetype2 routines don't seem to have the little glitches that appear in a size-dependent manner with the gfx.font routines.
Thorham
Posts: 73
Joined: Apr 16, 2008 21:25

Post by Thorham »

Minor update of the class, mostly just a cleanup.

Code: Select all

'
' True type font class. Simple api for the freetype libray.
'
' By Thorham.
' Based on the freetype example from the FreeBasic examples.
'
#Include "freetype2/freetype.bi"

Type truetype
	Dim errormsg As ft_error
	Dim library As ft_library

	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

	Dim bitmapft As ft_bitmap
	Dim bitmapptr As UByte Ptr
	Dim destptr As UInteger Ptr

	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
'
' Render mode:
'
' FT_RENDER_MODE_MONO for 1 bit per pixel rendering.
' FT_RENDER_MODE_NORMAL for anti-aliased rendering.
'
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
	errormsg=ft_set_pixel_sizes(face, size, size)

	If errormsg Then
		font_size=0
		Return 0
	Else
		font_size=size
		Return 1
	EndIf

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
		errormsg = ft_load_char(face, txt[t], FT_LOAD_DEFAULT)
		If errormsg Then Return 0

		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
	errormsg = ft_load_char(face, char, FT_LOAD_DEFAULT):If errormsg Then Return 0
	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

	x=x + face->glyph->bitmap_left
	y=y - face->glyph->bitmap_top

	bitmapft = face->glyph->bitmap
	bitmapptr = bitmapft.buffer
	destptr = Cast(UInteger Ptr, ScreenPtr) + (y * scr_width) + x

	If render_mode=FT_RENDER_MODE_NORMAL Then	'Render anti aliased glyph.

		bitmappitch = scr_width - bitmapft.width

		For yy As Integer=0 To bitmapft.rows-1
			For xx As Integer=0 To bitmapft.width-1

				If *bitmapptr<>0 Then
					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
			Next

			destptr += bitmappitch
		Next

	Else	'Render one bit per pixel glyph.
		bitmappitch = scr_width - bitmapft.pitch Shl 3

		For yy As Integer=0 To bitmapft.rows-1
			For xx As Integer=0 To bitmapft.pitch-1
				bmp_dat=*bitmapptr

				For b As Integer=0 To 7
					If (bmp_dat And 128)=128 Then *destptr=src_color

					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 font1
Dim As Double tm

If font1.init Then Stop
If font1.get_font("c:\windows\fonts\tahoma.ttf")=0 Then Stop
font1.set_render_mode(FT_RENDER_MODE_NORMAL)
font1.set_screen_size(800,600)
font1.set_size(64)
font1.set_color(RGB(0,0,0))
font1.set_back_color(RGB(255,255,255))

ScreenLock
Line(0,0)-(799,599),RGB(255,255,255),bf

Dim As Integer x
Dim As String txt

txt="Hello world!"
font1.print_text(100,400,txt)

x=font1.get_text_width(txt)
Line(100,0)-(100,599),RGB(255,0,0)
Line(100+x,0)-(100+x,599),RGB(255,0,0)
Line(0,400)-(799,400),RGB(255,0,0)

ScreenUnLock

Sleep
@BasicScience:

Cool that you like it :) Positive feedback is always apreciated, thanks.

To all:

Negative criticism is also apreciated. However, if you think this is s***t, don't just write that you think that, but also write why you think it's s***t ;)
BasicScience
Posts: 489
Joined: Apr 18, 2008 4:09
Location: Los Angeles, CA
Contact:

Post by BasicScience »

One performance consideration is processing time.

To print "Hello World" 100 times with a call to font1.print_text in your API took 70 msec. By comparison, Draw String (with the default font) completed 100 cycles in 2.2 msec.
Thorham
Posts: 73
Joined: Apr 16, 2008 21:25

Post by Thorham »

BasicScience wrote:One performance consideration is processing time.

To print "Hello World" 100 times with a call to font1.print_text in your API took 70 msec. By comparison, Draw String (with the default font) completed 100 cycles in 2.2 msec.
You got that right! It might be possible to have FreeType render directly to the screen, this should speed up the rendering. I'll try to find out using it's documentation.
Thorham
Posts: 73
Joined: Apr 16, 2008 21:25

Post by Thorham »

Hi BasicScience,

It seems the performance bottleneck is the following line:

Code: Select all

errormsg = ft_load_char(face, char, FT_LOAD_DEFAULT)
The actual rendering doesn't seem to be the problem. I'll try to get it faster, but I really can't promise anything.
BasicScience
Posts: 489
Joined: Apr 18, 2008 4:09
Location: Los Angeles, CA
Contact:

Post by BasicScience »

Two other suggestions....

1) To be compatible with Draw String, the y coordinate should be the top edge of the rendered font, not the bottom.

2) It would be great if the text printing could be rendered to any desired FB.Image buffer (with the standard default 0 = screen). This way, your routines could be used to add text to sprites.
Thorham
Posts: 73
Joined: Apr 16, 2008 21:25

Post by Thorham »

BasicScience wrote:1) To be compatible with Draw String, the y coordinate should be the top edge of the rendered font, not the bottom.
Yes, I think it's annoying, too. Will fix it.
BasicScience wrote:2) It would be great if the text printing could be rendered to any desired FB.Image buffer (with the standard default 0 = screen). This way, your routines could be used to add text to sprites.
Although this is outside the scope of the api's use (it's for a gui system), I don't think it can hurt to give it a go. However, if successful, I'll implement it as an extra function, because I have no need for it my gui.
BasicScience
Posts: 489
Joined: Apr 18, 2008 4:09
Location: Los Angeles, CA
Contact:

Post by BasicScience »

The ability to print to an FB.Image buffer would be very helpful for my GUI project. I use an FB.IMage buffer to create a pop-up form and then place new controls in it (which requires the print functionality).
Thorham
Posts: 73
Joined: Apr 16, 2008 21:25

Post by Thorham »

BasicScience wrote:The ability to print to an FB.Image buffer would be very helpful for my GUI project. I use an FB.IMage buffer to create a pop-up form and then place new controls in it (which requires the print functionality).
That's a good idea, hadn't thought of that :) I'll certainly give it priority now.
BasicScience
Posts: 489
Joined: Apr 18, 2008 4:09
Location: Los Angeles, CA
Contact:

Post by BasicScience »

I think I figured out how to optionally render fonts on an FB.Image rather than the screen. Just needed to set DestPtr of FB.Image ptr and set_screen_size to match the size of the FB.Image buf.

There are still a few quirks about (x,y) location of rendered font (perhpas @Thorham will fix ;-)

The antialiasing and clarity of the glyphs seem much better than with the FB_Ext lib (GFX.Font stuff). Moreover, it's easier to change font size, color, and style with the little api you put together.

Code: Select all

#Include "freetype2/freetype.bi"
Dim Shared Device_Ptr as any ptr 

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
                DestPtr = Cast(Uinteger Ptr, Device_Ptr) + (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
                DestPtr = Cast(Uinteger Ptr, Device_Ptr)+(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,2,0
line (0,0)-(799,599), rgb(255,255,255), bf

Dim as integer MyX, MyY, i
MyX = 180
MyY = 60
Dim Shared MyImage as any ptr 
Dim as uinteger bcolor
MyImage = ImageCreate (MyX, MyY)
bcolor = rgb(255,255,0)
line MyImage,(0,0)-(MyX,MyY), bcolor, bf

'Start with Screen
Device_Ptr = ScreenPtr

Dim As truetype simsun

If simsun.init Then Stop
If simsun.get_font("c:\windows\fonts\tahoma.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 xx, mx, my, mxold, myold
Dim As String txt="Hello world!"

ScreenLock
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

draw string (150,10), "Hit any key to continue", rgb(0,0,0)

sleep

line (150,0) - (400,20), rgb(255,255,255), bf
draw string (150,10), "Move mouse.  Hit esc to quit.", rgb(0,0,0)

'Now Print to Sprit
    Device_Ptr = MyImage
    simsun.set_back_color bcolor
    simsun.set_screen_size(MyX,MyY)
    simsun.set_size(28)
    simsun.print_text(20,40,txt)        'print to sprite
    pcopy 0,1                           'save screen
    do
        GetMouse (mx,my)
        if mx <> mxold or my <> myold then
            screenlock
            pcopy 1,0                       'restore original screen
            put (mx,my), MyImage, pset
            screenunlock
            mxold = mx:  myold = my
        end if
        sleep 30
    loop until multikey(1)
Sleep
Thorham
Posts: 73
Joined: Apr 16, 2008 21:25

Post by Thorham »

To BasicScience:

I had completely forgotten about it, sorry about that! Nice addition, I'll check it out right away :)

As for the character positioning, this has proven to be a little bit harder than I thought it would. Freetype uses the char sets base line instead of the bottom of the char. Check my original example which renders text and the base line and try rendering chars like g, and you'll see they stick out beneath the base line. Doh! That really sucks, but I'll try anyway.

Good you like the simple-ness, thank you :) And the anti-aliassing is indeed quite good with the Freetype library, you should see how it renders Chineese characters, they look truely awesome.
agamemnus
Posts: 1842
Joined: Jun 02, 2005 4:48

Post by agamemnus »

Is the string width broken?

Code: Select all

        string_width=0
        For t As Integer=0 To Len(txt)-1

                GlyphIndex = FT_Get_Char_Index(face, txt[t])
                string_width+=face->glyph->advance.x Shr 6

        Next

        Return string_width
edit:

Here is a working stringWidth function that I made from looking at http://www.cs.sunysb.edu/documentation/ ... step2.html :

Code: Select all

function truetype.stringWidth(byval text As string) As integer
 dim as FT_GlyphSlot slot = face->glyph
 dim as integer pen_x, n
 dim as ft_uint num_glyphs
 dim as ft_uint previous = 0
 dim delta as ft_vector

 for n = 0 to len(text)-1
  glyphindex = FT_Get_Char_Index( face, text[n] )
  if previous and glyphindex then
   FT_Get_Kerning (face, previous, glyphindex, FT_KERNING_DEFAULT, @delta)
   pen_x += delta.x shr 6
  end if
  FT_Load_Glyph( face, glyphindex, FT_LOAD_DEFAULT )
  pen_x += slot->advance.x shr 6
  previous = glyphindex
  num_glyphs+=1
 next n
 return pen_x
end function
Last edited by agamemnus on Jul 04, 2009 18:27, edited 1 time in total.
sir_mud
Posts: 1401
Joined: Jul 29, 2006 3:00
Location: US
Contact:

Post by sir_mud »

This looks pretty good, the font routines in Ext were really just thrown together and put in the library as a desired feature. Thorham, I would love to put a version of your type in the Extended Library as long as you're willing to put a copy under Ext's license.
agamemnus
Posts: 1842
Joined: Jun 02, 2005 4:48

Post by agamemnus »

Another thing: I'm not sure why (yet) but the text always seems to be off by a few pixels...

Edit: Ok, saw the comments above.... will try to fix.

Edit 2: Nope-- can't do it.. :(
Post Reply