Task

Implement a 2D sliding block puzzle game where blocks with numbers are combined to add their values.



Rules of the game

   The rules are that on each turn the player must choose a direction   (up, down, left or right).
   All tiles move as far as possible in that direction, some move more than others. 
   Two adjacent tiles (in that direction only) with matching numbers combine into one bearing the sum of those numbers. 
   A move is valid when at least one tile can be moved,   if only by combination. 
   A new tile with the value of   2   is spawned at the end of each turn at a randomly chosen empty square   (if there is one). 
   Adding a new tile on a blank space.   Most of the time,   a new   2   is to be added,   and occasionally   (10% of the time),   a   4.
   To win,   the player must create a tile with the number   2048. 
   The player loses if no valid moves are possible.


The name comes from the popular open-source implementation of this game mechanic, 2048.



Requirements

   "Non-greedy" movement.   
  The tiles that were created by combining other tiles should not be combined again during the same turn (move).   
  That is to say,   that moving the tile row of:
               [2][2][2][2] 

 to the right should result in: 
               ......[4][4] 

 and not:
               .........[8] 

   "Move direction priority".   
  If more than one variant of combining is possible,   move direction shall indicate which combination will take effect. 
  For example, moving the tile row of:
               ...[2][2][2] 

 to the right should result in:
               ......[2][4] 

 and not:
               ......[4][2] 



   Check for valid moves.   The player shouldn't be able to skip their turn by trying a move that doesn't change the board.
   Check for a  win condition.
   Check for a lose condition.


import System.IO
import Data.List
import Data.Maybe
import Control.Monad
import Data.Random
import Data.Random.Distribution.Categorical
import System.Console.ANSI
import Control.Lens
 
-- Logic
 
-- probability to get a 4
prob4 :: Double
prob4 = 0.1
 
type Position = [[Int]]
 
combine, shift :: [Int]->[Int]
combine (x:y:l) | x==y = (2*x) : combine l
combine (x:l) = x : combine l
combine [] = []
 
shift l = take (length l) $ combine (filter (>0) l) ++ [0,0..]
 
reflect :: [[a]] ->[[a]]
reflect = map reverse
 
type Move = Position -> Position
 
left, right, up, down :: Move
left = map shift
right = reflect . left . reflect
up = transpose . left . transpose
down = transpose . right . transpose
 
progress :: Eq a => (a -> a) -> a -> Maybe a
progress f pos = if pos==next_pos then Nothing else Just next_pos where next_pos= f pos
 
lost, win:: Position -> Bool
lost pos = all isNothing [progress move pos| move<-[left,right,up,down] ]
 
win = any $ any (>=2048)
 
go :: Position -> Maybe Move -> Maybe Position
go pos move = move >>= flip progress pos
 
 
{-
-- Adding 2 or 4 without lens:
update l i a = l1 ++ a : l2 where (l1,_:l2)=splitAt i l
indicesOf l = [0..length l-1]
 
add a x y pos = update pos y $ update (pos !! y) x a
 
add2or4 ::  Position -> RVar Position
add2or4 pos = do
  (x,y) <-  randomElement [(x,y) | y<-indicesOf pos, x<-indicesOf (pos!!y), pos!!y!!x ==0  ]
  a <- categorical [(0.9::Double,2), (0.1,4) ]
  return $ add a x y pos
-}
 
-- or with lens:
indicesOf :: [a] -> [ReifiedTraversal' [a] a]
indicesOf l = [ Traversal $ ix i | i <- [0..length l - 1] ]
 
indices2Of :: [[a]] -> [ReifiedTraversal' [[a]] a]
indices2Of ls = [ Traversal $ i.j | Traversal i <- indicesOf ls, let Just l = ls ^? i, Traversal j <- indicesOf l]
 
add2or4 ::  Position -> RVar Position
add2or4 pos = do
  xy <-  randomElement [ xy | Traversal xy <- indices2Of pos, pos ^? xy == Just 0 ]
  a <- categorical [(1-prob4, 2), (prob4, 4) ]
  return $  pos & xy .~ a
-- Easy, is'n it'?
 
-- Main loop
play :: Position -> IO ()
play pos = do
   c <- getChar
   case go pos $ lookup c [('D',left),('C',right),('A',up),('B',down)] of
      Nothing -> play pos
      Just pos1 -> do
         pos2 <- sample $ add2or4 pos1
         draw pos2
         when (win pos2 && not (win pos)) $ putStrLn $ "You win! You may keep going."
         if lost pos2 then putStrLn "You lost!"
            else play pos2
 
main :: IO ()
main = do
  pos <- sample $ add2or4 $ replicate 4 (replicate 4 0)
  draw pos
  play pos
 
-- Rendering
-- See https://en.wikipedia.org/wiki/ANSI_escape_code#Colors
colors =
 [(0,"\ESC[38;5;234;48;5;250m     ")
 ,(2,"\ESC[38;5;234;48;5;255m  2  ")
 ,(4,"\ESC[38;5;234;48;5;230m  4  ")
 ,(8,"\ESC[38;5;15;48;5;208m  8  ")
 ,(16,"\ESC[38;5;15;48;5;209m  16 ")
 ,(32,"\ESC[38;5;15;48;5;203m  32 ")
 ,(64,"\ESC[38;5;15;48;5;9m  64 ")
 ,(128,"\ESC[38;5;15;48;5;228m 128 ")
 ,(256,"\ESC[38;5;15;48;5;227m 256 ")
 ,(512,"\ESC[38;5;15;48;5;226m 512 ")
 ,(1024,"\ESC[38;5;15;48;5;221m 1024")
 ,(2048,"\ESC[38;5;15;48;5;220m 2048")
 ,(4096,"\ESC[38;5;15;48;5;0m 4096")
 ,(8192,"\ESC[38;5;15;48;5;0m 8192")
 ,(16384,"\ESC[38;5;15;48;5;0m16384")
 ,(32768,"\ESC[38;5;15;48;5;0m32768")
 ,(65536,"\ESC[38;5;15;48;5;0m65536")
 ,(131072,"\ESC[38;5;15;48;5;90m131072")
 ]
 
showTile x = fromJust (lookup x colors) ++ "\ESC[B\^H\^H\^H\^H\^H     \ESC[A\ESC[C"
 
draw :: Position -> IO ()
draw pos = do
  setSGR [Reset]
  clearScreen
  hideCursor
  hSetEcho stdin False
  hSetBuffering stdin NoBuffering
  setSGR [SetConsoleIntensity BoldIntensity]
  putStr "\ESC[38;5;234;48;5;248m" -- set board color
  setCursorPosition 0 0
  replicateM_ 13 $ putStrLn $ replicate 26 ' '
  setCursorPosition 1 1
  putStrLn $ intercalate "\n\n\n\ESC[C" $ concatMap showTile `map` pos
 