Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Make5 - Board clearing puzzle game
#1
Make5.bas is a small puzzle game where you try to clear the board by removing pieces of the same color.  You remove them by making combinations of 5 or more pieces of the same color in the same row or column.  Click on the ball to move, then click where you want to move it to.  Only large balls can be moved.

Points are scored for pieces that you clear off the board.  When the board gets full and no possible moves left then the game is over.  See how many points you can make before it's over.

This is an updated and enhanced version of the one posted at the old forum.  This new one auto sizes to fit users desktop (not hard coded to a small resolution), the Hi Score is now saved to file, matches are now found both ways at the same time (row+col), and the board and pieces have a better look.

- Dav

Code: (Select All)
'=========
'MAKE5.bas v2.1
'=========
'A board clearing puzzle game.
'Clear the board of balls and score points.
'Make rows/colums of 5 or more of same color.
'Coded by Dav, JUL/2023 for QB64-Phoenix Edition.

'New for version 2.1:
'
'                    - Added _ICON call for Linux users.
'                      (Needed for QB64PE icon to be used by program)
'                    - Removed slow _MOUSEINPUT polling for faster method.
'                    - Because mouse is faster, the board size can now be
'                      bigger on larger desktops (not capped out as before).

'===========
'HOW TO PLAY:
'===========

'Colored balls will appear randomly on the playing board.
'Move bigger balls of same color next to each other to form
'rows and columns of the same color. Make a row/column of 5
'or more of same color to erase them and score points.

'Three new smaller balls will appear after every move.
'The smaller balls will grow into big ones on the next move.
'You may move the big balls on top of the smaller ones.

'The goal is to see how many points you can score before
'running out of board space, in which the game will end.

'High score is save to a 'make5.dat' file.

'You can press SPACE to restart game.

'=========================================================

_ICON

RANDOMIZE TIMER

'This game was originally designed in 600x650.
'Here's a way to adapt that code to adjust larger screens.
'The df is a small display fix for autosizing to desktop.
'The .80 means it will size up to 80% of desktop height
'We will add a *df to any x/y used in a command.
DIM SHARED df: df = (_DESKTOPHEIGHT / 600) * .80

'set original screen size, but use the df value.
SCREEN _NEWIMAGE(600 * df, 650 * df, 32)

DO: LOOP UNTIL _SCREENEXISTS
_TITLE "Make5 Puzzle"

'=== define board info
DIM SHARED rows, cols, size, score, hiscore
rows = 9: cols = 9: size = _WIDTH / cols
DIM SHARED box.v(rows * cols), box.s(rows * cols) 'value, size
DIM SHARED box.x(rows * cols), box.y(rows * cols) 'x/y's
DIM SHARED checks(rows * cols) 'extra array for checking
'
'=== load hi score from file
IF _FILEEXISTS("make5.dat") THEN
    scr = FREEFILE
    OPEN "make5.dat" FOR BINARY AS #scr
    hiscore = CVL(INPUT$(4, scr))
    IF hiscore < 0 THEN hiscore = 0 'a failsafe
    CLOSE #scr
END IF

'=======
restart:
'=======

PLAY "MBL32O3CEGEC"

score = 0

'CLS , _RGB(13, 13, 13)

bc = 1 'counter
FOR c = 1 TO cols
    FOR r = 1 TO rows
        x = (r * size) '(df is already computed in the 'size')
        y = (50 * df) + (c * size)
        box.x(bc) = x - size
        box.y(bc) = y - size
        box.v(bc) = 0 'zero means no color, empty box
        box.s(bc) = 1 ' 1 = small size piece
        bc = bc + 1
    NEXT
NEXT

MakeNewBalls 3, 1 'put 3 big balls on board
MakeNewBalls 3, 2 'put 3 small balls on board

'====
main:
'====

selected = 0

UpdateBoard

second: 'Go back here when making second choice
_DISPLAY

