I would like it if we could use PSF fonts. Hopefully in a next version of QB64 PE
(05-07-2024, 10:58 PM)a740g Wrote: I would rather suggest doing what @SMcNeill said or if you are willing to wait, then we may have a way of loading PSF fonts (soonish).
(05-07-2024, 02:57 PM)BDS107 Wrote: In the MS-DOS days of Norton Utilities, PC-Tools, etc., you would see programs redrawing their ASCII characters to get different boxes and characters.
We can easily create font files via the VGA Font Editor (see https://github.com/a740g/VGA-Font-Editor).
But how do we get this on the screen via SCREEN 0? No not SCREEN 13 or so.
I used to write an assembler program for that, but I've lost it, years ago....
Yeah, that was cool how Norton and others did this. This was done by creating a new ASCII set in RAM and then hooking the BIOS call to that new section of RAM instead of grabbing the character from ROM. That is why the assembler program was needed, it would perform the redirection. This is not going to be possible with QB64 (as far as I know, the developers here are rather clever).
You'll need to create your own font file (.ttf) and then use the method Steve pointed out above.
(05-07-2024, 02:57 PM)BDS107 Wrote: In the MS-DOS days of Norton Utilities, PC-Tools, etc., you would see programs redrawing their ASCII characters to get different boxes and characters.
We can easily create font files via the VGA Font Editor (see https://github.com/a740g/VGA-Font-Editor).
But how do we get this on the screen via SCREEN 0? No not SCREEN 13 or so.
I used to write an assembler program for that, but I've lost it, years ago....
DECLARE LIBRARY ".\FONT\charset"
SUB Charset_8x8 (BYVAL o AS _OFFSET)
SUB Charset_8x16 (BYVAL o AS _OFFSET)
END DECLARE
DIM SHARED c16(7, 15, 255) AS _UNSIGNED _BYTE, charload AS _UNSIGNED _BYTE, FONT$(255 * 16)
OPEN ".\FONT\mzfont.fnt" FOR INPUT AS #1
FOR CHARLOOP% = 0 TO 255
FOR CHARHEIGHT% = 1 TO 16
INPUT #1, FONT$(CHARLOOP%)
FOR CHARWIDTH% = 1 TO 8
IF MID$(FONT$(CHARLOOP%), CHARWIDTH%, 1) = "0" THEN c16(CHARWIDTH% - 1, CHARHEIGHT% - 1, CHARLOOP%) = 0 ELSE c16(CHARWIDTH% - 1,CHARHEIGHT% - 1, CHARLOOP%) = 1
NEXT CHARWIDTH%
NEXT CHARHEIGHT%
NEXT CHARLOOP%
CLOSE #1
07-08-2025, 08:05 PM (This post was last modified: 07-08-2025, 08:22 PM by madscijr.
Edit Reason: removed some old and confusing code
)
(05-07-2024, 02:57 PM)BDS107 Wrote: In the MS-DOS days of Norton Utilities, PC-Tools, etc., you would see programs redrawing their ASCII characters to get different boxes and characters.
We can easily create font files via the VGA Font Editor (see https://github.com/a740g/VGA-Font-Editor).
But how do we get this on the screen via SCREEN 0? No not SCREEN 13 or so.
I used to write an assembler program for that, but I've lost it, years ago....
I'm a little late to the party for this, but if you want to define your own charset without a font editor, and just have each character defined right in the source code in an easy-to-read and edit format, this does it using BDF fonts. See Sub GetTileText at line 1790 to see the actual font definitions...
Code: (Select All)
Option _Explicit
' SCREEN 0 COLOR CONSTANTS, I KNOW THERE'S A WAY TO USE COLOR NAMES IN QB64PE W/O CONSTANTS, DON'T RECALL WHAT IT IS RIGHT NOW :-?
Const cBlackT& = 0
Const cBlueT& = 1
Const cGreenT& = 2
Const cLtBlueT& = 3
Const cRedT& = 4
Const cPurpleT& = 5
Const cOrangeT& = 6
Const cWhiteT& = 7
Const cGrayT& = 8
Const cPeriwinkleT& = 9
Const cLtGreenT& = 10
Const cCyanT& = 11
Const cLtRedT& = 12
Const cPinkT& = 13
Const cYellowT& = 14
Const cLtGrayT& = 15
' BASIC PROGRAM METADATA
Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
Dim Shared m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)
' SCREEN + COLORS
Dim Shared m_iScreenWidth As Long: m_iScreenWidth = 640 ' _DesktopWidth
Dim Shared m_iScreenHeight As Long: m_iScreenHeight = 480 ' _DesktopHeight
ReDim Shared FgColorArray(-1) As _Unsigned Long
ReDim Shared BgColorArray(-1) As _Unsigned Long
' FONTS + MAPPING
Dim Shared m_DefaultFontHandle& ' save default font handle
Dim Shared m_utfValue255_Default&
Dim Shared m_utfValue032_Default&
' INITIALIZE
AddBgColors BgColorArray() ' INIT GRAYSCALE COLOR ARRAY
AddFgColors FgColorArray() ' INIT SPECTRUM COLOR ARRAY
Sub MainMenu
Dim in$
Dim k$
Dim sLast As String
Dim sError As String: sError = ""
Do
Cls , cBlackT&: Color cLtGrayT&, cBlackT&
Print "Custom QB64PE fonts with BDF"
Print "1 = FontTest1$"
Print "2 = FontTest2$"
Print "Esc = Quit"
Print
If Len(sError) > 0 Then
Print "*******************************************************************************"
Print sLast + " returned:"
Print sError
Print "*******************************************************************************"
Print
End If
Do
k$ = InKey$: _KeyClear
Select Case k$
Case "1":
sLast = "FontTest1$"
sError = FontTest1$
Exit Do
Case "2":
sLast = "FontTest2$"
sError = FontTest2$
Exit Do
Case Chr$(27):
Exit Do
End Select
Loop
If k$ = Chr$(27) Then Exit Do
Loop
End Sub ' MainMenu
Function FontTest1$
Dim RoutineName As String: RoutineName = "FontTest1$"
Dim sError As String: sError = ""
Dim FontFilename$
Dim FontHandle&
Dim style$
Dim iFontHeight%
Dim FontW, FontH As Integer
Dim iIndex As Integer
Dim iCount As Integer
Dim iValue As Integer
Dim MaxRow As Integer
Dim MaxCol As Integer
Dim RowNum As Integer
Dim ColNum As Integer
Dim fgColor As _Unsigned Long
Dim bgColor As _Unsigned Long
Dim iColorFG As Integer
Dim iColorBG As Integer
Dim MyChar%
Dim iScaleX As Integer
Dim iScaleY As Integer
Dim LastY As Integer
ReDim arrScale(20, 1) As Integer
' INITIALIZE
FontFilename$ = "myfont.bdf"
' REMEMBER OLD FONT + ASC(255) MAPPING
m_DefaultFontHandle& = _Font
m_utfValue255_Default& = _MapUnicode(255)
m_utfValue032_Default& = _MapUnicode(32)
'' IF FONT FILE NOT FOUND, CREATE IT
'If Len(sError) = 0 Then
' If _FileExists(m_ProgramPath$ + FontFilename$) = _FALSE Then
' 'sError = "File not found: " + Chr$(34) + FontFilename$ + Chr$(34)
' sError = CreateBDF$(m_ProgramPath$ + FontFilename$)
' End If
'End If
' ALWAYS (RE)CREATE FONT FILE
sError = CreateBDF$(m_ProgramPath$ + FontFilename$)
If Len(sError) > 0 Then GoTo ExitFunction
' SET FONT
style$ = "monospace" ' font style is not case sensitive
iFontHeight% = 8 ' font is 8 pixels high
FontHandle& = _LoadFont(m_ProgramPath$ + FontFilename$, iFontHeight%, style$)
If FontHandle& = 0 Then
sError = "FontHandle& = " + _Trim$(Str$(FontHandle&))
GoTo ExitFunction
End If
' STORE FONT SIZE
FontH = _UFontHeight(FontHandle&)
FontW = _FontWidth ' FontH
' FONT LOADED
Color cCyan, cBlack
Print "Font " + Chr$(34) + FontFilename$ + Chr$(34) + " loaded."
Print
' ENTER FULLSCREEN MODE <- DOESN'T WORK ???
'_FullScreen _SquarePixels
'_FullScreen _Stretch
' PRINT CHARACTERS IN OUR CUSTOM FONT
If _TRUE = _FALSE Then
MaxRow = (_Height / FontH) - 3 ' CALCULATE MAXIMUM ROW
MaxCol = (_Width / _FontWidth) - 2 ' CALCULATE MAXIMUM COLUMN
RowNum = 3
ColNum = 0
iColorFG = LBound(FgColorArray)
bgColor = cBlack
For MyChar% = 128 To 159
fgColor = FgColorArray(iColorFG)
Color fgColor, bgColor
Print Chr$(MyChar%);
ColNum = ColNum + 1
If ColNum > MaxCol Then ColNum = 1: RowNum = RowNum + 1 ' WRAP AROUND
iColorFG = iColorFG + 1
If iColorFG > UBound(FgColorArray) Then iColorFG = LBound(FgColorArray)
Next MyChar%
LastY = FontH * RowNum ' GET PIXEL POSITION OF LAST ROW
End If
' FILL ARRAY WITH SOME TEST DATA TO TRY
ScaleXYdata: Data 1,1,1,2,2,1,2,2,2,3,3,2,3,3,3,4,4,4,5,3,6,6,6,3,4,4,2,8,0,0
Restore ScaleXYdata
iIndex = LBound(arrScale, 1)
Do
Read iScaleX: Read iScaleY
arrScale(iIndex, 0) = iScaleX: If iScaleX = 0 Then Exit Do
arrScale(iIndex, 1) = iScaleY: If iScaleY = 0 Then Exit Do
iIndex = iIndex + 1: If iIndex > UBound(arrScale, 1) Then Exit Do
Loop
' DISPLAY TEXT SCALED TO SIZES IN THEST DATA
bgColor = cEmpty
For iIndex = LBound(arrScale, 1) To UBound(arrScale, 1)
iScaleX = arrScale(iIndex, 0)
iScaleY = arrScale(iIndex, 1)
If iScaleX = 0 Or iScaleY = 0 Then Exit For
MaxRow = (_Height / (FontH * iScaleY)) - 3 ' CALCULATE MAXIMUM ROW
MaxCol = (_Width / (_FontWidth * iScaleX)) - 2 ' CALCULATE MAXIMUM COLUMN
RowNum = (LastY / (FontH * iScaleY)) + 2 ' FIGURE OUT WHAT ROW WE'RE AT
ColNum = 0 ' START AT FIRST COLUMN
iColorFG = LBound(FgColorArray) ' RESET TO FIRST COLOR IN FG COLOR ARRAY
For MyChar% = 128 To 159
fgColor = FgColorArray(iColorFG)
Color fgColor, bgColor
ColNum = ColNum + 1
If ColNum > MaxCol Then ColNum = 1: Exit For ' RowNum = RowNum + 1
iColorFG = iColorFG + 1
If iColorFG > UBound(FgColorArray) Then iColorFG = LBound(FgColorArray)
Next MyChar%
LastY = (FontH * iScaleY) * RowNum ' GET PIXEL POSITION OF LAST ROW
Next iIndex
' WAIT FOR USER
_AutoDisplay
RowNum = (_Height / FontH) - 1 ' FIGURE OUT WHAT ROW WE'RE AT
Locate RowNum, 1
Color cCyan, cBlack
Print "PRESS ANY KEY TO CONTINUE";
Sleep
_KeyClear: '_DELAY 1 ' clear keyboard buffer
' GO BACK TO DEFAULT FONT AND ERASE FONT HANDLE
'_Font 16
_Font m_DefaultFontHandle&
_MapUnicode 255 To m_utfValue255_Default&
_MapUnicode 32 To m_utfValue032_Default&
If FontHandle& > 0 Then _FreeFont FontHandle&
'' EXIT FULLSCREEN MODE
'_FullScreen _Off
' GO BACK TO TEXT SCREEN
Screen 0
' =============================================================================
' RETURN ANY ERROR MESSAGES
ExitFunction:
If Len(sError) > 0 Then
sError = "ERROR IN " + RoutineName + ": " + sError
End If
FontTest1$ = sError
Function FontTest2$
Dim RoutineName As String: RoutineName = "FontTest2$"
Dim sError As String: sError = ""
Dim iLoop As Integer
Dim FontHandle&
Dim RowNum, ColNum As Integer
Dim arrMaxCol(1 To 8) As Integer
Dim arrMaxRow(1 To 8) As Integer
Dim arrMidCol(1 To 8) As Integer
Dim arrMidRow(1 To 8) As Integer
Dim arrFontW(1 To 8) As Integer
Dim arrFontH(1 To 8) As Integer
Dim FontW, FontH As Integer
Dim iScaleX, iScaleY As Integer
Dim LastY As Integer
Dim MyChar%
Dim MaxRow As Integer
Dim MaxCol As Integer
Dim fgColor As _Unsigned Long
Dim bgColor As _Unsigned Long
Dim iColorFG As Integer
Dim iColorBG As Integer
Dim bIncrementX As Integer
' REMEMBER OLD FONT + ASC(255) MAPPING
m_DefaultFontHandle& = _Font
m_utfValue255_Default& = _MapUnicode(255)
m_utfValue032_Default& = _MapUnicode(32)
' GET CUSTOM FONT
sError = GenerateFont$(FontHandle&)
If Len(sError) > 0 Then GoTo ExitFunction ' EXIT IF GenerateFont$ FAILED
ColNum = ColNum + 1
If ColNum > MaxCol Then ColNum = 1: Exit For ' RowNum = RowNum + 1
iColorFG = iColorFG + 1
If iColorFG > UBound(FgColorArray) Then iColorFG = LBound(FgColorArray)
Next MyChar%
LastY = (FontH * iScaleY) * RowNum ' GET PIXEL POSITION OF LAST ROW
If bIncrementX = _TRUE Then
iScaleX = iScaleX + 1
bIncrementX = _FALSE
Else
iScaleY = iScaleY + 1
bIncrementX = _TRUE
End If
If iScaleX > 8 Then Exit Do
Loop
' WAIT FOR USER
_AutoDisplay
RowNum = (_Height / FontH) - 1 ' FIGURE OUT WHAT ROW WE'RE AT
Locate RowNum, 1
Color cCyan, cBlack
Print "PRESS ANY KEY TO CONTINUE";
Sleep
_KeyClear: '_DELAY 1 ' clear keyboard buffer
' =============================================================================
' RETURN ANY ERROR MESSAGES
ExitFunction:
If Len(sError) > 0 Then
sError = "ERROR IN " + RoutineName + ": " + sError
End If
FontTest2$ = sError
End Function ' FontTest2$
' ################################################################################################################################################################
' BEGIN SCALED PRINT FUNCTIONS #PRINT2
' ################################################################################################################################################################
' /////////////////////////////////////////////////////////////////////////////
' Draws scaled string at column / row (ColNum% & RowNum% = 0-based)
' Works for fonts whose style = monospace
' Does a _PrintString to a 32-bit screen in a given fg/bg color,
' and allows the text to be scaled to 2x, 3x, etc.,
' and works with a custom font.
' The font should already be set before this is called,
' and the screen should be a 32-bit image and set to _DEST.
Sub DrawStringRC (MyString As String, fg~&, bg~&, ColNum%, RowNum%, xScale%, yScale%, xOffset%, yOffSet%)
Dim FontHandle&, w1&, h1&, x1&, y1&
' /////////////////////////////////////////////////////////////////////////////
' Draws scaled string at coordinates xPos&, yPos&
' Works for fonts whose style = monospace
' Does a _PrintString to a 32-bit screen in a given fg/bg color,
' and allows the text to be scaled to 2x, 3x, etc.,
' and works with a custom font.
' The font should already be set before this is called,
' and the screen should be a 32-bit image and set to _DEST.
' Uses _UPrintWidth instead of _Width, _UFontHeight instead of _Height
Sub DrawStringXY (MyString As String, fg~&, bg~&, x1&, y1&, xScale%, yScale%)
'Dim SavedSource&
Dim SavedDest&
Dim TempImage&
Dim FontHandle&
Dim x2&, y2&
'Dim w1&
'' RESTORE THE SOURCE/DESTINATION
'_Source SavedSource&
'_Dest SavedDest&
' CLEANUP
_FreeImage TempImage&
End Sub ' DrawStringXY
' /////////////////////////////////////////////////////////////////////////////
' Older version draws scaled font to row/column
' Newer versions:
' * DrawStringRC draw string at row/column scaled, with x/y offset
' * DrawStringXY draw string at x,y position scaled
' Does a _PrintString to a 32-bit screen in a given fg/bg color,
' and allows the text to be scaled to 2x, 3x, etc.,
' and works with a custom font.
' The font should already be set before this is called,
' and the screen should be a 32-bit image and set to _DEST.
' ColNum%, RowNum% are 0-based
Sub PrintScaled (MyString As String, fg~&, bg~&, ColNum%, RowNum%, xScale%, yScale%)
Dim SavedSource&
Dim SavedDest&
Dim TempImage&
Dim FontHandle&
Dim x1&, y1&, x2&, y2&, w1&, h1&
' Restore the source/destination
_Source SavedSource&
_Dest SavedDest&
' Cleanup
_FreeImage TempImage&
End Sub ' PrintScaled
' ################################################################################################################################################################
' END SCALED PRINT FUNCTIONS @PRINT2
' ################################################################################################################################################################
' ################################################################################################################################################################
' BEGIN BDF FONT ROUTINES #BDF
' ################################################################################################################################################################
' /////////////////////////////////////////////////////////////////////////////
' CREATES BDF FONT FILE
' RETURNS BLANK STRING IF SUCCESSFUL
' ELSE RETURNS ERROR MESSAGE
' RETURNS HANDLE TO FONT IN BYREF PARAMETER FontHandle&
' REMEMBER: Free unused font handles with _FREEFONT FontHandle&
'Dim FontHandle&
'Dim sError As String
'sError = GenerateFont$(FontHandle&)
Function GenerateFont$ (FontHandle&)
Dim sError As String
Dim FontFilename$
Dim style$
Dim iFontHeight%: iFontHeight% = 8
'' IF FONT FILE NOT FOUND, CREATE IT
'If Len(sError) = 0 Then
' If _FileExists(m_ProgramPath$ + FontFilename$) = _FALSE Then
' 'sError = "File not found: " + Chr$(34) + FontFilename$ + Chr$(34)
' sError = CreateBDF$(m_ProgramPath$ + FontFilename$)
' End If
'End If
' (RE)CREATE FONT FILE
If Len(sError) = 0 Then
sError = CreateBDF$(m_ProgramPath$ + FontFilename$)
End If
' SET FONT
If Len(sError) = 0 Then
style$ = "monospace" ' font style is not case sensitive
FontHandle& = _LoadFont(m_ProgramPath$ + FontFilename$, iFontHeight%, style$)
If FontHandle& = 0 Then
sError = "FontHandle& = " + _Trim$(Str$(FontHandle&))
End If
End If
' RETURN RESULTS
GenerateFont$ = sError
End Function ' GenerateFont$
Sub GenerateFontTest
Dim sError As String
Dim FontHandle&
Dim iLoop As Integer
Dim MaxRow As Integer
Dim MaxCol As Integer
Dim RowNum As Integer
Dim ColNum As Integer
Dim fgColor As _Unsigned Long
Dim bgColor As _Unsigned Long
Dim iColorFG As Integer
Dim iColorBG As Integer
' INITIALIZE
sError = ""
' GNERATE FONT
If Len(sError) = 0 Then
sError = GenerateFont$(FontHandle&)
End If
' DISPLAY FONT
If Len(sError) = 0 Then
' INITIALIZE COLORS
AddBgColors BgColorArray() ' INIT GRAYSCALE COLOR ARRAY
AddFgColors FgColorArray() ' INIT SPECTRUM COLOR ARRAY
RowNum = 0
For iLoop = 33 To 255
Color cCyan, cBlack
Print Right$(" " + _Trim$(Str$(iLoop)), 3) + ": ";
ColNum = 0
For iColorBG = LBound(BgColorArray) To UBound(BgColorArray)
bgColor = BgColorArray(iColorBG)
For iColorFG = LBound(FgColorArray) To UBound(FgColorArray)
If iColorFG <> iColorBG Then
ColNum = ColNum + 1
If ColNum < MaxCol Then
fgColor = FgColorArray(iColorFG)
Color fgColor, bgColor
Print Chr$(iLoop);
Else
'ColNum = 0
'Color cCyan, cBlack : print
'Print " ";
'RowNum = RowNum + 1
'if RowNum > MaxRow then
' RowNum = 0
' Color cCyan, cBlack : Print "PRESS ANY KEY TO CONTINUE";
' Sleep
' _KeyClear: '_DELAY 1 ' clear keyboard buffer
' print
'end if
Exit For
End If
End If
Next iColorFG
If ColNum >= MaxCol Then Exit For
Next iColorBG
Color cCyan, cBlack: Print
RowNum = RowNum + 1
If RowNum > MaxRow Then
RowNum = 0
Color cCyan, cBlack: Print "PRESS ANY KEY TO CONTINUE";
Sleep
_KeyClear: '_DELAY 1 ' clear keyboard buffer
Print
End If
Next iLoop
Color cCyan, cBlack
Print
Print "PRESS ANY KEY TO CONTINUE"
Sleep
_KeyClear: '_DELAY 1 ' clear keyboard buffer
' GO BACK TO DEFAULT FONT AND ERASE FONT HANDLE
_Font 16
If FontHandle& > 0 Then _FreeFont FontHandle&
'' EXIT FULLSCREEN MODE
'_FullScreen _Off
End If
' SHOW ERRORS
If Len(sError) <> 0 Then
Print sError
End If
' Glyph Bitmap Distribution Format - Wikipedia
' https://en.wikipedia.org/wiki/Glyph_Bitmap_Distribution_Format
' The Glyph Bitmap Distribution Format (BDF) by Adobe is a file format for
' storing bitmap fonts. The content takes the form of a text file intended to be
' human- and computer-readable. BDF is typically used in Unix X Window
' environments. It has largely been replaced by the PCF font format which is
' somewhat more efficient, and by scalable fonts such as OpenType and TrueType
' fonts.
'
' Filename extension : .bdf
' Internet media type: application/x-font-bdf[1]
' Developed by : Adobe Inc.
' Initial release : 1987; 38 years ago
' Latest release : 2.2; 22 March 1993; 31 years ago
' Type of format : Bitmap font format
' Open format? : yes
' Website : Adobe Glyph Bitmap Distribution Format (BDF) Specification, version 2.2
' https://www.adobe.com/content/dam/Adobe/en/devnet/font/pdfs/5005.BDF_Spec.pdf
' Overview
' In 1988, the X Consortium adopted BDF 2.1 as a standard for X Window screen
' fonts,[2] but X Windows has largely moved to other font standards such as PCF,
' Opentype, and Truetype.
'
' Version 2.2 added support for non-Western writing. For example, glyphs in a BDF
' 2.2 font definition can specify rendering from top-to-bottom rather than simply
' left-to-right.
'
' A BDF font file contains three sections:
' 1. a global section that applies to all glyphs in a font;
' 2. a section with a separate entry for each glyph; and
' 3. the ENDFONT statement.
'
' Example
' This is an example font containing one glyph, for ASCII capital "A". This glyph
' is taken from the GNU Unifont.
' In the above example, the global declarations begin with the STARTFONT line
' and end with the CHARSline.
'
' STARTFONT 2.1 defines the version of this BDF file as version 2.1.
'
' FONT -gnu-unifont-medium-r-normal--16-160-75-75-c-80-iso10646-1 defines the
' font family and face names as an X logical font description.
'
' SIZE 16 75 75 defines this to be a 16 point font, with an X-axis resolution of
' 75 dots per inch (dpi) and a Y-axis resolution of 75 dpi. This is the norm
' under X Window.
'
' FONTBOUNDINGBOX 16 16 0 -2 defines a bounding box for the font of 16 pixels
' wide by 16 pixels high, with the lower left-hand corner starting at x = 0 and y
' = -2. Note that although the bounding box is defined to be a 16 by 16 cell,
' this can be overridden for individual glyphs. The "A" glyph, for example, is
' only 8 pixels wide.
'
' STARTPROPERTIES 2 declares that two special properties will follow.
' STARTPROPERTIES is optional in the BDF specification. X Window allows the
' properties FONT_ASCENT and FONT_DESCENT to show the height above and below the
' baseline, respectively, for all glyphs. FONT_ASCENT 14 declares that 14 of the
' 16 pixels in height are above the baseline. FONT_DESCENT 2 declares that 2 of
' the 16 pixels in height are below the baseline. ENDPROPERTIES appears at the
' end of the STARTPROPERTIES section.
'
' CHARS 1 declares that one character will follow. Although Adobe now refers to
' this file format as the Glyph BDF, they have retained the keyword CHARSin the
' final version of the specification.
'
' Lines beginning with the word COMMENT can be inserted within a BDF file.
' Anything following the COMMENT keyword on a line is ignored.
'
' Following the above global declarations, the following entries may repeat for
' each glyph.
'
' STARTCHAR U+0041 specifies the start of a character in version 2.1 and earlier,
' or of a glyph in version 2.2. The string name of this particular character is
' U+0041, expressing in the Unicodeconvention the code point hexadecimal 41
' (decimal 65, the ASCII character "A"). In version 2.1 and earlier, the
' character name string was limited to 14 characters. In version 2.2, the glyph
' name string can contain up to 65,535 characters.
'
' ENCODING 65 declares the decimal code point for this glyph in the font.
'
' SWIDTH 500 0 declares the scalable width of 500 on the X-axis and 0 (by
' default) on the Y-axis. This will result in an X-axis offset to the next glyph,
' but no Y-axis offset to the next glyph (i.e., the glyphs appear straight across
' in a line). The scalable width is 1000 times the actual point size of the
' character - the same unit used in an Adobe Font Metric (AFM) file. The number of
' pixels calculated as
'
' Pixels = (Scalable Width/1000) * (Resolution/72)
'
' where Scalable Width is 500 in this example,
' and resolution is 75 dpi for this font.
'
' Because 75 is approximately equal to 72, the number of pixels is the full width
' of a glyph (defined globally as 16 pixels) times (500/1000), or in other words
' the width of this glyph is 8 pixels.
'
' DWIDTH 8 0 declares the device width of a glyph. In this case, after the glyph
' is rendered, the start of the next glyph is offset 8 pixels on the X-axis and 0
' pixels on the Y-axis from the current glyph origin. Note that the device width
' is not necessarily equal to the width of the glyph. It is simply the offset on
' the X-axis to move the current point to the start of the next glyph.
'
' The scalable width is used to calculate the width of a high-resolution glyph on
' a printer, whereas the device width is used to calculate the width of a glyph
' on a display device. Thus the scalable width is specified to greater precision
' than the device width.
'
' BBX 8 16 0 -2 declares a bounding box that is 8 pixels wide and 16 pixels tall.
' The lower left-hand corner of the character is offset by 0 pixels on the X-axis
' and -2 pixels on the Y-axis.
'
' BITMAP begins the bitmap for the current glyph. This line must be followed by
' one line per pixel on the Y-axis. In this example the glyph is 16 pixels tall,
' so 16 lines follow. Each line contains the hexadecimal representation of pixels
' in a row. A "1" bit indicates a rendered pixel. Each line is rounded to an 8
' bit (one byte) boundary, padded with zeroes on the right. In this example, the
' glyph is exactly 8 pixels wide, and so occupies exactly 8 bits (one byte) per
' line so that there is no padding. The most significant bit of a line of raster
' data represents the leftmost pixel.
'
' ENDCHAR ends the current glyph.
'
' The declarations STARTCHAR through ENDCHARare repeated for each glyph in a font.
'
' ENDFONT appears as the last line in the file, after all glyphs in the font have
' been enumerated.
' Version 2.2 Extensions
'
' Version 2.2 of the BDF specification adds support for non-Western fonts. These
' additions allow moving the origin by a positive or negative movement on the X
' and Y axes. This not only accommodates right-to-left writing direction, but
' even top-to-bottom (for example, for Chinese). The following values provide
' multinational-font support:
'
' METRICSET is set to 0 for writing direction 0, 1 for writing direction 1, or 2
' (in the initial global area) for both writing directions within the same font.
' Traditional Western left-to-right scripts use METRICSET 0.
'
' SWIDTH1 and DWIDTH1 have the same parameters as SWIDTH and DWIDTH,
' respectively. DWIDTH1 must be present for a METRICSET 1glyph. Its offsets can
' be positive or negative.
'
' VVECTOR defines an X-axis offset and a Y-axis offset to transition from a mode
' 0 glyph to a mode 1 glyph. An opposite offset is applied during a mode 1 to
' mode 0 glyph transition.
'
' This scheme easily accommodates two writing directions. Historically, fonts had
' 128 or 256 code points. Today, Unicode allows for over one million code points.
' Fonts can conceivably contain thousands of glyphs, some of which should be
' written left-to-right, some right-to-left, and some top-to-bottom. Such
' multi-directional writing requires creative use of DWIDTH1 and SWIDTH1for each
' glyph.
'
' In addition to keywords added for international support, version 2.2 adds the
' CONTENTVERSIONdeclaration. This keyword is followed by an integer to indicate
' the version number of the font.
'
' For more detailed information, consult the version 2.2 specification.
' -----------------------------------------------------------------------------
' X Window Properties
' -----------------------------------------------------------------------------
' X Window font utilities support several properties that can be specified in the
' STARTPROPERTIESsection of a BDF file.[3] A generic BDF file is in
' ASCIIencoding. X Window properties are specified using ISO 8859-1 encoding,
' which is an extension of ASCII. These properties include:
'
' * CAP_HEIGHT (integer) The height above the baseline of a capital letter
' (See Cap height).
'
' * COPYRIGHT (string)[4] A copyright statement.
'
' * DEFAULT_CHAR (unsigned integer) The default character (glyph) to display
' for an undefined glyph.
'
' * FACE_NAME (string[4]) The name of the face for this font.
'
' * FONT (string)[4] The X Window name of the font.
'
' * FONT_ASCENT (integer) The height above the baseline, for line spacing
' calculation.
'
' * FONT_DESCENT (integer) The descender below the baseline, for line spacing
' calculation.
'
' * FONT_VERSION (string)[4] The version of the font.
'
' * FOUNDRY (string)[4] The name of the foundry.
'
' * FAMILY_NAME (string)[4] The font family name.
'
' * NOTICE (string)[4] A general comment.
'
' * POINT_SIZE (integer) See Point (typography).
' If it is not separately specified,
' EMspace = round(POINT_SIZE/10),
' ENspace = round(POINT_SIZE/20), and
' THINspace = round(POINT_SIZE/30).
'
' * RESOLUTION_X (unsigned integer)
'
' * RESOLUTION_Y (unsigned integer)
'
' * SLANT (string)[4]
' "R" is roman, "I" is italic, "O" is oblique, "RI" is reverse italic,
' "RO" is reverse oblique, "OT" is other,
' and a number indicates polymorphic slant capability.
'
' * WEIGHT_NAME (string)[4] The weight of this font ("Bold" and "Normal"
' are typical, though there is no set enumeration).
'
' * X_HEIGHT (integer) The height above the baseline of a lower-case "x"
' (See x-height).
' -----------------------------------------------------------------------------
' Notes
' -----------------------------------------------------------------------------
' 1. .bdf MIME type not registered at IANA
' 2. "X Window System, Version 11, Release 3". X.Org Foundation. October 1988.
' Retrieved 19 January 2016.
' 3. Flowers, Jim (1994) [1988]. "3.2 Font Properties".
' X Logical Font Description Conventions (Version 1.5 ed.).
' X Consortium, Inc. p. 13. Archived from the original on 2013-03-31.
' Retrieved 2009-01-08.
' 4. A ISO 8859-1 character string.
' -----------------------------------------------------------------------------
' References
' -----------------------------------------------------------------------------
' * The Unicode Standard, Version 5.0. The Unicode Consortium (5th ed.).
' Addison-Wesley. October 2006. ISBN 978-0-321-48091-0.
' -----------------------------------------------------------------------------
' External links
' -----------------------------------------------------------------------------
' * Adobe Glyph Bitmap Distribution Format (BDF) Specification, version 2.2
' https://www.adobe.com/content/dam/Adobe/en/devnet/font/pdfs/5005.BDF_Spec.pdf
' /////////////////////////////////////////////////////////////////////////////
' Q: write QB64 code to convert a bitmap font of 256 8x8 characters defined
' in a 2d array to a BDF file
' QB64 code to convert a 2D array representing a bitmap font to a BDF file.
' Example 2D array representing a simple 8x8 font (256 characters)
Function CreateBDF$ (FontFilename$)
ReDim arrFontData(255, 7) As Integer ' 256 characters, 8 rows (y)
Dim iChar As Integer
Dim iRow As Integer
Dim sError As String: sError = ""
If Len(sError) = 0 Then
sError = GetTiles$(arrFontData())
End If
If Len(sError) = 0 Then
SaveBDF arrFontData(), FontFilename$
End If
Sub SaveBDF (arrFontData%(), filename$)
Open filename$ For Output As #1
Dim iChar As Integer
Dim iRow As Integer
Dim hexString$
Dim rowValue As Integer
Print #1, "SWIDTH 500 0"
Print #1, "DWIDTH 8 0"
Print #1, "BBX 8 8 0 0"
Print #1, "BITMAP"
For iRow = 0 To 7
' Convert integer iRow to hexadecimal string
hexString$ = ""
rowValue = arrFontData%(iChar, iRow)
hexString$ = LTrim$(Hex$(rowValue))
If Len(hexString$) = 1 Then hexString$ = "0" + hexString$ ' Pad to two hex digits
Print #1, hexString$
Next iRow
Print #1, "ENDCHAR"
Next iChar
' --- BDF Footer ---
Print #1, "ENDFONT"
Close #1
End Sub ' SaveBDF
' ################################################################################################################################################################
' END BDF FONT ROUTINES @BDF
' ################################################################################################################################################################
' ################################################################################################################################################################
' BEGIN GENERAL PURPOSE ROUTINES #GEN
' ################################################################################################################################################################
' /////////////////////////////////////////////////////////////////////////////
' Convert a value to string and trim it (because normal Str$ adds spaces)
Function cstr$ (myValue)
'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
cstr$ = _Trim$(Str$(myValue))
End Function ' cstr$
' /////////////////////////////////////////////////////////////////////////////
' From: Bitwise Manipulations By Steven Roman
' http://www.romanpress.com/Articles/Bitwise_R/Bitwise.htm
' Returns the 8-bit binary representation
' of an integer iInput where 0 <= iInput <= 255
Function GetBinary$ (iInput1 As Integer)
Dim sResult As String
Dim iLoop As Integer
Dim iInput As Integer: iInput = iInput1
sResult = ""
If iInput >= 0 And iInput <= 255 Then
For iLoop = 1 To 8
sResult = LTrim$(RTrim$(Str$(iInput Mod 2))) + sResult
iInput = iInput \ 2
'If iLoop = 4 Then sResult = " " + sResult
Next iLoop
End If
GetBinary$ = sResult
End Function ' GetBinary$
' /////////////////////////////////////////////////////////////////////////////
' From: Bitwise Manipulations By Steven Roman
' http://www.romanpress.com/Articles/Bitwise_R/Bitwise.htm
' Returns the integer that corresponds to a binary string of length 8
Function GetIntegerFromBinary% (sBinary1 As String)
Dim iResult As Integer
Dim iLoop As Integer
Dim strBinary As String
Dim sBinary As String: sBinary = sBinary1
iResult = 0
strBinary = Replace$(sBinary, " ", "") ' Remove any spaces
For iLoop = 0 To Len(strBinary) - 1
iResult = iResult + 2 ^ iLoop * Val(Mid$(strBinary, Len(strBinary) - iLoop, 1))
Next iLoop
GetIntegerFromBinary% = iResult
End Function ' GetIntegerFromBinary%
' /////////////////////////////////////////////////////////////////////////////
' Returns _TRUE if value OriginalString$ is numeric.
' Re: Does a Is Number function exist in QB64?
' https://www.qb64.org/forum/index.php?topic=896.15
' Version 2 by madscijr
' Returns _TRUE (-1) if string is an integer, _FALSE (0) if not
' Version 1 by MWheatley
' Reply #18 on: January 01, 2019, 11:24:30 AM
' returns 1 if string is an integer, 0 if not
Function IsNumber% (OriginalString$)
Dim bResult%: bResult% = _FALSE
Dim iLoop%
Dim TestString$
'Dim bNegative%
Dim iDecimalCount%
Dim sNextChar$
'THEY SHOULD TRIM OUTSIDE THE FUNCTION!
'TestString$ = _TRIM$(OriginalString$)
If Len(OriginalString$) > 0 Then
TestString$ = ""
If Left$(OriginalString$, 1) = "+" Then
TestString$ = Right$(OriginalString$, Len(OriginalString$) - 1)
'bNegative% = _FALSE
ElseIf Left$(OriginalString$, 1) = "-" Then
TestString$ = Right$(OriginalString$, Len(OriginalString$) - 1)
'bNegative% = _TRUE
Else
TestString$ = OriginalString$
'bNegative% = _FALSE
End If
If Len(TestString$) > 0 Then
bResult% = _TRUE
iDecimalCount% = 0
For iLoop% = 1 To Len(TestString$)
sNextChar$ = Mid$(TestString$, iLoop%, 1)
If sNextChar$ = "." Then
iDecimalCount% = iDecimalCount% + 1
If iDecimalCount% > 1 Then
' TOO MANY DECIMAL POINTS, INVALID!
bResult% = _FALSE
Exit For
End If
ElseIf Asc(sNextChar$) < 48 Or Asc(sNextChar$) > 57 Then
' NOT A NUMERAL OR A DECIMAL, INVALID!
bResult% = _FALSE
Exit For
End If
Next iLoop%
End If
End If
IsNumber% = bResult%
End Function ' IsNumber%
' /////////////////////////////////////////////////////////////////////////////
' Return filename sFile without file extension (anything after last ".")
Function NoExt$ (sFile As String)
Dim iPos As Integer
iPos = _InStrRev(sFile, ".")
If iPos > 0 Then
If Len(sFile) > 1 Then
If iPos > 1 Then
NoExt$ = Left$(sFile, iPos - 1)
Else
' dot is first character, removing it returns blank!
' our version will just return the name unchanged
' but you can return blank if you prefer
NoExt$ = sFile
End If
Else
' file only has one character, the dot, removing it returns blank!
' our version will just return the name unchanged
' but you can return blank if you prefer
NoExt$ = sFile
End If
Else
' no dot found
' return the name unchanged
NoExt$ = sFile
End If
End Function ' NoExt$
' /////////////////////////////////////////////////////////////////////////////
' Generate random value between Min and Max inclusive.
Function RandomNumber% (Min%, Max%)
Dim NumSpread%
' SET RANDOM SEED
Randomize Timer
NumSpread% = (Max% - Min%) + 1
RandomNumber% = Int(Rnd * NumSpread%) + Min% ' GET RANDOM # BETWEEN Max% AND Min%
End Function ' RandomNumber%
' /////////////////////////////////////////////////////////////////////////////
' FROM: String Manipulation
' found at abandoned, outdated and now likely malicious qb64 dot net website
' http://www.qb64.[net]/forum/index_topic_5964-0/
'
'SUMMARY:
' Purpose: A library of custom functions that transform strings.
' Author: Dustinian Camburides (dustinian@gmail.com)
' Platform: QB64 (www.qb64.org)
' Revision: 1.6
' Updated: 5/28/2012
'SUMMARY:
'[Replace$] replaces all instances of the [Find] sub-string with the [Add] sub-string within the [Text] string.
'INPUT:
'Text: The input string; the text that's being manipulated.
'Find: The specified sub-string; the string sought within the [Text] string.
'Add: The sub-string that's being added to the [Text] string.
Function Replace$ (Text1 As String, Find1 As String, Add1 As String)
' VARIABLES:
Dim Text2 As String
Dim Find2 As String
Dim Add2 As String
Dim lngLocation As Long ' The address of the [Find] substring within the [Text] string.
Dim strBefore As String ' The characters before the string to be replaced.
Dim strAfter As String ' The characters after the string to be replaced.
' INITIALIZE:
' MAKE COPIESSO THE ORIGINAL IS NOT MODIFIED (LIKE ByVal IN VBA)
Text2 = Text1
Find2 = Find1
Add2 = Add1
lngLocation = InStr(1, Text2, Find2)
' PROCESSING:
' While [Find2] appears in [Text2]...
While lngLocation
' Extract all Text2 before the [Find2] substring:
strBefore = Left$(Text2, lngLocation - 1)
' Extract all text after the [Find2] substring:
strAfter = Right$(Text2, ((Len(Text2) - (lngLocation + Len(Find2) - 1))))
' Locate the next instance of [Find2]:
lngLocation = InStr(1, Text2, Find2)
' Next instance of [Find2]...
Wend
' OUTPUT:
Replace$ = Text2
End Function ' Replace$
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'
' FROM luke, QB64 Developer
' Date: February 15, 2019, 04:11:07 AM
'
' Given a string of words separated by spaces (or any other character),
' splits it into an array of the words. I've no doubt many people have
' written a version of this over the years and no doubt there's a million
' ways to do it, but I thought I'd put mine here so we have at least one
' version. There's also a join function that does the opposite
' array -> single string.
'
' Code is hopefully reasonably self explanatory with comments and a little demo.
' Note, this is akin to Python/JavaScript split/join, PHP explode/implode.
'Split in$ into pieces, chopping at every occurrence of delimiter$. Multiple consecutive occurrences
'of delimiter$ are treated as a single instance. The chopped pieces are stored in result$().
'
'delimiter$ must be one character long.
'result$() must have been REDIMmed previously.
' Modified to handle multi-character delimiters
Sub split (in$, delimiter$, result$())
Dim start As Integer
Dim finish As Integer
Dim iDelimLen As Integer
ReDim result$(-1)
iDelimLen = Len(delimiter$)
start = 1
Do
'While Mid$(in$, start, 1) = delimiter$
While Mid$(in$, start, iDelimLen) = delimiter$
'start = start + 1
start = start + iDelimLen
If start > Len(in$) Then
Exit Sub
End If
Wend
finish = InStr(start, in$, delimiter$)
If finish = 0 Then
finish = Len(in$) + 1
End If
ReDim _Preserve result$(0 To UBound(result$) + 1)
result$(UBound(result$)) = Mid$(in$, start, finish - start)
start = finish + 1
Loop While start <= Len(in$)
End Sub ' split
' ################################################################################################################################################################
' END GENERAL PURPOSE ROUTINES @GEN
' ################################################################################################################################################################
' ################################################################################################################################################################
' BEGIN COLOR ARRAY FUNCTIONS #COLR
' ################################################################################################################################################################
Sub AddColor (ColorValue As _Unsigned Long, arrColor() As _Unsigned Long)
ReDim _Preserve arrColor(0 To UBound(arrColor) + 1) As _Unsigned Long
arrColor(UBound(arrColor)) = ColorValue
End Sub ' AddColor
Sub AddColors (ColorValue As _Unsigned Long, arrColor() As _Unsigned Long, HowMany As Long)
Dim iLoop As Integer
For iLoop = 1 To HowMany
AddColor ColorValue, arrColor()
Next iLoop
End Sub ' AddColors
' ################################################################################################################################################################
' END COLOR ARRAY FUNCTIONS @COLR
' ################################################################################################################################################################
' ################################################################################################################################################################
' BEGIN COLOR FUNCTIONS #COLOR
' ################################################################################################################################################################
Function cRed~& ()
cRed = _RGB32(255, 0, 0)
End Function
Function cOrangeRed~& ()
cOrangeRed = _RGB32(255, 69, 0)
End Function ' cOrangeRed~&
Function cDarkOrange~& ()
cDarkOrange = _RGB32(255, 140, 0)
End Function ' cDarkOrange~&
Function cOrange~& ()
cOrange = _RGB32(255, 165, 0)
End Function ' cOrange~&
Function cGold~& ()
cGold = _RGB32(255, 215, 0)
End Function ' cGold~&
Function cYellow~& ()
cYellow = _RGB32(255, 255, 0)
End Function ' cYellow~&
' LONG-HAIRED FRIENDS OF JESUS OR NOT,
' THIS IS NOT YELLOW ENOUGH (TOO CLOSE TO LIME)
' TO USE FOR OUR COMPLEX RAINBOW SEQUENCE:
Function cChartreuse~& ()
cChartreuse = _RGB32(127, 255, 0)
End Function ' cChartreuse~&
' WE SUBSTITUTE THIS CSS3 COLOR FOR INBETWEEN LIME AND YELLOW:
Function cOliveDrab1~& ()
cOliveDrab1 = _RGB32(192, 255, 62)
End Function ' cOliveDrab1~&
Function cLime~& ()
cLime = _RGB32(0, 255, 0)
End Function ' cLime~&
Function cMediumSpringGreen~& ()
cMediumSpringGreen = _RGB32(0, 250, 154)
End Function ' cMediumSpringGreen~&
' ADDED THIS FOR THE GAUGE COLOR:
Function cSpringGreen~& ()
cSpringGreen = _RGB32(0, 255, 160)
End Function ' cSpringGreen~&
Function cCyan~& ()
cCyan = _RGB32(0, 255, 255)
End Function ' cCyan~&
Function cDeepSkyBlue~& ()
cDeepSkyBlue = _RGB32(0, 191, 255)
End Function ' cDeepSkyBlue~&
Function cDodgerBlue~& ()
cDodgerBlue = _RGB32(30, 144, 255)
End Function ' cDodgerBlue~&
Function cSeaBlue~& ()
cSeaBlue = _RGB32(0, 64, 255)
End Function ' cSeaBlue~&
Function cBlue~& ()
cBlue = _RGB32(0, 0, 255)
End Function ' cBlue~&
Function cBluePurple~& ()
cBluePurple = _RGB32(64, 0, 255)
End Function ' cBluePurple~&
Function cDeepPurple~& ()
cDeepPurple = _RGB32(96, 0, 255)
End Function ' cDeepPurple~&
Function cPurple~& ()
cPurple = _RGB32(128, 0, 255)
End Function ' cPurple~&
Function cPurpleRed~& ()
cPurpleRed = _RGB32(128, 0, 192)
End Function ' cPurpleRed~&
Function cDarkRed~& ()
cDarkRed = _RGB32(160, 0, 64)
End Function ' cDarkRed~&
Function cBrickRed~& ()
cBrickRed = _RGB32(192, 0, 32)
End Function ' cBrickRed~&
Function cDarkGreen~& ()
cDarkGreen = _RGB32(0, 100, 0)
End Function ' cDarkGreen~&
Function cGreen~& ()
cGreen = _RGB32(0, 128, 0)
End Function ' cGreen~&
Function cOliveDrab~& ()
cOliveDrab = _RGB32(107, 142, 35)
End Function ' cOliveDrab~&
Function cLightPink~& ()
cLightPink = _RGB32(255, 182, 193)
End Function ' cLightPink~&
Function cHotPink~& ()
cHotPink = _RGB32(255, 105, 180)
End Function ' cHotPink~&
Function cDeepPink~& ()
cDeepPink = _RGB32(255, 20, 147)
End Function ' cDeepPink~&
Function cMagenta~& ()
cMagenta = _RGB32(255, 0, 255)
End Function ' cMagenta~&
Function cBlack~& ()
cBlack = _RGB32(0, 0, 0)
End Function ' cBlack~&
Function cDimGray~& ()
cDimGray = _RGB32(105, 105, 105)
End Function ' cDimGray~&
Function cGray~& ()
cGray = _RGB32(128, 128, 128)
End Function ' cGray~&
Function cDarkGray~& ()
cDarkGray = _RGB32(169, 169, 169)
End Function ' cDarkGray~&
Function cSilver~& ()
cSilver = _RGB32(192, 192, 192)
End Function ' cSilver~&
Function cLightGray~& ()
cLightGray = _RGB32(211, 211, 211)
End Function ' cLightGray~&
Function cGainsboro~& ()
cGainsboro = _RGB32(220, 220, 220)
End Function ' cGainsboro~&
Function cWhiteSmoke~& ()
cWhiteSmoke = _RGB32(245, 245, 245)
End Function ' cWhiteSmoke~&
Function cWhite~& ()
cWhite = _RGB32(255, 255, 255)
End Function ' cWhite~&
Function cDarkBrown~& ()
cDarkBrown = _RGB32(128, 64, 0)
End Function ' cDarkBrown~&
Function cLightBrown~& ()
cLightBrown = _RGB32(196, 96, 0)
End Function ' cLightBrown~&
Function cKhaki~& ()
cKhaki = _RGB32(240, 230, 140)
End Function ' cKhaki~&
Function cEmpty~& ()
cEmpty = _RGB32(0, 0, 0, 0)
End Function ' cEmpty~&
' ################################################################################################################################################################
' END COLOR FUNCTIONS @COLOR
' ################################################################################################################################################################
' ################################################################################################################################################################
' BEGIN TILE DEFINITIONS #TILE
' ################################################################################################################################################################
Dim RoutineName As String: RoutineName = "GetTiles$"
Dim sError As String: sError = ""
ReDim arrTileText(0 To 255) As String
Dim iTileNum As Integer
ReDim arrLines(-1) As String
Dim iFromX As Integer
Dim iFromY As Integer
Dim sLine As String
Dim sChar As String
Dim sBinary As String
Dim iValue As Integer
Dim iLine As Integer
Dim ub%, lb%
If Len(sError) = 0 Then
ReDim arrFontData%(0 To 255, 0 To 7)
GetTileText arrTileText()
lb% = LBound(arrTileText)
ub% = UBound(arrTileText)
If lb% <> 0 Or ub% <> 255 Then
sError = "GetTileText returned array with invalid boundaries " + _
"(" + _
_TRIM$(str$( lb% )) + _
" - " +_
_TRIM$(str$( ub% )) + _
")"
End If
End If
If Len(sError) = 0 Then
For iTileNum = 0 To 255
split arrTileText(iTileNum), Chr$(13), arrLines()
iLine = 0
For iFromY = LBound(arrLines) To UBound(arrLines)
sLine = arrLines(iFromY)
If Len(sLine) > 0 Then
sBinary = ""
For iFromX = 1 To Len(sLine)
sChar = Mid$(sLine, iFromX, 1)
If sChar = "." Then
sBinary = sBinary + "0"
Else
sBinary = sBinary + "1"
End If
Next iFromX
If Len(sBinary) = 8 Then
iValue = GetIntegerFromBinary%(sBinary)
arrFontData%(iTileNum, iLine) = iValue
Else
iLine = iLine + 1
sError = "Invalid data for tile " + _Trim$(Str$(iTileNum)) + " at line " + _Trim$(Str$(iLine))
Exit For
End If
iLine = iLine + 1
If iLine > 7 Then Exit For
End If
Next iFromY
If Len(sError) > 0 Then Exit For
Next iTileNum
End If
![[Image: 64X16.png]](https://i.ibb.co/1tyN73gn/64X16.png)
its very easy in qb64 to change the bios fonts.... redifined my own ascii.... 100% possible. screen 0 set for 64,16 with 16cols just like vintage computers.![[Image: Screenshot-from-2025-07-07-23-12-34.png]](https://i.ibb.co/BVYKjJ4j/Screenshot-from-2025-07-07-23-12-34.png)
still working on it. 255 ascii chars.screen 0... qb64
![[Image: ascii.png]](https://i.ibb.co/ZzNDJjnZ/ascii.png)
qb64 ascii screen 0 ![[Image: digits2.png]](https://i.ibb.co/zVr6yCmx/digits2.png)
![[Image: faceb1.png]](https://i.ibb.co/hRt31R93/faceb1.png)