

 This page uses content from Wikipedia. The original article was at Snake_(video_game). The list of authors can be seen in the page history. As with Rosetta Code, the text of Wikipedia is available under the GNU FDL. (See links for details on variance)


Snake is a game where the player maneuvers a line which grows in length every time the snake reaches a food source.



Task
Implement a variant of the Snake game, in any interactive environment, in which a sole player attempts to eat items by running into them with the head of the snake.

Each item eaten makes the snake longer and a new item is randomly generated somewhere else on the plane.

The game ends when the snake attempts to eat himself.




{-# LANGUAGE TemplateHaskell #-}
import Control.Monad.Random (getRandomRs)
import Graphics.Gloss.Interface.Pure.Game
import Lens.Micro ((%~), (^.), (&), set)
import Lens.Micro.TH (makeLenses)
 
--------------------------------------------------------------------------------
-- all data types
 
data Snake = Snake { _body :: [Point], _direction :: Point }
makeLenses ''Snake
 
data World = World { _snake :: Snake , _food :: [Point]
                   , _score :: Int , _maxScore :: Int }
makeLenses ''World
 
--------------------------------------------------------------------------------
-- everything snake can do
 
moves (Snake b d) = Snake (step b d : init b) d
eats  (Snake b d) = Snake (step b d : b) d
bites (Snake b _) = any (== head b)
step ((x,y):_) (a,b) = (x+a, y+b)
 
turn (x',y') (Snake b (x,y)) | (x+x',y+y') == (0,0)  = Snake b (x,y)
                             | otherwise             = Snake b (x',y')
 
--------------------------------------------------------------------------------
-- all randomness
 
createWorld = do xs <- map fromIntegral <$> getRandomRs (2, 38 :: Int)
                 ys <- map fromIntegral <$> getRandomRs (2, 38 :: Int)
                 return (Ok, World snake (zip xs ys) 0 0)
                 where
                   snake = Snake [(20, 20)] (1,0)
 
-------------------------------------------------------------------------------
-- A tyny DSL for declarative description of business logic 
 
data Status = Ok | Fail | Stop
 
continue = \x -> (Ok, x)
stop     = \x -> (Stop, x)
f >>> g  = \x -> case f x of { (Ok, y) -> g y; b -> b }    -- chain composition
f <|> g  = \x -> case f x of { (Fail, _) -> g x; b -> b }  -- alternative
p ==> f  = \x -> if p x then f x else (Fail, x)            -- condition
l .& f   = continue . (l %~ f)                             -- modification
l .= y   = continue . set l y                              -- setting
 
--------------------------------------------------------------------------------
-- all business logic
 
updateWorld _ =  id >>> (snakeEats <|> snakeMoves) 
  where
    snakeEats  = (snakeFindsFood ==> (snake .& eats)) >>>
                 (score .& (+1)) >>> (food .& tail)
 
    snakeMoves = (snakeBitesTail ==> stop) <|>
                 (snakeHitsWall ==> stop) <|>
                 (snake .& moves)
 
    snakeFindsFood w = (w^.snake & moves) `bites` (w^.food & take 1)
    snakeBitesTail w = (w^.snake) `bites` (w^.snake.body & tail)
    snakeHitsWall w  = (w^.snake.body) & head & isOutside
    isOutside (x,y) = or [x <= 0, 40 <= x, y <= 0, 40 <= y]
 
--------------------------------------------------------------------------------
-- all event handing
 
handleEvents e (s,w) = f w
  where f = case s of
          Ok -> case e of
            EventKey (SpecialKey k) _ _ _ -> case k of
              KeyRight -> snake .& turn (1,0)
              KeyLeft  -> snake .& turn (-1,0)
              KeyUp    -> snake .& turn (0,1)
              KeyDown  -> snake .& turn (0,-1)
              _-> continue
            _-> continue
          _-> \w -> w & ((snake.body) .= [(20,20)]) >>>
                         (maxScore .& max (w^.score)) >>> (score .= 0)
 
--------------------------------------------------------------------------------
-- all graphics
 
renderWorld (s, w) = pictures [frame, color c drawSnake, drawFood, showScore]
  where c = case s of { Ok -> orange; _-> red }
        drawSnake = foldMap (rectangleSolid 10 10 `at`) (w^.snake.body)
        drawFood = color blue $ circleSolid 5 `at` (w^.food & head)
        frame = color black $ rectangleWire 400 400
        showScore = color orange $ scale 0.2 0.2 $ txt `at` (-80,130)
        txt = Text $ mconcat ["Score: ", w^.score & show
                             ,"   Maximal score: ", w^.maxScore & show]
        at p (x,y) = Translate (10*x-200) (10*y-200) p
 
--------------------------------------------------------------------------------
 
main = do world <- createWorld
          play inW white 7 world renderWorld handleEvents updateWorld
  where inW = InWindow "The Snake" (400, 400) (10, 10)