DO

    'wait until mouse button up to continue
    WHILE _MOUSEBUTTON(1) <> 0: n = _MOUSEINPUT: WEND

    WHILE _MOUSEINPUT: WEND

    'highlight box when a box is selected
    IF selected = 1 THEN
        LINE (box.x(t) + 2, box.y(t) + 2)-(box.x(t) + size - 2, box.y(t) + size - 2), _RGB(RND * 255, RND * 255, RND * 255), B
        LINE (box.x(t) + 3, box.y(t) + 3)-(box.x(t) + size - 3, box.y(t) + size - 3), _RGB(RND * 255, RND * 255, RND * 255), B
        LINE (box.x(t) + 4, box.y(t) + 4)-(box.x(t) + size - 4, box.y(t) + size - 4), _RGB(RND * 255, RND * 255, RND * 255), B
        _DISPLAY
    END IF


    'If user clicked mouse
    IF _MOUSEBUTTON(1) THEN

        'see where they clicked
        mx = _MOUSEX: my = _MOUSEY

        'cycle through all Check blocks...
        FOR t = 1 TO (rows * cols)

            'Block loction...
            tx = box.x(t): tx2 = box.x(t) + size
            ty = box.y(t): ty2 = box.y(t) + size

            'if clicked on a box clicked
            IF mx >= tx AND mx <= tx2 THEN
                IF my >= ty AND my <= ty2 THEN

                    'if this is a first choice...
                    IF selected = 0 THEN

                        'only select boxes not empty, with big size balls
                        IF box.v(t) <> 0 AND box.s(t) = 2 THEN
                            selected = 1
                            SOUND 3000, .1 'made a select
                            oldt = t
                            oldtv = box.v(t) 'save picked box number color
                            GOTO second 'now get second choice
                        END IF

                    END IF

                    IF selected = 1 THEN 'making second choice

                        'if selected an empty box or small ball
                        IF box.v(t) = 0 OR box.s(t) = 1 THEN

                            'swap 2nd box data
                            box.v(t) = oldtv
                            box.s(t) = 2
                            'erase 1st box data
                            box.v(oldt) = 0
                            box.s(oldt) = 1
                            SOUND 2000, .1
                            UpdateBoard
                            '===============================

                            'Grow small balls
                            FOR d = 1 TO rows * cols
                                IF box.v(d) <> 0 AND box.s(d) = 1 THEN box.s(d) = 2
                            NEXT

                            UpdateBoard

                            'copy current box values into checking array
                            FOR i = 1 TO (rows * cols)
                                checks(i) = box.v(i)
                            NEXT

                            'check Rows for 5 or more done
                            FOR i = 1 TO (rows * cols) STEP 9
                                CheckRow i
                            NEXT

                            'Check Cols for 5 or more
                            FOR i = 1 TO 9
                                CheckCol i
                            NEXT

                            'copy checking values back into box values
                            FOR i = 1 TO (rows * cols)
                                IF checks(i) = 0 THEN
                                    box.v(i) = 0: box.s(i) = 1
                                END IF
                            NEXT

                            'See how many boxes left to use...
                            howmany = 0
                            FOR h = 1 TO rows * cols
                                'empty ones
                                IF box.v(h) = 0 THEN howmany = howmany + 1
                            NEXT

                            'If not enough spaces left, game over
                            IF howmany < 3 THEN
                                LINE (200 * df, 250 * df)-(400 * df, 350 * df), _RGB(0, 0, 0), BF
                                LINE (200 * df, 250 * df)-(400 * df, 350 * df), _RGB(255, 255, 255), B
                                PPRINT 233 * df, 285 * df, 18 * df, _RGB(255, 255, 255), 0, "GAME OVER"
                                PLAY "mbl16o2bagfedc"
                                _DISPLAY: SLEEP 6
                                GOTO restart
                            END IF

                            'make 3 more random small balls
                            MakeNewBalls 3, 1
                            GOTO main

                        ELSE

                            'if clicked on another big ball instead...
                            IF box.s(t) = 2 THEN
                                'clear previous highlighted selection
                                selected = 0
                                UpdateBoard
                                selected = 1
                                oldt = t
                                oldtv = box.v(t) 'save picked box number color
                                SOUND 3000, .1
                                GOTO second
                            END IF

                        END IF

                    END IF

                END IF
            END IF

        NEXT

    END IF

    _DISPLAY

    IF INKEY$ = " " THEN GOTO restart

LOOP

