Τρίτη 28 Αυγούστου 2018

Game 2048

First publish in Rosettacode.org




Module Game2048 {
      \\ 10% 4 and 90% 2
      Def GetTlleNumber()=If(Random(10)<2->4, 2)
      \\ tile
      Def Tile$(x)=If$(x=0->"[    ]", format$("[{0::-4}]", x))
      \\ empty board
      BoardTileRight =lambda (x, y)->x+y*4
      BoardTileLeft=lambda (x, y)->3-x+y*4
      BoardTileUp=lambda (x, y)->x*4+y
      BoardTileDown=lambda (x, y)->(3-x)*4+y
      Dim Board(0 to 15)
      Inventory EmptyTiles
      \\ Score is a statement but we can use it as a variable too.
      Score=0
      \\ Win is also a statement but we can use it as a variable too.
      Win=False
      ExitNow=False
      BoardDirection=BoardtileRight
      Process(BoardDirection)
      \\ Split Rem lines to insert start condition to check valid moves
      Rem : board(0)=2
      Rem : board(1)=2, 2, 2 ' place to (1), (2), (3)
            While len(EmptyTiles) {
            NewTile()
            DrawBoard()
            Action=False
            do {
                  a$=key$
                  if len(a$)=2 then {
                        Action=true
                        Select case Asc(mid$(a$,2))
                        Case 72
                        BoardDirection=BoardTileUp
                        Case 75
                        BoardDirection=BoardTileRight
                        Case 77
                        BoardDirection=BoardTileLeft
                        Case 80
                        BoardDirection=BoardTileDown
                        Case 79 ' End key
                              ExitNow=True
                        Else
                        Action=false
                        end select
                  }
            } until Action
            If ExitNow then exit
            Process(BoardDirection)
      }
      If Win then {
            Print "You Win"
      } Else {
            Print "You Loose"
      }
      End
      Sub Process(Boardtile)
      Inventory EmptyTiles ' clear inventory
      local where, i, j, k
      For i=0 to 3
            Gravity()
            k=boardtile(0,i)
            For j=1 to 3
                  where=boardtile(j,i)
                  if Board(where)<>0 then {
                        if board(k)=board(where) then {
                               board(k)*=2 : score+=board(where): board(where)=0
                               if board(k)=2048 Then Win=True : ExitNow=true
                        }
                  }
                  k=where
            Next j
            Gravity()
            For j=0 to 3
                  where=boardtile(j,i)
                  if board(where)=0 then Append EmptyTiles, where
            Next j
      Next i
      End Sub
      Sub NewTile()
            local m=EmptyTiles(Random(0, len(EmptyTiles)-1)!)
            Board(m)=GetTlleNumber()
            Delete EmptyTiles, m
      End Sub
      Sub DrawBoard()
            Refresh 2000
            Cls
            Cursor 0, 10
            Local Doc$, line$
            Document Doc$
            Doc$=Format$("Game 2048 Score {0}", score)
            \\ Using Report 2 we use rendering as text, with center justify
            Report 2, Doc$
            Doc$={
            }
            Local i, j
            For i=0 to 3
                  line$=""
                  For j=0 to 3
                        line$+=Tile$(Board(BoardTileRight(j, i)))
                  Next j
                  Print Over $(2), Line$
                  Print
                  Doc$=Line$+{
                  }
            Next i
            Report 2, "Next:Use Arrows | Exit: Press End"
            Refresh
            ClipBoard Doc$
      End Sub
      Sub Gravity()
            k=-1
            for j=0 to 3 {
                  where=boardtile(j,i)
                  if k=-1 then if board(where)=0 then k=j : continue
                  if board(where)=0 then continue
                  if k=-1 then continue
                  board(boardtile(k,i))=board(where)
                  board(where)=0
                  k++
            }  
      End Sub
}
Game2048

Δεν υπάρχουν σχόλια:

Δημοσίευση σχολίου

You can feel free to write any suggestion, or idea on the subject.