'=========

'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