Code: Select all
Declare Function MakeImageOfASCIIchars (charHeight as uinteger, r as uinteger, g as uinteger, b as uinteger) As Any Ptr
Declare Function MakeImageOfString (charHeight as uinteger, r as uinteger, g as uinteger, b as uinteger, tx as string) As Any Ptr
Declare Sub TextH8(x as uinteger, y as uinteger, tx as string)
Declare Sub TextH14(x as uinteger, y as uinteger, tx as string)
Const screenW = 800 ' Must be divisible by 8.
' Must be divisible by 16 for characters 16 pixels high; by 14 for characters 16 pixels high; by 112 to have both.
Const screenD = 448
ScreenRes screenW, screenD, 32, 1 ' Just 1 screen, to keep it simple.
'Usually you'd set "32, 2" for 2 screens, then something like "screenset 1, 0" (for screen 1 'work', screen 0 visible).
Dim shared as uinteger numChrs, charWidth = 8
Dim shared as uinteger codeF1, codeT1 ' Codes for first and last non-blank ASCII characters.
Dim as uinteger i
Dim as integer p, q, r
Dim as string t
codeF1 = 1 ' Code of first non-blank ASCII character.
codeT1 = 254 ' Code of last non-blank ASCII character.
numChrs = codeT1 - codeF1 + 1
' MAKE THE IMAGES (make all of them before using any of them).
'Make an image with every non-blank ASCII symbol, 8 pixels high.
Dim shared As Any Ptr imChars8
imChars8 = MakeImageOfASCIIchars(8, 0, 32, 0)
'Make an image with every non-blank ASCII symbol, 14 pixels high.
Dim shared As Any Ptr imChars14
imChars14 = MakeImageOfASCIIchars(14, 0, 0, 112) ' Args: character height (8 or 14), r,g,b (color).
' Put a string into an image, while set for character height 8.
Dim shared As Any Ptr imString8
' Args: character height, r,g,b, string
imString8 = MakeImageOfString (8, 0, 0, 176, "This string was put into an image while character height was 8.")
' Put a string into an image, while set for character height 14.
Dim shared As Any Ptr imString14_1
imString14_1 = MakeImageOfString (14, 192, 96, 0, "This string was put into an image while character height was 14.")
' and another string ...
Dim shared As Any Ptr imString14_2
imString14_2 = MakeImageOfString (14, 192, 96, 0, "Just displaying a whole image is probably faster than fishing a series of characters out of it.")
' The images must be set up (as above) before the last width instruction, which sets the character height to 16.
color RGB(0, 0, 0), RGB(247, 255, 192) ' The following "width" will wipe the screen, with the background color.
width screenW/8, screenD/16 ' To make normal text 16 pixels high.
draw string (10, 20), "This text is 16 pixels high (it's all 8 pixels wide).", RGB(0, 128, 0)
draw string (10, 40), "It's shown using the standard Freebasic 'draw string'.", RGB(0, 128, 0)
TextH8 (10, 70, "This text is 8 pixels high (and 8 pixels wide), shown using 'TextH8'.")
TextH14 (10, 100, "This text is 14 pixels high (and 8 pixels wide), shown using TextH14.")
draw string (10, 140), "TextH8 and TextH14 lookup a little image for each character,", RGB(128, 64, 0)
draw string (10, 160), "which might be too slow somethimes.", RGB(128, 64, 0)
put (10, 210), imString8, Alpha ' "This string was put ... height was 8."
put (10, 240), imString14_1, Alpha ' "This string was put ... height was 14."
put (10, 270), imString14_2, Alpha ' "Just displaying the whole image is ... "
draw string (10, 300), "No need to put height-16 text into an image.", RGB(0, 92, 128)
circle (240, 400), 15 ' Just to show you can get standard graphics on the screen.
draw string (40, 340), "ASCII characters, height 14, in reverse order ==>", RGB(220, 0, 10)
for p = 7 to 0 step -1
t = ""
for q as integer = 31 to 0 step -1
r = p * 32 + q
if r > 0 then t += chr(r)
next
TextH14 (480, 300 + (7 - p) * 16, t)
next
sleep
' Making images of text.
Function MakeImageOfASCIIchars (charHeight as uinteger, r as uinteger, g as uinteger, b as uinteger) As Any Ptr
Dim As Any Ptr imChars
Dim as uinteger i
width screenW/charWidth, screenD/charHeight ' A strange instruction that sets char width and height.
imChars = ImageCreate( charWidth*numChrs + 1, charHeight, RGBA(255, 0, 255, 0) ) ' Magenta for mask.
for i = codeF1 to codeT1 ' Loop to slot image of each character into the wide image.
' I don't know why the "+ 1" is needed (and also in Sub TextH8), but without it there are unwanted pixels.
draw string imChars, ((i-codeF1)*charWidth + 1, 0), chr(i), RGB(r, g, b)
next
return imChars ' Returns a pointer to the image of the 8-high ASCII characters.
End Function
Function MakeImageOfString (charHeight as uinteger, r as uinteger, g as uinteger, b as uinteger, tx as string) As Any Ptr
Dim As Any Ptr imString
width screenW/charWidth, screenD/charHeight ' A strange instruction that sets char width and height.
imString = ImageCreate( charWidth*len(tx), charHeight, RGBA(255, 0, 255, 0) ) ' Magenta for mask.
draw string imString, (0, 0), tx, RGB(r, g, b)
return imString ' Returns a pointer to the image of the 8-high ASCII characters.
End Function
'Using the images to show text.
Sub TextH8(x as uinteger, y as uinteger, tx as string) ' Height 8 pixels.
Dim as uinteger c, i, len_tx
len_tx = len(tx)
for i = 1 to len_tx
c = asc(mid(tx, i, 1))
Put (x + (i-1)*8, y), imChars8, ((c-1)*8 + 1, 0)-(c*8, 7), Alpha
' "Alpha" is to not print the background (also needs "Magenta for mask" (find above).
next
End Sub
Sub TextH14(x as uinteger, y as uinteger, tx as string) ' Height 14 pixels.
Dim as uinteger c, i, len_tx
len_tx = len(tx)
for i = 1 to len_tx
c = asc(mid(tx, i, 1))
Put (x + (i-1)*8, y), imChars14, ((c-1)*8 + 1, 0)-(c*8, 13), Alpha
next
End Sub