## …Show last 252 lines

61`Shape = INT(RND * 6)`

62`ShapeAngle = INT(RND * 4)`

63`ShapeMap$ = GetRotatedShapeMap$(Shape, ShapeAngle)`

64`ShapeX = 0`

65`ShapeY = -BLOCKSIDE`

66

67`IF INT(RND * 2) = 0 THEN Direction = -1 ELSE Direction = 1`

68

69`FOR 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`

75`NEXT Move`

76`END SUB`

77

78`SUB DisplayStatus`

79`COLOR 4`

80`LOCATE INT((PITTOP * BLOCKSCALE) / 16), INT((PITLEFT * BLOCKSCALE) / 8) + 1`

81`IF GameOver THEN`

82` PRINT "Game over - press Enter to play a new game."`

83`ELSE`

84` PRINT "Score:" + STR$(Score)`

85`END IF`

86`END SUB`

87

88`SUB DrawBlock (ColorO$, PitX, PitY)`

89`DrawX = PitX * BLOCKSCALE`

90`DrawY = PitY * BLOCKSCALE`

91

92`LINE (DrawX + (PITLEFT * BLOCKSCALE), DrawY + (PITTOP * BLOCKSCALE))-STEP(BLOCKSCALE, BLOCKSCALE), VAL("&H" + ColorO$), BF`

93`LINE (DrawX + CINT(BLOCKSCALE / 10) + (PITLEFT * BLOCKSCALE), DrawY + CINT(BLOCKSCALE / 10) + (PITTOP * BLOCKSCALE))-STEP(BLOCKSCALE - CINT(BLOCKSCALE / 5), BLOCKSCALE - CINT(BLOCKSCALE / 5)), 0, B`

94`END SUB`

95

96`SUB DrawPit`

97`LINE ((PITLEFT * BLOCKSCALE) - 1, (PITTOP * BLOCKSCALE) - 1)-STEP((PITWIDTH * BLOCKSCALE) + 2, (PITHEIGHT * BLOCKSCALE) + 2), 15, B`

98`LINE ((PITLEFT * BLOCKSCALE) - 1, (PITTOP * BLOCKSCALE) - 1)-STEP(PITWIDTH * BLOCKSCALE + 2, 0), 0`

99

100`FOR 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`

110`NEXT PitY`

111`END SUB`

112

113`SUB DrawShape (EraseV)`

114`FOR 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`

128`NEXT BlockX`

129`END SUB`

130

131`SUB DropShape`

132`IF CanMove(ShapeMap$, 0, 1) THEN`

133` DrawShape -1`

134` IF DropRate! > 0 THEN SOUND 37, .3`

135` ShapeY = ShapeY + 1`

136` DrawShape 0`

137`ELSE`

138` SettleActiveShape`

139` CheckGameState`

140

141` IF NOT GameOver THEN`

142` CreateShape`

143` DrawShape 0`

144` END IF`

145`END IF`

146`END SUB`

147

148`FUNCTION GetRotatedShapeMap$ (Shape, Angle)`

149`Map$ = GetShapeMap$(Shape)`

150`NewBlockX = 0`

151`NewBlockY = 0`

152`RotatedMap$ = STRING$(16, "0")`

153

154`IF Angle = 0 THEN`

155` GetRotatedShapeMap = Map$`

156` EXIT FUNCTION`

157`ELSE`

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`

175`END IF`

176

177`GetRotatedShapeMap = RotatedMap$`

178`END FUNCTION`

179

180`FUNCTION GetShapeMap$ (Shape)`

181`SELECT 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$ = ""`

198`END SELECT`

199

200`GetShapeMap$ = Map$`

201`END FUNCTION`

202

203`SUB InitializeGame`

204`RANDOMIZE TIMER`

205`PLAY "ML L64"`

206

207`SCREEN 12`

208`COLOR 9`

209`LOCATE 1, 1`

210`PRINT "QBBlocks v1.00 - by: Peter Swinkels, ***2019***"`

211

212`CreateShape`

213

214`GameOver = 0`

215`Pit$ = STRING$(PITWIDTH * PITHEIGHT, "0")`

216`Score = 0`

217

218`DrawPit`

219`DisplayStatus`

220`END SUB`

221

222`SUB Main`

223`StartTime! = TIMER`

224`DO`

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`

263`LOOP`

264`END SUB`

265

266`SUB RemoveFullRows`

267`Full = 0`

268

269`FOR 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`

292`NEXT PitY`

293`END SUB`

294

295`SUB SettleActiveShape`

296`PLAY "N21"`

297

298`FOR 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`

308`NEXT BlockY`

309

310`RemoveFullRows`

311`END SUB`