Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
weicher text mit freetype v2 (hoffentlich flüssiger)
| Uploader: |  flo |
| Datum/Zeit: | 15.07.2008 18:41:13 |
#define conswrite(bla) open cons for output as #132: ?#132,bla: close #132
''
'' FreeType2 library test, by jofers (spam[at]betterwebber.com)
''
#include "fbgfx.bi"
#include "freetype2/freetype.bi"
' Alpha blending
#define FT_MASK_RB_32 &h00FF00FF
#define FT_MASK_G_32 &h0000FF00
' DataStructure to make it easy
Type FT_Var
ErrorMsg As FT_Error
Library As FT_Library
PixelSize As Integer
End Type
Dim Shared FT_Var As FT_Var
Declare Function GetFont(ByVal FontName As String) As Integer
declare Function PrintTest(ByVal x As Integer, ByVal y As Integer, ByVal Text As String, ByVal Font As Integer, ByVal Size As Integer = 14, ByVal Clr As UInteger = Rgb(255, 255, 255)) as integer
' Initialize FreeType
' -------------------
FT_Var.ErrorMsg = FT_Init_FreeType(@FT_Var.Library)
If FT_Var.ErrorMsg Then
Print "Could not load library"
End
End If
' Your program
' ------------
ScreenRes 320, 240, 32
Dim ArialFont As Integer
ArialFont = GetFont("/usr/local/share/freebasic/examples/libraries/SDL/data/Vera.ttf")
If ArialFont = 0 Then Print "couldn't find it": Sleep: End
dim as integer x,y
For x = 0 to 320
for y = 0 to 239
pset (x, y), x xor y
next y
next x
' Randomize timer
' For X = 1 To 20
' PrintFT Rnd * 200, Rnd * 180 + 20, "Hello World!", ArialFont, Rnd * 22 + 10, Rgb(Rnd * 255, Rnd * 255, Rnd * 255)
' Next X
PrintTest (10,100,"hello world ist das geil",ArialFont,25,rgb(255,255,0))
Sleep
' Load a font
' -----------
Function GetFont(ByVal FontName As String) As Integer
Dim Face As FT_Face
Dim ErrorMsg As FT_Error
ErrorMsg = FT_New_Face(FT_Var.Library, FontName, 0, @Face )
If ErrorMsg Then Return 0
Return CInt(Face)
End Function
' Print Text
' ----------
' Print Text
' ----------
Function PrintTest(ByVal x As Integer, ByVal y As Integer, ByVal Text As String, ByVal Font As Integer, ByVal Size As Integer = 14, ByVal Clr As UInteger = Rgb(255, 255, 255)) as integer
Dim ErrorMsg As FT_Error
Dim FontFT As FT_Face
Dim GlyphIndex As FT_UInt
Dim Slot As FT_GlyphSlot
Dim PenX As Integer
Dim PenY As Integer
Dim i As Integer
dim as fb.image ptr zeichen (0 to len(text)-1),zeichenBG(0 to len(text)-1)
dim as integer zx(0 to len(text)-1),zy(0 to len(text)-1)
dim as integer transp(0 to len(text)-1)
zx(0)=x
zy(0)=y
' Get rid of any alpha channel in AlphaClr
Clr = Clr Shl 8 Shr 8
' Convert font handle
FontFT = Cast(FT_Face, Font)
' Set font size
ErrorMsg = FT_Set_Pixel_Sizes(FontFT, Size, Size)
FT_Var.PixelSize = Size
If ErrorMsg Then Return 0
' Draw each character
Slot = FontFT->Glyph
PenX = x
PenY = y
For i = 0 To Len(Text) - 1
' Load character index
transp(i)=-i*50
GlyphIndex = FT_Get_Char_Index(FontFT, Text[i])
' Load character glyph
ErrorMsg = FT_Load_Glyph(FontFT, GlyphIndex, FT_LOAD_DEFAULT)
If ErrorMsg Then Return 0
' Render glyph
ErrorMsg = FT_Render_Glyph(FontFT->Glyph, FT_RENDER_MODE_NORMAL)
If ErrorMsg Then Return 0
' Check clipping
If (PenX + FontFT->Glyph->Bitmap_Left + FontFT->Glyph->Bitmap.Width) > 320 Then PenX=X:PenY+=size+2'Exit For
If (PenY - FontFT->Glyph->Bitmap_Top + FontFT->Glyph->Bitmap.Rows) > 240 Then Exit For
If (PenX + FontFT->Glyph->Bitmap_Left) < 0 Then Exit For
If (PenY - FontFT->Glyph->Bitmap_Top) < 0 Then Exit For
' Set pixels
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 Dst_RB As UInteger
Dim Dst_G As UInteger
Dim Dst_Color As UInteger
Dim Alpha As Integer
BitmapFT = FontFT->Glyph->Bitmap
BitmapPtr = BitmapFT.Buffer
BitmapWid = BitmapFT.Width
BitmapHgt = BitmapFT.Rows
'BitmapPitch = 320 - BitmapFT.Width
if BitmapWid>0 and BitmapHgt>0 then
zeichen(i)=imagecreate(BitmapWid,BitmapHgt)
zeichenBG(i)=imagecreate(BitmapWid,BitmapHgt)
zx(i)=PenX + FontFT->Glyph->Bitmap_Left
zy(i)=PenY - FontFT->Glyph->Bitmap_Top
BitmapPitch=(zeichen(i)->pitch)\4-BitmapWid
conswrite (BitmapPitch;" , ";zeichen(i)->pitch)
'sleep
get (zx(i),zy(i))-step (BitmapWid-1,BitmapHgt-1),zeichen(i)
get (zx(i),zy(i))-step (BitmapWid-1,BitmapHgt-1),zeichenBG(i)
DestPtr = Cast(UInteger Ptr, zeichen(i)+1)
'DestPtr+=8 '(sizeof(fb.image)\sizeof(uinteger))
'put (1,1),zeichen(i),pset
'sleep
'*(DestPtr+BitmapWid*BitmapHgt)=rgb (127,127,127)
'put (1,1),zeichen(i),pset
'sleep
'sleep
Do While BitmapHgt
Do While BitmapWid
conswrite (BitmapWid;" ";BitmapHgt)
' Thanks, GfxLib
Src_RB = Clr And FT_MASK_RB_32
Src_G = Clr And FT_MASK_G_32
Dst_Color = *DestPtr
Alpha = *BitmapPtr
Dst_RB = Dst_Color And FT_MASK_RB_32
Dst_G = Dst_Color And FT_MASK_G_32
Src_RB = ((Src_RB - Dst_RB) * Alpha) Shr 8
Src_G = ((Src_G - Dst_G) * Alpha) Shr 8
*DestPtr = ((Dst_RB + Src_RB) And FT_MASK_RB_32) Or ((Dst_G + Src_G) And FT_MASK_G_32)
'*DestPtr=rgb(255,255,255)
DestPtr += 1
BitmapPtr += 1
BitmapWid -= 1
Loop
BitmapWid = BitmapFT.Width
BitmapHgt -= 1
DestPtr+=BitmapPitch
Loop
'put (zx(i),zy(i)),zeichen(i),pset
'sleep
else
zeichen(i)=imagecreate (0,0)
zeichenBG(i)=imagecreate(0,0)
end if
'DrawGlyph FontFT, PenX + FontFT->Glyph->Bitmap_Left, PenY - FontFT->Glyph->Bitmap_Top, Clr
PenX +=Slot->Advance.x Shr 6
Next i
dim as double start
do
start=timer
for i=0 to len(text)-1
transp(i)+=10
if transp (i)>0 and transp(i)<255 then
put (zx(i),zy(i)),ZeichenBG(i),pset
put (zx(i),zy(i)),Zeichen(i),alpha,transp(i)
end if
next
do : loop until timer-start>=0.01
loop until transp(len(text)-1)>=255
End Function