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