Después de completar el curso sobre Haskell, decidí consolidar mis conocimientos con el primer proyecto. Escribiremos una serpiente para la terminal. Para hacer que el juego sea único, agreguemos un bot que revisará el juego en sí.
El proyecto está escrito en la plataforma haskell, Ubuntu 20.04.
Bucle de juego
. , . 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 , , . , , , , , .
Conectemos nuestro nextDirBot al controlador de movimiento de la serpiente, agreguemos un menú y observemos el resultado.
