Clone of an old Qbasic puzzle game called INSANE

[Dav]

One of my favorite little games made in the Qbasic heyday was a small puzzle game by 'entropy' called INSANE.  I don't know if entropy ever took it further, but the game was addicting.  I made a QB64 version here, staying true to the original game idea (but my version moves blocks right instead of left).  It's just something to play while waiting for the power to be restored in my area (been out for days now thanks to hurricane florence). 

- Dav

Code: QB64: [Select]

1. '===============
2. 'INSANECLONE.BAS
3. '===============
4. 'A close clone of Qbasic puzzle game called 'Insane" by entropy.
5. 'Coded for QB64 by Dav, SEP/2018 during Hurricane Florence (NC).
6.  
7. '==============================================================
8. 'CREDITS: Heavily inspired by Qbasic game "insane" by 'entropy'
9. '         It's about the same idea, you clear groups of blocks.
10. '==============================================================
11.  
12. '===========
13. 'HOW TO PLAY:
14. '===========
15. '
16. 'Try to clear the board of groups of color blocks.
17. 'You click on a group of colors to remove that group.
18. 'Any Blocks left above will drop down to fill in the holes.
19. 'Blocks move to the right when a whole column is cleared.
20.  
21. 'SPACE key will generate a new puzzle board.
22. 'ESC key quits.
23. '==============================================================
24.  
25. RANDOMIZE TIMER
26.  
27. DIM SHARED rows, columns
28.  
29. rows = 10: columns = 10: size = 60
30.  
31. REDIM SHARED Block(rows, columns)
32.  
33. '=== set up screen
34. SCREEN _NEWIMAGE(rows * size, columns * size, 256)
35.  
36. _SCREENMOVE _SCREENX, _SCREENY 'a fix to make _title work
37. _TITLE "INSANE CLONE v1.0"
38.  
39.  
40. '======
41. newgame:
42. '======
43.  
44. CLS: LOCATE 16, 31: PRINT "Generating...";
45.  
46. 'generate random board colors
47. FOR r = 1 TO rows
48.     FOR c = 1 TO columns
49.         Block(r, c) = INT(RND * 6)
50.     NEXT c
51. NEXT r
52.  
53. 'make sure there's enough groups present to do puzzle.
54. 'without this here, it's soooo hard! Really insane...
55. IF NumberOfGroups < rows * columns - rows THEN GOTO newgame
56.  
57. CLS: GOSUB updateboard
58.  
59. DO
60.     DO
61.         _LIMIT 60
62.         WHILE _MOUSEINPUT: WEND
63.  
64.         K$ = INKEY$
65.         IF K$ = CHR$(32) THEN GOTO newgame
66.         IF K$ = CHR$(27) THEN SYSTEM
67.  
68.         IF _MOUSEBUTTON(1) THEN
69.             mx = _MOUSEX: my = _MOUSEY
70.  
71.             nm = 0 'block count
72.             FOR r = 1 TO rows
73.                 FOR c = 1 TO columns
74.                     nm = nm + 1
75.                     bx = (r * size) - size: by = (c * size) - size
76.                     IF mx >= bx AND mx <= bx + size AND my >= by AND my <= by + size THEN
77.                         old = Block(r, c) 'block color
78.  
79.                         'only do when non black touched
80.                         IF old <> 6 THEN
81.                             'only do if a neighbor block color is same
82.                             nn = 0
83.                             IF r > 1 THEN
84.                                 IF Block(r - 1, c) = old THEN nn = 1
85.                             END IF
86.                             IF r < rows THEN
87.                                 IF Block(r + 1, c) = old THEN nn = 1
88.                             END IF
89.                             IF c > 1 THEN
90.                                 IF Block(r, c - 1) = old THEN nn = 1
91.                             END IF
92.                             IF c < columns THEN
93.                                 IF Block(r, c + 1) = old THEN nn = 1
94.                             END IF
95.                             'if a group of colors...
96.                             IF nn = 1 THEN
97.                                 x = (r * size) - size: y = (c * size) - size
98.                                 GOTO selected
99.                             END IF
100.                         END IF
101.                     END IF
102.                 NEXT
103.             NEXT
104.  
105.         END IF
106.  
107.     LOOP
108.  
109.  
110.     selected:
111.  
112.     'fill the group...
113.     FloodFill old, 6, r, c
114.  
115.     'show blacked out colors
116.     GOSUB updateboard
117.  
118.     'drop down blocks here...
119.     FOR r = 1 TO rows
120.         FOR c = columns TO 2 STEP -1
121.             IF Block(r, c) = 6 THEN
122.                 FOR c2 = c TO 1 STEP -1
123.                     IF Block(r, c2) <> 6 THEN EXIT FOR
124.                 NEXT
125.                 IF c2 > 0 THEN
126.                     IF Block(r, c) <> Block(r, c2) THEN moved = 1
127.                     Block(r, c) = Block(r, c2): Block(r, c2) = 6
128.                 END IF
129.             END IF
130.         NEXT
131.     NEXT
132.  
133.     'move blocks right here...
134.     FOR r = 1 TO rows - 1
135.         IF Block(r, columns) = 6 THEN
136.             FOR r2 = 1 TO rows
137.                 IF Block(r2, columns) <> 6 THEN EXIT FOR
138.             NEXT
139.             FOR c = 1 TO columns
140.                 IF Block(r, c) <> Block(r2, c) THEN moved = 1
141.                 Block(r, c) = Block(r2, c): Block(r2, c) = 6
142.             NEXT
143.         END IF
144.     NEXT
145.  
146.     'redraw puzzle board
147.     GOSUB updateboard
148.  
149.     'wait until mouse button up to continue
150.     WHILE _MOUSEBUTTON(1) <> 0: n = _MOUSEINPUT: WEND
151.  
152.     'see if all blocks gone (cleared!)
153.     h = 0
154.     FOR r = 1 TO rows
155.         FOR c = 1 TO columns
156.             IF Block(r, c) <> 6 THEN h = 1
157.         NEXT c
158.     NEXT r
159.  
160.     'if board is cleared, then you win...
161.     IF h = 0 THEN
162.         LINE (200, 200)-(400, 300), 15, BF
163.         LINE (202, 202)-(398, 298), _RGB(0, 0, 255), BF
164.         LOCATE 16, 31: COLOR 15, _RGB(0, 0, 255)
165.         PRINT "YOU DID IT!!!";
166.         _DELAY 3
167.         GOTO newgame
168.     END IF
169.  
170.     'see if any groups presently left
171.     dn = NumberOfGroups
172.  
173.     'if no more groups, end...
174.     IF NumberOfGroups = 0 THEN
175.         LINE (200, 200)-(400, 300), 15, BF
176.         LINE (202, 202)-(398, 298), _RGB(0, 0, 255), BF
177.         LOCATE 16, 31:: COLOR 15, _RGB(0, 0, 255)
178.         PRINT "NO GROUPS LEFT!";
179.         _DELAY 3
180.         GOTO newgame
181.     END IF
182.  
183. LOOP
184.  
185. END
186.  
187. '=============================================================================
188.  
189. '==========
190. updateboard:
191. '==========
192.  
193. nm = 0
194. FOR r = 1 TO rows
195.     FOR c = 1 TO columns
196.         j = Block(r, c): nm = nm + 1
197.         IF j = 0 THEN fill = 1
198.         IF j = 1 THEN fill = 2
199.         IF j = 2 THEN fill = 3
200.         IF j = 3 THEN fill = 4
201.         IF j = 4 THEN fill = 5
202.         IF j = 5 THEN fill = 6
203.         IF j = 6 THEN fill = 0
204.  
205.         x = (r * size) - size: y = (c * size) - size
206.  
207.         LINE (x, y)-(x + size, y + size), fill, BF
208.         LINE (x, y)-(x + size, y + size), 0, B
209.  
210.     NEXT c
211.  
212.     _DELAY .025 'add delay for moving effect
213.  
214. NEXT r
215.  
216. RETURN
217.  
218. '=====================================================
219.  
220. FUNCTION NumberOfGroups ()
221.  
222.     'returns how many block groups left on board
223.  
224.     dn = 0
225.     FOR r = 1 TO rows
226.         FOR c = 1 TO columns
227.             IF Block(r, c) <> 6 THEN
228.                 IF r > 1 THEN
229.                     IF Block(r - 1, c) = Block(r, c) THEN dn = dn + 1
230.                 END IF
231.                 IF r < rows THEN
232.                     IF Block(r + 1, c) = Block(r, c) THEN dn = dn + 1
233.                 END IF
234.                 IF c > 1 THEN
235.                     IF Block(r, c - 1) = Block(r, c) THEN dn = dn + 1
236.                 END IF
237.                 IF c < columns THEN
238.                     IF Block(r, c + 1) = Block(r, c) THEN dn = dn + 1
239.                 END IF
240.             END IF
241.         NEXT c
242.     NEXT r
243.  
244.     NumberOfGroups = dn
245.  
246. END FUNCTION
247.  
248. '=====================================================
249.  
250. SUB FloodFill (old, clr, x, y)
251.     IF Block(x, y) <> old THEN
252.         EXIT SUB
253.     ELSE
254.         Block(x, y) = clr
255.     END IF
256.     IF x > 1 THEN FloodFill old, clr, x - 1, y
257.     IF x < rows THEN FloodFill old, clr, x + 1, y
258.     IF y > 1 THEN FloodFill old, clr, x, y - 1
259.     IF y < columns THEN FloodFill old, clr, x, y + 1
260. END SUB
261.  

[Pete]

I don't remember this one in QB. What's a win? I keep getting no more color groups left message at some point, but so what?

I know, I don't game so I don't get it.

Pete

[bplus]

Oh I've learned and programmed this game as "Click-O-Mania" at JB forum.

The object is to clear all the squares by clicking groups of like color in row and/or column, click 1 of 2 red adjacent squares and they will blink away and the squares above will fall down and a whole blank column will move left columns, right now?
Oh Pete should love that!

So a message, no more color groups left, means to move on to next game. You do well if less than what? 8 squares left?

[Pete]

Clear all the squares is what I thought. In other words a blank screen is a win. I can hack that right now with one line of added code... CLS

I like Dav's peg game, in his other post, better. Did you see the graphics job on that?

Pete :D

[bplus]

Clear all the squares is what I thought. In other words a blank screen is a win. I can hack that right now with one line of added code... CLS

I like Dav's peg game, in his other post, better. Did you see the graphics job on that?

Pete :D

Next up but need lunch first!