|
|
|
2006/8/17(Thu) 17:26:52|NO.2025
ぷよぷよって、一直線じゃなくてもとにかく４つくっつけば消えますよね。
あのメカニズムが分かりません。
サンプルプログラムを下さい！お願いします。
下のは適当にマスを並べるプログラムです。
#const fx 6 ;横のマスの数
#const fy 10 ;縦のマスの数
#const size 20 ;マスのサイズ
blockcolor_r = 255,0,0,255,0 ;ブロックの色r
blockcolor_g = 0,255,0,255,255 ;ブロックの色g
blockcolor_b = 0,0,255,0,255 ;ブロックの色b
screen 0,fx*size,fy*size
*tukuru
dim blocks,fy,fx ;ブロックの色番号を格納
repeat fy
ycnt = cnt
repeat fx
blocks(ycnt,cnt) = rnd(5)+1 ;ブロックの色を決める（０ならブロック無しなので、４つくっついてるとここを０にしたい）
loop
loop
color 255,255,255:boxf
repeat fy
ycnt = cnt
repeat fx
bl = blocks(ycnt,cnt)
if bl{
bl--
color blockcolor_r(bl),blockcolor_g(bl),blockcolor_b(bl) ;描画↓
boxf size*cnt,size*ycnt,size*(cnt+1),size*(ycnt+1) ; ↓
}
loop
loop
onkey *tukuru ;キーを押すと作り直す
stop
|
|
|
2006/8/17(Thu) 17:38:30|NO.2026
|
|
|
2006/8/17(Thu) 18:34:08|NO.2027
なるほど…再帰ですか。
メカニズムは分かりました。ありがとうございます。
しかし、これをＨＳＰでどうするか…
頭が固い僕には分かりません。
サンプルがC++だったので、わけ分かりません。
僕が怠けてるだけかもしれませんが、
消すところまでのサンプルを下さい！お願いします！
|
|
|
2006/8/17(Thu) 21:11:10|NO.2029
>結構な量になりそうな…。(^ ^;
そうですか。自力でがんばってみます。
良く考えたら、C++だからって敬遠していたけど、
forやif、配列変数の書き方はJavaScriptで見覚えのあるものでした。
変数の宣言などもJavaで何とか…（汗
とにかく、自力でがんばってみます。
|
|
|
2006/8/17(Thu) 22:22:04|NO.2030
> 良く考えたら、C++だからって敬遠していたけど、
> forやif、配列変数の書き方はJavaScriptで見覚えのあるものでした。
> 変数の宣言などもJavaで何とか…（汗
まあ、JavaもJavaScriptもCやC++をモデルにしているので似ているのは当然・・・というか
ワザとそうしたみたいですけどね。
# CPLからBCPLが作られてBCPLからB言語が作られ、BからCへ、Cからobject-Cなどの
# オブジェクト指向言語が生まれ、それをベースにC++やJava, JavaScriptができたので。
# 更にこれらを統合し進化させたのがD言語だったりします。
# C#はちょっと特殊ですね。
# Cの影響を受けた言語は数知れず、Perlなども同様でCを覚えればほとんどの言語で
# 役に立つと思います。
# (最近のHSPも関数の実装やWinAPI/DLL関数実行など多少受けてきていますし)
|
|
|
2006/8/18(Fri) 01:04:14|NO.2031
> > 結構な量になりそうな…。(^ ^;
> そうですか。自力でがんばってみます。
がんばれる範囲でがんばってダメならまた質問してください。
全部はムリですが部分的に分からないポイントだけなら答えられると思います。
（私が答えられないときは他の人が答えてくれるはず…。）
|
|
|
2006/8/18(Fri) 12:12:19|NO.2037
ＨＳＰで書いてみましたが、行き詰ってしまいました。
#const global fx 6 ;横のマスの数
#const global fy 10 ;縦のマスの数
#const global size 20 ;マスのサイズ
#const global delnum 4 ;delnum個以上ぷよがつながれば消す
#module
#deffunc getcolor16 int intA,var varR,var varG,var varB
varR = (intA & $FF0000) >> 16
varG = (intA & $FF00) >> 8
varB = (intA & $FF)
return
#deffunc CopyBlocks array to,array from
repeat fy
ycnt=cnt
repeat fx
to(ycnt,cnt) = from(ycnt,cnt)
loop
loop
return
#deffunc count int intY,int intX,var kosu,local mcolor
mcolor = blocks@(intY,intX) ;色とっておく
// dialog "count\n\nintY:"+intY+"\nintX:"+intX+"\nkosu:"+kosu+"\nmcolor:"+mcolor
blocks@(intY,intX)=0 ;ブロック消す
kosu++ ;個数増やす
if ((intY+1) < fx) & (blocks@(intY+1,intX)=mcolor) : count intY+1,intX,kosu
if ((intX+1) < fy) & (blocks@(intY,intX+1)=mcolor) : count intY,intX+1,kosu ;ここでエラーが出る
if ((intY-1) >= 0) & (blocks@(intY-1,intX)=mcolor) : count intY-1,intX,kosu
if ((intX-1) >= 0) & (blocks@(intY,intX-1)=mcolor) : count intY,intX-1,kosu
blocks@(intY,intX)=mcolor
return
#deffunc Vanish array f,int intY,int intX,local mcolor
mcolor = f(intY,intX) ;自分の色
f(intY,intX)=0 ;色ぷよを消す
if (intY+1 < fy) & (f(intY+1,intX) = mcolor) : Vanish f,intY+1,intX
if (intX+1 < fx) & (f(intY,intX+1) = mcolor) : Vanish f,intY,intX+1
if (intY-1 >= 0) & (f(intY-1,intX) = mcolor) : Vanish f,intY-1,intX
if (intX-1 >= 0) & (f(intY,intX-1) = mcolor) : Vanish f,intY,intX-1
return
#deffunc deletePuyo
dim f,fy,fx
CopyBlocks f,blocks@ ;コピー
d=0 ;削除した数
repeat fy
ycnt = cnt
repeat fx
n=0
count cnt,ycnt,n
if n>=delnum{
Vanish f,cnt,ycnt
d+=n
}
loop
loop
CopyBlocks blocks@,f
return d
#deffunc printb ;描画する
color 255,255,255:boxf
repeat fy
ycnt = cnt
repeat fx
bl = blocks@(ycnt,cnt)
if bl{
bl--
getcolor16 blockcolor@(bl),mr,mg,mb
color mr,mg,mb ;描画↓
boxf size*cnt,size*ycnt,size*(cnt+1),size*(ycnt+1) ; ↓
}
loop
loop
return
#global
blockcolor = $FF0000,$FF00,$FF,$FFFF00,$FFFF
screen 0,fx*size,fy*size
*tukuru
dim blocks,fy,fx ;ブロックの色番号を格納
repeat fy
ycnt = cnt
repeat fx
blocks(ycnt,cnt) = rnd(5)+1 ;ブロックの色を決める（０ならブロック無し）
loop
loop
printb ;描画
deletePuyo ;つながってんの消す
printb ;描画
onkey *tukuru ;キーを押すと作り直す
stop
３０行目でエラーが出ます。
blocksはblocks(9,5)まであるはずなのにblocks(0,1)を参照しようとするとエラーが出ます。
どうしてでしょうか…
ついでに、色の指定方法も変えました。
| |
|
|
2006/8/18(Fri) 14:07:58|NO.2039
ifで『 x & y 』という条件式において、
C/C++では( 環境によるが ) x が先に評価され、偽りのときは y は評価されないですが、
HSPでは x の式( 値 )が偽りであっても y の式が評価されます。
|
|
|
2006/8/18(Fri) 17:18:13|NO.2041
これで参加できるのでしょぅか
|
|
|
2006/8/18(Fri) 17:32:00|NO.2042
なるほど…そういうことですか。
if ((intY+1) < fx) & (blocks@(intY+1,intX)=mcolor) : count intY+1,intX,kosu
if ((intX+1) < fy) & (blocks@(intY,intX+1)=mcolor) : count intY,intX+1,kosu ;ここでエラーが出る
if ((intY-1) >= 0) & (blocks@(intY-1,intX)=mcolor) : count intY-1,intX,kosu
if ((intX-1) >= 0) & (blocks@(intY,intX-1)=mcolor) : count intY,intX-1,kosu
を
if ((intY+1) < fx) :if (blocks@(intY+1,intX)=mcolor) : count intY+1,intX,kosu
if ((intX+1) < fy) :if (blocks@(intY,intX+1)=mcolor) : count intY,intX+1,kosu
if ((intY-1) >= 0) :if (blocks@(intY-1,intX)=mcolor) : count intY-1,intX,kosu
if ((intX-1) >= 0) :if (blocks@(intY,intX-1)=mcolor) : count intY,intX-1,kosu
に変えることで解決しました。
もう１箇所同じようなところがあったので、そこも変えました。
しかし、これを実行するとそのうち必ずVanishが繰り返されてsublevが128になった時点で
エラーになります。
この原因はどこにあるのでしょうか…
|
|
|
2006/8/18(Fri) 19:01:01|NO.2043
>原因はどこにあるのでしょうか…
> if ((intY+1) < fx) :if (blocks@(intY+1,intX)=mcolor) : count intY+1,intX,kosu
> if ((intX+1) < fy) :if (blocks@(intY,intX+1)=mcolor) : count intY,intX+1,kosu
> if ((intY-1) >= 0) :if (blocks@(intY-1,intX)=mcolor) : count intY-1,intX,kosu
> if ((intX-1) >= 0) :if (blocks@(intY,intX-1)=mcolor) : count intY,intX-1,kosu
再帰に対する終了条件がない点ではないでしょうか？
再帰に限定したサンプルです。そのままお望みのものではない点はご了承ください。
#module
#deffunc whiteout array map, int d1, int d2, int m1, int m2
if map.d1.d2 ! "*": return ; 終了条件
map.d1.d2 = " "
if( d1+1 < m1 ): whiteout map, d1+1, d2, m1, m2 ; 右
if( d2+1 < m2 ): whiteout map, d1, d2+1, m1, m2 ; 下
if( d1-1 >= 0 ): whiteout map, d1-1, d2, m1, m2 ; 左
if( d2-1 >= 0 ): whiteout map, d1, d2-1, m1, m2 ; 上
return
#global
; v
h.0.0 = "@", "@", "@", "@", "@", "@", "@"
h.0.1 = "@", "*", "@", "@", "@", "*", "@"
h.0.2 = "@", "*", "*", "*", "*", "*", "@";<
h.0.3 = "@", "*", "@", "@", "@", "*", "@"
h.0.4 = "@", "@", "@", "@", "@", "@", "@"
gosub *tex
whiteout h, length(h)/2, length2(h)/2, length(h), length2(h)
gosub *tex
stop
*tex
repeat length2(h)
_cnt = cnt
buf = ""
repeat length(h)
buf += h.cnt._cnt
loop
mes buf
loop
return
1) 指定した位置が*でなかったらそれ以上進まずに『戻って』別の方向を試みる。
2) *だったら空白に置き換える
3) 右->下->左->上の順に進む。正確には、
開始┬->右->下->左->上->終了
｜ ｜ ｜ ｜ ｜
└<-┴<-┴<-┴<-┘
こんな感じ...？
| |
|
|
2006/8/18(Fri) 19:20:13|NO.2044
効率悪いと思うけど、総当りでチェックやってみた
#const fx 6 ;横のマスの数
#const fy 10 ;縦のマスの数
#const size 20 ;マスのサイズ
#const ms size/20 ;ブロックのサイズ調整用
#const ws size/5 ;ブロックのサイズ調整用
blockcolor_r2 = 255,100,100,255,100 ;ブロックの色r
blockcolor_g2 = 100,255,100,255,255 ;ブロックの色g
blockcolor_b2 = 100,100,255,100,255 ;ブロックの色b
buffer 1,fx*size,fy*size
cls 4
buffer 2,fx*size,fy*size
cls 4
screen 0,fx*size+2,fy*size+2,8
width fx*size,fy*size
dim blocks,fy,fx ;ブロックの色番号を格納
dim blocks2,fy,fx ;ブロックの色番号を格納（作業用）
dim gettotlx,100 ;検索ブロックの場所ｘ
dim gettotly,100 ;検索ブロックの場所ｙ
dim gettotl2,2,100 ;ブロックの色番号+接続方向を格納（一次作業用）
dim blocksdel,2,100 ;ブロックの色番号+接続方向を格納
dim delno,fx*fy ;blocksdelの格納ポイントを保存
onkey *tukuru ;キーを押すと作り直す
*tukuru
delcnt=0 ;4個以上繋がった数
del=0 ;blocksdelの格納ポイント計算用
repeat fy
ycnt = cnt
repeat fx
blocks(ycnt,cnt) = rnd(5)+1 ;ブロックの色を決める（０ならブロック無しなので、４つくっついてるとここを０にしたい）
loop
loop
*redraw2
redraw 0
if delcnt=0 {
cntset=maincnt
gsel 0:color 0,0,0:boxf:gsel 1:color 0,0,0:boxf:gsel 0:gsel 0
memcpy blocks2,blocks,4*fy*fx,0,0 ;作業用にblocksをコピー
m=ms
w=ws
for ycnt,0,fy,1
for xcnt,0,fx,1
bl = blocks2(ycnt,xcnt)
if (bl<6) {if (bl>0){check=0:x=xcnt:y=ycnt:gettotl2(0,0)=y,x:getcheck=1:gosub *get}}
next
next
gsel 2
color 0,0,0:pos 0,0:gmode 0,fx*size,fy*size,255:gcopy 0,0,0:gsel 0 ;繋がりが3個以下のブロックを裏2にコピー
}else{
gsel 1:color 0,0,0:boxf:gsel 0:pos 0,0:gmode 0,fx*size,fy*size,255:gcopy 2,0,0 ;裏1クリア、裏2を表へ
gosub *delsub ;裏面に4個以上繋がったブロックを再描画
gsel 0
}
color 0,0,0
pos 0,0:gmode 4,fx*size,fy*size,255-limit((maincnt-cntset)*3-100,0,255) ;裏面に描いた絵を表にコピー
gcopy 1,0,0
wait 1
redraw 1
maincnt++
goto *redraw2
*get
repeat
x2=x
y2=y
x++
join=$1000 ;$1000チェック済み $100|$200|$400|$800左上右下に繋がる check getcheck繋がってたら+1
if x<fx {if bl=blocks2(y,x){jyoin|$400:blocks2(y,x)|$1100:gettotlx(check)=x:gettotly(check)=y:gettotl2(0,getcheck)=y,x:check++:getcheck++}else{if bl=(blocks2(y,x)&$f){blocks2(y,x)|$1100}}}
x-2
if x>=0 {if bl=blocks2(y,x){jyoin|$100:blocks2(y,x)|$1400:gettotlx(check)=x:gettotly(check)=y:gettotl2(0,getcheck)=y,x:check++:getcheck++}else{if bl=(blocks2(y,x)&$f){blocks2(y,x)|$1400}}}
x++
y++
if y<fy {if bl=blocks2(y,x){jyoin|$800:blocks2(y,x)|$1200:gettotlx(check)=x:gettotly(check)=y:gettotl2(0,getcheck)=y,x:check++::getcheck++}else{if bl=(blocks2(y,x)&$f){blocks2(y,x)|$1200}}}
y-2
if y>=0 {if bl=blocks2(y,x){jyoin|$200:blocks2(y,x)|$1800:gettotlx(check)=x:gettotly(check)=y:gettotl2(0,getcheck)=y,x:check++:getcheck++}else{if bl=(blocks2(y,x)&$f){blocks2(y,x)|$1800}}}
blocks2(y2,x2)|join ;検索元に接続方向をセット
//最後に見つかった所を基準にして再検索 checkが0なら検索終了
if check{check--:x=gettotlx(check):y=gettotly(check)}else{break}
loop
bl--
if getcheck>3{ ;4個以上繋がりのある検索結果をblocksdelに追加保存 裏1に書き込む為にgsel 1
gsel 1
memcpy blocksdel,gettotl2,4*(getcheck)*2,del,0
del+4*(getcheck)*2
delno(delcnt)=del
delcnt++
}else{gsel 0}
circ=1
gosub *bljoint ;ブロックを
return
*bljoint
if getcheck>1{ ;2個以上繋がりのあるブロックを書き込む
repeat getcheck
x=gettotl2(1,cnt)
y=gettotl2(0,cnt)
bl=blocks(y,x)-1
color blockcolor_r2(bl),blockcolor_g2(bl),blockcolor_b2(bl)
switch (blocks2(y,x)&$0f00)
case $100
circle size*x-w,size*y+m,size*(x+1)-m,size*(y+1)-m,circ ;⊂ 左に接続有り
swbreak
case $400
circle size*x+m,size*y+m,size*(x+1)+w,size*(y+1)-m,circ ;⊃
swbreak
case $200
circle size*x+m,size*y-w,size*(x+1)-m,size*(y+1)-m,circ ;∩
swbreak
case $800
circle size*x+m,size*y+m,size*(x+1)-m,size*(y+1)+w,circ ;∪
swbreak
case $100|$400
circle size*x-w,size*y+m,size*(x+1)+w,size*(y+1)-m,circ ;⊂⊃ 左右に接続有り
swbreak
case $200|$800 ;∩
circle size*x+m,size*y-w,size*(x+1)-m,size*(y+1)+w,circ ;∪ 上下に接続有り
swbreak
case $100|$200
circle size*x-w,size*y-w,size*(x+1)-m,size*(y+1)-m,circ ;⊂+∩
swbreak
case $100|$800
circle size*x-w,size*y+m,size*(x+1)-m,size*(y+1)+w,circ ;⊂+∪
swbreak
case $400|$200
circle size*x+m,size*y-w,size*(x+1)+w,size*(y+1)-m,circ ;∩+⊃
swbreak
case $400|$800
circle size*x+m,size*y+m,size*(x+1)+w,size*(y+1)+w,circ ;∪+⊃
swbreak
case $100|$200|$400
circle size*x-w,size*y-w,size*(x+1)+w,size*(y+1)-m,circ ;⊂+∩+⊃
swbreak
case $100|$800|$400
circle size*x-w,size*y-m,size*(x+1)+w,size*(y+1)+w,circ ;⊂+∪+⊃
swbreak
case $200|$400|$800
circle size*x+m,size*y-w,size*(x+1)+w,size*(y+1)+w,circ ;∩+⊃+∪
swbreak
case $800|$100|$200
circle size*x-w,size*y-w,size*(x+1)-m,size*(y+1)+w,circ ;∪+⊂+∩
swbreak
case $800|$100|$200|$400
circle size*x-w,size*y-w,size*(x+1)+w,size*(y+1)+w,circ ;∪+⊂+∩+⊃
swbreak
swend
loop
}else{;繋がりのないブロックを表に書き込む
gsel 0
x=gettotl2(1,0)
y=gettotl2(0,0)
color blockcolor_r2(bl),blockcolor_g2(bl),blockcolor_b2(bl)
circle size*x,size*y,size*(x+1),size*(y+1),1
}
color 200,200,200:pos xcnt*size+3,ycnt*size+1:mes str(getcheck)
color 0,0,0:pos xcnt*size+5,ycnt*size+3:mes str(getcheck)
color 255,255,255:pos xcnt*size+4,ycnt*size+2:mes str(getcheck)
return
*delsub
del_=0
bljointanm=(maincnt-cntset)/5 ;アニメ処理用
if bljointanm<5{circ=1:m=ms-bljointanm\2:w=ws-bljointanm\2}else{
if bljointanm>9{bljointanm=bljointanm-10:circ=0}else{
m=ms-bljointanm-5
w=ws+bljointanm-5
circ=0
}
}
gsel 1
repeat delcnt ;4個以上の繋がりのあるブロックをアニメさせ裏1に書き込む
del=delno(cnt)-del_
memcpy gettotl2,blocksdel,del,0,del_
getcheck=del/8
del_=delno(cnt)
xcnt=gettotl2(1,0)
ycnt=gettotl2(0,0)
gosub *bljoint
loop
return
結局は、無駄な検索をどう減らすかが問題・・・
| |
|
ぷよぷよのような処理について
