|
|
白石先生こんにちは。
「人の色覚の数理」掲示板にすでに書いたことなんですが、BASIC.EXEのエラーが発生したが、ver7.6.6に更新したら直ったから問題解決、ということでその場では話を済ませていました。
ところがやっぱり直っていなかったんです。同様のエラーがまた発生してしまいました。
以下、その書き込みを重出します。
「 私、十進ＢＡＳＩＣでジグソーパズルを作成中なんです。
初めはマウス入力型で作っていました。
エラーに関係ある所だけ説明すると、まずこのプログラムは、バラのままのピースが置いてある第１の画面と、それを取り出して組立てるための第２の画面で構成されています。
第１画面では、左クリックでピースを１つ選び、右クリックで何もせずに、ともに第２画面に移動します(1番目のmouse pollに対応)。第２画面では、画面下方の「切替」ボタンを左クリックすると、第１画面で右クリックしたときのみ、何もせず第１画面に戻ります（3番目のmouse pollに対応）。
はずでした。
ところがナンボ「切替」ボタンを押しても画面が切り替わりません。マウスクリックしてない状態にもかかわらずmouse pollステートメントが、右ボタン変数に1を代入、do~mouse poll~loopループを脱出してしまうためです。
クリックしてないのにmouse pollステートメントが右ボタン変数に1を入れてしまうため、上のような作業ではこのようなエラーが起こるわけです。
今では、マウス入力型をあきらめキーボード入力型に変更しました。
ところが7.6.6にバージョンアップしたらこのエラーも直りました。
最新バージョンで直ったわけだから、もう過去の思い出話で済ませられる訳なんですけどね、ハハハ。
コレが問題のソースプログラムです。
SET COLOR mode"native"
OPTION BASE 0
DEF kaku(n)=PI/2*n
LET name$="" !任意の画像ファイル名
FILE SPLITNAME(name$)path$,namae$,ext$
gload Path$&namae$&ext$
ASK PIXEL SIZE(0,1;1,0)A,B
LET cp=45-1
LET aa=IP(a/(cp+1))
LET bb=IP(b/(cp+1))
LET xcel=aa-1
LET ycel=bb-1
DIM cm(cp,cp),cs(aa*bb-1,cp,cp),ID(ycel,xcel),idmo(ycel,xcel),IDku(ycel,xcel),ckyu(cp,cp),rot(aa*bb-1)
LET igaid=-1
LET igawh1=-1
LET palid=-1
SET WINDOW 0,a-1,b-1,0
FOR yd=0TO ycel
FOR xd=0TO xcel
LET n=aa*yd+xd
FOR y=0TO cp
FOR x=0TO cp
ASK PIXEL VALUE((cp+1)*xd+x,(cp+1)*yd+y)cs(n,y,x)
NEXT x
NEXT y
NEXT xd
NEXT yd
LET celba=cp+61
LET xpix=celba*aa
LET ypix=celba*bb
LET xpix2p=(cp+1)*aa-1
LET ypix2p=(cp+1)*bb-1
SET bitmap SIZE xpix,ypix
SET WINDOW 0,xpix-1,ypix-1,0
CALL 黒
DIM wh1(xpix-1,ypix-1),wh2(xpix2p+24,ypix2p+24+celba)
CALL shuffle
FOR yd=1 TO ycel
PLOT 0,celba*yd;xpix-1,celba*yd
NEXT YD
FOR xd=1 TO xcel
PLOT celba*xd,0;celba*xd,ypix-1
NEXT XD
CALL 凸凹ロオテイニ
LET x=0
LET y=0
SET AREA COLOR 0
DO
DO
mouse poll xm,ym,l,r
LOOP UNTIL l^2+r^2<>0
IF l=1 OR r=1 THEN
LET x=INT(xm/celba)
LET y=INT(ym/celba)
END IF
IF -1<x AND x<xcel AND -1<y AND y<ycel THEN
IF r=1 THEN CALL 組立面移動
IF l=1 THEN
IF id(y,x)<0THEN
pause"それはエラーだね"&CHR$(13)&CHR$(10)&"ウッ!"
ELSE
CALL 囲い
CALL 決定
CALL 組立面移動
END IF
END IF
END IF
LET l=0
LET r=0
LOOP
SUB 凸凹ロオテイニ
FOR yd=0 TO ycel
FOR xd=0 TO xcel
LET n=id(yd,xd)
LET rot(n)=INT(RND*3)
DRAW 凸凹ロオテ(n)WITH ROTATE(kaku(rot(n)))*SHIFT(celba*xd+30+cp/2,celba*yd+30+cp/2)
NEXT XD
NEXT YD
END SUB
SUB 囲い
SET LINE width 9
SET LINE COLOR 0
SET LINE COLOR"blue"
LET xccn=celba*x
LET yccn=celba*y
PLOT xccn+5,yccn+5;xccn+celba-5,yccn+5;xccn+celba-5,yccn+celba-5;xccn+5,yccn+celba-5;xccn+5,yccn+5
END SUB
SUB 決定
LET xccn=celba*x
LET yccn=celba*y
ASK PIXEL ARRAY(xccn+30,yccn+30)cm
LET n=id(y,x)
LET igaid=n
LET igawh1=aa*y+x
LET id(y,x)=-1
PLOT AREA:xccn+1,yccn+1;xccn+celba-1,yccn+1;xccn+celba-1,yccn+celba-1;xccn+1,yccn+celba-1
END SUB
SUB shuffle
LET n=aa*bb-1
MAT id=(-1)*CON
FOR o=0 TO n
DO
LET xd2=INT(RND*aa)
LET yd2=INT(RND*bb)
IF id(yd2,xd2)<0THEN
LET id(yd2,xd2)=o
EXIT DO
END IF
LOOP
NEXT o
END SUB
SUB 組立面イニ
SET LINE width 9
set line color"black"
LET xccn=celba*x
LET yccn=celba*y
PLOT xccn+5,yccn+5;xccn+celba-5,yccn+5;xccn+celba-5,yccn+celba-5;xccn+5,yccn+celba-5;xccn+5,yccn+5
ASK PIXEL ARRAY(0,0)wh1
SET bitmap SIZE xpix2p+1+24,ypix2p+1+24+celba
SET WINDOW -12,xpix2p+12,ypix2p+12+celba,-12
CLEAR
SET LINE width 1
SET LINE COLOR 16777215
PLOT -12,ypix2p+1+12;xpix2p+1+12,ypix2p+1+12
MAT idku=(-1)*CON
MAT idmo=idku
LET kais=1
LET palid=-1
LET palwh1=-1
SET TEXT HEIGHT 12
SET TEXT JUSTIFY"center","top"
SET AREA COLOR 255
PLOT AREA:70,ypix2p+1+12+10;129,ypix2p+1+12+10;129,ypix2p+1+12+39;70,ypix2p+1+12+39
PLOT TEXT,AT 100,ypix2p+1+12+18:"切替"
SET AREA COLOR 16711935
PLOT AREA:150,ypix2p+1+12+10;209,ypix2p+1+12+10;209,ypix2p+1+12+39;150,ypix2p+1+12+39
PLOT TEXT,AT 180,ypix2p+1+12+18:"移動"
END SUB
SUB ボタン反応(x,c)
SET LINE width 5
SET LINE COLOR 16711680
PLOT LINES:70+2,ypix2p+1+12+10+2;129,ypix2p+1+12+10+2;129-2,ypix2p+1+12+39-2;70+2,ypix2p+1+12+39-2;70+2,ypix2p+1+12+10+2
WAIT DELAY .4
SET LINE COLOR c
PLOT LINES:70+2,ypix2p+1+12+10+2;129,ypix2p+1+12+10+2;129-2,ypix2p+1+12+39-2;70+2,ypix2p+1+12+39-2;70+2,ypix2p+1+12+10+2
END SUB
SUB 組立面移動
IF kais=0THEN CALL 組立面イニ ELSE CALL 画面12
WAIT DELAY 1.5
SET LINE width 1
SET LINE COLOR"green"
SET AREA COLOR 0
LET x=0
LET y=0
LET xold=0
LET yold=0
IF igaid>-1THEN
ASK PIXEL ARRAY((cp+1)*x,(cp+1)*y)ckyu
MAT PLOT CELLS,IN (cp+1)*x,(cp+1)*y;(cp+1)*x+cp,(cp+1)*y+cp:cm
PLOT LINES:(cp+1)*x,(cp+1)*y;(cp+1)*x+cp,(cp+1)*y;(cp+1)*x+cp,(cp+1)*y+cp;(cp+1)*x,(cp+1)*y+cp;(cp+1)*x,(cp+1)*y
DO
DO
mouse poll xm,ym,l,r
LOOP UNTIL l^2+r^2<>0
IF l=1 OR r=1 THEN
LET x=INT(xm/(cp+1))
LET y=INT(ym/(cp+1))
END IF
IF -1<x AND x<aa AND -1<y AND y<bb THEN
IF l*r=1THEN
IF idku(y,x)<0THEN
CALL 復活(0,0,ckyu)
CALL 嵌込
LET l=0
LET r=0
EXIT DO
END IF
ELSEIF r=1THEN
LET xccn=(cp+1)*x
LET yccn=(cp+1)*y
DRAW ロオテ(rot(igaid),cm)WITH ROTATE(kaku(1))*SHIFT(cp/2+xccn,cp/2+yccn)
ASK PIXEL ARRAY(xccn,yccn)cm
PLOT LINES:xccn,yccn;xccn+cp,yccn;xccn+cp,yccn+cp;xccn,yccn+cp;xccn,yccn
LET l=0
LET r=0
END IF
ELSEIF ypix2p+1+12<ym AND xm<cp+1THEN
IF l=1THEN
IF palid<0THEN
CALL パレ吉
LET l=0
LET r=0
EXIT DO
END IF
END IF
END IF
LOOP
END IF
LET l=0
LET r=0
LET f=0
LET f2=1
DO
!!!!!!!!!!!!!!!!!!!!!!!!!
!
!問題の発生箇所!
!
!!!!!!!!!!!!!!!!!!!!!!!!!
DO
mouse poll xm,ym,l,r
LOOP UNTIL l^2+r^2<>0
IF l=1 OR r=1 THEN
LET x=INT(xm/(cp+1))
LET y=INT(ym/(cp+1))
END IF
IF -1<x AND x<aa AND -1<y AND y<bb THEN
IF l=1THEN
CALL 選嵌
ELSEIF r=1THEN
IF igaid>-1THEN
IF y>-1THEN
LET xccn=x*(cp+1)-10
LET yccn=y*(cp+1)-10
ELSE
LET xccn=-10
LET yccn=ypix2p+1+12+20
END IF
DRAW ロオテ(rot(igaid),cm)WITH ROTATE(kaku(1))*SHIFT(cp/2+xccn-10,cp/2+yccn-10)
ASK PIXEL ARRAY(xccn,yccn)cm
PLOT LINES:xccn,yccn;xccn+cp+20,yccn;xccn+cp+20,yccn+cp+20;xccn,yccn+cp+20;xccn,yccn
END IF
END IF
END IF
IF ypix2p+1+12<ym AND xm<cp+1THEN
IF l=1 THEN
IF palid<0AND igaid>-1AND f=1THEN
CALL パレ吉
ELSEIF palid>-1AND igaid<0AND f=0THEN
CALL パレ吉戻
END IF
END IF
END IF
IF ypix2p+1+12<ym AND 150<xm AND xm<209THEN
IF l=1AND igaid>-1THEN
CALL ボタン反応(150,16111935)
caLL 面間移動
EXIT SUB
END IF
ELSEIF ypix2p+1+12<ym AND 150<xm AND xm<209THEN
IF l=1 AND igaid<0THEN
CALL ボタン反応(70,255)
CALL 復活(x,y,ckyu)
CALL 画面21
LET l=0
LET r=0
EXIT SUB
END IF
END IF
LOOP
END SUB
SUB 持移動
LET xccn=x*(cp+1)-10
LET yccn=y*(cp+1)-10
ASK PIXEL ARRAY(xccn-10,yccn-10)ckyu
MAT PLOT CELLS,IN xccn,yccn;xccn+cp+20,yccn+cp+20:cm
SET LINE COLOR 65280
PLOT LINES:xccn,yccn;xccn,yccn+cp+20;xccn+cp+20,yccn+cp+20;xccn+cp+20,yccn;xccn,yccn
LET f2=0
END SUB
SUB 只移動
LET xccn=x*(cp+1)-10
LET yccn=y*(cp+1)-10
ASK PIXEL ARRAY(xccn-10,yccn-10)ckyu
SET LINE COLOR 16777215
PLOT LINES:xccn,yccn;xccn,yccn+cp+20;xccn+cp+20,yccn+cp+20;xccn+cp+20,yccn;xccn,yccn
LET f2=0
END SUB
SUB 復活(xold,yold,c(,))
MAT PLOT CELLS,IN (cp+1)*xold,(cp+1)*yold;(cp+1)*xold+cp,(cp+1)*yold+cp:c
END SUB
SUB 嵌込
LET xccn=(cp+1)*x
LET yccn=(cp+1)*y
FOR o=1 TO 3
sET LINE COLOR"blue"
PLOT xccn,yccn;xccn+cp,yccn;xccn+cp,yccn+cp;xccn,yccn+cp;xccn,yccn
WAIT DELAY .1
sET LINE COLOR"green"
PLOT xccn,yccn;xccn+cp,yccn;xccn+cp,yccn+cp;xccn,yccn+cp;xccn,yccn
WAIT DELAY .1
NEXT O
SET LINE COLOR 0
PLOT xccn,yccn;xccn+cp,yccn;xccn+cp,yccn+cp;xccn,yccn+cp;xccn,yccn
DRAW 凸凹ロオテ(igaid)WITH ROTATE(kaku(rot(igaid)))*SHIFT(cp/2+xccn,cp/2+yccn)
LET idku(y,x)=igaid
LET idmo(y,x)=igawh1
LET igaid=-1
LET f2=1
END SUB
PICTURE ロオテ(r,c(,))
LET r=r+1
IF r>3THEN LET r=0
MAT PLOT CELLS,IN -cp/2,-cp/2;cp/2,cp/2:c
END PICTURE
SUB パレ吉
IF y>-1THEN CALL 復活(x,y,ckyu)
LET yccn=ypix2p+1+12+20
MAT PLOT CELLS,IN 0,yccn;cp,yccn+cp:cm
LET palid=igaid
LET palwh1=igawh1
LET igaid=-1
LET f=0
LET f2=1
END SUB
SUB パレ吉戻
IF f2=0THEN CALL 復活(x,y,ckyu)
SET LINE color"green"
LET yccn=ypix2p+1+12+20
ASK PIXEL ARRAY(0,yccn)cm
PLOT LINES:-10,yccn;cp+10,yccn;cp+10,yccn+cp+20;-10,yccn+cp+20;-10,yccn
LET igaid=palid
LET igawh1=palwh1
LET palid=-1
LET y=-1
LET f=1
LET f2=1
END SUB
SUB 選嵌
IF f=0THEN
IF igaid<0AND idku(y,x)>-1THEN
LET xccn=x*(cp+1)-10
LET yccn=y*(cp+1)-10
PLOT AREA:xccn,yccn;xccn+cp,yccn;xccn+cp,yccn+cp;xccn,yccn+cp
ASK PIXEL ARRAY(xccn,yccn)ckyu
DRAW 凸凹ロオテ(idku(y,x)) WITH ROTATE(kaku(rot(idku(y,x))))*SHIFT(xccn+cp/2-10,yccn+cp/2-10)
ASK PIXEL ARRAY(xccn,yccn)cm
SET LINE COLOR"green"
PLOT LINES:xccn,yccn;xccn+cp+20,yccn;xccn+cp+20,yccn+cp+20;xccn,yccn+cp+20;xccn,yccn
LET igaid=idku(y,x)
LET igawh1=idmo(y,x)
LET yold=y
LET idku(y,x)=-1
LET F=1
LET f2=0
END IF
ELSE
IF idku(y,x)<0AND igaid>-1THEN
CALL 嵌込
ASK PIXEL ARRAY((cp+1)*x-10,(cp+1)*y-10)ckyu
LET f=0
END IF
END IF
END SUB
SUB 面間移動
IF y>-1THEN CALL 復活(x,y,ckyu) ELSE PLOT AREA:-10,ypix2p+1+12+20;-10,ypix2p+1+12+20+cp;cp+10,ypix2p+1+12+20+cp+20;cp+10,ypix2p+1+12+20
LET yq=INT(igawh1/aa)
LET xq=MOD(igawh1,aa)
LET id(yq,xq)=igaid
LET igaid=-1
CALL 画面21
LET x=xq
LET y=yq
MAT PLOT CELLS,IN celba*x+20,celba*y+20;celba*x+20+cp+20,celba*y+20+cp+20:cm
CALL 囲い
END SUB
SUB 画面12
SET LINE width 9
SET LINE COLOR 0
LET xccn=celba*x
LET yccn=celba*y
PLOT xccn+5,yccn+5;xccn+celba-5,yccn+5;xccn+celba-5,yccn+celba-5;xccn+5,yccn+celba-5;xccn+5,yccn+5
ASK PIXEL ARRAY(0,0)wh1
SET bitmap SIZE xpix2p+1+24,ypix2p+1+24+celba
SET WINDOW -12,xpix2p+12,ypix2p+12+celba,-12
MAT PLOT CELLS,IN -12,-12;xpix2p+12,ypix2p+12+celba:wh2
END SUB
SUB 画面21
ASK PIXEL ARRAY(-12,-12)wh2
SET bitmap SIZE xpix,ypix
SET WINDOW 0,xpix-1,ypix-1,0
mat plot cells,in 0,0;xpix-1,ypix-1:wh1
END SUB
PICTURE 凸凹ロオテ(n)
SET AREA COLOR 0
FOR yd2=1 TO cp-1
FOR xd2=1 TO cp-1
SET LINE COLOR cs(n,yd2,xd2)
PLOT xd2-cp/2,yd2-cp/2
NEXT Xd2
NEXT Yd2
END PICTURE
END
EXTERNAL SUB 黒
SET COLOR Mode"regular"
SET COLOR MIX(0)0,0,0
SET COLOR MIX(1)1,1,1
CLEAR
SET COLOR Mode"native"
END SUB
機種：東芝 dynabook AX2525CMS
ＯＳ:windows xp sp1 」
これは重大なエラーだと思います。
何とかしましょう。
|
|