FBTrueType static Win/Lin 32/64-bit

Headers, Bindings, Libraries for use with FreeBASIC, Please include example of use to help ensure they are tested and usable.
owen
Posts: 555
Joined: Apr 19, 2006 10:55
Location: Kissimmee, FL
Contact:

Re: FBTrueType static Win/Lin 32/64-bit

Post by owen »

i see it is not necessary to copy fonts to the folder of the source code.
specifying the path is possible.
font = FontLoad("c:\windows\fonts\" & fontfilename)
owen
Posts: 555
Joined: Apr 19, 2006 10:55
Location: Kissimmee, FL
Contact:

Re: FBTrueType static Win/Lin 32/64-bit

Post by owen »

Code: Select all

#include once "FBTrueType.bi"
screenres 1000,400,32

Dim As String fontfile,fontfiles()
Dim As Integer font_c
Dim As Long font
fontfile=Dir("c:\windows\fonts\*.ttf")
Do
	If fontfile="" Then
		Exit Do
	Else
		font = FontLoad("c:\windows\fonts\" & fontfile)
		If font>0 Then
			font_c+=1
			ReDim Preserve fontfiles(font_c)
			fontfiles(font_c)=fontfile
			FontDestroy()
		EndIf
		fontfile=Dir()
	EndIf
Loop
For i As Integer = 1 To font_c
	fontfile = Mid(fontfiles(i),1,Len(fontfiles(i))-4)
	font = FontLoad("c:\windows\fonts\" & fontfiles(i))
	TTPrint font,10,20*i-20, fontfile,rgb(255,255,255),20
	FontDestroy()
Next



Dim As Integer mr,mx,my,myp,mw,mwp,mb,mc
Dim As Integer wy
Dim As Integer selected_font,selected_font_p
Do
	Select Case InKey
		Case Chr(27),Chr(255)+"k"
			Exit Do
	End Select
	mr=GetMouse(mx,my,mw,mb,mc)
	If mr=0 And mw<>mwp Then
		If mw>mwp Then
			wy+=20
		Else
			wy-=20
		EndIf
		If wy>0 Then wy=0
		If wy<font_c*20*-1+400 Then wy=font_c*20*-1+400
		mwp=mw
	EndIf
	mw=0
	selected_font=(my+10)/20+Abs(wy)/20
	If selected_font<>selected_font_p Then
		selected_font_p=selected_font
		ScreenLock
		Cls
		For i As Integer = 1 To font_c
			Select Case 20*i-20+wy
				Case -20 To 400
					fontfile = Mid(fontfiles(i),1,Len(fontfiles(i))-4)
					font = FontLoad("c:\windows\fonts\" & fontfiles(i))
					If i=selected_font Then
						TTPrint font,10,20*i-20+wy, fontfile,rgb(255,0,255),20
					Else
						TTPrint font,10,20*i-20+wy, fontfile,rgb(255,255,255),20
					EndIf
					
					FontDestroy()
			End Select
		Next
		font = FontLoad("c:\windows\fonts\" & fontfiles(selected_font))
		TTPrint font,500,20, "Hello World",rgb(255,255,255),80
		FontDestroy()
		ScreenUnLock
	End If
	Sleep 1
Loop
owen
Posts: 555
Joined: Apr 19, 2006 10:55
Location: Kissimmee, FL
Contact:

Re: FBTrueType static Win/Lin 32/64-bit

Post by owen »

this is really a great contribution to fb.

i never knew what was involved in ttf and now we have otf to look forward to.

fonts are all about kerning and white space and a whole lot more so i'm finding out.
jupe
Posts: 2
Joined: Oct 06, 2019 15:58

Re: FBTrueType static Win/Lin 32/64-bit

Post by jupe »

any ideas how i can handle thing anyone knows someone dont have C in their boot partion drive label? more than likely my mother for example has E in such device.
srvaldez
Posts: 3398
Joined: Sep 25, 2005 21:54

Re: FBTrueType static Win/Lin 32/64-bit

Post by srvaldez »

@jupe
are you a BOT ?
Knatterton
Posts: 165
Joined: Apr 19, 2019 19:03

Re: FBTrueType static Win/Lin 32/64-bit

Post by Knatterton »

owen wrote:

Code: Select all

#include once "FBTrueType.bi"
screenres 1000,400,32

Dim As String fontfile,fontfiles()
Dim As Integer font_c
Dim As Long font
fontfile=Dir("c:\windows\fonts\*.ttf")
Do
	If fontfile="" Then
		Exit Do
	Else
		font = FontLoad("c:\windows\fonts\" & fontfile)
		If font>0 Then
			font_c+=1
			ReDim Preserve fontfiles(font_c)
			fontfiles(font_c)=fontfile
			FontDestroy()
		EndIf
		fontfile=Dir()
	EndIf
Loop
For i As Integer = 1 To font_c
	fontfile = Mid(fontfiles(i),1,Len(fontfiles(i))-4)
	font = FontLoad("c:\windows\fonts\" & fontfiles(i))
	TTPrint font,10,20*i-20, fontfile,rgb(255,255,255),20
	FontDestroy()
Next



Dim As Integer mr,mx,my,myp,mw,mwp,mb,mc
Dim As Integer wy
Dim As Integer selected_font,selected_font_p
Do
	Select Case InKey
		Case Chr(27),Chr(255)+"k"
			Exit Do
	End Select
	mr=GetMouse(mx,my,mw,mb,mc)
	If mr=0 And mw<>mwp Then
		If mw>mwp Then
			wy+=20
		Else
			wy-=20
		EndIf
		If wy>0 Then wy=0
		If wy<font_c*20*-1+400 Then wy=font_c*20*-1+400
		mwp=mw
	EndIf
	mw=0
	selected_font=(my+10)/20+Abs(wy)/20
	If selected_font<>selected_font_p Then
		selected_font_p=selected_font
		ScreenLock
		Cls
		For i As Integer = 1 To font_c
			Select Case 20*i-20+wy
				Case -20 To 400
					fontfile = Mid(fontfiles(i),1,Len(fontfiles(i))-4)
					font = FontLoad("c:\windows\fonts\" & fontfiles(i))
					If i=selected_font Then
						TTPrint font,10,20*i-20+wy, fontfile,rgb(255,0,255),20
					Else
						TTPrint font,10,20*i-20+wy, fontfile,rgb(255,255,255),20
					EndIf
					
					FontDestroy()
			End Select
		Next
		font = FontLoad("c:\windows\fonts\" & fontfiles(selected_font))
		TTPrint font,500,20, "Hello World",rgb(255,255,255),80
		FontDestroy()
		ScreenUnLock
	End If
	Sleep 1
Loop
Here is the linux version:

Code: Select all

' show_ttf_linux.bas

#include once "FBTrueType.bi"
screenres 1000,400,32

Dim As String fontfile,fontfiles()
Dim As Integer font_c
Dim As Long font
fontfile=dir("/usr/share/fonts/truetype/dejavu/*.ttf")
Do
   If fontfile="" Then
      Exit Do
   Else
      font = FontLoad("/usr/share/fonts/truetype/dejavu/" & fontfile)
      If font>0 Then
         font_c+=1
         ReDim Preserve fontfiles(font_c)
         fontfiles(font_c)=fontfile
         FontDestroy()
      EndIf
      fontfile=Dir()
   EndIf
Loop
For i As Integer = 1 To font_c
   fontfile = Mid(fontfiles(i),1,Len(fontfiles(i))-4)
   font = FontLoad("/usr/share/fonts/truetype/dejavu/" & fontfiles(i))
   TTPrint font,10,20*i-20, fontfile,rgb(255,255,255),20
   FontDestroy()
Next



Dim As Integer mr,mx,my,myp,mw,mwp,mb,mc
Dim As Integer wy
Dim As Integer selected_font,selected_font_p
Do
   Select Case InKey
      Case Chr(27),Chr(255)+"k"
         Exit Do
   End Select
   mr=GetMouse(mx,my,mw,mb,mc)
   If mr=0 And mw<>mwp Then
      If mw>mwp Then
         wy+=20
      Else
         wy-=20
      EndIf
      If wy>0 Then wy=0
      If wy<font_c*20*-1+400 Then wy=font_c*20*-1+400
      mwp=mw
   EndIf
   mw=0
   selected_font=(my+10)/20+Abs(wy)/20
   If selected_font<>selected_font_p Then
      selected_font_p=selected_font
      ScreenLock
      Cls
      For i As Integer = 1 To font_c
         Select Case 20*i-20+wy
            Case -20 To 400
               fontfile = Mid(fontfiles(i),1,Len(fontfiles(i))-4)
               font = FontLoad("/usr/share/fonts/truetype/dejavu/" & fontfiles(i))
               If i=selected_font Then
                  TTPrint font,10,20*i-20+wy, fontfile,rgb(255,0,255),20
               Else
                  TTPrint font,10,20*i-20+wy, fontfile,rgb(255,255,255),20
               EndIf
               
               FontDestroy()
         End Select
      Next
      font = FontLoad("/usr/share/fonts/truetype/dejavu/" & fontfiles(selected_font))
      TTPrint font,500,20, "Hello World",rgb(255,255,255),80
      FontDestroy()
      ScreenUnLock
   End If
   Sleep 1
Loop
Drawback: in this folder all fonts are in separate subfolders...
Makoto WATANABE
Posts: 232
Joined: Apr 10, 2010 11:41
Location: Japan
Contact:

Re: FBTrueType static Win/Lin 32/64-bit

Post by Makoto WATANABE »

Dear D.J.Peters;
Dear owen;

I have learned that FBTrueType allows me to use Japanese fonts to display Japanese characters on drawing screens.
I would like to add Japanese comments to your program examples and introduce them on my site to FreeBASIC fans in Japan.
Thank you for your understanding.
D.J.Peters
Posts: 8588
Joined: May 28, 2005 3:28
Contact:

Re: FBTrueType static Win/Lin 32/64-bit

Post by D.J.Peters »

I edit the include file "FBTrueType.bi" this fixed the trouble with fbc 1.8.0 !
(unused parameters with ImageInfo())

Joshy
Makoto WATANABE
Posts: 232
Joined: Apr 10, 2010 11:41
Location: Japan
Contact:

Re: FBTrueType static Win/Lin 32/64-bit

Post by Makoto WATANABE »

Dear Kwabbernoot;

Thank you for telling me about FBTrueType.
With FreeBASIC 1.08.0, I can display Japanese characters on drawing screens using Japanese fonts.
I am very grateful to you.
D.J.Peters
Posts: 8588
Joined: May 28, 2005 3:28
Contact:

Re: FBTrueType static Win/Lin 32/64-bit

Post by D.J.Peters »

I fixed a tiny bug (integer vs long) and added for testing some free TrueType Fonts.
(see first post for download)

Joshy
thrive4
Posts: 72
Joined: Jun 25, 2021 15:32

Re: FBTrueType static Win/Lin 32/64-bit

Post by thrive4 »

Great work thank you for sharing this library,
even better I, at least i think, read somewhere
on the forum that there is a good chance that
this will become a standard lib for FB!

I've made a small sample with the following code:
viewtopic.php?p=295676&hilit=fb+lib+ttf#p295676

There a some small issues I came across that might
be worthwhile looking into:

a) a kerning issue with the letter 'j' (lowercase)
try 'dj jd' with the sample code note how j sticks to d
used 'TTPrintString.bas'

Image
actually more letters are effectd w, m Q etc....

b) regrettably there is no support for text styles aka attributes
similar to sdl_ttf see:
https://wiki.libsdl.org/SDL_ttf/TTF_SetFontStyle
TTF_SetFontStyle(font, TTF_STYLE_BOLD)

c) getTextWidth seems only to work with images(.bmp)?
made a work around in the above mentioned code
'fb_querytexture' but it is a bit wasteful and not so
scale able.

d) text orientation is not supported.
granted with sdl_ttf the work around is
by using SDL_RenderCopyEx, see
example in above mentioned code maybe
something similar is possible with this library.

e) there is a very small but still noticeable memory leak
specifacly when using TTPrint in a do ... loop

Hope this helps.
Post Reply