SUB CheckRow (num)

    'space to hold box nums to clear
    REDIM nums(9)

    'found some to clear flag
    rdone = 0

    'set place and num
    rc = 1
    nums(1) = num

    'step through the boxes

    FOR r = (num + 1) TO (num + 8)

        'if this box is same as previous...
        IF box.s(r) = 2 AND box.v(r) = box.v(nums(rc)) THEN
            'store this box value in nums too
            nums(rc + 1) = r
            'increase how many so far
            rc = rc + 1
        ELSE
            'bot same, so reset

            IF rdone = 0 THEN
                'no more, so start over from here
                ERASE nums
                REDIM nums(9)
                rc = 1: nums(1) = r
            ELSE
                'no more can exists on line
                EXIT FOR
            END IF
        END IF

        'if there was 5 or more found
        IF rc >= 5 THEN rdone = 1

    NEXT

    'if group was found, clear
    IF rdone = 1 THEN
        PLAY "mbl32o3cdefga"
        'step through nums values
        FOR d = 1 TO 9
            IF nums(d) <> 0 THEN

                score = score + 55 '55 points per ball

                x = box.x(nums(d)): y = box.y(nums(d))
                LINE (x + 2, y + 2)-(x + size - 2, y + size - 2), _RGB(255, 255, 255), BF
                _DELAY .025: _DISPLAY
                LINE (x + 2, y + 2)-(x + size - 2, y + size - 2), _RGB(64, 64, 64), BF
                _DELAY .025: _DISPLAY
                checks(nums(d)) = 0 'mark checking array
            END IF
        NEXT
    END IF

    ERASE nums

END SUB

SUB CheckCol (num)

    'space to hold box nums to clear
    REDIM nums(9)

    'found some to clear flag
    rdone = 0

    'set place and num
    rc = 1
    nums(1) = num

    'step through the boxes

    FOR r = (num + 9) TO (rows * cols) STEP 9

        'if this box is same as previous...
        IF box.s(r) = 2 AND box.v(r) = box.v(nums(rc)) THEN
            'store this box value in nums too
            nums(rc + 1) = r
            'increase how many so far
            rc = rc + 1
        ELSE
            'bot same, so reset

            IF rdone = 0 THEN
                'no more, so start over from here
                ERASE nums
                REDIM nums(9)
                rc = 1: nums(1) = r
            ELSE
                'no more can exists on line
                EXIT FOR
            END IF
        END IF

        'if there was 5 or more found
        IF rc >= 5 THEN rdone = 1

    NEXT

    'if group was found, clear
    IF rdone = 1 THEN
        PLAY "mbl32o3cdefga"
        'step through nums values
        FOR d = 1 TO 9
            IF nums(d) <> 0 THEN
                score = score + 55 'add to score
                x = box.x(nums(d)): y = box.y(nums(d))
                LINE (x + 2, y + 2)-(x + size - 2, y + size - 2), _RGB(255, 255, 255), BF
                _DELAY .025: _DISPLAY
                LINE (x + 2, y + 2)-(x + size - 2, y + size - 2), _RGB(64, 64, 64), BF
                _DELAY .025: _DISPLAY
                checks(nums(d)) = 0 'mark checking array
            END IF
        NEXT
    END IF

    ERASE nums

END SUB


SUB UpdateBoard

    CLS , _RGB(96, 96, 96)

    PPRINT 20 * df, 14 * df, 15 * df, _RGB(255, 255, 0), 0, "SCORE:" + LTRIM$(STR$(score))
    IF score >= hiscore THEN
        hiscore = score
        SaveScore
    END IF
    PPRINT 475 * df, 14 * df, 15 * df, _RGB(255, 150, 150), 0, "HI:" + LTRIM$(STR$(hiscore))

    PPRINT 222 * df, 12 * df, 24 * df, _RGB(1, 1, 1), 0, "-=MAKE5=-"
    PPRINT 220 * df, 10 * df, 24 * df, _RGB(255, 255, 255), 0, "-=MAKE5=-"

    '=== draw board based on box values
    bc = 1 'counter
    FOR cl = 1 TO cols
        FOR ro = 1 TO rows
            '=== if empty box
            IF box.v(bc) = 0 THEN
                LINE (box.x(bc) + 2, box.y(bc) + 2)-(box.x(bc) + size - 2, box.y(bc) + size - 2), _RGB(32, 32, 32), BF
            ELSE
                LINE (box.x(bc) + 2, box.y(bc) + 2)-(box.x(bc) + size - 2, box.y(bc) + size - 2), _RGB(32, 32, 32), BF
                '=== draw color ball
                x2 = box.x(bc) + (size / 2) 'find middle of box
                y2 = box.y(bc) + (size / 2)
                IF box.s(bc) = 1 THEN sz = size / 4 ELSE sz = size / 2
                SELECT CASE box.v(bc)
                    CASE IS = 1: r = 255: g = 64: b = 64 'red
                    CASE IS = 2: r = 64: g = 232: b = 64 'green
                    CASE IS = 3: r = 64: g = 64: b = 255 'blue
                    CASE IS = 4: r = 255: g = 255: b = 0 'yellow
                    CASE IS = 5: r = 255: g = 255: b = 255 'white
                END SELECT
                'draw colored balls
                FOR s = 1 TO (sz - 4) STEP .3
                    CIRCLE (x2, y2), s, _RGB(r, g, b)
                    r = r - 1: g = g - 1: b = b - 1
                NEXT

            END IF
            bc = bc + 1
        NEXT
    NEXT

    'overlay a very faint QB64-PE icon on board
    _SETALPHA 16, , -11: _PUTIMAGE (0, 50 * df)-(_WIDTH, _HEIGHT), -11

    _DISPLAY
    _ICON _DISPLAY 'update app icon on taskbar
