+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Programs (https://staging.qb64phoenix.com/forumdisplay.php?fid=7)
+---- Thread: Star Trek X The Search for The BOB's White Cake (/showthread.php?tid=1235)
Pages:
1
2
Star Trek X The Search for The BOB's White Cake - Pete - 12-05-2022
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 SUBPete
RE: Star Trek X The Search for The BOB's White Cake - james2464 - 12-05-2022
Incredible...
Thanks for posting this. The code is amazing! So much stuff I haven't seen yet.
Cheers
RE: Star Trek X The Search for The BOB's White Cake - johnno56 - 12-05-2022
Mmmm... Cake. Is there anything cake cannot do? Mmmm...
RE: Star Trek X The Search for The BOB's White Cake - mnrvovrfc - 12-05-2022
(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)
RE: Star Trek X The Search for The BOB's White Cake - Pete - 12-05-2022
(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://staging.qb64phoenix.com/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
RE: Star Trek X The Search for The BOB's White Cake - james2464 - 12-05-2022
Thanks! Bookmarked. This stuff is gold.
RE: Star Trek X The Search for The BOB's White Cake - bplus - 12-05-2022
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. ;-))
RE: Star Trek X The Search for The BOB's White Cake - Pete - 12-05-2022
> 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!
+1
Pete
RE: Star Trek X The Search for The BOB's White Cake - Pete - 12-05-2022
(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
RE: Star Trek X The Search for The BOB's White Cake - james2464 - 12-06-2022
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, 8And 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.