Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Star Trek X The Search for The BOB's White Cake
#1
With all the Trekkie stuff of late, I'd thought I'd repost this spoof. For those of you who didn't know TheBOB, he was a frequent contributor to the QBasic Forum and a professional graphic artist and programmer in the 1980's. He got the nick, Batman. When we needed graphics help, back in the day, we'd post the bat signal... ^^0^^ and Bob would come to the rescue.

Well one day he posted his white cake recipe program, and something went terribly wrong...

Code: (Select All)
DEFINT A-Y
TYPE RockTYPE 'establish data TYPE for meteors
    Mx AS INTEGER 'meteor x coordinate
    My AS INTEGER 'meteor y coordinate
    Mr AS INTEGER 'meteor radius (fixed)
    Ms AS INTEGER 'meteor speed (fixed)
END TYPE

SCREEN 12, 0, 0, 0
_FULLSCREEN

FOR n = 1 TO 9
    READ Attribute: OUT &H3C8, Attribute
    FOR Reps = 1 TO 3
        READ Intensity: OUT &H3C9, Intensity
    NEXT Reps
NEXT n

PRINT
PRINT
COLOR 15
PRINT SPACE$(4); "W H I T E"; SPACE$(3); "C A K E"; SPACE$(3); "R E C I P E"
LINE (16, 60)-(620, 60), 9
LINE (16, 62)-(620, 62), 9
LINE (418, 60)-(542, 62), 0, BF
PRINT
PRINT
COLOR 12
PRINT SPACE$(4); "Heat oven to 350 degrees"
PRINT SPACE$(4); "Grease and flour 2 circular pans (8-9 inches)"
PRINT
COLOR 15
PRINT SPACE$(4); "CAKE:";
COLOR 11
PRINT SPACE$(9); "Flour: 2-1/4 cups"
PRINT SPACE$(18); "Sugar: 1-2/3 cups"
PRINT SPACE$(13); "Shortening: 2/3 cup"
PRINT SPACE$(19); "Milk: 1-1/4 cups"
PRINT SPACE$(10); "Baking powder: 3-1/2 tsps"
PRINT SPACE$(19); "Salt: 1 tsp"
PRINT SPACE$(16); "Vanilla: 1 tsp"
PRINT SPACE$(13); "Egg whites: 5 (reserve yolks for icing)"
PRINT
COLOR 12
PRINT SPACE$(4);
PRINT "Combine all ingredients except the egg whites in a bowl. Beat for 1/2"
PRINT SPACE$(4);
PRINT "minute at low speed, scraping bowl constantly, then 2 minutes at high"
PRINT SPACE$(4);
PRINT "speed, scraping bowl occasionally. Beat in egg whites, 2 minutes at"
PRINT SPACE$(4);
PRINT "high speed. Pour into pans. Bake until a toothpick inserted comes out"
PRINT SPACE$(4);
PRINT "clean or cake springs back when touched lightly (30 - 35 minutes)."
PRINT
COLOR 15
PRINT SPACE$(4); "ICING:";
COLOR 11
PRINT SPACE$(3); "Shortening: 2/3 cup"
PRINT SPACE$(17); "Butter: 2/3 cup"
PRINT SPACE$(14); "Egg yolks: 5"
PRINT SPACE$(16); "Vanilla: 1-1/2 tsps"
PRINT SPACE$(12); "Icing sugar: 3/4 cup or to taste"

