#author("2018-02-26T11:38:19+09:00","","")
結局のところ、ブロックの直下(上)だけでなく、その隣のブロックの角も当たり判定しないと根本的な解決にはならないので、思い切って修正した。そもそも「1段だけ...」のつもりで書き足したアルゴリズムなのでややこしくなった。最初から複数段置くつもりで配列変数 BL を設計しておけばよかったのだが、後の祭りなのでそのまま押し通すことにした。角当たりで「コ」の字状に消した直後のボールの跳ね返りで当たり判定をしていない(まだボールが動いていない状態なので)ことから起こるブロックの角欠けが発生したので、ブロックの角に当たっときはボールの左右方向も反転(跳ね返す)ように修正した。それでもある特定の状況下で、ブロックの角をボールが通過して消える現象がたまに発生する。原因は「コ」の字状に消えている場所にボールが入り込んで例えば上のブロックに当たった時、そのブロックやその横のブロックの角当たり判定をしてボールを跳ね返すと、下のブロックは当たり判定していないのでそのまま透過してしまうという現象。まぁしかたがないから仕様です。
#author("2023-01-31T10:38:23+09:00","default:maa","maa")

#htmlinsert(video001)

 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	locate 0,1:print "CN =   "
 1120		if YM=1 then BLLN=Y-BLY+1 else BLLN=Y-BLY-1
 1130		BLN=int((X-BLX)/3)+13*BLLN
// 1150	locate 0,0:print using "BLN= ##";BLN
 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
// 1200	locate 0,1:print "CN =";CN
 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


トップ   編集 差分 履歴 添付 複製 名前変更 リロード   新規 一覧 検索 最終更新   ヘルプ   最終更新のRSS