either natively or with sdl2 in order:
- static text
- dynamic (clock and date) and scrolling text
- text input
update 18/12/2022 (fb native)
- reworked rotate text actually rotates instead of vertical orientation text
- added a boundary check for text input
- note there are still a number of issues with the fb ttf library
- like text alignment and more importantly a slight memory leak
- deprecated old flip
' slightly tweaked from viewtopic.php?t=12068&hilit=invert+value+put
' code by counting_pine
update 02/12/2022 (fb native)
- added ghetto rotate text (90 degrees) and flip very primitive
- added some intrinsic defines
update 23/11/2022
- added (fake) text styles (strike-through and underlined)
- added a customizable text marker
- note regrettably the fb library does not support
- text styles, or rotating text, in its current form.
- pre requisites
either copy a ttf font from
<os drive>:\windows\fonts
or download a ttf font and place it
in the same folder as the compiled exe
either rename the ttf to 'gisha.ttf'
or change line 38 (fb only 22):
ttffont as string = exepath + "\gisha.ttf"
to:
ttffont as string = exepath + "\<fontname>.ttf"
- fb native
Add the fb ttf library by d.j.peters aka Joshy
viewtopic.php?t=25083
place the 'lib' folder and 'FBTrueType.bi' contained in
the zip package in the same folder as this code to
compile.
usage: press F11 for fullscreen and basic text input
Code: Select all
' fb truetype lib can be found at
' https://www.freebasic.net/forum/viewtopic.php?t=25083
#include once "fbgfx.bi"
#include once "FBTrueType.bi"
#include once "vbcompat.bi"
#if __FB_LANG__ = "fb"
Using fb '' constants and structures are stored in the FB namespace in lang fb
#endif
Dim e As Event
dim running as boolean = True
dim screenwidth As integer = 1280
dim screenheight As integer = 720
dim fullscreen as boolean = false
dim desktopw as integer
dim desktoph as integer
dim desktopr as integer
' get desktop info
ScreenInfo desktopw, desktoph,,,desktopr
' font
dim shared ttffontsize as integer
Dim ttffontcolor as ulong = rgb(255, 255, 255)
Dim logocolor as ulong = rgb(55, 55, 55)
Dim textmarkercolor as ulong = rgb(75, 0, 0) ' used for custom text marker as underline etc
Dim ttffont as string = exepath + "\gisha.ttf"
dim fontsizeclock as integer
dim fontsizedate as integer
dim fontsizelogo as integer
' supplement message with fb system metrics or...
' wmic cpu list /format:list
' lscpu for unix
dim os as string = "unknown"
#ifdef __FB_WIN32__
os = "windows"
#endif
#ifdef __FB_UNIX__
os = "unix"
#endif
dim ttfmessagea as string = ":cpu cores "
dim ttfmessageb as string = ":ram "
dim ttfmessagec as string = ":platform " & os
dim ttfmessaged as string = ":fb version " & __FB_VERSION__
dim ttfmessagee as string = ":deprecated "
' used for dimensions and location of text
Dim As Integer iW, iH
Dim As integer posx, sposx
Dim As integer posy, sposy
' setup clock and date display
dim shared clockposx as integer
dim shared clockposy as integer
Dim datetime As Double
dim dateformat as string = "dd/mm/yyyy"
dim timeformat as string = "hh:mm:ss"
' used for text input
Dim inptext as string = ""
dim bkminptext as string = ""
' load the font
var font = FontLoad(ttffont)
if font < 0 then
print "error: loading: " & ttffont & " " & ErrorText(font)
end if
Type tmpimage
image As FB.Image Ptr
xpos As Integer
ypos As Integer
iwidth As Integer
iheight As Integer
bypp As Integer
pitch As Integer
pixdata As Any Ptr
size As Long
End Type
Dim Shared tmpimg As tmpimage
' image information
Function checkimg(img As FB.Image Ptr) As Long
checkimg = ImageInfo(img,tmpimg.iwidth,tmpimg.iheight,_
tmpimg.bypp,tmpimg.pitch,tmpimg.pixdata,tmpimg.size)
End Function
' rotates image 90, 180, or 270 degrees
' based on code by NorbyDroid
' https://www.freebasic.net/forum/viewtopic.php?t=29100
' tweaked by thrive4 2022 rotation only
Function imagerotate(img As FB.Image Ptr, rotation As Integer) As Integer
Dim As Integer iwidth, iheight
If checkimg(img) = 0 Then
iwidth = tmpimg.iheight - 1
iheight = tmpimg.iwidth
if rotation = 180 then
iwidth = tmpimg.iwidth - 1
iheight = tmpimg.iheight
end if
tmpimg.image = ImageCreate(iwidth + 1, iheight)
For ypos As Integer = 0 To iheight + iwidth
For xpos As Integer = 0 To iwidth + 1
Select Case As Const rotation
Case -90, 270:PSet tmpimg.image,(iwidth - ypos, xpos), Point(xpos, ypos, img)
Case 180 :PSet tmpimg.image,(iwidth - xpos, iheight - yPos), Point(xpos, yPos - 1, img)
Case -270, 90:PSet tmpimg.image,(ypos, iheight - xpos), Point(xpos - 1, ypos, img)
End Select
Next
Next
Else
return -1
End If
End Function
' ttprintex font, posx, posy, txt, fontcolor, orientation, rotation, fontsize
' work around for getting size of text with font
dim shared txtwidth as long
sub ttprintex overload(byval font as long, _
byval x as long, byval y as long, _
byref txt as string, _
byval col as ulong = rgb(255,255,255), _
byref orientation as string, _
byref rotate as integer, _
byval size as long = 24)
dim as FontProps fProps
dim as GlyphProps gProps
dim as long maxw, maxh, bytes, cx = x, cy = y, bmky = cy
if screenptr() = 0 then return
screeninfo maxw, maxh,, bytes
if bytes <> 4 then return
if size < 4 then return
txt = trim(txt)
var nChars = len(txt) : if nChars < 1 then return
if FontPorperties(font, size, fprops) then return
nChars -= 1
txtwidth = 0
for i as long = 0 to nChars
var char = txt[i]
if char < 33 then
if char = 32 then cx += size * 0.25f
else
var index1 = GlyphIndex(font, char)
if index1 <> GLYPH_NOT_FOUND then
dim as long index2 = iif(i < nChars,GlyphIndex(font, txt[i + 1]), 0)
if index2 = GLYPH_NOT_FOUND then index2 = 0
if GlyphProperties(font, fProps, gProps, index1, index2) = 0 then
if cx + gProps.w >= maxw then cy += fProps.advanceHeight : cx = x
var AlphaChannel = GlyphImageCreate(font, fProps, gProps, index1)
if AlphaChannel then
var glyph = ImageCreate(gProps.w , gProps.h, col)
put glyph, (0,0), AlphaChannel, ALPHA
Dim As FB.Image Ptr swapimage = glyph
' added rotate and orientation text
select case orientation
case "vertical"
if rotate <> 0 then
imagerotate(swapimage, rotate)
Put(x, bmky + gProps.y), tmpimg.image, alpha
imagedestroy(swapimage)
imagedestroy(tmpimg.image)
else
Put(x, bmky + gProps.y),glyph,alpha
end if
case else
if rotate <> 0 then
imagerotate(swapimage, rotate)
Put(cx, cy + gProps.y), tmpimg.image,alpha
imagedestroy(swapimage)
imagedestroy(tmpimg.image)
else
put(cx, cy + gProps.y), glyph, ALPHA
end if
end select
bmky += fProps.advanceHeight * 0.8f
ImageDestroy glyph
ImageDestroy AlphaChannel
endif
cx += gProps.advanceWidth + gProps.kernAdvance
endif
endif
endif
txtwidth = cx
next
end sub
' create curved boxes
' lifted from joytest.zip by coderjeff
' see https://www.freebasic.net/forum/viewtopic.php?p=54746&hilit=joytest#p54746
'fb_fillrect x loc,y loc, height, width, arc size, fill color
sub fb_fillrect _
( _
byval x as integer, _
byval y as integer, _
byval w as integer, _
byval h as integer, _
byval r as integer, _
byval c as integer _
)
circle (x + r , y + r ), r, c, , , , f
circle (x + r , y + h - r - 1), r, c, , , , f
circle (x + w - r - 1, y + r ), r, c, , , , f
circle (x + w - r - 1, y + h - r - 1), r, c, , , , f
line (x, y + r) - (x + w - 1, y + h - r), c, bf
line (x + r, y) - (x + w - r, y + h - 1), c, bf
end sub
initscreen:
if fullscreen then
screenres screenwidth, screenheight, 32, 1, GFX_NO_FRAME
else
screenres screenwidth, screenheight, 32, 1, GFX_WINDOWED
end if
' (screenwidth * 0.25f) * 14 = 14pt approximation of fontsize proportional to screensize
ttffontsize = fix(screenheight / (screenwidth * 0.25f) * 14)
fontsizeclock = fix(screenheight / (screenwidth * 0.25f) * 18)
fontsizedate = fix(screenheight / (screenwidth * 0.25f) * 13)
fontsizelogo = fix(screenheight / (screenwidth * 0.25f) * 104)
' main loop
Do
Dim datetime As Double = Now()
dim offsetcursor as integer = len(inptext)
If (ScreenEvent(@e)) Then
Select Case e.type
case EVENT_WINDOW_CLOSE
exit do
Case EVENT_KEY_PRESS
Case EVENT_KEY_RELEASE
select case e.scancode
case SC_ESCAPE
exit do
case SC_F11
select case fullscreen
case true
screenwidth = 1280
screenheight = 720
fullscreen = false
goto initscreen
case false
screenwidth = desktopw
screenheight = desktoph
fullscreen = true
goto initscreen
end select
case SC_BACKSPACE
inptext = Left(inptext, offsetcursor - 1) + Mid(inptext, offsetcursor + 1)
case SC_ENTER
bkminptext = inptext
case else
if e.ascii > 31 and e.ascii < 127 then
inptext = inptext + chr(e.ascii)
end if
end select
Case EVENT_WINDOW_CLOSE
exit do
End Select
End If
ScreenLock()
CLS()
' clock
clockposx = screenwidth - 150
clockposy = 30
ttprintex font, clockposx, clockposy, format(datetime, timeformat), ttffontcolor, "", 0, fontsizeclock
' date
ttprintex font, clockposx, clockposy + fontsizeclock, format(datetime, dateformat), ttffontcolor, "", 0, fontsizedate
' metrics
ttprintex font, 10, 200, ttfmessagea, ttffontcolor, "", 0, ttffontsize
ttprintex font, 10, 200 + ttffontsize, ttfmessageb, ttffontcolor, "", 0, ttffontsize
ttprintex font, 10, 200 + ttffontsize * 2, ttfmessagec, ttffontcolor, "", 0, ttffontsize
ttprintex font, 10, 200 + ttffontsize * 3, ttfmessaged, ttffontcolor, "", 0, ttffontsize
' fake underline with text marker
fb_fillrect 10, 200 + ttffontsize * 4, txtwidth, 1, 0, ttffontcolor
ttprintex font, 10, 200 + ttffontsize * 4, ttfmessagee, ttffontcolor, "", 0, ttffontsize
' fake striketrhough with text marker
fb_fillrect 10, 200 + ttffontsize * 4.5, txtwidth, 1, 0, ttffontcolor
' text marker
fb_fillrect 10, 200 + ttffontsize * 5, txtwidth, 3, 0, textmarkercolor
' logo
ttprintex font, screenwidth * 0.5 - fontsizelogo * 0.5, screenheight * 0.5 - fontsizelogo * 0.5, "FB", logocolor, "", 0, fontsizelogo
' rotated text
ttprintex font, screenwidth * 0.5 - ttffontsize * 4.75, screenheight * 0.5 - ttffontsize * 2.7, "ROTATED", ttffontcolor, "vertical", -90, ttffontsize
' text input
ttprintex font, screenwidth * 0.5 - ttffontsize * len(inptext) * 0.25, (screenheight * 0.5 - ttffontsize * 0.5) + 200, inptext & "|", ttffontcolor, "", 0, ttffontsize
if bkminptext <> "" then
ttprintex font, screenwidth * 0.5 - ttffontsize * len(bkminptext) * 0.25, (screenheight * 0.5 - ttffontsize * 0.5) + 250, bkminptext, ttffontcolor, "", 0, ttffontsize
end if
' scrolling text
ttprintex font, sposx, screenheight * 0.95 - ttffontsize * 0.95, "scrolling text scrolling textscrolling textscrolling textscrolling text", ttffontcolor, "", 0, ttffontsize
if sposx > 0 then
sposx = sposx - 1
else
sposx = (screenwidth * 0.5 - ttffontsize * 0.5)
end if
ScreenUnlock()
' reduce cpus usage
Sleep(15, 1)
Loop
end