CIRCLE (480, 86), 74, 1, , , .4
PAINT STEP(0, 0), 1
CIRCLE (480, 80), 72, 15, , , .4
PAINT STEP(0, 0), 15
CIRCLE (480, 79), 67, 9, , , .4
PAINT STEP(0, 0), 9
CIRCLE (480, 80), 72, 14, , , .4
CIRCLE (480, 78), 48, 15, , , .4
CIRCLE (480, 40), 60, 7, -4.5, -3.5, .4
PSET (423, 46), 7: DRAW "F2"
PAINT STEP(0, -10), 7
CIRCLE (480, 80), 60, 7, -4.5, -3.5, .4
PSET (423, 86), 7: DRAW "F2"
PAINT STEP(0, -10), 7
LINE (540, 40)-STEP(0, 40), 7
LINE (420, 40)-STEP(0, 40), 7
PAINT (430, 60), 7
PAINT (530, 60), 7
LINE (420, 40)-STEP(0, 40), 7
LINE STEP(4, -33)-STEP(0, 40), 7
LINE STEP(43, -24)-STEP(0, 40), 7
PAINT STEP(8, -18), 7
CIRCLE (480, 40), 60, 15, -4.5, -3.5, .4
LINE (540, 40)-STEP(0, 40), 15
LINE (420, 40)-STEP(0, 40), 15
LINE (420, 40)-STEP(0, 40), 15
LINE STEP(4, -33)-STEP(0, 40), 15
LINE STEP(43, -24)-STEP(0, 40), 15
PSET (430, 52), 4
DRAW "M+47,-7 M-9,+14 M-38,+6 U12 BR12 P4,4 BL13 D12 LU13Ld13"
PSET (427, 70), 4
DRAW "M+40,-7 D19 M-40,+7 U19 BF8 P4,4"
DIM Box(1000)
GET (427, 53)-(467, 78), Box()
PUT (427, 55), Box(), PSET
PSET (481, 40), 15
DRAW "M-13,+21"
PAINT (470, 30), 13, 15
FOR Reps = 1 TO 1200
    X = FIX(RND * 60) + 420
    y = FIX(RND * 54) + 40
    IF POINT(X, y) = 4 THEN PSET (X, y), 15
NEXT Reps
PSET (427, 70), 2
DRAW "bM+40,-7 bD19 M-40,+7"
PSET (427, 70), 2
DRAW "bM+40,-7 bD20 M-30,+5"
CIRCLE (480, 80), 60, 2, 4.5, 6, .4
LINE (4, 4)-(635, 475), 9, B
FOR X = 524 TO 525
    FOR y = 30 TO 100
        IF POINT(X, y) = 7 THEN PSET (X, y), 13
    NEXT y
NEXT X
FOR X = 528 TO 540
    FOR y = 30 TO 100
        IF POINT(X, y) = 7 THEN PSET (X, y), 13
    NEXT y
NEXT X

CALL BSU
CALL SPACE
SYSTEM

PaletteDATA:
DATA 0,0,0,36,1,0,0,24,2,48,36,44,4,54,54,63,7,63,48,48,8
DATA 54,54,54,9,60,48,63,12,42,42,42,13,63,52,52,14,63,42,24

DEFSNG Z
SUB BSU

    LOCATE 27, 60: PRINT CHR$(24);
    LOCATE 28, 60: PRINT CHR$(219);: FIREPIN = 1
    _DELAY 1

    DO
        b$ = INKEY$
        _LIMIT 30
        LOCATE 28, 62
        PRINT "Press arrow up.";
        LOCATE 28, 62
        IF b$ = CHR$(0) + "H" THEN EXIT DO
        _DELAY .45
        PRINT "              ";
        IF b$ = CHR$(0) + "H" THEN EXIT DO
        _DELAY .45
        IF b$ = CHR$(27) THEN SYSTEM
    LOOP UNTIL b$ = CHR$(0) + "H"
    b$ = CHR$(13)
    LOCATE 28, 60: PRINT "                ";

    FIREMISSILE:
    FOR I = 1 TO 25
        LOCATE 28 - I, 60: PRINT " ";
        LOCATE CSRLIN - 1, 60: PRINT CHR$(24);
        Z = TIMER
        DO
        LOOP UNTIL ABS(Z - TIMER) >= .02: 'DELAY LOOP
    NEXT
    FOR I = 1 TO 5
        SOUND 2000, 2: SOUND 500, 2

        WAIT &H3DA, 8
        WAIT &H3DA, 8, 8

        OUT &H3C8, 12
        IF I >= 3 THEN
            IF I / 2 <> I \ 2 THEN OUT &H3C8, 33 ELSE OUT &H3C8, 0
        ELSE
            OUT &H3C8, 0
            OUT &H3C9, 63 'set background (briefly) to bright red
            OUT &H3C9, 0
            OUT &H3C9, 0
        END IF
    NEXT I
    Z = TIMER
    DO
    LOOP UNTIL ABS(Z - TIMER) >= 1.5: 'DELAY LOOP

END SUB

