{-
  A simple single player snake game.
-}
module Snake where

import ANSI
import Program
import Game
import Coord

-- | A snake is a list of coordinates for the body and a direction of travel.
data Snake = Snake { pos :: [Coord]
                   , dir :: Dir
                   }

-- | The starting position of the snake.
startingSnake :: Snake
startingSnake = Snake ((11,10) : replicate 20 (10,10)) East

-- | The main function. Just kicks off the game.
main :: IO ()
main = runGame 0.1 snake startingSnake

-- | Check if a snake has collided with itself.
collision :: Snake -> Bool
collision g = case pos g of
  p : ps  -> outOfBounds p || any (==p) ps

-- | Output a string at a given coordinate (uses some ANSI magic).
putStrAt :: Coord -> String -> Program ()
putStrAt p s = putS $ gotoPos p ++ s
  where
    gotoPos (x, y) = ansiGoto (x * 2 + 1) (y + 1)

-- | Draw the snake. The last part of the tail is erased.
drawSnake :: Colour -> String -> Snake -> Program ()
drawSnake col px s = do
  let ps = pos s
  putStrAt (last ps) "  "
  putStrAt (head ps) $ ansiColour col px

-- | The different actions that the player can take.
data Action = Turn Dir | Exit

-- | Keyboard controls. Binds keys to actions.
controls :: [(Char, Action)]
controls =
  zip "wars" (map Turn [North, West, South, East]) ++
  [ ('q', Exit), ('\ESC', Exit) ]

-- | The actual game.
snake :: Game Snake
snake g 
  | collision g = do
    putStrAt (0, 28) "Game Over!"
    stop
  | otherwise = do
    drawSnake Red  "()" g
    putStrAt (0,0) ""
    mc <- getC
    case mc >>= \c -> lookup c controls of  -- Maybe is also a monad!
      Nothing       -> continue_
      Just (Turn d) -> continue d
      Just Exit     -> stop
  where
    -- Moving the snake means adding a new head and remove the last
    -- element of the tail.
    move (p:ps) d = movePos p d : p : init ps

    stop          = return Nothing
    continue d    = return $ Just $ g { pos = move (pos g) d, dir = d }
    continue_     = continue (dir g)