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
![[Image: 117.png]](https://i.ibb.co/DtgnVsj/117.png)