SUB SPACE
    SCREEN 9

    'Set all attributes to black to hide draw/GET process
    FOR n = 1 TO 15
        PALETTE n, 0
    NEXT n

    'Ships differ in that the ship 2 rocket blasts are slightly larger
    'Draw and GET ship 1 and mask
    X = 0: Y = 0
    MaxWIDTH = 83
    MaxDEPTH = 60

    DIM Rocks(1 TO 100) AS RockTYPE 'holds the location, size
    'and speed of 100 meteors

    IF X < 326 THEN
        FOR n = 1 TO 100 'loop to initialize meteor array

            Rocks(n).Mx = FIX(RND * 640) 'initial x coordinates
            Rocks(n).My = FIX(RND * 350) 'initial y coordinates
            Rocks(n).Mr = FIX(RND * 5) + 2 'permanent radius (2-6 pixels)

            SELECT CASE n 'speed variations create perspective
                CASE 1 TO 30: Rocks(n).Ms = 12 'background meteors
                CASE 31 TO 65: Rocks(n).Ms = 18 'midground meteors
                CASE 66 TO 100: Rocks(n).Ms = 24 'foreground meteors
            END SELECT

        NEXT n
        Rocks(50).Mr = 10 'meteor 50 specially sized (large)
        Rocks(100).Mr = 16 'meteor 100 specially sized (larger)
    ELSE
        Z = TIMER: DO: IF ABS(Z - TIMER) > .1 THEN EXIT DO
        LOOP
    END IF

    ActivePAGE = 0: VisualPAGE = 1 'establish page variables for SWAP

    SCREEN 9, , ActivePAGE, VisualPAGE 'page 0 active, page 1 visual

    PALETTE
    PALETTE 10, 0 'set palette values for attributes
    PALETTE 12, 35 'which do not respond to OUT

    'set palette values for attributes
    'that respond to OUT
    OUT &H3C8, 0
    OUT &H3C9, 0
    OUT &H3C9, 0 'background: midnight blue
    OUT &H3C9, 12

    OUT &H3C8, 1
    OUT &H3C9, 16
    OUT &H3C9, 8 'meteor: dark brown
    OUT &H3C9, 2

    OUT &H3C8, 2
    OUT &H3C9, 32
    OUT &H3C9, 32 'medium ship gray
    OUT &H3C9, 32

    OUT &H3C8, 3
    OUT &H3C9, 22
    OUT &H3C9, 12 'meteor highlight brown
    OUT &H3C9, 5

    OUT &H3C8, 4
    OUT &H3C9, 63
    OUT &H3C9, 0 'bright red
    OUT &H3C9, 0

    OUT &H3C8, 5
    OUT &H3C9, 52
    OUT &H3C9, 52 'ship light gray
    OUT &H3C9, 52

    'MAIN LOOP BEGINS -------------------------------

    Count = 0

    FOR X = 6 TO 546 STEP 2 'main loop wherein ship will
        _DELAY .115 ' Reading speed
        'travel 540 pixels in steps
        'of two

        CLS 'active screen cleared

        OUT &H3C8, 0 'background color reestablished
        OUT &H3C9, 0 'in case "space lightning" has
        OUT &H3C9, 0 'flashed
        OUT &H3C9, 12

        'The following loop draws/updates x/y's of first 80 meteors
        IF X < 326 THEN
            FOR n = 1 TO 80
                GOSUB DrawMETEORS 'see DrawMETEORS subroutine
            NEXT n

            'Second meteor-drawing loop draws last 20 meteors so that they *may*
            'overdraw the ship (creating sense of its 'involvement' in meteor storm)
            FOR n = 81 TO 100
                GOSUB DrawMETEORS 'see DrawMETEORS subroutine
            NEXT n
        ELSE
            ''Z = TIMER: DO: IF ABS(Z - TIMER) > .1 THEN EXIT DO
            ''LOOP
        END IF

        Z = TIMER: DO: IF ABS(Z - TIMER) > .05 THEN EXIT DO
        LOOP

        'PRINT section -------------------------------------
        'Blurbs are printed (with gaps) based on the ship's x location
        COLOR 13: A1 = 30
        SELECT CASE X
            CASE 10 + A1 TO 100 + A1
                LOCATE 21, 19: PRINT "Kirk to Spock. What are those strange looking"
                LOCATE 22, 31: PRINT "blobs on the screen?"
            CASE 101 + A1 TO 170 + A1
                LOCATE 21, 21: PRINT "Sensors indicate they are the remains of"
                LOCATE 22, 23: PRINT "TheBob's White Cake Recipe, Captain."
            CASE 171 + A1 TO 240 + A1
                LOCATE 21, 16: PRINT "Kirk to Scottie. Beam those pieces of cake onboard!"
            CASE 241 + A1 TO 317 + A1
                LOCATE 21, 19: PRINT "Aye Captain, I'll get right on it, as soon as"
                LOCATE 22, 28: PRINT "I finish my Dunkin Donuts."
            CASE 336 + A1 TO 435 + A1
                LOCATE 21, 15: PRINT "Kirk to Sick Bay. Bones, MEDICAL EMERGENCY! Report to"
                LOCATE 22, 13: PRINT "the Transporter Room and put TheBob's cake back together!"
            CASE IS > 440 + A1
                LOCATE 21, 19: PRINT "Dammit Jim. I'm a doctor, not Martha Stewart!"
                LOCATE 21, 19: PRINT "Dammit Jim. I'm a doctor, not a confectioner!"
        END SELECT
        '-----------------------------------------------------

        'Border line
        LINE (0, 0)-(639, 349), 8, B

        '"Space lightning" flash (1 chance in 25)
        'Flash = FIX(RND * 25)
        IF X = 326 THEN
            SOUND 1000, .5: SOUND 2000, .5: SOUND 3000, .5: SOUND 4000, .5: SOUND 5000, .5: SOUND 6000, .5
            SOUND 6000, .5: SOUND 7000, .5: SOUND 8000, .5: SOUND 4000, .5: SOUND 9000, .5
            OUT &H3C8, 0
            OUT &H3C9, 63 'set background (briefly) to bright red
            OUT &H3C9, 0
            OUT &H3C9, 0
        END IF

        'PAGING SECTION --------------------------------
        SWAP ActivePAGE, VisualPAGE 'SWAP values of page variables...
        SCREEN 9, , ActivePAGE, VisualPAGE 'which toggles active/visual page
        '-----------------------------------------------

        WAIT &H3DA, 8
        WAIT &H3DA, 8, 8

    NEXT X 'main loop ends

    SCREEN 9, 0, 0, 0
    LOCATE 21, 5: PRINT SPACE$(70);
    LOCATE 22, 5: PRINT SPACE$(70);
    _DELAY 1
    LEVEL1 = 10
    A1$ = " [Sometimes The Joker Wins!]"
    REDIM BAT$(3)
    BAT$(3) = "^^o^^"
    BAT$(2) = "--o--"
    BAT$(1) = "vvovv"
    LOCATE LEVEL1, 2
    _DELAY 1
    FOR I = 1 TO 12
        FOR J = 1 TO 3
            IF I = 1 AND J = 1 THEN LOCATE , 3 ELSE PRINT " ";
            PRINT BAT$(J);
            LOCATE , POS(1) - 5
            Z = TIMER
            DO: IF ABS(Z - TIMER) > .1 THEN EXIT DO
            LOOP
        NEXT J
    NEXT I
    _DELAY 1
    FOR I = 2 TO LEVEL1
        IF I = LEVEL1 - 1 THEN SOUND 3000, .7: SOUND 358, 1.5: SOUND 5000, 1
        IF I <> 2 THEN LOCATE I - 1, 27: PRINT SPACE$(28);
        LOCATE I, 27: PRINT A1$;
        Z = TIMER
        DO: IF ABS(Z - TIMER) > .1 THEN EXIT DO
        LOOP
    NEXT

    _DELAY 4
    SYSTEM

    '- SUBROUTINE SECTION BEGINS -------------------------

    DrawMETEORS:

    'If the meteor's x coordinate has moved off-screen to the left, it is as-
    'signed a new random y coordinate, then reset to the right of the screen
    IF Rocks(n).Mx < 0 THEN
        Rocks(n).My = FIX(RND * 350)
        Rocks(n).Mx = 642
    END IF

    'Meteors are drawn with lighter highlight circle offset +1/-1 pixel
    CIRCLE (Rocks(n).Mx, Rocks(n).My), Rocks(n).Mr, 1
    PAINT STEP(0, 0), 1
    CIRCLE (Rocks(n).Mx + 1, Rocks(n).My - 1), Rocks(n).Mr - 2, 3
    PAINT STEP(0, 0), 3

    'Establish new location for each meteor by subtracting their
    'individual speed (Ms) from their current x coordinate (Mx) ...
    Rocks(n).Mx = Rocks(n).Mx - Rocks(n).Ms

    RETURN

    Mask:
    FOR xx = 0 TO 83
        FOR yy = 0 TO 60
            IF POINT(xx, yy) = 0 THEN PSET (xx, yy), 15 ELSE PSET (xx, yy), 0
        NEXT yy
    NEXT xx
    RETURN

