Beer Wipe - An IDE Screen Saver Utility for a Special Day!

[Pete]

Beerwipe.bas by Bob Seguin.

Description: A special day screen saver for your QBasic IDE.

Code: (Select All)

_TITLE "Beer Wipe by Bob Seguin"

DEFINT A-Z
DIM Box(1 TO 32000)
TYPE BubbleTYPE
    x AS INTEGER
    y AS INTEGER
END TYPE
DIM Bubbles(1 TO 200) AS BubbleTYPE
FOR n = 1 TO 200
    Bubbles(n).x = FIX(RND * 640)
    Bubbles(n).y = FIX(RND * 480)
NEXT n

SCREEN 12
_FULLSCREEN

OUT &H3C8, 0
FOR Reps = 1 TO 48
    OUT &H3C9, 0
NEXT Reps
PAINT (0, 0), 1
LOCATE 1, 3: PRINT "FileÿÿEditÿÿViewÿÿSearchÿÿRunÿÿDebugÿÿOptions"
LOCATE 1, 75: PRINT "Help"
FOR x = 0 TO 639
    FOR y = 0 TO 16
        IF POINT(x, y) = 15 THEN PSET (x, y), 0 ELSE PSET (x, y), 7
    NEXT y
NEXT x
COLOR 12
LINE (5, 23)-(634, 479), 11, B
LINE (6, 24)-(633, 478), 11, B
LOCATE 2, 38: PRINT "QBASIC"
FOR x = 288 TO 350
    FOR y = 16 TO 30
        IF POINT(x, y) = 12 THEN PSET (x, y), 1 ELSE PSET (x, y), 11
    NEXT y
NEXT x
LINE (5, 421)-(634, 422), 11, B
LOCATE 27, 36: PRINT "Immediate"
FOR x = 270 TO 360
    FOR y = 412 TO 431
        IF POINT(x, y) = 12 THEN PSET (x, y), 11 ELSE PSET (x, y), 1
    NEXT y
NEXT x
LOCATE 30, 3: PRINT "<Shift+F1=Help> <F6=Window> <F2=Subs> <F5=Run> <F8=Step>";
LOCATE 30, 69: PRINT "N 00000:000";
FOR x = 0 TO 639
    FOR y = 462 TO 479
        IF x < 500 THEN Colr = 15 ELSE Colr = 0
        IF POINT(x, y) = 12 THEN PSET (x, y), Colr ELSE PSET (x, y), 3
    NEXT y
NEXT x
LINE (500, 462)-(501, 479), 0, B

LINE (606, 16)-(621, 32), 11, BF
LINE (608, 16)-(609, 32), 1, B
LINE (618, 16)-(619, 32), 1, B
LINE (613, 18)-(614, 30), 1, B
LINE (611, 21)-(612, 22), 1, B
LINE (615, 21)-(616, 22), 1, B
LINE (630, 30)-(637, 390), 7, BF
LINE (633, 33)-(634, 46), 0, B
LINE (631, 36)-(632, 37), 0, B
LINE (635, 36)-(636, 37), 0, B
LINE (633, 372)-(634, 386), 0, B
LINE (631, 382)-(632, 383), 0, B
LINE (635, 382)-(636, 383), 0, B

FOR x = 630 TO 638 STEP 4
    FOR y = 48 TO 370 STEP 2
        PSET (x, y), 0
        IF y + 1 <> 415 THEN PSET (x + 2, y + 1), 0
    NEXT y
NEXT x
LINE (10, 394)-(629, 414), 7, BF
LINE (11, 404)-(18, 405), 0, B
LINE (13, 402)-(14, 403), 0, B
LINE (13, 406)-(14, 407), 0, B
LINE (621, 404)-(628, 405), 0, B
LINE (624, 402)-(625, 403), 0, B
LINE (624, 406)-(625, 407), 0, B
LINE (20, 394)-(28, 414), 0, BF
FOR x = 28 TO 618 STEP 4
    FOR y = 394 TO 414 STEP 2
        PSET (x, y), 0
        IF y + 1 <> 415 THEN PSET (x + 2, y + 1), 0
    NEXT y
NEXT x
LOCATE 4, 4: PRINT "HAPPY SAINT PATRICK'S DAY!"
xx = 68: yy = 200
FOR x = 20 TO 240
    FOR y = 44 TO 64
        IF POINT(x, y) = 12 THEN
            IF y > 54 THEN Colr = 2 ELSE Colr = 10
            LINE (x * 2 + xx, y * 2 + yy)-(x * 2 + xx + 1, y * 2 + yy + 1), Colr, B
        END IF
        PSET (x, y), 1
    NEXT y
