Author Topic: Breakout (Read 7318 times)

FellippeHeitor · « **on:** March 24, 2019, 11:34:16 pm »

Control the paddle with your mouse or your keyboard arrows.

Code: QB64: [Select]

CONST true = -1, false = 0
 
DIM gameArea AS LONG
gameArea = _NEWIMAGE(400, 500, 32)
SCREEN gameArea
_TITLE "Breakout"
_PRINTMODE _KEEPBACKGROUND
 
TYPE Block
    x AS INTEGER
    y AS INTEGER
    c AS _UNSIGNED LONG
    state AS _BYTE
END TYPE
 
TYPE Ball
    x AS SINGLE
    y AS SINGLE
    c AS _UNSIGNED LONG
    radius AS INTEGER
    state AS _BYTE
    xDir AS _BYTE
    yDir AS _BYTE
    xVel AS SINGLE
    yVel AS SINGLE
END TYPE
 
CONST blockWidth = 50
CONST blockHeight = 25
CONST paddleHeight = 10
 
DIM SHARED block(1 TO 80) AS Block, ball AS Ball
DIM SHARED win AS _BYTE, quit AS STRING * 1
DIM SHARED paddleX AS INTEGER, paddleY AS INTEGER
DIM SHARED paddleWidth AS INTEGER
DIM SHARED score AS INTEGER, lives AS INTEGER
 
paddleY = _HEIGHT - blockHeight - paddleHeight - 1
 
DO
    IF lives = 0 THEN score = 0: lives = 3
    win = false
    generateBlocks
    paddleWidth = 100
    ball.state = false
    ball.c = _RGB32(161, 161, 155)
    ball.radius = 5
    ball.xDir = 1
    ball.yDir = -1
    ball.xVel = 3
    ball.yVel = 3
 
    _MOUSEHIDE
    _KEYCLEAR
 
    DO
        alpha = map(ball.xVel, 3, 6, 255, 30)
        LINE (0, 0)-(_WIDTH, _HEIGHT), _RGBA32(0, 0, 0, alpha), BF
        showBlocks
        doPaddle
        doBall
 
        m$ = "Score:" + STR$(score) + " Lives:" + STR$(lives)
        COLOR _RGB32(0, 0, 0)
        _PRINTSTRING (1, 1), m$
        COLOR _RGB32(255, 255, 255)
        _PRINTSTRING (0, 0), m$
 
        _DISPLAY
        _LIMIT 60
    LOOP UNTIL win OR lives = 0
 
    _MOUSESHOW
 
    CLS
    IF win THEN
        PRINT "Good job, you win."
    ELSE
        PRINT "You lose."
    END IF
 
    PRINT "Continue (y/n)?"
    _AUTODISPLAY
 
    DO
        quit = LCASE$(INPUT$(1))
    LOOP UNTIL quit = "y" OR quit = "n"
 
LOOP WHILE quit = "y"
 
SYSTEM
 
SUB generateBlocks
    FOR i = 1 TO 8
        FOR j = 1 TO 10
            b = b + 1
            block(b).x = (i - 1) * blockWidth
            block(b).y = (j - 1) * blockHeight
            block(b).c = _RGB32(255 * RND, 255 * RND, 255 * RND)
            block(b).state = RND
        NEXT
    NEXT
END SUB
 
SUB showBlocks
    win = true
    FOR i = 1 TO 80
        IF block(i).state = false THEN _CONTINUE
        win = false
        LINE (block(i).x, block(i).y)-STEP(blockWidth - 1, blockHeight - 1), block(i).c, BF
        LINE (block(i).x, block(i).y)-STEP(blockWidth - 1, blockHeight - 1), _RGB32(0, 0, 0), B
    NEXT
END SUB
 
SUB doPaddle
    STATIC lastX AS INTEGER
    WHILE _MOUSEINPUT: WEND
 
    IF _MOUSEX <> lastX THEN
        lastX = _MOUSEX
        paddleX = _MOUSEX - paddleWidth / 2
    END IF
 
    IF _KEYDOWN(19200) THEN paddleX = paddleX - 5
    IF _KEYDOWN(19712) THEN paddleX = paddleX + 5
 
    IF paddleX < 0 THEN paddleX = 0
    IF paddleX + paddleWidth > _WIDTH - 1 THEN paddleX = _WIDTH - 1 - paddleWidth
 
    LINE (paddleX + paddleHeight / 2, paddleY)-STEP(paddleWidth - paddleHeight, paddleHeight), _RGB32(89, 161, 255), BF
    CircleFill paddleX + paddleHeight / 2, paddleY + paddleHeight / 2, paddleHeight / 2, _RGB32(194, 89, 61)
    CircleFill paddleX + paddleWidth - paddleHeight / 2, paddleY + paddleHeight / 2, paddleHeight / 2, _RGB32(194, 89, 61)
    IF _MOUSEBUTTON(1) OR _KEYDOWN(13) THEN ball.state = true
END SUB
 
SUB doBall
    IF ball.state = false THEN
        ball.x = paddleX + paddleWidth / 2
        ball.y = paddleY - (ball.radius)
    ELSE
        ball.x = ball.x + ball.xDir * ball.xVel
        ball.y = ball.y + ball.yDir * ball.yVel
 
        checkCollision
    END IF
    CircleFill ball.x, ball.y, ball.radius, ball.c
END SUB
 
SUB checkCollision
    'paddle
    IF ball.x > paddleX AND ball.x < paddleX + paddleWidth AND ball.y > paddleY AND ball.y < paddleY + paddleHeight THEN
        IF ball.x < paddleX + paddleWidth / 2 THEN
            ball.xDir = -1
            ball.xVel = map(ball.x, paddleX, paddleX + paddleWidth / 3, 6, 3)
        ELSE
            ball.xDir = 1
            ball.xVel = map(ball.x, paddleX + paddleWidth / 3, paddleX + paddleWidth, 3, 6)
        END IF
        IF ball.xVel < 3 THEN ball.xVel = 3
 
        IF ball.yDir = 1 AND ball.y < paddleY + paddleHeight / 2 THEN ball.yDir = -1
        EXIT SUB
    END IF
 
    'blocks
    FOR i = 1 TO 80
        IF block(i).state = false THEN _CONTINUE
        IF ball.x > block(i).x AND ball.x < block(i).x + blockWidth AND ball.y > block(i).y AND ball.y < block(i).y + blockHeight THEN
            block(i).state = false
            IF ball.x < block(i).x + blockWidth / 2 THEN ball.xDir = -1 ELSE ball.xDir = 1
            IF ball.y < block(i).y + blockHeight / 2 THEN ball.yDir = -1 ELSE ball.yDir = 1
            points = ((_RED32(block(i).c) + _GREEN32(block(i).c) + _BLUE32(block(i).c)) / 3) / 10
            score = score + points
            EXIT SUB
        END IF
    NEXT
 
    'walls
    IF ball.x < ball.radius THEN ball.xDir = 1
    IF ball.x > _WIDTH - ball.radius THEN ball.xDir = -1
    IF ball.y > _HEIGHT + ball.radius THEN
        lives = lives - 1
        ball.state = false
        ball.xDir = 1
        ball.yDir = -1
        ball.xVel = 3
        ball.yVel = 3
    END IF
    IF ball.y < 0 THEN ball.yDir = 1