END SUB

Pete
Reply
#2
Incredible...

Thanks for posting this.   The code is amazing!   So much stuff I haven't seen yet.

Cheers
Reply
#3
Mmmm... Cake.  Is there anything cake cannot do? Mmmm...
May your journey be free of incident. Live long and prosper.
Reply
#4
Shocked 
(12-05-2022, 01:29 AM)Pete Wrote: For those of you who didn't know TheBOB, he was a frequent contributor to the QBasic Forum and a professional graphic artist and programmer in the 1980's. He got the nick, Batman. When we needed graphics help, back in the day, we'd post the bat signal... ^^0^^ and Bob would come to the rescue.
So it was his signal I was shooting at in "ASCII Invaders?" (facepalm) Dodgy Sick Tongue Angry
Reply
#5
(12-05-2022, 05:18 AM)james2464 Wrote: Incredible...

Thanks for posting this.   The code is amazing!   So much stuff I haven't seen yet.

Cheers

When the forum started here, back in April, I ported TheBOB's programs from The QBasic Forum to here: https://qb64phoenix.com/forum/forumdisplay.php?fid=27

Bob also created some a complete graphics tutorial. I think I have that on a zip on my one of my other computers or saved drives.

If you ever have any questions about his code, he can be reached here: https://www.tapatalk.com/groups/qbasic/

