'===========================================================================
' Subject: 8X8 VGA FONT ROUTINE              Date: 11-21-98 (20:42)       
' Author:  Sam Thursfield                    Code: QB, QBasic, PDS        
' Origin:  sam.thursfield@btinternet.com   Packet: GRAPHICS.ABC
'===========================================================================
DECLARE SUB VPrint (X%, Y%, Text$, FCol%, SCol%, XSize%, YSize%, Style%)
DEFINT A-Z

DECLARE SUB PalSet (I%, R%, G%, B%)
DECLARE SUB PalCycle ()
    
SCREEN 12
CLS
PAINT (1, 1), 1
LOCATE 3

VPrint 1, 1, "This is an example of normal 8*8 text", 14, 0, 8, 8, 0
VPrint 1, 10, "This is an example of normal 16*8 text", 14, 0, 16, 8, 0
VPrint 1, 19, "This is the 8*16 text that doesn't quite work yet, see what I mean?!", 14, 0, 8, 16, 0
VPrint 1, 36, "The above 8*16 text doesn't quite work yet, HELP!!!", 14, 0, 8, 8, 0
VPrint 1, 45, "This is underlined text, notice the underlining in a different colour to the text", 14, 6, 8, 8, 1
VPrint 1, 54, "This is 8*8 shadowed text", 14, 6, 8, 8, 2
VPrint 1, 63, "This is 16*8 shadowed text", 14, 6, 16, 8, 2
VPrint 1, 72, "This is HEADLINE text", 14, 6, 16, 8, 3
VPrint 1, 81, "You may modify and use this code but please give me credit. Go on, this is my", 12, 4, 8, 8, 3
VPrint 1, 90, "first WORKING program!", 12, 4, 8, 8, 3
VPrint 1, 99, " ElvisII AKA Sam Thursfield, 19 Nov 1998", 15, 8, 16, 8, 2
PalCycle
END

SUB PalCycle
BWay = 1
GWay = 1
RWay = 1
B = 63
R = 0
G = 0
DO
    IF B + BWay < 0 OR B + BWay > 63 THEN BWay = -BWay
    B = B + BWay
'    IF G + GWay < 0 OR G + GWay > 63 THEN GWay = -GWay
'    G = G + GWay
'    IF R + RWay < 0 OR R + RWay > 63 THEN RWay = -RWay
'    R = R + RWay
    PalSet 1, R, G, B
    FOR I = 1 TO 5000
    NEXT I
    WAIT &H3DA, 8
LOOP UNTIL INKEY$ <> ""
PalSet 1, 0, 0, 42

END SUB

SUB PalGet (I, R, G, B)
OUT &H3C7, I
R = INP(&H3C9)
G = INP(&H3C9)
B = INP(&H3C9)
END SUB

SUB PalSet (I, R, G, B)
OUT &H3C8, I
OUT &H3C9, R
OUT &H3C9, G
OUT &H3C9, B
END SUB

SUB VPrint (X, Y, Text$, FCol, SCol, XSize, YSize, Style)
DEF SEG = &HFFA6
XPos = X
YPos = Y
FOR Letter = 1 TO LEN(Text$)
    FOR I = YPos TO YPos + YSize - 1 STEP YSize \ 8
        Char$ = MID$(Text$, Letter, 1)
        Char = ASC(Char$)
        Mask = PEEK(&HE + (Char * 8) + (I \ (YSize \ 8) - Y))
        FOR J = 0 TO 7
            IF Mask AND (2 ^ (7 - J)) THEN
                IF Style AND 2 THEN
                    PSET (XPos + (XSize \ 8), I), SCol
                    IF XSize AND 16 THEN PSET (XPos + (XSize \ 8) + 1, I), SCol
                    IF YSize AND 16 THEN PSET (XPos + (XSize \ 8), I + 1), SCol
                    IF XSize AND 32 THEN PSET (XPos + (XSize \ 8) + 2, I), SCol
                    IF YSize AND 32 THEN PSET (XPos + (XSize \ 8), I + 2), SCol
                END IF
                PSET (XPos, I), FCol
                IF XSize AND 16 THEN PSET (XPos + 1, I), FCol
                IF YSize AND 16 THEN PSET (XPos, I + 1), FCol
                IF XSize AND 32 THEN PSET (XPos + 2, I), FCol
                IF YSize AND 32 THEN PSET (XPos, I + 2), FCol
            END IF
            IF Style AND 1 THEN
                PSET (XPos, YPos + YSize), SCol
                IF XSize AND 16 THEN PSET (XPos + 1, YPos + YSize), SCol
                IF YSize AND 16 THEN PSET (XPos, I + 1 + YSize), SCol
                IF XSize AND 32 THEN PSET (XPos + 2, I + YSize), SCol
                IF YSize AND 32 THEN PSET (XPos, I + 2 + YSize), SCol
            END IF
            XPos = XPos + (XSize \ 8)
        NEXT J
        XPos = XPos - XSize
    NEXT I
    XPos = XPos + XSize
NEXT Letter
DEF SEG
END SUB