CGA136.BAS 2/6

 BBS: Inland Empire Archive
Date: 06-14-93 (11:54)             Number: 395
From: PETER BARNEY                 Refer#: NONE
  To: GERALD RICHTER                Recvd: NO  
Subj: CGA136.BAS 2/6                 Conf: (2) Quik_Bas

'>>> Start of page 2.

NEXT

' this draws the rainbow square
FOR y = 0 TO 19
        FOR x = 0 TO 19
                PixSet 40 + x + (19 - y), x + y, Spectral(x)
                PixSet 40 + x + (19 - y), x + y + 1, Spectral(x)
        NEXT x
NEXT y
SaveScreen "Demo.scn"
SLEEP 5

END SUB

SUB GPrint (A$, x, y, Colr, Size)
'
' This Sub will print text on the graphics screen.
'
' Example
'  Gprint "Hello",10,5,23,1
'
' Will print Hello at position 10,5 in color 23.
'
' The 1 on the end specifies big or small text.
' Use a 1 for big, 0 for small.  Add 2 if you want wide letters.
'
' If you make Colr < 0 then it will use the Spectral Color Set,
' starting at color # ABS(Colr)
'
REDIM A(0 TO 7)

FOR M = 1 TO LEN(A$)
    N = ASC(MID$(A$, M, 1))
    DEF SEG = &HFFA6
    FOR l = 0 TO 7: B = (N * 8) + l + 14: A(l) = PEEK(B): NEXT
    DEF SEG = &HB800
    FOR r = 0 TO 7
        FOR J = 7 TO 1 STEP -1
            IF (A(r) AND 2 ^ J) <> 0 THEN
                IF Colr < 0 THEN Co = Spectral(r - Colr) ELSE Co_
 = Colr
                SELECT CASE Size
                    CASE 0
                        PixSet x + (7 - J) + ((M - 1) * 8), y +_
 r, Co
                    CASE 1
                        PixSet x + (7 - J) + ((M - 1) * 8), y +_
 r * 2, Co
                        PixSet x + (7 - J) + ((M - 1) * 8), y +_
 r * 2 + 1, Co
                    CASE 2
                        PixSet x + (7 - J) + ((M - 1) * 8) * 2,_
 y + r, Co
                        PixSet x + (7 - J) + ((M - 1) * 8) * 2 +_
 1, y + r, Co
                    CASE 3
                        PixSet x + (7 - J) + ((M - 1) * 8) * 2,_
 y + r * 2, Co
                        PixSet x + (7 - J) + ((M - 1) * 8) * 2,_
 y + r * 2 + 1, Co
                        PixSet x + (7 - J) + ((M - 1) * 8) * 2 +_
 1, y + r * 2, Co
                        PixSet x + (7 - J) + ((M - 1) * 8) * 2 +_
 1, y + r * 2 + 1, Co
                END SELECT
            END IF
        NEXT
    NEXT
NEXT
END SUB

SUB LoadScreen (f$)
BLOAD f$, 0
END SUB

SUB Mode (M, BG)
IF M <> 136 AND M <> 16 THEN ERROR 5 'illegal function call
'
'clear screen:      Character = &HB1, Attributes=0
'
' this part is necessary to run before any pixels are drawn, because it

'>>> Continued on page 3

 * Call PTS!  * It's psychosomatic. You need a lobotomy. I'll get a saw.

--- TMail v1.31.3
 * Origin: Programmer's Tech Shop - Toledo, Ohio (1:234/56)