NEXT x
CIRCLE (300, 130), 32, 3
PAINT STEP(0, 0), 3
CIRCLE (340, 130), 32, 3
PAINT STEP(0, 0), 3
CIRCLE (250, 182), 32, 3
PAINT STEP(0, 0), 3
CIRCLE (258, 216), 32, 3
PAINT STEP(0, 0), 3
CIRCLE (390, 182), 32, 3
PAINT STEP(0, 0), 3
CIRCLE (382, 216), 32, 3
PAINT STEP(0, 0), 3
CIRCLE (288, 169), 8, 3, 3.4, 1.5
CIRCLE (353, 169), 8, 3, 1.8, 5.5
CIRCLE (300, 256), 36, 3, 0, 2.4, 1.8
CIRCLE (340, 258), 40, 3, .8, 3.3, 2
CIRCLE (296, 246), 30, 3, 5, 0, 1.4
CIRCLE (202, 240), 120, 3, 5.95, 0
LINE (302, 275)-(315, 278), 3
LINE (317, 220)-(322, 250), 3, BF
PAINT (320, 199), 3
PAINT (310, 270), 3
YLine = 1
FOR y = 330 TO 78 STEP -1
    GET (105, y)-(535, y), Box(YLine)
    YLine = YLine + 115
NEXT y
LINE (105, 85)-(535, 330), 1, BF
WAIT &H3DA, 8: WAIT &H3DA, 8, 8
GOSUB SetPALETTE

_DELAY 3
REM StartTIME! = TIMER: DO: LOOP WHILE TIMER < StartTIME! + 2

YYLine = 1
FOR y = 480 TO -40 STEP -1
    _DELAY .025
    FOR Reps = 1 TO 60
        x = FIX(RND * 640)
        yy = y + FIX(RND * 16) - 8
        Radius = FIX(RND * 12)
        CIRCLE (x, yy), Radius, 10
        PSET (x + Radius / 2, yy - Radius / 2), 15
    NEXT Reps
    FOR x = 0 TO 639
        IF POINT(x, y) <> 2 AND POINT(x, y) <> 10 THEN PSET (x, y), 1
    NEXT x
    LINE (0, y + 28)-(639, y + 31), 10, BF
    LINE (0, y + 32)-(639, y + 32), 3
    IF y = 329 THEN LINE (100, y + 37)-(540, y + 37), 1
    IF y = 68 THEN LINE (100, y + 37)-(540, y + 37), 1
    IF y >= 78 AND y < 330 THEN
        PUT (105, y + 32), Box(YYLine), PSET
        YYLine = YYLine + 115
    END IF
    IF y >= 70 AND y < 332 THEN PSET (100, y + 35), 1: PSET (540, y + 35), 1
    FOR n = 1 TO 200
        IF POINT(Bubbles(n).x, Bubbles(n).y) = 15 THEN
            PSET (Bubbles(n).x, Bubbles(n).y), 3
        END IF
        Bubbles(n).x = Bubbles(n).x + FIX(RND * 3) - 1
        Bubbles(n).y = Bubbles(n).y - 5
        IF Bubbles(n).y < 0 THEN
            Bubbles(n).y = 479
            Bubbles(n).x = FIX(RND * 640)
        END IF
        IF POINT(Bubbles(n).x, Bubbles(n).y) = 3 THEN
            PSET (Bubbles(n).x, Bubbles(n).y), 15
        END IF
    NEXT n
NEXT y

_KEYCLEAR ' Clear keyboard buffer.
DO
    FOR n = 1 TO 200
        IF POINT(Bubbles(n).x, Bubbles(n).y) = 15 THEN
            PSET (Bubbles(n).x, Bubbles(n).y), 3
        END IF
        Bubbles(n).x = Bubbles(n).x + FIX(RND * 3) - 1
        Bubbles(n).y = Bubbles(n).y - 2
        IF Bubbles(n).y < 0 THEN
            Bubbles(n).y = 479
            Bubbles(n).x = FIX(RND * 640)
        END IF
        IF POINT(Bubbles(n).x, Bubbles(n).y) = 3 THEN
            PSET (Bubbles(n).x, Bubbles(n).y), 15
        END IF
    NEXT n
LOOP WHILE INKEY$ = ""

_DELAY .5

COLOR 1

SYSTEM

SetPALETTE:
DATA 0,18,0,0,32,0,0,50,0,0,50,0
DATA 42,0,0,42,0,42,42,21,0,32,52,32
DATA 21,21,21,21,21,63,21,63,21,21,63,21
DATA 63,21,21,63,21,63,63,63,21,63,63,63
OUT &H3C8, 0
FOR n = 1 TO 48
    READ Intensity
    OUT &H3C9, Intensity
NEXT n
RETURN