! ==================================================================
! NumberTiles ver1.01
! 
! （十進BASIC ソース）：　全文コピーして実行してください。
!
! 某ゲームにインスパイアされて、プログラミングの練習で書いてみました。
! 本家とは、ゲームルールや動作等が違う部分があります。
! 盤面上になるべく大きい数字を作ることが目的です。
!
! ※ バグ取り用の print 文等をコメントアウトして残してあります。
!    参考にしてみてください。
!             
!   十進BASIC は、以下のURIより入手してください。
!   http://hp.vector.co.jp/authors/VA008683/
!  
! 
! （註）入力は、テンキー（半角数字）の 2,4,6,8 または、
! 　　　方向キー（矢印キー）です。
! 　　　隣接した同じ数字のタイル２枚を縦または横に重ねると、数が上がり、
! 　　　空きマスがあれば、同時に新しくタイルが生まれます。
! 　　　プレイヤの操作後、空きマスがなければゲームオーバーです。
! 　　　始めは、モード３（３×３マス）からをオススメします。
!
!
!                                                       2014.06.14 opened
!                                                       2014.06.15 updated
!                                                       S. Nakajima
! ==================================================================

! 初期設定
CALL DecideSize
! LET SIZE = 3      ! 盤面サイズを任意に指定することも可能です。
DIM B(SIZE,SIZE)
SET ECHO "OFF"      ! エコーオフにすることで、キー入力（input 文）を表示しない。
LET HighScore = 0

! グラフィックスウィンドウ用の初期設定
SET WINDOW 0,SIZE+1,SIZE+1,0
SET TEXT JUSTIFY "center" , "half"
SET TEXT HEIGHT 0.8

! ================================================
! メインルーチン

DO
   CALL InitTheBoard
   CALL ZeroCellCheck
   CALL PutNumToEmpCell
    
   DO 
    
      CALL ZeroCellCheck   
      IF ZeroCellNum = 0 THEN EXIT DO
       
      CALL PutNumToEmpCell
       
      CALL ShowBoard
       
      CALL Action
       
   LOOP
    
   CALL CalcScore
    
   INPUT PROMPT "Your Score was "& STR$(Score) &".  Try again ? (Y/N)" : YN$
LOOP WHILE YN$="Y" OR YN$="y" OR YN$=""

! ================================================
SUB DecideSize
   DO
      INPUT PROMPT "Input 3〜5 to select mode（3:Easy, 4:Normal, 5:Hard)":SIZE
   LOOP UNTIL SIZE=3 OR SIZE=4 OR SIZE=5
END SUB

SUB InitTheBoard
   FOR j = 1 TO SIZE
      FOR i = 1 TO SIZE
         LET B(i,j)=0
      NEXT i
   NEXT j
   LET NX = 0
   LET NY = 0
END SUB

SUB ShowBoard
! 盤面表示（グラフィックス利用）
   CLEAR
   LET TX = 0.46
   LET TY = 0.46
   SET AREA COLOR 6
   FOR j = 1 TO SIZE
      FOR i = 1 TO SIZE
         IF B(i,j)<>0 THEN
            IF i <> NX OR j<>NY THEN 
               PLOT AREA : i-TX,j-TY; i-TX,j+TY; i+TX,j+TY
               PLOT TEXT ,AT i,j: STR$(B(i,j))
            END IF
         END IF
      NEXT i
   NEXT j
   WAIT DELAY 0.2
   SET AREA COLOR 5
   PLOT AREA : nx-TX,ny-TY; nx-TX,ny+TY; nx+TX,ny+TY
   PLOT TEXT ,AT nx,ny: STR$(B(nx,ny))
END SUB

SUB ShowBoard2
! 盤面表示（print文のみ利用、DecideTheDirection2 推奨）
   FOR j = 1 TO SIZE
      FOR i = 1 TO SIZE
         PRINT USING "###":B(i,j);
      NEXT i
      PRINT
   NEXT j
   PRINT
END SUB