END SUB
 
SUB CircleFill (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
    ' CX = center x coordinate
    ' CY = center y coordinate
    '  R = radius
    '  C = fill color
    DIM Radius AS INTEGER, RadiusError AS INTEGER
    DIM X AS INTEGER, Y AS INTEGER
    Radius = ABS(R)
    RadiusError = -Radius
    X = Radius
    Y = 0
    IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
    LINE (CX - X, CY)-(CX + X, CY), C, BF
    WHILE X > Y
        RadiusError = RadiusError + Y * 2 + 1
        IF RadiusError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    WEND
END SUB
 
FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
    map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
END FUNCTION
 

qb4ever · « **Reply #1 on:** March 25, 2019, 05:44:35 am »

Great job !
Probably, the best basic breakout ever.
Have a nice day.

bplus · « **Reply #2 on:** March 25, 2019, 11:46:26 am »

Very interesting variations from what I have played and coded.

Usually there is a solid wall of blocks with each layer up a color with a point value.
Here the block state is assigned by RND, 0 or 1 (present or not), I've not seen that before.

The ball approaches paddle at same basic angle but velocity depends on where ball hits paddle.
I wonder if there are blocks unreachable because the angle is so restricted?

johnno56 · « **Reply #3 on:** March 25, 2019, 07:17:13 pm »

Nice job. You can never go wrong with a nice breakout game. Well done.

bplus · « **Reply #4 on:** March 25, 2019, 11:02:39 pm »

Found my old SdlBasic program and translated it to QB64. Here it is, might be fun to compare. All mouse!

Code: QB64: [Select]

_TITLE "Breakout trans from SdlBasic" 'B+ tranlate 2019-03-25
'Breakout.sdlbas  (B+=MGA) 2016-12-24
'adapted from just posted JB version add 3d modifications
 
RANDOMIZE TIMER
 
CONST xmax = 700 '<==== drawing area width
CONST ymax = 560 '<==== drawing area height
SCREEN _NEWIMAGE(xmax, ymax, 32)
 
'              Recommend: If you go FULLSCREEN then MOUSEHIDE
_FULLSCREEN
_MOUSEHIDE
'      You might want to keep mouse visible to see when it goes off screen in height
 
' wall is 50 pixels X 14 columns wide = 700 make screen width
' wall is 20 pixels X 8  rows = 160 = 1/3 screen height = 480 + 20  paddle height
' under paddle track score and lifes on one line padded by blank lines 540 = 27
' so total height 480 to paddle 500 + 60 for 3 lines = 560 (text height 20)
 
CONST br = 10 ' ball radius
CONST bkw = 50 ' brick width
CONST bkh = 20 ' brick height
CONST py = 480 ' paddle surface
 
'colors used
CONST red = &HFFFF0000
CONST orange = &HFFFF6400
CONST green = &HFF008000
CONST yellow = &HFFFFFF00
CONST silver = &HFFD0C6C6
CONST white = &HFFFFFFFF
CONST black = &HFF000000
 
DIM SHARED bx, by, dx, dy, px, my, pw, plf, prt, score, life, hits, obk, rbk, speedups
bx = 0 ' ball x position
by = 0 ' ball y position
dx = 0 ' ball horizontal change
dy = 0 ' ball vertical change
 
px = 0 ' paddle x
pw = 50 ' paddle width,  100 wide to start half that at certain point
plf = 0 ' paddle left side
prt = 0 ' paddle right side
 
score = 0
life = 5 '  (or balls left) only 3 allowed according to wiki
hits = 0 'bricks busted
obk = 0 ' first orange brick hits bool
rbk = 0 ' first red brick hit bool, when this happens paddle width is cut in half!
speedups = 0 ' count, bump up dy when hits = 4 and 8, then with first orange, then with first red
scrn = 0
 
DIM SHARED wc(13, 7), wp(13, 7) 'brick wall colors, brick wall points according to color
' get 448 points clear 1 screen/wall, perfect game is clearing 2 screens/walls
 
initwall 'load arrays with data
initball 'set dx, dy, bx, by ball position and change
drawtable
updatescore
WHILE life AND _KEYDOWN(27) = 0
    drawtable
    drawpaddle
    drawball
    updatescore
    IF hits = 112 AND scrn = 0 THEN 'setup new
        _DELAY 1
        scrn = 1
        speedups = 0: obk = 0: rbk = 0: pw = 50
        initwall
        drawtable
        initball
    ELSE
        IF hits = 224 THEN
            COLOR white
            Text 65, 200, 32, orange, "Congratulations on a perfect score!!!"
            EXIT WHILE
        END IF
    END IF
    _DISPLAY
    _LIMIT 60 '< adjust as needed for speed of your system
WEND
COLOR white
Text 260, 290, 48, orange, "Game Over"
_DISPLAY
SLEEP
 
SUB initwall
    DIM cr AS _UNSIGNED LONG
    FOR r = 0 TO 7
        SELECT CASE r
            CASE 0, 1: cr = red: p = 7
            CASE 2, 3: cr = orange: p = 5
            CASE 4, 5: cr = green: p = 3
            CASE 6, 7: cr = yellow: p = 1
        END SELECT
        FOR c = 0 TO 13
            wc(c, r) = cr: wp(c, r) = p
        NEXT
    NEXT
END SUB
 
SUB initball 'set ball in play with location and dx, dy
    bx = rand(br, 700 - br)
    by = rand(py - 100, py - 10)
    dx = rand(3, 7)
    IF rand(0, 1) THEN dx = -1 * dx
    dy = (3 + speedups) * -1
END SUB
 
SUB drawtable ' in JB don't want to redraw this every loop
    CLS
    FOR r = 0 TO 7
        FOR c = 0 TO 13
            IF wp(c, r) THEN
                FOR i = 1 TO 10
                    COLOR _RGB32(120, 60, 60)
                    LINE (c * bkw + i, r * bkh + bkh + i)-(c * bkw + bkw + i, r * bkh + bkh + i)
                    COLOR silver
                    PSET (c * bkw + i, r * bkh + bkh + i)
                    'ink(white)
                    LINE (c * bkw + bkw + i, r * bkh + i)-(c * bkw + bkw + i, r * bkh + bkh + i)
                NEXT
                COLOR wc(c, r)
                LINE (c * bkw, r * bkh)-(c * bkw + bkw, r * bkh + bkh), , BF
                COLOR white
                LINE (c * bkw, r * bkh)-(c * bkw + bkw, r * bkh + bkh), , B
            END IF
        NEXT
    NEXT
END SUB
 
SUB drawpaddle ' update paddle to mouseY, paddle top and bottom are global
    'erase last paddle, it is aligned with Blue Computer Goal Line
    COLOR black
    EllipseFill px, py + 10, pw, 20, black
    WHILE _MOUSEINPUT: WEND
    px = _MOUSEX 'update paddle location
    my = _MOUSEY
    plf = px - pw
    prt = px + pw
    FOR i = 20 TO 1 STEP -1
        cc = 255 - i * 10
        EllipseFill px, py + 10, pw - (20 - i), i, _RGB32(cc, .5 * cc, .25 * cc)
    NEXT
END SUB
 
SUB drawball
    'erase last ball, blend into table color
    CircleFill bx, by, br, black
 
    'update
    bx = bx + dx
    IF bx < br THEN dx = dx * -1: bx = br + 1
    IF bx > xmax - br THEN dx = dx * -1: bx = xmax - br - 1
 
    by = by + dy
    IF by + br > py THEN 'ball past paddle line
        by = py - br 'don't let ball go into paddle or goal
        IF bx + br < plf OR bx - br > prt THEN 'paddle miss
            life = life - 1
            ' if life = 0 then end game
            updatescore
            silverball bx, by
            _DELAY 2.5 'reflect on position of ball and loss of life
            CircleFill bx, by, br, black
            initball 'get ball rolling again
        ELSE 'paddle hit
            dy = dy * -1
            dx = dx + rand(-2, 2)
            IF dx > 7 THEN: dx = 7:
            IF dx < -7 THEN dx = -7
        END IF
    ELSE
        IF by - br < 0 THEN 'ball hits back border, reverse direction
            by = br: dy = dy * -1
        ELSE
            IF by - br < 160 THEN 'in wall area, what row and column?
                starthits = hits
                'maybe should check all 4 corners or smaller ball
                row = INT((by - br) / bkh): col = INT((bx - br) / bkw)
                handleBall row, col
                row = INT((by - br) / bkh): col = INT((bx + br) / bkw)
                handleBall row, col
                row = INT((by + br) / bkh): col = INT((bx - br) / bkw)
                handleBall row, col
                row = INT((by + br) / bkh): col = INT((bx + br) / bkw)
                handleBall row, col
                IF hits <> starthits THEN: dy = dy * -1: 'reverse ball direction
            END IF
        END IF
    END IF
    silverball bx, by
END SUB
 
SUB handleBall (row, col)
    IF 0 <= row AND row <= 7 AND 0 <= col AND col <= 13 THEN
        IF wp(col, row) THEN 'brick just hit, lot's to do before update ball
            hits = hits + 1
            IF hits = 4 OR hits = 8 OR hits = 116 OR hits = 120 THEN
                speedups = speedups + 1
                IF dy < 0 THEN: dy = dy - 1: ELSE: dy = dy + 1:
            END IF
            value = wp(col, row)
            IF value = 5 THEN 'first orange brick
                IF obk = 0 THEN 'flag first orange speed increase
                    obk = 1
                    speedups = speedups + 1
                    IF dy < 0 THEN: dy = dy - 1: ELSE: dy = dy + 1:
                END IF
            END IF
            IF value = 7 THEN 'flag first red, speed increase paddle decrease!
                IF rbk = 0 THEN
                    rbk = 1
                    speedups = speedups + 1
                    IF dy < 0 THEN: dy = dy - 1: ELSE: dy = dy + 1:
                    ' erase last paddle before change width
                    EllipseFill px, py + 10, pw, 20, black
                    pw = pw / 2
                END IF
            END IF
            score = score + wp(col, row) 'update score with point value
            wp(col, row) = 0 'no points here now
            'black out box
            LINE (col * bkw, row * bkh)-(col * bkw + bkw, row * bkh + bkh), black, BF
        END IF
    END IF
END SUB
 
SUB updatescore
    LINE (0, 500)-(xmax, ymax), black, BF
    dys$ = RIGHT$("    " + STR$(my), 4)
    dxs$ = RIGHT$("    " + STR$(px), 4)
    scores$ = RIGHT$("   " + STR$(score), 3)
    ms$ = " Mouse:" + dxs$ + "," + dys$ + "   Lifes:" + STR$(life) + "     Score:" + scores$
    Text 0, 520, 32, silver, ms$
END SUB
 
SUB silverball (x, y)
    FOR i = 10 TO 1 STEP -1
        cc = 255 - i * 20
        CircleFill x, y, i, _RGB32(cc, cc, cc)
    NEXT
END SUB
 
FUNCTION rand% (lo%, hi%)
    rand% = INT(RND * (hi% - lo% + 1)) + lo%
END FUNCTION
 
SUB EllipseFill (CX AS INTEGER, CY AS INTEGER, a AS INTEGER, b AS INTEGER, C AS _UNSIGNED LONG)
    ' CX = center x coordinate
    ' CY = center y coordinate
    '  a = semimajor axis
    '  b = semiminor axis
    '  C = fill color
    IF a = 0 OR b = 0 THEN EXIT SUB
    DIM h2 AS _INTEGER64
    DIM w2 AS _INTEGER64
    DIM h2w2 AS _INTEGER64
    DIM x AS INTEGER
    DIM y AS INTEGER
    w2 = a * a
    h2 = b * b
    h2w2 = h2 * w2
    LINE (CX - a, CY)-(CX + a, CY), C, BF
    DO WHILE y < b
        y = y + 1
        x = SQR((h2w2 - y * y * w2) \ h2)
        LINE (CX - x, CY + y)-(CX + x, CY + y), C, BF
        LINE (CX - x, CY - y)-(CX + x, CY - y), C, BF
    LOOP
END SUB
 
SUB CircleFill (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
    ' CX = center x coordinate
    ' CY = center y coordinate
    '  R = radius
    '  C = fill color
    DIM Radius AS INTEGER, RadiusError AS INTEGER
    DIM X AS INTEGER, Y AS INTEGER
    Radius = ABS(R)
    RadiusError = -Radius
    X = Radius
    Y = 0
    IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
    LINE (CX - X, CY)-(CX + X, CY), C, BF
    WHILE X > Y
        RadiusError = RadiusError + Y * 2 + 1
        IF RadiusError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    WEND
END SUB
 
SUB Text (x, y, textHeight, K AS _UNSIGNED LONG, txt$)
    fg = _DEFAULTCOLOR
    cur& = _DEST
    I& = _NEWIMAGE(8 * LEN(txt$), 16, 32)
    _DEST I&
    COLOR K, _RGBA32(0, 0, 0, 0)
    _PRINTSTRING (0, 0), txt$
    mult = textHeight / 16
    xlen = LEN(txt$) * 8 * mult
    _PUTIMAGE (x, y)-STEP(xlen, textHeight), I&, cur&
    COLOR fg
    _FREEIMAGE I&
END SUB
 
 
 

SldBasic had a nice sub for displaying text at a given pixel height. I think I will try to duplicate, Rotozoom is overkill.

EDIT: I have updated this code with a sim of SdlBasic's Text(x, y, height, text$) subroutine to get text at different sizes (and now color parameter.)

johnno56 · « **Reply #5 on:** March 26, 2019, 01:23:28 am »

Nice conversion. I thought it was quite sneaky how, after I accumulated about 200 points, the bat (which looks like a long loaf of bread) turned into a hamburger bun... Cool

FellippeHeitor · « **Reply #6 on:** March 26, 2019, 09:34:03 am »

Cool, version bplus, thanks for sharing! Love the 3d blocks too!

@johnno56 it does indeed look like a loaf of bread :-)

bplus · « **Reply #7 on:** March 26, 2019, 10:12:15 am »

:D yep! Loaf of bread and hamburger bun! Ha! that paddle ain't half what it used to be when you hit the first red brick!
But I like how silver ball sinks into the bread a little before bouncing back out.

I have updated the code with a sim of SdlBasic's Text() routine that allows text to be sized. This is actually the toolbox routine I wanted to make before I got Rotozoom involved for rotations.

And instead of tracking dx, dy of ball, it tracks mouse position.
I have noticed when I play the game, that I am constantly moving the mouse outside the screen boundary getting the paddle stuck, so maybe by tracking mouse / paddle x, y on score board, will help warn the player.

bplus · « **Reply #8 on:** March 26, 2019, 10:40:19 am »

Oh, I have to say, Fellippes random fill of blocks makes for a much more entertaining knock out of the remaining bricks!

It would be nice to have that aspect and still keep games fair for scoring between players which I think the original game was doing. I thought the game needed more paddle control so players could have a chance to direct where the ball goes after contact with paddle.

FellippeHeitor · « **Reply #9 on:** March 26, 2019, 10:46:21 am »

Since I can't stop tweaking this, here's the latest iteration of my breakout clone (I'm calling it Blockout for now):

- I've built in a particle system which allows for some cool visual additions.
- Three types of blocks: regular, hit twice and unbreakable.
- Power-ups: you get a Fireball (allows destroying "hit twice" blocks at once), Shooter, Magnetic paddle, Breakthrough, Stretch Paddle.
- Power-ups show up when you destroy certain blocks. You must catch them to activate them.

Code: QB64: [Select]

CONST true = -1, false = 0
 
RANDOMIZE TIMER
 
DIM gameArea AS LONG
gameArea = _NEWIMAGE(400, 500, 32)
SCREEN gameArea
_TITLE "Blockout"
_PRINTMODE _KEEPBACKGROUND
_ALLOWFULLSCREEN _STRETCH , _OFF
 
TYPE Block
    x AS INTEGER
    y AS INTEGER
    c AS _UNSIGNED LONG
    state AS _BYTE
    special AS _BYTE
    kind AS _BYTE
END TYPE
 
TYPE Ball
    x AS SINGLE
    y AS SINGLE
    c AS _UNSIGNED LONG
    radius AS INTEGER
    state AS _BYTE
    xDir AS _BYTE
    yDir AS _BYTE
    xVel AS SINGLE
    yVel AS SINGLE
END TYPE
 
TYPE Particle
    x AS SINGLE
    y AS SINGLE
    xAcc AS SINGLE
    yAcc AS SINGLE
    xVel AS SINGLE
    yVel AS SINGLE
    r AS _UNSIGNED _BYTE
    g AS _UNSIGNED _BYTE
    b AS _UNSIGNED _BYTE
    state AS _BYTE
    size AS INTEGER
    lifeSpan AS SINGLE
    birth AS SINGLE
    special AS _BYTE
    kind AS _BYTE
END TYPE
 
TYPE Special
    start AS SINGLE
    span AS INTEGER
END TYPE
 
CONST gravity = .03
 
CONST blockWidth = 50
CONST blockHeight = 25
CONST paddleHeight = 10
 
CONST round = 0
CONST square = 1
CONST specialPower = 2
 
CONST left = -1
CONST right = 1
CONST up = -1
CONST down = 1
 
CONST regular = 0
CONST hitTwice = 1
CONST unbreakable = 2
 
CONST bullet = 1
 
DIM SHARED block(1 TO 80) AS Block, ball AS Ball
DIM SHARED particle(1 TO 10000) AS Particle
DIM SHARED win AS _BYTE, quit AS STRING * 1
DIM SHARED paddleX AS INTEGER, paddleY AS INTEGER
DIM SHARED paddleWidth AS SINGLE, magneticOffset AS INTEGER
DIM SHARED score AS INTEGER, lives AS INTEGER
DIM SHARED paused AS _BYTE, stillImage&
 
DIM SHARED electricColor(1 TO 2) AS _UNSIGNED LONG
electricColor(1) = _RGB32(255)
electricColor(2) = _RGB32(50, 211, 255)
 
CONST FireBall = 1
CONST Shooter = 2
CONST BreakThrough = 3
CONST Magnetic = 4
CONST StretchPaddle = 5
CONST StretchPaddle2 = 6
CONST totalSpecialPowers = 6
 
DIM SHARED special(1 TO totalSpecialPowers) AS Special
 
FOR i = 1 TO totalSpecialPowers
    special(i).span = 15
NEXT
 
CONST defaultPaddleWidth = 100
 
paddleY = _HEIGHT - blockHeight - paddleHeight - 1
 
DO
    IF lives = 0 THEN score = 0: lives = 3
    win = false
    paused = false
    generateBlocks
    paddleWidth = defaultPaddleWidth
    ball.state = false
    ball.c = _RGB32(161, 161, 155)
    ball.radius = 5
    ball.xDir = right
    ball.yDir = up
    ball.xVel = 3
    ball.yVel = 3
    FOR i = 1 TO totalSpecialPowers
        special(i).start = 0
    NEXT
    magneticOffset = paddleWidth / 2
 
    FOR i = 1 TO UBOUND(particle)
        resetParticle particle(i)
    NEXT
 
    _MOUSEHIDE
 
    DO
        k& = _KEYHIT
        'IF k& = ASC("s") THEN special(Shooter).start = TIMER
        'IF k& = ASC("m") THEN special(Magnetic).start = TIMER
        'IF k& = ASC("b") THEN special(BreakThrough).start = TIMER
        'IF k& = ASC("f") THEN special(FireBall).start = TIMER
        'IF k& = ASC("p") THEN special(StretchPaddle).start = TIMER
        'IF k& = ASC("P") THEN special(StretchPaddle2).start = TIMER
        'IF k& = ASC("r") THEN EXIT DO
 
        noFocus%% = lostFocus
        IF (paused = true AND k& = 13) OR k& = 27 OR noFocus%% THEN
            IF paused THEN
                _FREEIMAGE stillImage&
                paused = false
                showFullScreenMessage%% = false
                pauseDiff = TIMER - pauseStart
                FOR i = 1 TO totalSpecialPowers
                    IF special(i).start > 0 THEN
                        special(i).start = special(i).start + pauseDiff
                    END IF
                NEXT
                FOR i = 1 TO UBOUND(particle)
                    IF particle(i).birth > 0 THEN
                        particle(i).birth = particle(i).birth + pauseDiff
                    END IF
                NEXT
            ELSE
                paused = true
                IF noFocus%% THEN showFullScreenMessage%% = true
                pauseStart = TIMER
                stillImage& = _COPYIMAGE(0)
            END IF
        END IF
 
        IF paused THEN
            _PUTIMAGE , stillImage&
            m$ = "Paused (ENTER to continue)"
            COLOR _RGB32(0)
            _PRINTSTRING ((_WIDTH - _PRINTWIDTH(m$)) / 2 + 1, (_HEIGHT - _FONTHEIGHT) / 2 + 1 + _FONTHEIGHT), m$
            COLOR _RGB32(255)
            _PRINTSTRING ((_WIDTH - _PRINTWIDTH(m$)) / 2, (_HEIGHT - _FONTHEIGHT) / 2 + _FONTHEIGHT), m$
 
            IF showFullScreenMessage%% THEN
                m$ = "(Hit Alt+Enter to switch to fullscreen)"
                COLOR _RGB32(0)
                _PRINTSTRING ((_WIDTH - _PRINTWIDTH(m$)) / 2 + 1, (_HEIGHT - _FONTHEIGHT) / 2 + 1 + _FONTHEIGHT * 2), m$
                COLOR _RGB32(255)
                _PRINTSTRING ((_WIDTH - _PRINTWIDTH(m$)) / 2, (_HEIGHT - _FONTHEIGHT) / 2 + _FONTHEIGHT * 2), m$
            END IF
        ELSE
            IF TIMER - special(BreakThrough).start < special(BreakThrough).span THEN
                alpha = map(ball.xVel, 3, 6, 80, 30)
            ELSE
                alpha = 255
            END IF
            LINE (0, 0)-(_WIDTH, _HEIGHT), _RGBA32(0, 0, 0, alpha), BF
 
            showBlocks
            doPaddle
            doBall
            doParticles
 
            m$ = "Score:" + STR$(score) + " Lives:" + STR$(lives)
            COLOR _RGB32(0)
            _PRINTSTRING (1, 1), m$
            COLOR _RGB32(255)
            _PRINTSTRING (0, 0), m$
 
            'IF TIMER - special(FireBall).start < special(FireBall).span THEN
            '    _PRINTSTRING (0, 350), "fireball: " + STR$(INT(TIMER - special(FireBall).start))
            'END IF
 
            'IF TIMER - special(BreakThrough).start < special(BreakThrough).span THEN
            '    _PRINTSTRING (0, 370), "breakthrough: " + STR$(INT(TIMER - special(BreakThrough).start))
            'END IF
 
            'IF TIMER - special(Shooter).start < special(Shooter).span THEN
            '    _PRINTSTRING (0, 388), "shooter: " + STR$(INT(TIMER - special(Shooter).start))
            'END IF
 
            'IF TIMER - special(Magnetic).start < special(Magnetic).span THEN
            '    _PRINTSTRING (0, 406), "magnetic: " + STR$(INT(TIMER - special(Magnetic).start))
            'END IF
 
            IF TIMER - special(StretchPaddle).start < special(StretchPaddle).span THEN
                '_PRINTSTRING (0, 422), "stretch: " + STR$(INT(TIMER - special(StretchPaddle).start))
                paddleWidth = defaultPaddleWidth * 1.5
            ELSE
                paddleWidth = defaultPaddleWidth
            END IF
 
            IF TIMER - special(StretchPaddle2).start < special(StretchPaddle2).span THEN
                '_PRINTSTRING (0, 438), "stretch2: " + STR$(INT(TIMER - special(StretchPaddle2).start))
                paddleWidth = defaultPaddleWidth * 2
            ELSE
                IF TIMER - special(StretchPaddle).start > special(StretchPaddle).span OR special(StretchPaddle).start = 0 THEN
                    paddleWidth = defaultPaddleWidth
                END IF
            END IF
 
        END IF
 
        _DISPLAY
        _LIMIT 60
    LOOP UNTIL win OR lives = 0
 
    _MOUSESHOW
 
    CLS
    IF win THEN
        PRINT "Good job, you win."
        PRINT "Continue (y/n)?"
    ELSE
        PRINT "You lose."
        PRINT "Restart (y/n)?"
    END IF
 
    _AUTODISPLAY
    _KEYCLEAR
 
    DO
        quit = LCASE$(INPUT$(1))
    LOOP UNTIL quit = "y" OR quit = "n"
 
LOOP WHILE quit = "y"
 
SYSTEM
 
FUNCTION lostFocus%%
    STATIC Focused AS _BYTE
 
    IF _WINDOWHASFOCUS = false THEN
        IF Focused THEN
            Focused = false
            lostFocus%% = true
        END IF
    ELSE
        Focused = true
    END IF
END FUNCTION
 
SUB doParticles
    DIM thisColor AS _UNSIGNED LONG, alpha AS _UNSIGNED _BYTE
 
    FOR i = 1 TO UBOUND(particle)
        IF particle(i).state = false THEN _CONTINUE
        IF particle(i).lifeSpan > 0 AND TIMER - particle(i).birth > particle(i).lifeSpan THEN particle(i).state = false: _CONTINUE
 
        'move
        particle(i).xVel = particle(i).xVel + particle(i).xAcc
        particle(i).yVel = particle(i).yVel + particle(i).yAcc + gravity
        particle(i).x = particle(i).x + particle(i).xVel
        particle(i).y = particle(i).y + particle(i).yVel
 
        IF particle(i).kind = bullet THEN
            l = newParticle
            IF l THEN
                particle(l).r = 222 + (RND * 30)
                particle(l).g = 100 + (RND * 70)
                particle(l).x = particle(i).x
                particle(l).y = particle(i).y
                particle(l).lifeSpan = 0.05
            END IF
        END IF
 
        'check visibility
        IF particle(i).x - particle(i).size / 2 < 0 OR particle(i).x + particle(i).size / 2 > _WIDTH OR particle(i).y - particle(i).size / 2 < 0 OR particle(i).y + particle(i).size / 2 > _HEIGHT THEN
            particle(i).state = false
            _CONTINUE
        END IF
 
        'show
        IF particle(i).lifeSpan > 0 THEN
            alpha = map(TIMER - particle(i).birth, 0, particle(i).lifeSpan, 255, 0)
        ELSE
            alpha = 255
        END IF
 
        thisColor = _RGBA32(particle(i).r, particle(i).g, particle(i).b, alpha)
 
        IF particle(i).size > 0 THEN
            SELECT CASE particle(i).kind
                CASE round, bullet
                    CircleFill particle(i).x, particle(i).y, particle(i).size, thisColor
                CASE square
                    LINE (particle(i).x - size / 2, particle(i).y - size / 2)-STEP(particle(i).size, particle(i).size), thisColor, BF
                CASE specialPower
                    SELECT CASE particle(i).special
                        'CONST FireBall = 1
                        'CONST Shooter = 2
                        'CONST BreakThrough = 3
                        'CONST Magnetic = 4
                        'CONST StretchPaddle = 5
                        'CONST StretchPaddle2 = 6
                        CASE FireBall
                            FOR j = 1 TO 10
                                l = newParticle
                                IF l = 0 THEN EXIT FOR
                                particle(l).r = 222 + (RND * 30)
                                particle(l).g = 100 + (RND * 70)
                                particle(l).x = particle(i).x + COS(RND * _PI(2)) * (ball.radius * RND)
                                particle(l).y = particle(i).y + SIN(RND * _PI(2)) * (ball.radius * RND)
                                particle(l).lifeSpan = .1
                            NEXT
                            CircleFill particle(i).x, particle(i).y, particle(i).size, _RGBA32(222 + (RND * 30), 100 + (RND * 70), 0, RND * 255)
                            specialDrawn = true
                        CASE Shooter
                            LINE (particle(i).x - 7, particle(i).y + 1)-STEP(15, 8), _RGB32(89, 161, 255), BF
                            CircleFill particle(i).x - 7, particle(i).y + 5, 4, _RGB32(194, 89, 61)
                            CircleFill particle(i).x - 7, particle(i).y + 2, 3, _RGB32(194, 133, 61)
                            CircleFill particle(i).x - 7, particle(i).y, 3, _RGB32(194, 188, 61)
 
                            l = newParticle
                            IF l > 0 THEN
                                particle(l).r = 222 + (RND * 30)
                                particle(l).g = 100 + (RND * 70)
                                particle(l).x = particle(i).x - 7
                                particle(l).y = particle(i).y
                                particle(l).lifeSpan = .1
                            END IF
 
                            specialDrawn = true
                        CASE BreakThrough
                            CircleFill particle(i).x - 8, particle(i).y + 8, 3, _RGB32(177, 30)
                            CircleFill particle(i).x - 6, particle(i).y + 6, 3, _RGB32(177, 50)
                            CircleFill particle(i).x - 3, particle(i).y + 3, 4, _RGB32(177, 100)
                            CircleFill particle(i).x, particle(i).y, 4, _RGB32(177, 200)
                            specialDrawn = true
                        CASE Magnetic
                            FOR j = 1 TO 2
                                PSET (particle(i).x + COS(0) * (particle(i).size + particle(i).size * RND), particle(i).y + SIN(0) * (particle(i).size + particle(i).size * RND)), electricColor(j)
                                FOR k = 0 TO _PI(2) STEP .2
                                    LINE -(particle(i).x + COS(k) * (particle(i).size + particle(i).size * RND), particle(i).y + SIN(k) * (particle(i).size + particle(i).size * RND)), electricColor(j)
                                NEXT
                                LINE -(particle(i).x + COS(0) * (particle(i).size + particle(i).size * RND), particle(i).y + SIN(0) * (particle(i).size + particle(i).size * RND)), electricColor(j)
                            NEXT
                            specialDrawn = true
                        CASE StretchPaddle
                            LINE (particle(i).x - 7, particle(i).y + 1)-STEP(15, 8), _RGB32(89, 161, 255), BF
                            CircleFill particle(i).x - 7, particle(i).y + 5, 4, _RGB32(194, 89, 61)
                            _FONT 8
                            COLOR _RGB32(255, 150)
                            _PRINTSTRING (particle(i).x - 16, particle(i).y - 10), "1.5x"
                            _FONT 16
                            specialDrawn = true
                        CASE StretchPaddle2
                            LINE (particle(i).x - 3, particle(i).y + 1)-STEP(15, 8), _RGB32(89, 161, 255), BF
                            CircleFill particle(i).x - 3, particle(i).y + 5, 4, _RGB32(194, 89, 61)
                            _FONT 8
                            COLOR _RGB32(255, 150)
                            _PRINTSTRING (particle(i).x + 8, particle(i).y - 10), "2x"
                            _FONT 16
                            specialDrawn = true
                    END SELECT
            END SELECT
        ELSE
            PSET (particle(i).x, particle(i).y), thisColor
        END IF
 
        'check collision with paddle if this particle contains a special power
        IF particle(i).special THEN
            'IF specialDrawn = false THEN
            '    m$ = LTRIM$(STR$(particle(i).special))
            '    COLOR _RGB32(0)
            '    _PRINTSTRING (particle(i).x + 1, particle(i).y + 1), m$
            '    COLOR _RGB32(255)
            '    _PRINTSTRING (particle(i).x, particle(i).y), m$
            'END IF
            IF particle(i).x - particle(i).size / 2 > paddleX AND particle(i).x + particle(i).size / 2 < paddleX + paddleWidth AND particle(i).y + particle(i).size / 2 >= paddleY THEN
                particle(i).state = false
                special(particle(i).special).start = TIMER
            END IF
        END IF
 
        'check collision with blocks if this particle is a bullet
        IF particle(i).kind = bullet THEN
            FOR j = 1 TO 80
                IF block(j).state = false THEN _CONTINUE
                IF particle(i).x > block(j).x AND particle(i).x < block(j).x + blockWidth AND particle(i).y < block(j).y + blockHeight THEN
                    destroyBlock j, false
                    IF TIMER - special(BreakThrough).start > special(BreakThrough).span OR special(BreakThrough).start = 0 THEN
                        particle(i).state = false
                    END IF
                    EXIT FOR
                END IF
            NEXT
        END IF
    NEXT
END SUB
 
SUB resetParticle (this AS Particle)
    DIM empty AS Particle
    this = empty
END SUB
 
SUB generateBlocks
    FOR i = 1 TO 8
        FOR j = 1 TO 10
            b = b + 1
            block(b).x = (i - 1) * blockWidth
            block(b).y = (j - 1) * blockHeight
            minRGB = 50
            DO
                red = 255 * RND
                green = 255 * RND
                blue = 255 * RND
            LOOP UNTIL red > minRGB AND green > minRGB AND blue > minRGB
            block(b).c = _RGB32(red, green, blue)
            block(b).state = RND
            r = RND * 1000
            IF r > 150 AND r < 200 THEN
                block(b).special = RND * totalSpecialPowers
            END IF
 
            r = RND * 1000
            IF r > 150 AND r < 200 THEN
                block(b).kind = RND * 2
            END IF
        NEXT
    NEXT
END SUB
 
SUB showBlocks
    FOR i = 1 TO 80
        IF block(i).state = false THEN _CONTINUE
        activeBlocks = activeBlocks + 1
        IF block(i).kind <> unbreakable THEN
            LINE (block(i).x, block(i).y)-STEP(blockWidth - 1, blockHeight - 1), block(i).c, BF
        END IF
 
        IF block(i).kind = hitTwice THEN
            FOR x = block(i).x TO block(i).x + blockWidth - 1 STEP 5
                LINE (x, block(i).y)-(x, block(i).y + blockHeight - 1), _RGB32(188)
            NEXT
        ELSEIF block(i).kind = unbreakable THEN
            activeBlocks = activeBlocks - 1
            FOR x = block(i).x TO block(i).x + blockWidth - 1 STEP 5
                LINE (x, block(i).y)-(x, block(i).y + blockHeight - 1), _RGB32(72)
            NEXT
            FOR y = block(i).y TO block(i).y + blockHeight - 1 STEP 5
                LINE (block(i).x, y)-(block(i).x + blockWidth - 1, y), _RGB32(72)
            NEXT
        END IF
 
        LINE (block(i).x, block(i).y)-STEP(blockWidth - 1, blockHeight - 1), _RGB32(255), B
        LINE (block(i).x + 1, block(i).y + 1)-STEP(blockWidth - 3, blockHeight - 3), _RGB32(0), B
 
        IF block(i).special THEN
            'COLOR _RGB32(0)
            '_PRINTSTRING (block(i).x + 1, block(i).y + 1), STR$(block(i).special)
            'COLOR _RGB32(255)
            '_PRINTSTRING (block(i).x, block(i).y), STR$(block(i).special)
            FOR j = 1 TO 5
                LINE (block(i).x + j, block(i).y + j)-STEP(blockWidth - j * 2, blockHeight - j * 2), _RGB32(255, 166, 0), B
                LINE (block(i).x + j, block(i).y + j)-STEP(blockWidth - j * 2, blockHeight - j * 2), _RGB32(255, 238, 0), B
            NEXT
        END IF
    NEXT
    win = (activeBlocks = 0)
END SUB
 
SUB doPaddle
    STATIC lastX AS INTEGER
    WHILE _MOUSEINPUT: WEND
 
    IF _MOUSEX <> lastX THEN
        lastX = _MOUSEX
        paddleX = _MOUSEX - paddleWidth / 2
    END IF
 
    IF _KEYDOWN(19200) THEN paddleX = paddleX - 5
    IF _KEYDOWN(19712) THEN paddleX = paddleX + 5
 
    IF paddleX < 0 THEN paddleX = 0
    IF paddleX + paddleWidth > _WIDTH - 1 THEN paddleX = _WIDTH - 1 - paddleWidth
 
    LINE (paddleX + paddleHeight / 2, paddleY)-STEP(paddleWidth - paddleHeight, paddleHeight), _RGB32(89, 161, 255), BF
    CircleFill paddleX + paddleHeight / 2, paddleY + paddleHeight / 2, paddleHeight / 2, _RGB32(194, 89, 61)
    CircleFill paddleX + paddleWidth - paddleHeight / 2, paddleY + paddleHeight / 2, paddleHeight / 2, _RGB32(194, 89, 61)
 
    IF TIMER - special(Magnetic).start < special(Magnetic).span THEN
        FOR j = 1 TO 2
            PSET (paddleX + paddleHeight / 2, paddleY), electricColor(j)
            FOR i = paddleX + paddleHeight TO paddleX + paddleWidth - paddleHeight STEP paddleWidth / 10
                LINE -(i, paddleY - (RND * 10)), electricColor(j)
            NEXT
            LINE -(paddleX + paddleWidth - paddleHeight / 2, paddleY), electricColor(j)
 
        NEXT
    END IF
 
    IF _MOUSEBUTTON(1) OR _KEYDOWN(13) THEN ball.state = true
 
    IF _MOUSEBUTTON(1) THEN
        STATIC mouseWasDown AS _BYTE
        mouseWasDown = true
    END IF
 
    IF TIMER - special(Shooter).start < special(Shooter).span THEN
        CircleFill paddleX + paddleHeight / 2, paddleY, paddleHeight / 3, _RGB32(194, 133, 61)
        CircleFill paddleX + paddleWidth - paddleHeight / 2, paddleY, paddleHeight / 3, _RGB32(194, 133, 61)
 
        CircleFill paddleX + paddleHeight / 2, paddleY - paddleHeight / 4, paddleHeight / 4, _RGB32(194, 188, 61)
        CircleFill paddleX + paddleWidth - paddleHeight / 2, paddleY - paddleHeight / 4, paddleHeight / 4, _RGB32(194, 188, 61)
 
        IF _MOUSEBUTTON(1) = false AND mouseWasDown THEN
            mouseWasDown = false
 
            FOR i = 1 TO 2
                l = newParticle
                particle(l).r = 100
                particle(l).g = 100
                particle(l).b = 100
                IF i = 1 THEN particle(l).x = paddleX + paddleHeight / 2 ELSE particle(l).x = paddleX + paddleWidth - paddleHeight / 2
                particle(l).y = paddleY
                particle(l).yVel = -4.5
                particle(l).yAcc = -gravity * 1.5
                particle(l).size = 2
                particle(l).kind = bullet
            NEXT
        END IF
    END IF
 
END SUB
 
SUB doBall
    IF ball.state = false THEN
        ball.x = paddleX + magneticOffset
        ball.y = paddleY - (ball.radius)
    ELSE
        ball.x = ball.x + ball.xDir * ball.xVel
        ball.y = ball.y + ball.yDir * ball.yVel
 
        ballCollision
    END IF
 
    IF TIMER - special(FireBall).start < special(FireBall).span THEN
        FOR j = 1 TO 10
            l = newParticle
            IF l = 0 THEN EXIT FOR
            particle(l).r = 222 + (RND * 30)
            particle(l).g = 100 + (RND * 70)
            particle(l).x = ball.x + COS(RND * _PI(2)) * (ball.radius * RND)
            particle(l).y = ball.y + SIN(RND * _PI(2)) * (ball.radius * RND)
            particle(l).lifeSpan = RND
        NEXT
    END IF
 
    CircleFill ball.x, ball.y, ball.radius, ball.c
END SUB
 
FUNCTION newParticle&
    FOR i = 1 TO UBOUND(particle)
        IF particle(i).state = false THEN
            newParticle& = i
            resetParticle particle(i)
            particle(i).state = true
            particle(i).birth = TIMER
            EXIT FUNCTION
        END IF
    NEXT
END FUNCTION
 
SUB ballCollision
    'paddle
    IF ball.x > paddleX AND ball.x < paddleX + paddleWidth AND ball.y > paddleY AND ball.y < paddleY + paddleHeight THEN
        IF TIMER - special(Magnetic).start < special(Magnetic).span THEN
            ball.state = false
            magneticOffset = ball.x - paddleX
        END IF
 
        IF ball.x < paddleX + paddleWidth / 2 THEN
            ball.xDir = left
            ball.xVel = map(ball.x, paddleX, paddleX + paddleWidth / 3, 6, 3)
        ELSE
            ball.xDir = right
            ball.xVel = map(ball.x, paddleX + paddleWidth / 3, paddleX + paddleWidth, 3, 6)
        END IF
        IF ball.xVel < 3 THEN ball.xVel = 3
 
        IF ball.yDir = 1 AND ball.y < paddleY + paddleHeight / 2 THEN ball.yDir = -1
        EXIT SUB
    END IF
 
    'blocks
    FOR i = 1 TO 80
        IF block(i).state = false THEN _CONTINUE
        IF ball.x > block(i).x AND ball.x < block(i).x + blockWidth AND ball.y > block(i).y AND ball.y < block(i).y + blockHeight THEN
            destroyBlock i, true
            EXIT SUB
        END IF
    NEXT
 
    'walls
    IF ball.x < ball.radius THEN ball.xDir = right
    IF ball.x > _WIDTH - ball.radius THEN ball.xDir = left
    IF ball.y > _HEIGHT + ball.radius THEN
        lives = lives - 1
        magneticOffset = paddleWidth / 2
        ball.state = false
        ball.xDir = right
        ball.yDir = up
        ball.xVel = 3
        ball.yVel = 3
    END IF
    IF ball.y < 0 THEN ball.yDir = down
END SUB
 
SUB destroyBlock (i AS LONG, ballHit AS _BYTE)
    SELECT CASE block(i).kind
        CASE regular
            block(i).state = false
 
            IF TIMER - special(BreakThrough).start < special(BreakThrough).span THEN
                maxJ = 10
                maxK = 3
                FOR j = 1 TO maxJ
                    FOR k = 1 TO maxK
                        l = newParticle
                        IF l = 0 THEN EXIT FOR
                        a = RND * 1000
                        IF a < 100 THEN
                            particle(l).r = _RED32(block(i).c)
                            particle(l).g = _GREEN32(block(i).c)
                            particle(l).b = _BLUE32(block(i).c)
                        ELSE
                            particle(l).r = map(a, 0, 1000, 50, 255)
                            particle(l).g = map(a, 0, 1000, 50, 255)
                            particle(l).b = map(a, 0, 1000, 50, 255)
                        END IF
                        particle(l).x = block(i).x + ((blockWidth / maxJ) * (j - 1))
                        particle(l).y = block(i).y + ((blockHeight / maxK) * (k - 1))
                        a = RND
                        IF ball.xDir = right AND ball.yDir = up THEN
                            particle(l).xAcc = COS(map(a, 0, 1, _PI(1.5), _PI(2)))
                            particle(l).yAcc = SIN(map(a, 0, 1, _PI(1.5), _PI(2)))
                        ELSEIF ball.xDir = right AND ball.yDir = down THEN
                            particle(l).xAcc = COS(map(a, 0, 1, 0, _PI(.5)))
                            particle(l).yAcc = SIN(map(a, 0, 1, 0, _PI(.5)))
                        ELSEIF ball.xDir = left AND ball.yDir = up THEN
                            particle(l).xAcc = COS(map(a, 0, 1, _PI, _PI(1.5)))
                            particle(l).yAcc = SIN(map(a, 0, 1, _PI, _PI(1.5)))
                        ELSEIF ball.xDir = left AND ball.yDir = down THEN
                            particle(l).xAcc = COS(map(a, 0, 1, _PI(.5), _PI))
                            particle(l).yAcc = SIN(map(a, 0, 1, _PI(.5), _PI))
                        END IF
                        particle(l).lifeSpan = .5
                        particle(l).size = 1
                    NEXT
                NEXT
            END IF
 
            IF block(i).special THEN
                STATIC lastSpecialGiven AS SINGLE
                IF TIMER - lastSpecialGiven > 3 THEN
                    lastSpecialGiven = TIMER
                    l = newParticle
                    IF l THEN
                        particle(l).size = 6
                        particle(l).x = block(i).x + blockWidth / 2
                        particle(l).y = block(i).y + blockHeight / 2
                        particle(l).r = 255
                        particle(l).g = 255
                        particle(l).b = 255
                        particle(l).kind = specialPower
                        particle(l).special = block(i).special
                    END IF
                END IF
            END IF
 
            points = ((_RED32(block(i).c) + _GREEN32(block(i).c) + _BLUE32(block(i).c)) / 3) / 10
            score = score + points
        CASE hitTwice
            block(i).kind = regular
            IF ballHit THEN
                IF TIMER - special(FireBall).start < special(FireBall).span THEN destroyBlock i, ballHit
            END IF
        CASE unbreakable
            'check if the ball is trapped between two unbreakable blocks
            STATIC lastBlock(1 TO 3) AS Block
            lastBlock(3) = lastBlock(2)
            lastBlock(2) = lastBlock(1)
            lastBlock(1) = block(i)
            IF (lastBlock(1).x = lastBlock(3).x AND lastBlock(1).y = lastBlock(3).y) OR _
               lastBlock(1).x = lastBlock(2).x AND lastBlock(1).y = lastBlock(2).y THEN
                IF ball.xVel > 4.5 AND ball.xVel < 6 THEN
                    ball.xVel = 6
                ELSEIF ball.xVel = 6 THEN
                    ball.xVel = 5
                END IF
 
                IF ball.xVel <= 4.5 AND ball.xVel > 3 THEN
                    ball.xVel = 3
                ELSEIF ball.xVel = 3 THEN
                    ball.xVel = 4
                END IF
            END IF
    END SELECT
 
    IF ballHit THEN
        IF (block(i).kind = unbreakable OR block(i).kind = hitTwice) THEN
            FOR j = 1 TO map(ball.xVel, 3, 6, 10, 30)
                l = newParticle
                IF l = 0 THEN EXIT FOR
                particle(l).r = 222 + (RND * 30)
                particle(l).g = 100 + (RND * 70)
                particle(l).x = ball.x + COS(RND * _PI(2)) * (ball.radius * RND)
                particle(l).y = ball.y + SIN(RND * _PI(2)) * (ball.radius * RND)
                particle(l).lifeSpan = RND
 
                a = RND
                IF ball.xDir = right AND ball.yDir = up THEN
                    particle(l).xVel = COS(map(a, 0, 1, _PI(1.5), _PI(2)))
                    particle(l).yVel = SIN(map(a, 0, 1, _PI(1.5), _PI(2)))
                ELSEIF ball.xDir = right AND ball.yDir = down THEN
                    particle(l).xVel = COS(map(a, 0, 1, 0, _PI(.5)))
                    particle(l).yVel = SIN(map(a, 0, 1, 0, _PI(.5)))
                ELSEIF ball.xDir = left AND ball.yDir = up THEN
                    particle(l).xVel = COS(map(a, 0, 1, _PI, _PI(1.5)))
                    particle(l).yVel = SIN(map(a, 0, 1, _PI, _PI(1.5)))
                ELSEIF ball.xDir = left AND ball.yDir = down THEN
                    particle(l).xVel = COS(map(a, 0, 1, _PI(.5), _PI))
                    particle(l).yVel = SIN(map(a, 0, 1, _PI(.5), _PI))
                END IF
            NEXT
        END IF
 
        IF TIMER - special(BreakThrough).start > special(BreakThrough).span OR special(BreakThrough).start = 0 THEN
            IF ball.x < block(i).x + blockWidth / 2 THEN ball.xDir = left ELSE ball.xDir = right
            IF ball.y < block(i).y + blockHeight / 2 THEN ball.yDir = up ELSE ball.yDir = down
        END IF
    END IF
END SUB
 
SUB CircleFill (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
    ' CX = center x coordinate
    ' CY = center y coordinate
    '  R = radius
    '  C = fill color
    DIM Radius AS INTEGER, RadiusError AS INTEGER
    DIM X AS INTEGER, Y AS INTEGER
    Radius = ABS(R)
    RadiusError = -Radius
    X = Radius
    Y = 0
    IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
    LINE (CX - X, CY)-(CX + X, CY), C, BF
    WHILE X > Y
        RadiusError = RadiusError + Y * 2 + 1
        IF RadiusError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    WEND
END SUB
 
FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
    map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
END FUNCTION
 

Petr · « **Reply #10 on:** March 26, 2019, 10:47:04 am »

Very nice work, Fellippe and BPlus!

FellippeHeitor · « **Reply #11 on:** March 26, 2019, 12:07:43 pm »

Quote from: Petr on March 26, 2019, 10:47:04 am

Very nice work, Fellippe and BPlus!

Thanks, Petr!

And here's the fireball:

FellippeHeitor · « **Reply #12 on:** March 26, 2019, 12:45:14 pm »

Quote from: bplus on March 26, 2019, 10:40:19 am

I thought the game needed more paddle control so players could have a chance to direct where the ball goes after contact with paddle.

I hope you'll enjoy the magnetic paddle power-up I've added.

bplus · « **Reply #13 on:** March 26, 2019, 01:14:48 pm »

Wow! marvelous variations Fellippe.

FellippeHeitor · « **Reply #14 on:** March 26, 2019, 01:24:42 pm »

Thanks! I had never actually played the original game and I cut my teeth on the format with a game called DXBall, back in Windows 98 days. That's where the inspiration for this one comes from.

News:

Author Topic: Breakout (Read 7318 times)

FellippeHeitor

Breakout

qb4ever

Re: Breakout

bplus

Re: Breakout

johnno56

Re: Breakout

bplus

Re: Breakout

johnno56

Re: Breakout

FellippeHeitor

Re: Breakout

bplus

Re: Breakout

bplus

Re: Breakout

FellippeHeitor

Re: Breakout

Petr

Re: Breakout

FellippeHeitor

Re: Breakout

FellippeHeitor

Re: Breakout

bplus

Re: Breakout

FellippeHeitor

Re: Breakout