snake (empty) → 0.1.0.0

raw patch · 9 files changed

+264/−0 lines, 9 filesdep +basedep +randomdep +splitsetup-changed

Dependencies added: base, random, split, terminal-size

Files

• LICENSE +20/−0
• Main.hs +29/−0
• Movement.hs +45/−0
• README.md +4/−0
• Setup.hs +2/−0
• Snake.hs +11/−0
• Terminal.hs +21/−0
• World.hs +105/−0
• snake.cabal +27/−0

@@ -0,0 +1,20 @@+Copyright (c) 2016 Habib Alamin++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,29 @@+module Main where++import System.Exit (exitSuccess)++import Terminal+import World+import Movement++main :: IO ()+main = catchInput $ randomWorld >>= snake++snake :: World -> IO ()+snake world = if gameOver world+    then printWorld world >>+        getChar >> clearScreenWorldPassthru world >>+        exitSuccess+    else printWorld world >>+        getNextMove >>= updateWorldIO world >>=+        clearScreenWorldPassthru >>= snake where+            printWorld = putStr . show+            updateWorldIO world move = updatePelletCoords world >>=+                \coords -> return $ updateWorld move coords world+            changeMoveArgumentToLast fn m p w = fn p w m+            clearScreenWorldPassthru world = clearScreen world >> return world where+                -- We add 1 to the height to account for the top border. We+                -- are already on the same line as the bottom border (as we+                -- use putStr to avoid printing a newline after the world),+                -- so no need to need to account for that.+                clearScreen world = putStr $ "\r\ESC[" ++ show (worldHeight world + 1) ++ "A"

@@ -0,0 +1,45 @@+module Movement where++import System.IO (hReady, stdin)+import Control.Concurrent (threadDelay)+import Control.Monad (replicateM)++data Move = Up | Down | Left | Right | Noop deriving (Show, Eq, Enum)++data Direction = North | East | South | West deriving (Show, Eq, Enum)+data Coords = Coords Integer Integer deriving Eq++instance Show Coords where+    show (Coords x y) = "(x: " ++ show x ++ ", y: " ++ show y ++ ")"++instance Ord Coords where+    (Coords x y) `compare` (Coords a b) = let yAxisOrdering = y `compare` b+        in if yAxisOrdering == EQ then x `compare` a else yAxisOrdering++mkMove :: String -> Move+mkMove "\ESC[A" = Up+mkMove "\ESC[B" = Down+mkMove "\ESC[C" = Movement.Right+mkMove "\ESC[D" = Movement.Left+mkMove _        = Noop++getNextMove :: IO Move+getNextMove = mkMove <$> keys where+    -- MAGICNUMBER: this feels like a good pace when repeated, but it+    -- should probably be customisable & labelled for why I chose it?+    -- SRP: I think this function does too much, and assumes too much+    -- about its callers.+    keys = threadDelay 100000 >> hReady stdin >>= getFirstChar >>= getRestChars >>= flushInput where+        getFirstChar ready = if ready then sequence [getChar] else return "\NUL"+        getRestChars firstChar = if firstChar == "\ESC" then+            (firstChar ++) <$> replicateM 2 getChar else+            return firstChar+        flushInput caughtChars = hReady stdin >>=+            \ready -> if ready then getChar >> flushInput caughtChars else return caughtChars++indexToCoords :: Integral a => a -> a -> Coords+indexToCoords width index = tupleToCoords $ swap $ index `divMod` width where+    swap (x,y) = (y,x)++tupleToCoords :: Integral a => (a, a) -> Coords+tupleToCoords (x,y) = Coords (fromIntegral x) (fromIntegral y)

@@ -0,0 +1,4 @@+Snake+=====++A basic console snake game.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,11 @@+module Snake where++import Movement++data Snake = Snake { getDirection :: Direction+                   , getCoords :: [Coords] } deriving Eq++instance Show Snake where+    show (Snake direction []) = "Snake " ++ show direction ++ " []"+    show (Snake direction coords) = "Snake " ++ show direction ++ " [" ++ unwords (map showSnakeCoord coords) ++ "]" where+        showSnakeCoord (Coords x y) = "(" ++ show x ++ " " ++ show y ++ ")"

@@ -0,0 +1,21 @@+module Terminal where++import System.IO (stdin+                , hGetEcho+                , hGetBuffering+                , hSetEcho+                , hSetBuffering+                , BufferMode(..))+import Data.Maybe (fromMaybe)++import qualified System.Console.Terminal.Size as T++catchInput :: IO a -> IO a+catchInput action = (,) <$> hGetEcho stdin <*> hGetBuffering stdin >>=+    \(echo, buffering) -> hSetEcho stdin False >> hSetBuffering stdin NoBuffering >> action >>=+    \result -> hSetEcho stdin echo >> hSetBuffering stdin buffering >> return result++getTerminalWidthHeight :: Integral a => IO (a, a)+getTerminalWidthHeight = maybeWindowToWidthHeight <$> T.size where+    maybeWindowToWidthHeight maybeWindow = (T.width window, T.height window) where+        window = fromMaybe T.Window { T.width = 0, T.height = 0 } maybeWindow

