|
|
![15] 白石先生へ投稿者：十進BASICファン 投稿日：2013年 6月30日(日)23時30分48秒 返信
!十進BASICファン 投稿者：白石先生へ 投稿日：2013年10月 1日(火)20時47分6秒 返信・引用
!Re: 十進BASICファン 投稿者：名無し 投稿日：2013年10月 1日(火)23時58分33秒 返信・引用
!以上の３回に渡って投稿されたリストを出発点に、手を加えて来たものです。
!もはや、原形も留めない姿になっていますが、
!カーソルのデザインや、画像採取の方法や、ピ－スの微妙さ、考え方など、引き継がれて
!います。このリストも誰かに引き継がれ、改造されていくのを期待します。
!-----------------
! ジグソー・パズル
!-----------------
!● ピースの移動方法 (周囲の何処でも、空いている所に組み立てていく)
!
!１）移動元ピースを選び 左クリックする。ピースが持ち上がりカーソルＯＮ。
! ※この状態で、ピースを 右クリックすると、90°刻みに右回転する。(ｙ軸↓)
!２）移動先の 空所を、左クリック、その場所へピースが移動。
!
! ※移動先が、他のピース上の場合は、移動中止、移動元は復帰、
! その新しい場所のピースを移動元として、持ち替える。
!
!●ボタン操作
! □Shuffle2: 乱数回転＋乱数配置 □Shuffle1: 乱数配置 □Normal: 原画配置
! □End: プログラムの停止
!
!●リアルタイム「完成」チェックを、行なっています。
! 起動時は、原画配置 状態になっているので、１つ選んで元へ戻すと反応確認可。
!
!●見た目に完成しているのに「完成」チェックが表示されない事がある・・
! △ベタ色のピースが複数有って、入替っている場合。
! △ベタ色のピースが１個でも、向きが回転している場合。□Shuffle1 なら回避可。
!
! ※冒頭に出る Text Window の数表は、この問題の対策として、
! 各ピースの 4x4 画素単位での縦横２方向の濃淡エッジの程度を数量化
! してみたものです。この数値の小さいものは、ベタ色ピース または、
! 識別困難なピースとして、左 →右、上 →下、の昇順で、中央に「数字」を
! 印字して、回転と位置の入替りを識別しようとするものですが、、
! あまり適切に動いているとは、言えない、、なにかもっと良い案が期待される。
!
! IF w< 41 THEN ←現在は、41 未満で「数字」を付加。
! !---- 目印番号を中央に書いて再ロード
!
!●現在 １個のピースの縦横画素数40x40 ppw=40 (piece pixel width) ですが、
! かなり難しいです。 45x45 ppw=45 位だと、楽になります。
! ピースの寸法が、劇的に難易度を変化させますので、試して下さい。
! 原画によって変わるはずで、意味の有る最小サイズを、算出する問題も残る。
!-----------------------------------------------------------------
DEBUG ON
OPTION ARITHMETIC NATIVE
RANDOMIZE
OPTION BASE 0
SET TEXT JUSTIFY"center","half"
SET POINT STYLE 1
gload "sample\ZENKOUJI.JPG" !piece の原画
!--------------------------------------------------------
!ここで、エラー停止した方は、
!ご自身の 十進BASICフォルダー位置に調整して下さい、
!上のパス名は、BASIC.EXE と同フォルダーから起動の場合です。
!--------------------------------------------------------
ASK PIXEL SIZE(0,0;1,1) x,y
SET WINDOW 0,x-1,y-1,0
!
LET bgc=BVAL("002000",16) !bgr 背景色
CALL n_bgr(bgc)
SET COLOR MIX(0) r/256,g/256,b/256 !clear color (also native mode)
SET COLOR mode"native"
SUB n_bgr(n)
LET b=IP(n/65536)
LET g=MOD(IP(n/256),256)
LET r=MOD(n,256)
END SUB
!---
LET ppw=40 !原画piece x.y pix.width
LET ppe=ppw-1 ! x.y pix.end
LET gxw=IP(x/ppw) !原画grid x width
LET gyw=IP(y/ppw) ! y width
!---
LET sxw=IP(640/ppw) !組立space x width( 数倍の余白 grid を含む様に決める)
LET syw=IP(480/ppw) ! y width
LET sxpw=ppw*sxw ! x pix.width
LET sypw=ppw*syw ! y pix.width
LET bw=12 ! border pix.width
!---
LET pbh= 80 !push button H pix.width
LET pbv= 30 ! V pix.width
LET pbj=sypw+bw+bw !push button Top pix.position
LET pb1=sxpw-pbh ! button 1 Left pix.position
LET pb2=pb1-(pbh+bw) ! button 2 L pix.position
LET pb3=pb2-(pbh+bw) ! button 3 L pix.position
LET pb4=pb3-(pbh+bw) ! button 4 L pix.position
!---
LET zw=5 !組立面piece の編集中リフト・アップ pix.width
DIM img(gxw*gyw-1, ppe,ppe), rot(gxw*gyw-1) !各 piece_ID の image, 回転角度
DIM bak(zw+ppw+zw-1, zw+ppw+zw-1) !back ground の save/restore
DIM id(syw-1,sxw-1) !組立面_ID
!----画像の分割、Piece の採取と、そのID 設定( 終了まで固定 )
LET n1=0
FOR y=0 TO gyw-1
FOR x=0 TO gxw-1
LET n=gxw*y+x
FOR j=0 TO ppe
FOR i=0 TO ppe
ASK PIXEL VALUE( ppw*x+i,ppw*y+j ) img(n,j,i)
NEXT i
NEXT j
!---- ベタ色で上下左右 識別困難な piece を探し、目印番号を中央に。
LET wl=255
LET wh=0
FOR j=0 TO ppe-3 STEP 4
FOR i=0 TO ppe-3 STEP 4
CALL edge
NEXT i
NEXT j
FOR i=0 TO ppe-3 STEP 4
FOR j=0 TO ppe-3 STEP 4
CALL edge
IF i=j AND i=20 THEN LET c=e1
NEXT j
NEXT i
LET w=wh-wl
PRINT USING$("#####",w);
IF w< 41 THEN
!---- 目印番号を中央に書いて再ロード
IF 150< c THEN SET TEXT COLOR 0 ELSE SET TEXT COLOR BVAL("ffffff",16)
LET n1=n1+1
PLOT TEXT,AT ppe/2+ppw*x, ppe/2+ppw*y: STR$(n1)
FOR j=0 TO ppe
FOR i=0 TO ppe
ASK PIXEL VALUE( ppw*x+i,ppw*y+j ) img(n,j,i)
NEXT i
NEXT j
SET TEXT COLOR BVAL("ffffff",16)
END IF
NEXT x
PRINT
NEXT y
SUB edge
LET e1=0
FOR v=j TO j+3
FOR u=i TO i+3
CALL n_bgr(img(n,v,u))
LET e1=e1+b+g+r
NEXT u
NEXT v
LET e1=e1/48
IF 0< i THEN
LET v=e1-e0
IF v< wl THEN LET wl=v
IF wh< v THEN LET wh=v
END IF
LET e0=e1
END SUB
!----screen
SET bitmap SIZE bw+sxpw+bw, bw+pbv+bw+bw+sypw+bw
SET WINDOW -bw,sxpw+bw-1, bw+pbv+bw+bw+sypw-1,-bw
SET TEXT font "",12
CLEAR
SET TEXT COLOR BVAL("ffffff",16)
SET LINE COLOR BVAL("ffffff",16)
PLOT LINES: -bw,pbj-bw; sxpw+bw,pbj-bw
CALL button( pb1, "404040","End")
CALL button( pb2, "404040","Normal")
CALL button( pb3, "404040","Shuffle1")
CALL button( pb4, "404040","Shuffle2")
SUB button(i, c$, t$)
SET AREA COLOR BVAL(c$,16)
PLOT AREA: i,pbj; i+pbh-1,pbj; i+pbh-1,pbj+pbv-1; i,pbj+pbv-1
PLOT TEXT,AT i+pbh/2,pbj+pbv/2 :t$
CALL b_edge(i,"303030","FFFFFF")
END SUB
SUB b_edge(i, c1$,c2$)
SET LINE width 3
SET LINE COLOR BVAL(c1$,16)
PLOT LINES: i+pbh-1,pbj+1; i+pbh-1,pbj+pbv-1; i+1,pbj+pbv-1
SET LINE COLOR BVAL(c2$,16)
PLOT LINES: i+1,pbj+pbv-2; i+1,pbj+1; i+pbh-2,pbj+1
SET LINE width 1
END SUB
SUB b_down(i)
CALL b_edge(i,"FFFFFF","303030")
WAIT DELAY .4
CALL b_edge(i,"303030","FFFFFF")
END SUB
!----Piece の初期 描画
SUB dpiece(m)
MAT id=(-1)*CON
MAT rot=ZER
LET bak_x=-1 !bak()=空。 (bak_x,bak_y)= 背景.bak(i,j)のxy
LET edtid=-1 !edit.ID=空
FOR y=0 TO gyw-1
FOR x=0 TO gxw-1
LET n=gxw*y+x
LET id(y,x)=n !Piece.ID 配置( linear for debug)
NEXT x
NEXT y
!----Piece.の ID.乱数配置、乱数回転
IF 0< m THEN
FOR y=0 TO gyw-1
FOR x=0 TO gxw-1
swap id(y,x),id( INT(RND*gyw),INT(RND*gxw))
IF 1< m THEN LET rot(y*gxw+x)=INT(RND*4)*PI/2
NEXT x
NEXT y
END IF
!----描画
SET LINE COLOR 0
SET AREA COLOR bgc
PLOT AREA: 0,0;sxpw,0;sxpw,sypw;0,sypw
FOR y=0 TO gyw-1
FOR x=0 TO gxw-1
LET n=id(y,x)
LET i=x*ppw
LET j=y*ppw
DRAW plot_img(n) WITH ROTATE(rot(n))*SHIFT(ppe/2+i, ppe/2+j)
PLOT LINES: i,j+ppe; i,j; i+ppe,j !gap line width 1
NEXT x
NEXT y
END SUB
!-------------
CALL dpiece(0)
DO
DO
LET i=mlb+mrb
mouse poll mx,my,mlb,mrb
WAIT DELAY 0
LOOP UNTIL i=0 AND (0< mlb OR 0< mrb)
LET x=INT(mx/ppw)
LET y=INT(my/ppw)
IF 0<=x AND x< sxw AND 0<=y AND y< syw THEN
IF mlb=1 THEN
CALL edit00
ELSEIF mrb=1 AND bak_x=x AND bak_y=y THEN
LET i=x*ppw-zw
LET j=y*ppw-zw
LET rot(edtid)=MOD( rot(edtid)+PI/2, 2*PI)
DRAW plot_img(edtid) WITH ROTATE(rot(edtid))*SHIFT(ppe/2+i,ppe/2+j)
PLOT LINES: i,j; i+ppe+zw+zw,j; i+ppe+zw+zw,j+ppe+zw+zw; i,j+ppe+zw+zw; i,j
END IF
ELSEIF pbj<=my AND my< pbj+pbv AND mlb=1 THEN
IF pb1<=mx AND mx< pb1+pbh THEN !終了
CALL b_down(pb1)
STOP
ELSEIF pb2<=mx AND mx< pb2+pbh THEN !ノーマル
CALL b_down(pb2)
CALL dpiece(0)
ELSEIF pb3<=mx AND mx< pb3+pbh THEN !シャッフル1
CALL b_down(pb3)
CALL dpiece(1)
ELSEIF pb4<=mx AND mx< pb4+pbh THEN !シャッフル2
CALL b_down(pb4)
CALL dpiece(2)
END IF
END IF
LOOP
!---------------
SUB edit00
IF 0<=id(y,x) THEN
!---pick piece on screen
IF 0<=edtid THEN
LET id(bak_y,bak_x)=edtid !編集中断
LET i=bak_x*ppw
LET j=bak_y*ppw
CALL restore_bak
DRAW plot_img(edtid) WITH ROTATE(rot(edtid))*SHIFT(ppe/2+i,ppe/2+j)
SET LINE COLOR 0
PLOT LINES: i,j+ppe; i,j; i+ppe,j !gap width 1
END IF
LET i=x*ppw
LET j=y*ppw
LET edtid=id(y,x) !0<=edtid 編集始まり
LET id(y,x)=-1
!---erase before lift up
PLOT AREA: i,j; i+ppe,j; i+ppe,j+ppe; i,j+ppe
CALL save_bak(i-zw,j-zw)
!---write lift up picec
DRAW plot_img(edtid) WITH ROTATE(rot(edtid))*SHIFT(ppe/2+i-zw,ppe/2+j-zw)
SET LINE COLOR "green"
PLOT LINES: i-zw,j-zw; i+ppe+zw,j-zw; i+ppe+zw,j+ppe+zw; i-zw,j+ppe+zw; i-zw,j-zw
ELSEIF 0<=edtid THEN
!---put piece on screen
CALL restore_bak
!---
LET id(y,x)=edtid
LET i=ppw*x
LET j=ppw*y
CALL checker !完成検査
!---put piece on destination
FOR n=1 TO 2
SET LINE COLOR "blue"
PLOT LINES: i,j; i+ppe,j; i+ppe,j+ppe; i,j+ppe; i,j
WAIT DELAY .1
SET LINE COLOR "green"
PLOT LINES: i,j; i+ppe,j; i+ppe,j+ppe; i,j+ppe; i,j
WAIT DELAY .1
NEXT n
DRAW plot_img(edtid) WITH ROTATE(rot(edtid))*SHIFT(ppe/2+i,ppe/2+j)
SET LINE COLOR 0
PLOT LINES: i,j+ppe; i,j; i+ppe,j !gap width 1
LET edtid=-1 !edtid< 0 編集終わり
END IF
END SUB
SUB checker
FOR y=0 TO syw-gyw
FOR x=0 TO sxw-gxw
IF id(y,x)=0 THEN EXIT FOR
NEXT x
IF x<=sxw-gxw THEN EXIT FOR
NEXT y
IF sxw-gxw< y THEN EXIT SUB !err.on
LET n=0
FOR v=y TO y+gyw-1
FOR u=x TO x+gxw-1
IF id(v,u)<>n OR 0< rot(n) THEN EXIT SUB !err.on
LET n=n+1
NEXT u
NEXT v
PLOT TEXT,AT i+ppe/2, j+ppe/2 :"完成"
beep
END SUB
!---------------
SUB save_bak(i,j) !(i,j) = 背景.xy の左上端.pix
CALL restore_bak
ASK PIXEL ARRAY(i,j) bak
LET bak_i=i
LET bak_j=j
LET bak_x=x
LET bak_y=y
END SUB
SUB restore_bak !(bak_i,bak_j) = 画像bak()の左上端.pix
IF bak_x< 0 THEN EXIT SUB
MAT PLOT CELLS,IN bak_i,bak_j; bak_i+ppe+zw+zw,bak_j+ppe+zw+zw :bak
LET bak_x=-1
LET bak_y=-1
END SUB
!--------------
PICTURE plot_img(n) !(0,0) = 画像img()の中心
FOR j_=0 TO ppe
FOR i_=0 TO ppe
SET POINT COLOR img(n,j_,i_)
PLOT POINTS: i_-ppe/2,j_-ppe/2
NEXT i_
NEXT j_
END PICTURE
END
|
|