結局のところ、ブロックの直下(上)だけでなく、その隣のブロックの角も当たり判定しないと根本的な解決にはならないので、思い切って修正した。そもそも「1段だけ...」のつもりで書き足したアルゴリズムなのでややこしくなった。最初から複数段置くつもりで配列変数 BL を設計しておけばよかったのだが、後の祭りなのでそのまま押し通すことにした。角当たりで「コ」の字状に消した直後のボールの跳ね返りで当たり判定をしていない(まだボールが動いていない状態なので)ことから起こるブロックの角欠けが発生したので、ブロックの角に当たっときはボールの左右方向も反転(跳ね返す)ように修正した。それでもある特定の状況下で、ブロックの角をボールが通過して消える現象がたまに発生する。原因は「コ」の字状に消えている場所にボールが入り込んで例えば上のブロックに当たった時、そのブロックやその横のブロックの角当たり判定をしてボールを跳ね返すと、下のブロックは当たり判定していないのでそのまま透過してしまうという現象。まぁしかたがないから仕様です。
100 cls 110 '--- 壁を描く 120 locate 19,1 130 color 4 140 print "#########################################" 150 for I=2 to 22 160 locate 19,I 170 print "# #" 180 next I 190 color 7 200 '--- ボールの個数とスコアの表示 210 BALL=3:SCORE=0:BS=0 220 locate 20,0:print "Score: ";SCORE 230 locate 51,0:print "Ball: ";BALL 240 '--- ブロックの初期化と表示 250 BLX=20:BLY=4:BLL=4:DIM BL(13*BLL-1,2):CN=0:f0=0:BLS=0 260 for I=0 to BLL-1 270 for J=0 to 12 280 BLN=J+13*I 290 BL(BLN,0)=BLX+J*3 300 BL(BLN,1)=I+BLY 310 BL(BLN,2)=1 320 if (J mod 2)=0 then color 3 else color 5 330 locate BL(BLN,0),BL(BLN,1) 340 print "@@@" 350 next J 360 next I 370 color 7 380 '--- ボール座標 X,Y 移動方向 XM,YM 390 X=30:Y=BLY+BLL:XM=1:YM=1 400 '--- ラケットの座標 BX,BY 移動方向 BM 410 BX=38:BY=22:BM=0 420 '--- 最初のラケットの表示 430 locate BX,BY:print "===" 440 '--- ゲーム開始メッセージ 450 gosub *START 460 '--- メインループ 持ち球がある間はゲームが続く 470 while BALL>0 480 '--- ボールを表示 490 locate X,Y:print "o" 500 '--- ボールの速度調整 510 for I=0 to 150 520 '--- 押されているキーを読み取る 530 K$=inkey$ 540 '--- 左右(,.)のキーが押されていたら移動方向をセットして *MOVE へ 550 if K$="," and BX>20 then BM=-1:gosub *MOVE 560 if K$="." and BX<56 then BM=+1:gosub *MOVE 570 next I 580 '--- ボールがブロックの上下ラインに来たら *BCHECK へ 590 if (YM=1 and Y>=BLY-1 and Y<=BLY+BLL-2) or (YM=-1 and Y>=BLY+1 and Y<=BLY+BLL) then gosub *BCHECK 600 '--- ラケットに当たったらボールの移動方向を反転 610 if Y=BY-1 and X>=BX-1 and X<=BX+3 then YM=-YM:BS=100:gosub *SCORE 620 if Y=BY-1 and ((XM=1 and X=BX-1) or (XM=-1 and X=BX+3)) then XM=-XM 630 '--- 上下左右の壁に当たったら移動方向を反転 640 if Y=2 then YM=-YM 650 if X=20 or X=58 then XM=-XM 660 '--- ボールを消す 670 locate X,Y:print " " 680 '--- ミスした 690 if Y=BY+1 then gosub *MISS 700 '--- 次のボール座標を計算 710 X=X+XM:Y=Y+YM 720 wend 730 locate 34,12:print "Game Over..." 740 for I=0 to 50000:next I 750 end 760 '--- ラケットを表示するサブルーチン 770 *MOVE 780 '--- ラケットを消す 790 locate BX,BY:print " " 800 '--- ラケットの座標を計算して表示 810 BX=BX+BM 820 locate BX,BY:print "===" 830 return 840 '--- ミスしたときのサブルーチン 850 *MISS 860 locate 36,12:print "Booo!!" 870 for I=1 to 20000:next I 880 BALL=BALL-1 890 locate 51,0:print "Ball: ";BALL 900 locate 36,12:print " " 910 Y=BLY+BLL 920 return 930 '--- スコア表示 940 *SCORE 950 BALL=BALL+int((SCORE+BS+BLS)/10000)-int(SCORE/10000) 960 SCORE=SCORE+BS+BLS 970 locate 20,0:print "Score: ";SCORE 980 locate 51,0:print "Ball: ";BALL 990 BS=0:BLS=0 1000 return 1010 '--- ゲーム開始メッセージ 1020 *START 1030 locate 31,12:print "Ready..." 1040 for I=1 to 15000:next I 1050 locate 41,12:print "Go!!!" 1060 for I=1 to 15000:next I 1070 locate 31,12:print " " 1080 for I=1 to 5000:next I 1090 return 1100 '--- ブロックが存在したら消して跳ね返す 1110 *BCHECK 1120 if YM=1 then BLLN=Y-BLY+1 else BLLN=Y-BLY-1 1130 BLN=int((X-BLX)/3)+13*BLLN 1140 if (X-BL(BLN,0))=0 and XM=-1 and BL(BLN,0)>=BLX+3 then CN=-1 1150 if (X-BL(BLN,0))=2 and XM=1 and BL(BLN,0)<BLX+3*12 then CN=1 1160 while CN<>0 1170 if BL(BLN+CN,2)=0 then CN=0:wend 1180 BL(BLN+CN,2)=0 1190 locate BL(BLN+CN,0),BL(BLN+CN,1) 1200 print " " 1210 f0=1:CN=0:XM=-XM 1220 wend 1230 while BL(BLN,2)<>0 1240 BL(BLN,2)=0 1250 locate BL(BLN,0),BL(BLN,1) 1260 print " " 1270 f0=f0+1 1280 wend 1290 if f0<>0 then YM=-YM 1300 BLS=500*f0:f0=0 1310 gosub *SCORE 1320 return