![[茨城キリスト教大学]](image/bible.png "[茨城キリスト教大学]"){kind=small}
#author("2018-01-29T17:19:19+09:00","","") さらに拡張して複数段ブロックを置いてみた。コメント行 「ブロックの初期化と表示」 以下にある変数 BLL の値がブロックの段数で、段数によってボールの出どころなど、多くの座標系の初期値が影響を受けるため、各変数の定義や初期化の場所を変更している。これまでの流れで場当たり的に拡張したので、ブロックの角での当たり判定をしていないことからくる既知のバグ（仕様）が残っています。 #author("2023-01-31T10:31:44+09:00","default:maa","maa") 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 220 locate 20,0:print "Score: ";SCORE 230 locate 51,0:print "Ball: ";BALL 240 '--- ブロックの初期化と表示 250 BLX=20:BLY=3:BLL=4:DIM BL(13*BLL-1,2) 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 70 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: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>=BLY and Y<=BLY+BLL-1 then gosub *PBLOCK 700 '--- ミスした 710 if Y=BY+1 then gosub *MISS 720 '--- 次のボール座標を計算 730 X=X+XM:Y=Y+YM 740 wend 750 locate 34,12:print "Game Over..." 760 for I=0 to 50000:next I 770 end 780 '--- ラケットを表示するサブルーチン 790 *MOVE 800 '--- ラケットを消す 810 locate BX,BY:print " " 820 '--- ラケットの座標を計算して表示 830 BX=BX+BM 840 locate BX,BY:print "===" 850 return 860 '--- ミスしたときのサブルーチン 870 *MISS 880 locate 36,12:print "Booo!!" 890 for I=1 to 20000:next I 900 BALL=BALL-1 910 locate 51,0:print "Ball: ";BALL 920 locate 36,12:print " " 930 Y=BLY+BLL 940 return 950 '--- スコア表示 960 *SCORE 970 SCORE=SCORE+100 980 locate 20,0:print "Score: ";SCORE 990 if (SCORE mod 2500)=0 then BALL=BALL+1:locate 51,0:print "Ball: ";BALL 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 '--- ブロックが無かったらリターン 1150 if BL(BLN,2)=0 then return 1160 BL(BLN,2)=0 1170 locate BL(BLN,0),BL(BLN,1) 1180 print " " 1190 YM=-YM 1200 SCORE=SCORE+400:gosub *SCORE 1210 return 1220 '--- ブロックの再描画 1230 *PBLOCK 1240 BLLN=Y-BLY 1250 for I=0 to 12 1260 if (I mod 2)=0 then color 3 else color 5 1270 BLN=I+13*BLLN 1280 if BL(BLN,2)=1 then locate BL(BLN,0),BL(BLN,1):print "@@@" 1290 next I 1300 color 7 1310 return