Just sign up and post a ^^O^^ in The Community Forum section. I let new sign ups post there, but I've long since archived the rest of the board for posterity.

------------------------------------

Yep, Johnno, who doesn't like cake... Yum!

And mn, no worries on the bat signal. Since the space invaders game was the "Halloween" edition, purely by coincidence I replaced the usual --<>-- alien crafts with bats. And yes, TheBOB did notice. He stated he never had so much fun shooting down his own legacy. We've been friends now for going on some 25+ years. I hopefully kept my promise to the former forum owner, Mac, who wrote a PM to me once that read: I'm fine with all the kidding around on the boards, Pete. Most of the stuff is pretty funny, but promise me this; whatever you do, don't piss off TheBOB!"

Pete
Reply
#6
Thanks!  Bookmarked.   This stuff is gold.
Reply
#7
Cake now there's a Love | Hate thing going on with me!

Why can't broccoli taste like that?

I wonder if anything weird pisses off The Bob, something you wouldn't expect in normal person. These graphics genii you never know?

Oh just had a thought, it's the broccoli that's fattening because I have to eat all that cake to get that taste out of my mouth. ;-))
b = b + ...
Reply
#8
> Oh just had a thought, it's the broccoli that's fattening because I have to eat all that cake to get that taste out of my mouth. ;-))

LOL! Big Grin

+1

Pete
Reply
#9
(12-05-2022, 04:43 PM)james2464 Wrote: Thanks!  Bookmarked.   This stuff is gold.



Bob will enjoy hearing that.

For me to get such accolades, I have to go to the bedroom. I can hear my wife applauding and shouting from the family room... Finally I can watch T.V. without listing to anymore of your ********. Come to think of it, I haven't got accolade in a long time. (Shut up, Steve!)

Pete
Reply
#10
I was going to post this in "Help Me" but it's just a quick question.  

From Kong2.bas...I saw this:

Code: (Select All)
Wait &H3DA, 8
Wait &H3DA, 8, 8

And the wiki explains this as:  
Quote:The WAIT statement waits until the value read from an I/O port has certain bits set.

So I'm just wondering if this is something that would still apply to the latest QB64PE or is this something from the older versions?


It seems to be used for smoother animations but I'm not really 100% sure.
Reply




Users browsing this thread: 5 Guest(s)