Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Whatever happened to TheBOB's White Cake?
#1
Whenever we had a graphics emergency at The QBasic Forum, we always put up the Bat Signal ^^0^^ to call on TheBOB (aka The Batman) for help. One of Bob's creations, a recipe for White cake, and his Page Flipping Screen 9 demo were combined in the following code, but something went amiss that day in Gotham City...

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, 15: PRINT "Kirk to Scottie. Beam those pieces of cake on board!"
            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!"
        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
Reply




Users browsing this thread: 1 Guest(s)