…Show last 252 lines
61Shape = INT(RND * 6)
62ShapeAngle = INT(RND * 4)
63ShapeMap$ = GetRotatedShapeMap$(Shape, ShapeAngle)
64ShapeX = 0
65ShapeY = -BLOCKSIDE
66
67IF INT(RND * 2) = 0 THEN Direction = -1 ELSE Direction = 1
68
69FOR Move = 0 TO INT(RND * PITWIDTH)
70 IF CanMove(ShapeMap$, Direction, 1) THEN
71 ShapeX = ShapeX + Direction
72 ELSE
73 EXIT FOR
74 END IF
75NEXT Move
76END SUB
77
78SUB DisplayStatus
79COLOR 4
80LOCATE INT((PITTOP * BLOCKSCALE) / 16), INT((PITLEFT * BLOCKSCALE) / 8) + 1
81IF GameOver THEN
82 PRINT "Game over - press Enter to play a new game."
83ELSE
84 PRINT "Score:" + STR$(Score)
85END IF
86END SUB
87
88SUB DrawBlock (ColorO$, PitX, PitY)
89DrawX = PitX * BLOCKSCALE
90DrawY = PitY * BLOCKSCALE
91
92LINE (DrawX + (PITLEFT * BLOCKSCALE), DrawY + (PITTOP * BLOCKSCALE))-STEP(BLOCKSCALE, BLOCKSCALE), VAL("&H" + ColorO$), BF
93LINE (DrawX + CINT(BLOCKSCALE / 10) + (PITLEFT * BLOCKSCALE), DrawY + CINT(BLOCKSCALE / 10) + (PITTOP * BLOCKSCALE))-STEP(BLOCKSCALE - CINT(BLOCKSCALE / 5), BLOCKSCALE - CINT(BLOCKSCALE / 5)), 0, B
94END SUB
95
96SUB DrawPit
97LINE ((PITLEFT * BLOCKSCALE) - 1, (PITTOP * BLOCKSCALE) - 1)-STEP((PITWIDTH * BLOCKSCALE) + 2, (PITHEIGHT * BLOCKSCALE) + 2), 15, B
98LINE ((PITLEFT * BLOCKSCALE) - 1, (PITTOP * BLOCKSCALE) - 1)-STEP(PITWIDTH * BLOCKSCALE + 2, 0), 0
99
100FOR PitY = 0 TO PITHEIGHT - 1
101 FOR PitX = 0 TO PITWIDTH - 1
102 IF GameOver THEN
103 ColorO$ = "4"
104 ELSE
105 ColorO$ = MID$(Pit$, ((PITWIDTH * PitY) + PitX) + 1, 1)
106 END IF
107
108 DrawBlock ColorO$, PitX, PitY
109 NEXT PitX
110NEXT PitY
111END SUB
112
113SUB DrawShape (EraseV)
114FOR BlockX = 0 TO 3
115 FOR BlockY = 0 TO 3
116 PitX = ShapeX + BlockX
117 PitY = ShapeY + BlockY
118 IF PitX >= 0 AND PitX < PITWIDTH AND PitY >= 0 AND PitY < PITHEIGHT THEN
119 IF EraseV THEN
120 ColorO$ = MID$(Pit$, ((PITWIDTH * PitY) + PitX) + 1, 1)
121 ELSE
122 ColorO$ = MID$(ShapeMap$, ((BLOCKSIDE * BlockY) + BlockX) + 1, 1)
123 IF ColorO$ = "0" THEN ColorO$ = MID$(Pit$, ((PITWIDTH * PitY) + PitX) + 1, 1)
124 END IF
125 DrawBlock ColorO$, PitX, PitY
126 END IF
127 NEXT BlockY
128NEXT BlockX
129END SUB
130
131SUB DropShape
132IF CanMove(ShapeMap$, 0, 1) THEN
133 DrawShape -1
134 IF DropRate! > 0 THEN SOUND 37, .3
135 ShapeY = ShapeY + 1
136 DrawShape 0
137ELSE
138 SettleActiveShape
139 CheckGameState
140
141 IF NOT GameOver THEN
142 CreateShape
143 DrawShape 0
144 END IF
145END IF
146END SUB
147
148FUNCTION GetRotatedShapeMap$ (Shape, Angle)
149Map$ = GetShapeMap$(Shape)
150NewBlockX = 0
151NewBlockY = 0
152RotatedMap$ = STRING$(16, "0")
153
154IF Angle = 0 THEN
155 GetRotatedShapeMap = Map$
156 EXIT FUNCTION
157ELSE
158 FOR BlockX = 0 TO 3
159 FOR BlockY = 0 TO 3
160 SELECT CASE Angle
161 CASE 1
162 NewBlockX = 3 - BlockY
163 NewBlockY = BlockX
164 CASE 2
165 NewBlockX = 3 - BlockX
166 NewBlockY = 3 - BlockY
167 CASE 3
168 NewBlockX = BlockY
169 NewBlockY = 3 - BlockX
170 END SELECT
171
172 MID$(RotatedMap$, ((BLOCKSIDE * NewBlockY) + NewBlockX) + 1, 1) = MID$(Map$, ((BLOCKSIDE * BlockY) + BlockX) + 1, 1)
173 NEXT BlockY
174 NEXT BlockX
175END IF
176
177GetRotatedShapeMap = RotatedMap$
178END FUNCTION
179
180FUNCTION GetShapeMap$ (Shape)
181SELECT CASE Shape
182 CASE 0
183 Map$ = "0000333300000000"
184 CASE 1
185 Map$ = "0000111000100000"
186 CASE 2
187 Map$ = "0000666060000000"
188 CASE 3
189 Map$ = "00000EE00EE00000"
190 CASE 4
191 Map$ = "0000022022000000"
192 CASE 5
193 Map$ = "0000555005000000"
194 CASE 6
195 Map$ = "0000440004400000"
196 CASE ELSE
197 Map$ = ""
198END SELECT
199
200GetShapeMap$ = Map$
201END FUNCTION
202
203SUB InitializeGame
204RANDOMIZE TIMER
205PLAY "ML L64"
206
207SCREEN 12
208COLOR 9
209LOCATE 1, 1
210PRINT "QBBlocks v1.00 - by: Peter Swinkels, ***2019***"
211
212CreateShape
213
214GameOver = 0
215Pit$ = STRING$(PITWIDTH * PITHEIGHT, "0")
216Score = 0
217
218DrawPit
219DisplayStatus
220END SUB
221
222SUB Main
223StartTime! = TIMER
224DO
225 Key$ = ""
226 DO WHILE Key$ = ""
227 IF NOT GameOver THEN
228 IF TIMER >= StartTime! + DropRate! OR StartTime! > TIMER THEN
229 DropShape
230 StartTime! = TIMER
231 END IF
232 END IF
233 Key$ = INKEY$
234 LOOP
235 IF Key$ = CHR$(27) THEN
236 SCREEN 0
237 END
238 ELSEIF GameOver THEN
239 IF Key$ = CHR$(13) THEN InitializeGame
240 ELSE
241 SELECT CASE Key$
242 CASE "A", "a"
243 DrawShape -1
244 IF ShapeAngle = 3 THEN NewAngle = 0 ELSE NewAngle = ShapeAngle + 1
245 RotatedMap$ = GetRotatedShapeMap(Shape, NewAngle)
246 IF CanMove(RotatedMap$, 0, 0) THEN
247 ShapeAngle = NewAngle
248 ShapeMap$ = RotatedMap$
249 END IF
250 DrawShape 0
251 CASE CHR$(0) + "K"
252 DrawShape -1
253 IF CanMove(ShapeMap$, -1, 0) THEN ShapeX = ShapeX - 1
254 DrawShape 0
255 CASE CHR$(0) + "M"
256 DrawShape -1
257 IF CanMove(ShapeMap$, 1, 0) THEN ShapeX = ShapeX + 1
258 DrawShape 0
259 CASE " "
260 DropRate! = 0
261 END SELECT
262 END IF
263LOOP
264END SUB
265
266SUB RemoveFullRows
267Full = 0
268
269FOR PitY = 0 TO PITHEIGHT - 1
270 Full = -1
271 FOR PitX = 0 TO PITWIDTH - 1
272 IF MID$(Pit$, ((PITWIDTH * PitY) + PitX) + 1, 1) = "0" THEN
273 Full = 0
274 EXIT FOR
275 END IF
276 NEXT PitX
277 IF Full THEN
278 FOR RemovedRow = PitY TO 0 STEP -1
279 FOR RemovedColumn = 0 TO PITWIDTH - 1
280 IF RemovedRow = 0 THEN
281 ColorO$ = "0"
282 ELSE
283 ColorO$ = MID$(Pit$, ((PITWIDTH * (RemovedRow - 1)) + RemovedColumn) + 1, 1)
284 END IF
285
286 MID$(Pit$, ((PITWIDTH * RemovedRow) + RemovedColumn) + 1, 1) = ColorO$
287 NEXT RemovedColumn
288 NEXT RemovedRow
289
290 Score = Score + 1
291 END IF
292NEXT PitY
293END SUB
294
295SUB SettleActiveShape
296PLAY "N21"
297
298FOR BlockY = 0 TO 3
299 FOR BlockX = 0 TO 3
300 PitX = ShapeX + BlockX
301 PitY = ShapeY + BlockY
302 IF PitX >= 0 AND PitX < PITWIDTH AND PitY >= 0 AND PitY < PITHEIGHT THEN
303 IF NOT MID$(ShapeMap$, ((BLOCKSIDE * BlockY) + BlockX) + 1, 1) = "0" THEN
304 MID$(Pit$, ((PITWIDTH * PitY) + PitX) + 1, 1) = MID$(ShapeMap$, ((BLOCKSIDE * BlockY) + BlockX) + 1, 1)
305 END IF
306 END IF
307 NEXT BlockX
308NEXT BlockY
309
310RemoveFullRows
311END SUB