END SUB

SUB MakeNewBalls (num, ballsize)
    'Assign 3 new balls
    newball = 0
    DO
        c = INT((RND * (cols * rows)) + 1)
        IF box.v(c) = 0 THEN
            box.v(c) = INT((RND * 5) + 1)
            box.s(c) = ballsize
            newball = newball + 1
        END IF
        IF newball = num THEN EXIT DO
    LOOP
END SUB

SUB PPRINT (x, y, size, clr&, trans&, text$)
    orig& = _DEST
    bit = 32: IF _PIXELSIZE(0) = 1 THEN bit = 256
    FOR t = 0 TO LEN(text$) - 1
        pprintimg& = _NEWIMAGE(16, 16, bit)
        _DEST pprintimg&
        CLS , trans&: COLOR clr&
        PRINT MID$(text$, t + 1, 1);
        _CLEARCOLOR _RGB(0, 0, 0), pprintimg&
        _DEST orig&
        x1 = x + (t * size): x2 = x1 + size
        y1 = y: y2 = y + size
        _PUTIMAGE (x1 - (size / 2), y1)-(x2, y2 + (size / 3)), pprintimg&
        _FREEIMAGE pprintimg&
    NEXT
END SUB

SUB SaveScore
    'Out with the old
    IF _FILEEXISTS("make5.dat") THEN KILL "make5.dat"
    'In with the new
    scr = FREEFILE
    OPEN "make5.dat" FOR OUTPUT AS #scr
    hi$ = MKL$(hiscore)
    PRINT #scr, hi$;
    CLOSE #scr
END SUB

   

Find my programs here in Dav's QB64 Corner
Reply
#2
Nice one, Dav! A nice relaxing game.
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, W.A.) Big Grin
Please visit my Website at: http://oldendayskids.blogspot.com/
Reply
#3
Photo 
Very nice Dav.


[Image: 117.png]
Reply
#4
This is why we eventually need to go mobile. A perfect phone app.

Nice!

Pete
Reply
#5
as always. excellent.

Linux is case sensitive, replace Make5.dat by make5.dat otherwise there will be an error at execution...
Reply
#6
Thumbs Up 
Thanks Dav! I've got to rebuild my collection so new and improved is better!
b = b + ...
Reply
#7
Thanks, everyone. A mobile QB64 version would be cool, maybe it would make me finally get a smart phone. Nah, but I would love to play with QB64 on my iPad though.

- Dav

Find my programs here in Dav's QB64 Corner
Reply
#8
Thanks @Coolman for the tip.

This program has a file In/Out error running under Linux, but it's an easy fix.  The hi score filename 'make5.dat' needs to have all the same case or there is an error.  I should have tested this under Linux before posting.  Under Windows, OPEN "Make5.dat"  and OPEN 'make5.dat" would open the same file.  But that won't work under Linux, the name has to be exact.  You can change your code on your own, but I will update the source above too with the change, for future downloads.

- Dav

Find my programs here in Dav's QB64 Corner
Reply
#9
diagonally 5 do not erase
Write name of program in 1st line to copy & paste & save filename.bas
Insert program pictures: press print-screen-shot button
Open paint & Paste & Save as PNG
Add picture file to program topic

Russia looks world from future. Big data is peace data.
I never recommend anything & always write only about myself
Reply
#10
I've updated the Make5.bas game to correct a few issues.  Added an _ICON call so Linux user will have the icon in the compiled program (it's used by the program).  Also changed the way _MOUSEINPUT is used, which speed up clicking on the board a lot.  As a result of that increase in speed, the board can now be larger on desktops that have higher resolution (before the board was restricted at a certain size because mouse polling was too slow).

The updated Make5.bas version is on the first post.

- Dav

Find my programs here in Dav's QB64 Corner
Reply




Users browsing this thread: 2 Guest(s)