After completing the course on Haskell, I decided to consolidate my knowledge with the first project. We will write a snake for the terminal. To make the game unique, let's add a bot that will go through the game itself.
The project is written on haskell-platform, Ubuntu 20.04.
Game loop
. , . Control.Concurrent. forkIO MVar. , tryInput Maybe Char , . . System.IO - EOL . , hSetBuffering stdin NoBuffering Windows - getChar EOL . System.Console.ANSI .
UPDATE
hReady, @GospodinKolhoznik
import Control.Concurrent
import System.Console.ANSI
import System.IO
gameLoop :: ThreadId -> MVar Char -> IO ()
gameLoop inputThId input = do
tryInput <- tryTakeMVar input
gameLoop inputThId input
inputLoop :: MVar Char -> IO ()
inputLoop input = (putMVar input =<< getChar) >> inputLoop input
main = do
hSetBuffering stdin NoBuffering
hSetEcho stdin False
clearScreen
input <- newEmptyMVar
inputThId <- forkIO $ inputLoop input
gameLoop inputThId input
. 4 : Process - , Bot - , GameOver Quit. data World, - gameLoop. , , . . (0,0) . , 4 .
data StepDirection = DirUp
| DirDown
| DirLeft
| DirRight deriving (Eq)
type Point = (Int, Int)
type Snake = [Point]
data WorldState = Process
| GameOver
| Quit
| Bot deriving (Eq)
data World = World { snake :: Snake
, direction :: StepDirection
, fruit :: Point
, worldState :: WorldState
}
gameLoop :: ThreadId -> MVar Char -> World -> IO ()
{-- … --}
. Data.Time.Clock. 3 : lastUpdateTime - , updateDelay - isUpdateIteration - . timerController. isUpdateIteration, .
import Data.Time.Clock
data World = World {
{-- … --}
, lastUpdateTime :: UTCTime
, updateDelay :: NominalDiffTime
, isUpdateIteration :: Bool
}
initWorld :: UTCTime -> World
initWorld timePoint = World { snake = [(10, y) | y <- [3..10]]
, direction = DirRight
, fruit = (3, 2)
, lastUpdateTime = timePoint
, updateDelay = 0.3
, isUpdateIteration = True
, worldState = Process
}
timerController :: UTCTime -> World -> World
timerController timePoint world
| isUpdateTime timePoint world = world { lastUpdateTime = timePoint
, isUpdateIteration = True
}
| otherwise = world where
isUpdateTime timePoint world =
diffUTCTime timePoint (lastUpdateTime world) >= updateDelay world
gameLoop inputThId input oldWorld = do
{-- … --}
timePoint <- getCurrentTime
let newWorld = timerController timePoint oldWorld
gameLoop inputThId input newWorld { isUpdateIteration = False }
main = do
{-- … --}
timePoint <- getCurrentTime
gameLoop inputThId input (initWorld timePoint)
inputController. WSAD . , , , 1 . , . , , updateDelay. pointStep , , .
pointStep :: StepDirection -> Point -> Point
pointStep direction (x, y) = case direction of
DirUp -> (x, y - 1)
DirDown -> (x, y + 1)
DirLeft -> (x - 1, y)
DirRight -> (x + 1, y)
inputController :: Maybe Char -> World -> World
inputController command world = let
boost dir1 dir2 = if dir1 == dir2 then 0.05 else 0.3
filterSecondSegmentDir (x:[]) dirOld dirNew = dirNew
filterSecondSegmentDir (x:xs) dirOld dirNew | pointStep dirNew x == head xs = dirOld
| otherwise = dirNew in
case command of
Just 'w' -> world { direction = filterSecondSegmentDir (snake world) (direction world) DirUp
, updateDelay = boost (direction world) DirUp
, worldState = Process
}
Just 's' -> world { direction = filterSecondSegmentDir (snake world) (direction world) DirDown
, updateDelay = boost (direction world) DirDown
, worldState = Process
}
Just 'a' -> world { direction = filterSecondSegmentDir (snake world) (direction world) DirLeft
, updateDelay = boost (direction world) DirLeft
, worldState = Process
}
Just 'd' -> world { direction = filterSecondSegmentDir (snake world) (direction world) DirRight
, updateDelay = boost (direction world) DirRight
, worldState = Process
}
Just 'q' -> world { worldState = Quit }
Just 'h' -> world { worldState = Bot }
_ -> world { updateDelay = 0.3 }
moveController , isUpdateIteration .
snakeStep :: StepDirection -> Snake -> Snake
snakeStep direction snake = (pointStep direction $ head snake):(init snake)
moveController :: World -> World
moveController world
| not $ isUpdateIteration world = world
| otherwise = world { snake = snakeStep (direction world) (snake world) }
. , . , . (1,1) — (20,20) — .
initWalls :: Walls
initWalls = ((1,1),(20,20))
, . Haskell System.Random, randomR. , , randomR , . . , . .
import System.Random
data World = World {
{-- … --}
, oldLast :: Point
, rand :: StdGen
}
initWorld timePoint = World {
{-- … --}
, oldLast = (0, 0)
, rand = mkStdGen 0
}
{-- … --}
timerController timePoint world
| isUpdateTime timePoint world = world {
{-- … --}
, oldLast = last $ snake world
}
{-- … --}
.
collisionSnake :: Snake -> Bool
collisionSnake (x:xs) = any (== x) xs
collisionWall :: Point -> Walls -> Bool
collisionWall (sx,sy) ((wx1,wy1),(wx2,wy2)) =
sx <= wx1 || sx >= wx2 || sy <= wy1 || sy >= wy2
collisionController. GameOver , . , . , 1 , GameOver .
collisionController :: World -> World
collisionController world
| not $ isUpdateIteration world = world
| collisionSnake $ snake world = world { worldState = GameOver }
| collisionWall (head $ snake world) initWalls = world { worldState = GameOver }
| checkWin (snake world) initWalls = world { worldState = GameOver }
| collisionFruit (snake world) (fruit world) = world { snake =
(snake world) ++ [oldLast world]
, fruit = newFruit
, rand = newRand
}
| otherwise = world where
checkWin snake ((x1, y1),(x2, y2)) = (x2 - x1 - 1) * (y2 - y1 - 1) - length snake == 1
collisionFruit snake fruit = fruit == head snake
(newFruit, newRand) = freeRandomPoint world (rand world)
randomPoint ((minX, minY), (maxX, maxY)) g = let
(x, g1) = randomR (minX + 1, maxX - 1) g
(y, g2) = randomR (minY + 1, maxY - 1) g1 in
((x, y), g2)
freeRandomPoint world g | not $ elem point ((fruit world):(snake world)) =
(point, g1)
| otherwise = freeRandomPoint world g1 where
(point, g1) = randomPoint initWalls g
. drawPoint . renderWorld . isUpdateIteration, moveController, collisionController renderWorld . , . .
renderWorld :: World -> IO ()
renderWorld world
| not $ isUpdateIteration world = return ()
| otherwise = do
drawPoint '@' (fruit world)
drawPoint ' ' (oldLast world)
mapM_ (drawPoint 'O') (snake world)
setCursorPosition 0 0
drawPoint :: Char -> Point -> IO ()
drawPoint char (x, y) = setCursorPosition y x >> putChar char
drawWalls :: Char -> Walls -> IO ()
drawWalls char ((x1, y1),(x2, y2)) = do
mapM_ (drawPoint char) [(x1, y)| y <- [y1..y2]]
mapM_ (drawPoint char) [(x, y1)| x <- [x1..x2]]
mapM_ (drawPoint char) [(x2, y)| y <- [y1..y2]]
mapM_ (drawPoint char) [(x, y2)| x <- [x1..x2]]
main = do
{-- … --}
drawWalls '#' initWalls
{-- … --}
.
gameLoop inputThId input oldWorld = do
{-- … --}
let newWorld = collisionController . moveController $ timerController timePoint (inputController tryInput oldWorld)
renderWorld newWorld
{-- … --}
. . CodeBullet. @RussianDragon. .
: - , . . : Path - , ClosedPath - .
type Path = [Point]
type ClosedPath = [Point]
, wallsFirstPoint . . isPathContain , . clockwise . distBetweenPoints - , .
clockwise = [DirUp, DirRight, DirDown, DirLeft]
wallsFirstPoint :: Point
wallsFirstPoint = ((fst $ fst initWalls) + 1, (snd $ fst initWalls) + 1)
isPathContain :: Path -> Point -> Bool
isPathContain path point = any (== point) path
distBetweenPoints :: Point -> Point -> Int
distBetweenPoints (x1, y1) (x2, y2) = abs (x1 - x2) + abs (y1 - y2)
getHamPath. , , . , , . , nextHamPathPoint. 4 . , . , nextHamPathPoint , . , .
getHamPath :: Point -> ClosedPath -> ClosedPath
getHamPath currentPoint hamPath | hamPathCapacity initWalls == length (currentPoint:hamPath)
&& distBetweenPoints currentPoint (last hamPath) == 1
= currentPoint:hamPath
| otherwise = getHamPath newPoint (currentPoint:hamPath) where
newPoint = nextHamPathPoint (currentPoint:hamPath) clockwise
hamPathCapacity ((x1, y1),(x2, y2)) = (x2 - x1 - 1) * (y2 - y1 - 1)
nextHamPathPoint :: Path -> [StepDirection] -> Point
nextHamPathPoint _ [] = error "incorrect initWalls"
nextHamPathPoint hamPath (dir:dirs) | isPathContain hamPath virtualPoint
|| collisionWall virtualPoint initWalls =
nextHamPathPoint hamPath dirs
| otherwise = virtualPoint where
virtualPoint = pointStep dir (head hamPath)
.
data World = World {
{-- … --}
, hamPath :: ClosedPath
}
initWorld timePoint = World {
{-- … --}
, hamPath = getHamPath wallsFirstPoint []
}
2 . , , . DirFromHead DirFromTail .
data PathDirection = DirFromHead | DirFromTail deriving (Eq)
nextDirOnPath, . (botStepDir, botPathDir) . . DirFromHead, , .
moveController world
{-- … --}
| worldState world == Process = world {snake = snakeStep (direction world) (snake world)}
| otherwise = world { snake = snakeStep botStepDir (snake world)
, hamPath = if botPathDir == DirFromTail then hamPath world else reverse $ hamPath world
} where
(botStepDir, botPathDir) = nextDirOnPath (snake world) (hamPath world)
nextDirOnPath :: Snake -> ClosedPath -> (StepDirection, PathDirection)
nextDirOnPath = undefined
: dirBetweenPoints pointNeighborsOnPath .
dirBetweenPoints :: Point -> Point -> StepDirection
dirBetweenPoints (x1, y1) (x2, y2) | x1 == x2 = if y1 > y2 then DirUp else DirDown
| y1 == y2 = if x1 > x2 then DirLeft else DirRight
| otherwise = if abs (x1 - x2) < abs (y1 - y2) then
dirBetweenPoints (x1, 0) (x2, 0) else
dirBetweenPoints (0, y1) (0, y2)
pointNeighborsOnPath :: Point -> ClosedPath -> (Point, Point)
pointNeighborsOnPath point path | not $ isPathContain path point || length path < 4 = error "incorrect initWalls"
| point == head path = (last path, head $ tail path)
| point == last path = (last $ init path, head path)
| otherwise = _pointNeighborsOnPath point path where
_pointNeighborsOnPath point (a:b:c:xs) = if point == b then (a,c) else _pointNeighborsOnPath point (b:c:xs)
, , .
nextDirOnPath :: Snake -> ClosedPath -> (StepDirection, PathDirection)
nextDirOnPath (snakeHead:snakeTail) path | snakeTail == [] = (dirBetweenPoints snakeHead point1, DirFromTail)
| point1 == head snakeTail = (dirBetweenPoints snakeHead point2, DirFromHead)
| otherwise = (dirBetweenPoints snakeHead point1, DirFromTail) where
(point1, point2) = pointNeighborsOnPath snakeHead path
, , .
, : collisionSnakeOnPath , distBetweenPointsOnPath . DirFromTail , DirFromHead.
collisionSnakeOnPath :: Snake -> Point -> ClosedPath -> PathDirection -> Bool
collisionSnakeOnPath snake point path pathDir | null $ common snake pathPart = False
| otherwise = True where
pathPart = takePathPart point (if pathDir == DirFromHead then path else reverse path) (length snake)
common xs ys = [ x | x <- xs , y <- ys, x == y]
takePathPart point path len = _takePathPart point (path ++ (take len path)) len where
_takePathPart _ [] _ = []
_takePathPart point (x:xs) len | x == point = x:(take (len - 1) xs)
| otherwise = _takePathPart point xs len
distBetweenPointsOnPath :: Point -> Point -> ClosedPath -> (Int, Int)
distBetweenPointsOnPath point1 point2 path | point1 == point2 = (0, 0)
| id1 < id2 = (length path - id2 + id1,id2 - id1)
| otherwise = (id1 - id2, length path - id1 + id2) where
(id1,id2) = pointIndexOnPath (point1,point2) path 0 (0,0)
pointIndexOnPath _ [] _ ids = ids
pointIndexOnPath (point1,point2) (x:xs) acc (id1,id2) | x == point1 = pointIndexOnPath (point1,point2) xs (acc+1) (acc,id2)
| x == point2 = pointIndexOnPath (point1,point2) xs (acc+1) (id1,acc)
| otherwise = pointIndexOnPath (point1,point2) xs (acc+1) (id1,id2)
. enterPointBypass , . , nextDirOnPath.
nextDirBot :: Snake -> Point -> ClosedPath -> (StepDirection, PathDirection)
nextDirBot snake fruit path | distBypass1 < distBypass2 && distBypass1 < distToFruit1
&& not (collisionSnakeOnPath snake enterPointBypass path DirFromTail)
= (dirBetweenPoints (head snake) enterPointBypass, DirFromTail)
| distBypass2 < distToFruit1
&& not (collisionSnakeOnPath snake enterPointBypass path DirFromHead)
= (dirBetweenPoints (head snake) enterPointBypass, DirFromHead)
| otherwise = nextDirOnPath snake path where
dirBypass = dirBetweenPoints (head snake) fruit
enterPointBypass = pointStep dirBypass (head snake)
(distBypass1, distBypass2) = distBetweenPointsOnPath enterPointBypass fruit path
(distToFruit1, _) = distBetweenPointsOnPath (head snake) fruit path
2 . enterPointBypass , , . , , , , , .
Let's connect our nextDirBot to the snake motion controller, add a menu and look at the result.
