For those who haven't seen my St. Patrick's day salute...

by TheBOB (Login qb432l)
Graphics-Forum

 
'Possibly the first "beer wipe" in the history of programming
'Runs in QB64 only

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, 37: PRINT "Untitled"
FOR x = 280 TO 358
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 "";
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, 140), 32, 3
CIRCLE (340, 140), 32, 3
PAINT (300, 140), 3
PAINT (340, 140), 3
PAINT (320, 140), 3
PSET (275, 160), 3
DRAW "M+45,+60 NM+45,-60 BU5 P3,3"
FOR x = 268 TO 372
FOR y = 108 TO 220
IF POINT(530 - y, x - 104) = 1 THEN PSET (530 - y, x - 104), POINT(x, y)
NEXT y
NEXT x
'LINE (300, 195)-(420, 288), 1
'PAINT (340, 240), 1
FOR x = 320 TO 460
FOR y = 120 TO 270
PSET (640 - x, y), POINT(x, y)
'IF POINT(x, y) = 1 THEN PSET (x, y), 12
NEXT y
NEXT x
PSET (240, 285), 1
DRAW "M+80,-60 M+80,+60"
PAINT (320, 240), 1
CIRCLE (0, 230), 318, 3, 6.12, .2
CIRCLE (639, 230), 318, 3, 3, 3.3
LINE (312, 280)-(328, 280), 3
PAINT (320, 278), 3
LINE (312, 280)-(328, 290), 1, BF

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

PALETTE
_DELAY 3
GOSUB SetPALETTE

YYLine = 1
FOR y = 480 TO -40 STEP -1
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
_DELAY .02
NEXT y

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
_DELAY .02
LOOP WHILE INKEY$ = ""

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



    
This message has been edited by qb432l on Mar 17, 2017 6:39 PM

Posted on Mar 17, 2017, 5:12 PM

Respond to this message   

Return to Index

Response TitleAuthor and Date
That's phenonmim.. phenonmab... ahhh that's great is what that is!Foster Brooks on Mar 17
 * Thanks! The program loaded is called QBasic.BAS (j/k) I never noticed!TheBOB on Mar 17
  * I corrected it... now people will think you really were drunk!TheBOB on Mar 17
Cheers!FellippeHeitor on Mar 17
 *Thanks, FH!TheBOB on Mar 17
Great job, TheBOB. But of course, I do have one suggestion.Kew on Mar 18
 * Terrific idea, Kew! Definitely doable. Never thought of it--maybe for next St Pat's!TheBOB on Mar 18
  Here you go, Kew, a bit late for this year, definitely too early for next...TheBOB on Mar 18
   P.S. For Pete--something you didn't notice...TheBOB on Mar 18
    Not surprising...Pete on Mar 18
     You must be one of the new kids...TheBOB on Mar 18
      Richard Gere had a similar problem...Pete on Mar 18
       *that explains some of his acting, toomn on Mar 19
    TheBOB, you call yourself a programmer???!!!Kew on Mar 19
     * LOL--My pleasure! Thanks!TheBOB on Mar 19
      * Oh sure, get people drunk and get rave reviews. What's so new about that?Pete on Mar 19
       Yeah, drunk with the sheer beauty and elegance and...TheBOB on Mar 19
        * Please, don't lower yourself to their level, Robert.TheBOB's Hipster Douchebag Cousin on Mar 24

 Copyright © 1999-2017 Network54. All rights reserved.   Terms of Use   Privacy Statement  

Quantcast