{- 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)