ジグソー・パズル

 投稿者:SECOND  投稿日:2013年10月23日(水)23時07分12秒
  ![15] 白石先生へ投稿者:十進BASICファン 投稿日:2013年 6月30日(日)23時30分48秒 返信
!十進BASICファン 投稿者:白石先生へ  投稿日:2013年10月 1日(火)20時47分6秒  返信・引用
!Re: 十進BASICファン 投稿者:名無し  投稿日:2013年10月 1日(火)23時58分33秒  返信・引用

!以上の3回に渡って投稿されたリストを出発点に、手を加えて来たものです。
!もはや、原形も留めない姿になっていますが、
!カーソルのデザインや、画像採取の方法や、ピ-スの微妙さ、考え方など、引き継がれて
!います。このリストも誰かに引き継がれ、改造されていくのを期待します。

!-----------------
! ジグソー・パズル
!-----------------

!● ピースの移動方法  (周囲の何処でも、空いている所に組み立てていく)
!
!1)移動元ピースを選び 左クリックする。ピースが持ち上がりカーソルON。
! ※この状態で、ピースを 右クリックすると、90°刻みに右回転する。(y軸↓)
!2)移動先の 空所を、左クリック、その場所へピースが移動。
!
! ※移動先が、他のピース上の場合は、移動中止、移動元は復帰、
!  その新しい場所のピースを移動元として、持ち替える。
!
!●ボタン操作
! □Shuffle2: 乱数回転+乱数配置 □Shuffle1: 乱数配置 □Normal: 原画配置
! □End: プログラムの停止
!
!●リアルタイム「完成」チェックを、行なっています。
! 起動時は、原画配置 状態になっているので、1つ選んで元へ戻すと反応確認可。
!
!●見た目に完成しているのに「完成」チェックが表示されない事がある・・
! △ベタ色のピースが複数有って、入替っている場合。
! △ベタ色のピースが1個でも、向きが回転している場合。□Shuffle1 なら回避可。
!
! ※冒頭に出る Text Window の数表は、この問題の対策として、
!  各ピースの 4x4 画素単位での縦横2方向の濃淡エッジの程度を数量化
!  してみたものです。この数値の小さいものは、ベタ色ピース または、
!  識別困難なピースとして、左 →右、上 →下、の昇順で、中央に「数字」を
!  印字して、回転と位置の入替りを識別しようとするものですが、、
!  あまり適切に動いているとは、言えない、、なにかもっと良い案が期待される。
!
!    IF w< 41 THEN                     ←現在は、41 未満で「数字」を付加。
!    !---- 目印番号を中央に書いて再ロード
!
!●現在 1個のピースの縦横画素数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
 

戻る