CGA136.BAS 3/6

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

'>>> Start of page 3.

' layers a specific bit pattern on the screen that produces the colors.
'
' BG is the background color.
'   for example, if you want a dark blue background, do ClearScreen 1

DEF SEG = &HB800
IF M = 136 THEN ch = &HB1 ELSE ch = &HDE
FOR CHAR = 0 TO 15998 STEP 2: POKE CHAR, ch: POKE CHAR + 1, BG:_
 NEXT
ModeNum = M
END SUB

SUB Moire
IF ModeNum = 136 THEN XM = 40: tc = 255
IF ModeNum = 16 THEN XM = 80: tc = 15
IF XM = 0 THEN STOP
YM = 50
FOR y = -YM TO YM: Y2 = y * y
    FOR x = -XM TO XM
        r = INT((1E+07 * (Y2 + x * x)) ^ .255)
        IF r MOD 2 THEN
            PixSet x + XM, y + YM, 1 '(r / tc) AND
        ELSE
            PixSet x + XM, y + YM, ((r / 15) AND tc) + 1
        END IF
    NEXT x
NEXT y
END SUB

SUB Outline (x1, y1, x2, Y2, Colr, Colr2)
FOR x = x1 TO x2
    FOR y = y1 TO Y2
        IF PixColr(x, y) = 0 THEN
            IF PixColr(x + 1, y + 1) = Colr2 THEN PixSet x, y,_
 Colr: GOTO Skip
            IF PixColr(x + 1, y + 0) = Colr2 THEN PixSet x, y,_
 Colr: GOTO Skip
            IF PixColr(x + 1, y - 1) = Colr2 THEN PixSet x, y,_
 Colr: GOTO Skip
            IF PixColr(x - 0, y - 1) = Colr2 THEN PixSet x, y,_
 Colr: GOTO Skip
            IF PixColr(x - 1, y - 1) = Colr2 THEN PixSet x, y,_
 Colr: GOTO Skip
            IF PixColr(x - 1, y - 0) = Colr2 THEN PixSet x, y,_
 Colr: GOTO Skip
            IF PixColr(x - 1, y + 1) = Colr2 THEN PixSet x, y,_
 Colr: GOTO Skip
            IF PixColr(x + 0, y + 1) = Colr2 THEN PixSet x, y,_
 Colr
Skip:
        END IF
    NEXT
NEXT
END SUB

SUB PBox (x1, y1, x2, Y2, Colr, Style)
IF x1 > x2 THEN SWAP x1, x2
IF y1 > Y2 THEN SWAP y1, Y2
IF Style = 0 THEN
    FOR x = x1 TO x2: PixSet x, y1, Colr: NEXT
    FOR y = y1 TO Y2: PixSet x1, y, Colr: NEXT
    FOR x = x1 TO x2: PixSet x, Y2, Colr: NEXT
    FOR y = y1 TO Y2: PixSet x2, y, Colr: NEXT
ELSE
    FOR x = x1 TO x2: FOR y = y1 TO Y2
        PixSet x, y, Colr
    NEXT y, x
END IF
END SUB

SUB PCircle (x, y, r, c)
'
' Draws a circle at coordinates x,y with radius r and color c
'
'
FOR xv = 0 TO r
        yv = SQR(r ^ 2 - xv ^ 2)
        PixSet x + xv, y + yv, c
        PixSet x - xv, y - yv, c
        PixSet x + xv, y - yv, c
        PixSet x - xv, y + yv, c

'>>> Continued on page 4

 * Call PTS!  * "Filth! Contamination! Pestilence! Ha Ha Ha!"

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