@@ -0,0 +1,105 @@+module World where++import System.Random (randomRIO, Random)++import Data.List.Split (chunksOf)++import Terminal+import Movement+import Snake++data World = World { worldWidth :: Integer+                   , worldHeight :: Integer+                   , worldSnake :: Snake+                   , pellet :: Coords+                   , gameOver :: Bool } deriving Eq++instance Show World where+    -- OPTIMIZE: this is a hella long function.+    show World { worldWidth = width +               , worldHeight = height+               , worldSnake = snake+               , pellet = pellet+               , gameOver = gameOver } = if gameOver+    then "Game Over!\n"+    else showChunked $ map drawPoint rowReverseList where+        rowReverseList = concat $ reverse $ chunksOf (fromIntegral width) [0..(size - 1)]+        size = width * height++        drawPoint index = if snakeBodyIsAt index snake || pelletIsAt index pellet then 'o' else ' '+        snakeBodyIsAt index snake = indexToCoords width index `elem` getCoords snake+        pelletIsAt index pellet = indexToCoords width index == pellet++        showChunked list = boxWorld $ chunksOf (fromIntegral width) list+        boxWorld lineList = "/" ++ horizontalEdges ++ "\\\n" +++            concatMap (\line -> "|" ++ line ++ "|\n") lineList +++            "\\" ++ horizontalEdges ++ "/"+        horizontalEdges = replicate (fromIntegral width) '-'++randomWorld :: IO World+randomWorld = getTerminalWidthHeight >>= (\(x,y) -> return (x - 2, y - 2)) >>=+    return . newWorld >>= seedWorld++newWorld :: Integral a => (a, a) -> World+newWorld (width, height) = World { worldWidth = fromIntegral width+                                 , worldHeight = fromIntegral height+                                 , worldSnake = Snake North []+                                 , pellet = Coords pelletX pelletY+                                 , gameOver = False } where+    pelletX = fromIntegral $ width `div` 2+    pelletY = fromIntegral $ height `div` 2++-- OPTIMIZE: this should really be done with a Random instance for the+-- Snake, Coords, World, and Direction types.+seedWorld :: World -> IO World+seedWorld world = randomCoords (worldWidth world) (worldHeight world) >>=+    \coords -> return world { worldSnake = Snake North [coords] }++randomCoords :: (Integral a, Random a) => a -> a -> IO Coords+randomCoords width height = (,) <$> randomRIO (0, width) <*> randomRIO (0, height) >>=+    \(x, y) -> return $ Coords (fromIntegral x) (fromIntegral y)++getSnakeCoords :: World -> [Coords]+getSnakeCoords = getCoords . worldSnake++updatePelletCoords :: World -> IO Coords+updatePelletCoords world = if pellet world `elem` getSnakeCoords world+    then randomCoords (worldWidth world) (worldHeight world)+    else return $ pellet world++-- OPTIMIE: this is a very large function (albeit mainly pattern+-- matching and other simple constructs). It seems to be working+-- well, however, it is not unlikely that I've missed something.+updateWorld :: Move -> Coords -> World -> World+updateWorld move pelletCoords world@World { worldWidth = width+                                          , worldHeight = height+                                          , worldSnake = snake } = if newWorld == world+    then world { gameOver = True }+    else newWorld where+        newWorld = world { pellet = pelletCoords+                         , worldSnake = updateSnake move width height snake } where+            updateSnake m w h Snake { getDirection = d+                                    , getCoords = c } = Snake { getDirection = newDirection m d+                                                              , getCoords = newCoords m w h d c } where+                newDirection Noop           d = d+                newDirection Up             d = if d == South then d else North+                newDirection Down           d = if d == North then d else South+                newDirection Movement.Left  d = if d == East then d else West+                newDirection Movement.Right d = if d == West then d else East+                newCoords m w h d coords = let newHeadCoords = updateHead w h d (head coords) in+                    newHeadCoords : updateTail newHeadCoords coords where+                        updateTail nhc cs = if nhc == pelletCoords then cs+                            else if nhc == head cs then tail cs else init cs+                        updateHead w h d head = progressHead w h d head where+                            progressHead w h d head = if outOfBounds w h $ newHead d head+                                then head+                                else newHead d head where+                                outOfBounds w h coords@(Coords headX headY) = headX > (w - 1) ||+                                                                            headY > (h - 1) ||+                                                                            headX < 0 ||+                                                                            headY < 0 ||+                                                                            coords `elem` c+                                newHead North (Coords x y) = Coords x (y + 1)+                                newHead East  (Coords x y) = Coords (x + 1) y+                                newHead South (Coords x y) = Coords x (y - 1)+                                newHead West  (Coords x y) = Coords (x - 1) y

@@ -0,0 +1,27 @@+--  See http://haskell.org/cabal/users-guide++name:                snake+version:             0.1.0.0+synopsis:            A basic console snake game.+description:         A basic console snake game with rudimentary ASCII-based graphics and minimal dependencies.+homepage:            http://code.alaminium.me/habibalamin/snake+license:             MIT+license-file:        LICENSE+author:              Habib Alamin+maintainer:          ha.alamin@gmail.com+category:            Game+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++executable snake+  main-is:             Main.hs+  build-depends:       base >=4.8 && <4.9,+                       terminal-size >=0.3.2.1 && <0.3.3,+                       split >=0.2.3 && <0.2.4,+                       random >=1.1 && <1.1.1+  other-modules:       Terminal,+                       World,+                       Snake,+                       Movement+  default-language:    Haskell2010