SUB ZeroCellCheck
! 盤面チェック、0 の項の数をカウント。
   LET ZeroCellNum = 0
   FOR y = 1 TO SIZE
      FOR x = 1 TO SIZE
         IF B(x,y) = 0 THEN LET ZeroCellNum = ZeroCellNum +1
      NEXT x
   NEXT y
   ! PRINT "0 tile was：";ZeroCellNum
END SUB

SUB PutNumToEmpCell
! 空のセル（0の数値）のどれかに NewNum を入力する。
   RANDOMIZE
   LET n = 1+INT(ZeroCellNum*RND)  ! 数字を置く位置を示す乱数
   LET NewNum = 1                  ! 乱数で 1、2を選ばせてもよい
    
   ! PRINT "... I guess, "; n ;"/" ; ZeroCellNum ; "is Lucky Num."
    
   LET ZeroCellSer = 0
   FOR y = 1 TO SIZE
      FOR x = 1 TO SIZE
         IF B(x,y) = 0 THEN
            LET ZeroCellSer = ZeroCellSer +1
         END IF
         IF ZeroCellSer = n AND B(x,y) = 0 THEN
            LET B(x,y) = NewNum
            ! PRINT "was putted on";x;y;
            LET NX = x
            LET NY = y
         END IF
      NEXT x
   NEXT y
    
   ! PRINT "Added a New Num"
   ! CALL ShowBoard2 
END SUB

SUB CalcScore
   PRINT "GAME OVER"
   LET Score = 0
   FOR y = 1 TO SIZE
      FOR x = 1 TO SIZE
         LET Score = Score + 2^B(x,y)
      NEXT x
   NEXT y
    
   IF Score > HighScore THEN
      PRINT "HighScore !"
      INPUT PROMPT " You Made a New Record ! (Continue to Hit Enter)":Dummy$
      LET HighScore = Score
   END IF
   PRINT "Score:"; Score
   print 
END SUB

! ================================================
SUB Action
   CALL DecideTheDirection
   CALL ClosenTheTile
   CALL SumTheSameNum
END SUB

SUB DecideTheDirection2
! 上下左右の決定 テンキー 2,4,6,8 のみ
! テキスト出力でゲームを進行する場合、推奨

   LET inkey$ = ""
   DO
      CHARACTER INPUT CLEAR :inkey$
      IF inkey$ = "2" OR inkey$ = "4" OR inkey$ = "6" OR inkey$ = "8" THEN EXIT DO
   LOOP
    
   IF inkey$ = "2" THEN LET inkey$ = "Down"    
   IF inkey$ = "4" THEN LET inkey$ = "Left"
   IF inkey$ = "6" THEN LET inkey$ = "Right"
   IF inkey$ = "8" THEN LET inkey$ = "Up"
    
   ! PRINT "Slided to ";inkey$
    
END SUB

SUB DecideTheDirection
! 上下左右の決定 カーソルキー使用
   LET inkey$ = ""
   DO
      CHARACTER INPUT NOWAIT :inkey$
       
       
      IF GetKeyState(37)>=0 AND GetKeyState(38)>=0 AND GetKeyState(39)>=0 AND GetKeyState(40)>=0 THEN
      ! 連続判定を避けるため。矢印キーが全て押されていない状態を経由しないと、矢印キーを有効にしない。
         LET MoveFlag = 0
      END IF
      IF GetKeyState(37)<0 AND MoveFlag = 0 THEN
         LET inkey$ ="4"
         LET MoveFlag = 1
      END IF
      IF GetKeyState(38)<0 AND MoveFlag = 0 THEN
         LET inkey$ ="8"
         LET MoveFlag = 1
      END IF
      IF GetKeyState(39)<0 AND MoveFlag = 0 THEN 
         LET inkey$ ="6"
         LET MoveFlag = 1
      END IF
      IF GetKeyState(40)<0 AND MoveFlag = 0 THEN 
         LET inkey$ ="2"
         LET MoveFlag = 1
      END IF
       
   LOOP UNTIL inkey$ = "2" OR inkey$ = "4" OR inkey$ = "6" OR inkey$ = "8"
    
   IF inkey$ = "2" THEN LET inkey$ = "Down"    
   IF inkey$ = "4" THEN LET inkey$ = "Left"
   IF inkey$ = "6" THEN LET inkey$ = "Right"
   IF inkey$ = "8" THEN LET inkey$ = "Up"
    
   ! PRINT "Slided to ";inkey$
    
