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
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