DECLARE SUB SaveFonts ()
DEFINT A-Z

DECLARE SUB TogglePoint (FontNum, PixelX, PixelY)
DECLARE SUB MovePixLite (PixelX%, PixelY%)
DECLARE SUB MoveHiLite (OldFont%, FontNum%)
DECLARE SUB ShowCharSet ()
DECLARE SUB BigFont (FontNum)
DECLARE SUB gprint (Text$, TX, TY, Col, ml)
DECLARE SUB LoadFonts ()
DIM SHARED FBuff(0) AS STRING * 8960 'For Fonts

LoadFonts

SCREEN 13

ShowCharSet
FontNum = 65
PixelX = 0
PixelY = 0
BigFont (FontNum)
MoveHiLite OldFont, FontNum

a$ = "": TheMode = 1
WHILE a$ <> CHR$(27)
    a$ = INKEY$
    IF TheMode = 1 THEN
        IF a$ = CHR$(13) THEN
            TheMode = 2
            MovePixLite PixelX, PixelY
        END IF
        OldFont = FontNum
        IF LEN(a$) = 2 AND RIGHT$(a$, 1) = CHR$(75) AND FontNum > 0 THEN
            FontNum = FontNum - 1
            BigFont (FontNum)
        END IF
        IF LEN(a$) = 2 AND RIGHT$(a$, 1) = CHR$(72) AND FontNum > 31 THEN
            FontNum = FontNum - 32
            BigFont (FontNum)
        END IF
        IF LEN(a$) = 2 AND RIGHT$(a$, 1) = CHR$(77) AND FontNum < 255 THEN
            FontNum = FontNum + 1
            BigFont (FontNum)
        END IF
        IF LEN(a$) = 2 AND RIGHT$(a$, 1) = CHR$(80) AND FontNum < 224 THEN
            FontNum = FontNum + 32
            BigFont (FontNum)
        END IF
        IF OldFont <> FontNum THEN
            MoveHiLite OldFont, FontNum
        END IF
    ELSE
        IF a$ = CHR$(13) THEN
            TheMode = 1
            BigFont (FontNum)
            MoveHiLite OldFont, FontNum
        END IF
        IF a$ = CHR$(32) THEN
            TogglePoint FontNum, PixelX, PixelY
            BigFont (FontNum)
        END IF
        OldPixX = PixelX: OldPixy = PixelY
        IF LEN(a$) = 2 AND RIGHT$(a$, 1) = CHR$(75) AND PixelX > 0 THEN
            PixelX = PixelX - 1
        END IF
        IF LEN(a$) = 2 AND RIGHT$(a$, 1) = CHR$(72) AND PixelY > 0 THEN
            PixelY = PixelY - 1
        END IF
        IF LEN(a$) = 2 AND RIGHT$(a$, 1) = CHR$(77) AND PixelX < 4 THEN
            PixelX = PixelX + 1
        END IF
        IF LEN(a$) = 2 AND RIGHT$(a$, 1) = CHR$(80) AND PixelY < 6 THEN
            PixelY = PixelY + 1
        END IF
        IF PixelX <> OldPixX OR PixelY <> OldPixy THEN
            BigFont (FontNum)
            MovePixLite PixelX, PixelY
        END IF
    END IF
WEND

SaveFonts

SCREEN 0, 0, 0, 0

SUB BigFont (FontNum)

post = FontNum * 35
DEF SEG = VARSEG(FBuff(0))
FOR y = 0 TO 6
FOR x = 0 TO 4

   Clr = PEEK(VARPTR(FBuff(0)) + post)
   post = post + 1
   IF Clr THEN
       LINE (10 + (x * 10), 80 + (y * 10))-(10 + (x * 10 + 9), 80 + (y * 10 + 9)), 15, BF
   ELSE
       LINE (10 + (x * 10), 80 + (y * 10))-(10 + (x * 10 + 9), 80 + (y * 10 + 9)), 0, BF
   END IF

NEXT
NEXT
DEF SEG

LINE (8, 78)-(61, 151), 15, B

END SUB

SUB gprint (Text$, TX, TY, Col, ml)
keepx = TX

DEF SEG = VARSEG(FBuff(0))
FOR c = 1 TO LEN(Text$)
       ptr = 35 * (ASC(MID$(Text$, c, 1)))
       FOR y = 0 TO 6
          FOR x = 0 TO 4
             Clr = PEEK(VARPTR(FBuff(0)) + ptr)
             ptr = ptr + 1
             IF Clr THEN PSET (x + TX, y + TY), Col
          NEXT x
       NEXT y
       TX = TX + 6
NEXT c

END SUB

SUB LoadFonts

OPEN "example.fnt" FOR BINARY AS 1 'Change EXAMPLE.FNT to your font's filename
GET #1, , FBuff(0)
CLOSE #1

END SUB

SUB MoveHiLite (OldFont, FontNum)

x1 = (OldFont MOD 32)
x1 = 10 + (x1 * 6)
y1 = INT(OldFont / 32)
y1 = 10 + (y1 * 8)

x2 = (FontNum MOD 32)
x2 = 10 + (x2 * 6)
y2 = INT(FontNum / 32)
y2 = 10 + (y2 * 8)

LINE (x1, y1)-(x1 + 4, y1 + 6), 0, BF
gprint CHR$(OldFont), x1, y1, 9, 0

LINE (x2, y2)-(x2 + 4, y2 + 6), 9, BF
gprint CHR$(FontNum), x2, y2, 15, 0

LOCATE 11, 9: COLOR 14
IF FontNum >= 32 THEN
    PRINT CHR$(FontNum);
ELSE
    PRINT " ";
END IF
PRINT "(" + LTRIM$(RTRIM$(STR$(FontNum))) + ")";

END SUB

SUB MovePixLite (PixelX, PixelY)

x = PixelX * 10 + 10
y = PixelY * 10 + 80

LINE (x, y)-(x + 9, y + 9), 14, B


END SUB

SUB SaveFonts

OPEN "example.fnt" FOR BINARY AS 1 'Change EXAMPLE.FNT to your font's filename
PUT #1, , FBuff(0)
CLOSE #1

END SUB

SUB ShowCharSet

B$ = ""
FOR y = 0 TO 7
    FOR x = 0 TO 31
        B$ = B$ + CHR$((y * 32) + x)
    NEXT
    gprint B$, 10, 10 + (y * 8), 9, 0
    B$ = ""
NEXT

LINE (8, 8)-(202, 74), 15, B

END SUB

SUB TogglePoint (FontNum, PixelX, PixelY)

DEF SEG = VARSEG(FBuff(0))
ptr = (35 * FontNum) + (PixelY * 5 + PixelX)
Clr = PEEK(VARPTR(FBuff(0)) + ptr)
IF Clr THEN
    POKE VARPTR(FBuff(0)) + ptr, 0
ELSE
    POKE VARPTR(FBuff(0)) + ptr, 4
END IF
DEF SEG

END SUB

