-- Simple Snake Game (CUI)
import Data.Char
import System.Random

type Pos = (Int, Int)
type Snake = [Pos]
type Apple = Pos

data Move = UP | DOWN | LEFT | RIGHT | NONE
            deriving (Show)

main = do
  let snake = [(1,1)]
  apple <- newApple snake
  showGame snake apple
  loop snake apple

loop :: Snake -> Apple -> IO ()
loop snake apple = do
  move <- getMove
  let (snake', isEated) = moveSnake move apple snake
  apple' <- do if isEated then newApple snake' 
                          else return apple
  showGame snake' apple'
  if isGameOver snake' then print $ "Game Over!! snake length: " ++
                                    show (length snake')
                       else loop snake' apple'

getMove :: IO Move
getMove = do
  c1 <- getChar
  if ord c1 == 0x5B
    then do
           c2 <- getChar;
           case ord c2 of
             0x41 -> return UP
             0x42 -> return DOWN
             0x43 -> return RIGHT
             0x44 -> return LEFT
    else getMove

newApple :: Snake -> IO Apple
newApple snake = do
  x <- getStdRandom(randomR(1,5))
  y <- getStdRandom(randomR(1,5))
  if (x, y) `elem` snake then newApple snake
                         else return (x, y)

showGame :: Snake -> Apple -> IO ()
showGame snake apple = do
  cls
  showBoard
  showSnake snake
  showApple apple
  setPos(0, 8)

isGameOver :: Snake -> Bool
isGameOver snake@(head@(x,y):body) =
  head `elem` body || x == 0 || x == 6 || y == 0 || y == 6

setPos :: Pos -> IO ()
setPos (x, y) = putStr $ "\ESC[" ++ show y ++ ";" ++ show x ++ "H"

cls :: IO ()
cls = do
  putStr "\ESC[2J"
  setPos (0, 0)

showBoard :: IO ()
showBoard = do
  setPos (0, 0)
  putStrLn "+-----+"
  putStrLn "|     |"
  putStrLn "|     |"
  putStrLn "|     |"
  putStrLn "|     |"
  putStrLn "|     |"
  putStrLn "+-----+"

showSnake :: Snake -> IO ()
showSnake snake = do
  mapM_ (\(x, y) -> setPos (x+1, y+1) >> putChar '*') snake

showApple :: Apple -> IO ()
showApple apple = do
  setPos(x+1, y+1)
  putChar 'O'
    where (x, y) = apple

moveSnake :: Move -> Apple -> Snake -> (Snake, Bool)
moveSnake move apple snake =
  let newHead = case move of
                  UP    -> (x, y-1)
                  DOWN  -> (x, y+1)
                  RIGHT -> (x+1, y)
                  LEFT  -> (x-1, y)
                  _     -> (x, y)
  in if newHead == apple then (newHead:snake, True)
                         else (newHead:body,  False)
  where (x, y) = head snake
        body = take ((length snake) - 1) snake
