Simple FreeType api.

User projects written in or related to FreeBASIC.
Thorham
Posts: 73
Joined: Apr 16, 2008 21:25

Simple FreeType api.

Postby Thorham » Jan 20, 2009 21:30

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

Postby BasicScience » Jan 20, 2009 23:25

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

Postby Thorham » Jan 22, 2009 13:37

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

Postby BasicScience » Jan 22, 2009 22:26

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

Postby Thorham » Jan 22, 2009 22:36

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

Postby Thorham » Jan 22, 2009 23:28

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

Postby BasicScience » Jan 22, 2009 23:55

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

Postby Thorham » Jan 23, 2009 23:19

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

Postby BasicScience » Jan 23, 2009 23:31

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

Postby Thorham » Jan 23, 2009 23:36

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

Postby BasicScience » Feb 03, 2009 17:37

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

Postby Thorham » Feb 10, 2009 19:10

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

Postby agamemnus » Jun 27, 2009 18:56

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:

Postby sir_mud » Jun 29, 2009 8:02

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

Postby agamemnus » Jul 04, 2009 17:53

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.. :(

Return to “Projects”

Who is online

Users browsing this forum: No registered users and 3 guests