END SUB


SUB ClosenTheTile
   IF inkey$ = "Down"  THEN CALL ClosenTheTileToDown
   IF inkey$ = "Left"  THEN CALL ClosenTheTileToLeft
   IF inkey$ = "Right" THEN CALL ClosenTheTileToRight
   IF Inkey$ = "Up"    THEN CALL ClosenTheTileToUp
    
   ! CALL ShowBoard2 
    
END  SUB

SUB ClosenTheTileToUp
   FOR x = 1 TO SIZE
      FOR y = SIZE-1 TO 1 STEP -1
         IF B(x,y) = 0 THEN
            FOR k = y TO SIZE-1
               LET B(x,k)= B(x,k+1)
            NEXT k
            LET B(x,k) = 0 
         END IF
      NEXT y
   NEXT x 
END SUB

SUB ClosenTheTileToDown
   FOR x = 1 TO SIZE
      FOR y = 2 TO SIZE
         IF B(x,y) = 0 THEN
            FOR k = y TO 2 STEP -1
               LET B(x,k)= B(x,k-1)
            NEXT k
            LET B(x,k) = 0 
         END IF
      NEXT y
   NEXT x 
END SUB

SUB ClosenTheTileToLeft
   FOR y = 1 TO SIZE
      FOR x = SIZE-1 TO 1 STEP -1
         IF B(x,y) = 0 THEN
            FOR k = x TO SIZE-1
               LET B(k,y)= B(k+1,y)
            NEXT k
            LET B(k,y) = 0 
         END IF
      NEXT x
   NEXT y 
END SUB

SUB ClosenTheTileToRight
   FOR y = 1 TO SIZE
      FOR x = 2 TO SIZE
         IF B(x,y) = 0 THEN
            FOR k = x TO 2 STEP -1
               LET B(k,y)= B(k-1,y)
            NEXT k
            LET B(k,y) = 0 
         END IF
      NEXT x
   NEXT y 
END SUB

SUB SumTheSameNum
   IF inkey$ = "Down"  THEN CALL SumTheTileToDown
   IF inkey$ = "Left"  THEN CALL SumTheTileToLeft
   IF inkey$ = "Right" THEN CALL SumTheTileToRight
   IF Inkey$ = "Up"    THEN CALL SumTheTileToUp
    
   ! PRINT "AdjacentSameTilesWereAdded to ";inkey$
   ! CALL ShowBoard2 
END SUB

SUB SumTheTileToUp
   FOR x = 1 TO SIZE
      FOR y = 1 TO SIZE-1
         IF B(x,y)<>0 AND B(x,y) = B(x,y+1) THEN
            LET B(x,y) = B(x,y)+1
            LET B(x,y+1) = 0
         END IF
      NEXT y
   NEXT x
   CALL ClosenTheTileToUp
END SUB

SUB SumTheTileToDown
   FOR x = 1 TO SIZE
      FOR y = SIZE TO 2 STEP -1
         IF B(x,y)<>0 AND B(x,y) = B(x,y-1) THEN
            LET B(x,y) = B(x,y)+1
            LET B(x,y-1) = 0
         END IF
      NEXT y   
   NEXT x
   CALL ClosenTheTileToDown
END SUB

SUB SumTheTileToLeft
   FOR y = 1 TO SIZE
      FOR x = 1 TO SIZE-1
         IF B(x,y)<>0 AND B(x,y) = B(x+1,y) THEN
            LET B(x,y) = B(x,y)+1
            LET B(x+1,y) = 0
         END IF
      NEXT x
   NEXT y
   CALL ClosenTheTileToLeft
END SUB

SUB SumTheTileToRight
   FOR y = 1 TO SIZE
      FOR x = SIZE TO 2 STEP -1
         IF B(x,y)<>0 AND B(x,y) = B(x-1,y) THEN
            LET B(x,y) = B(x,y)+1
            LET B(x-1,y) = 0
         END IF
      NEXT x   
   NEXT y
   CALL ClosenTheTileToRight
END SUB

END