Racetrack game with reading the track from a file

For this community challenge I made the racetrack game. I'm reading the race data from a text file, which is available here. This is only playable by entering the velocity at the console.

I've got two modules. I'm open for any comments.

Racetrack.hs

import Data.Serialize
import qualified Data.ByteString.Char8 as BStr
import RacetrackGameData

zipT :: (a -> b -> c) -> (a, a) -> (b, b) -> (c, c)
zipT f (x,y) (x', y') = (f x x',f y y')

isCrossingTheLine :: (Point,Point)->Point->Point->Bool
isCrossingTheLine line origin target =
let
reduce = uncurry $zipT (-) (dx,dy) = reduce line (dx',dy') = reduce (origin, target) in 0 /= dx * dy' - dx' * dy updatePlayer :: Player -> Point -> Player updatePlayer player newVelocity = player { position = newPosition, velocity = newVelocity } where newPosition = zipT (+) (position player) newVelocity playerInput :: Player -> IO Player playerInput player = do velo' <- safeGetLine$ "You must type a tuple like this one " ++ (show $velocity player) if uncurry (&&)$ zipT verify (velocity player) velo' then
return $updatePlayer player velo' else do putStrLn "You must specify a valid new velocity" playerInput player where verify x x' = (x' - x) elem [-1, 0, 1] playGame :: [Player] -> Game -> IO () playGame allPlayers game = play allPlayers where play [] = error "No players" play players@(current:nexts) = do print current putStrLn$ prettyGameOutput players game
current' <- playerInput current
if playerIsInValidState current' $gameBoard game then if isCrossingTheLine (finishLine game) (position current) (position current') then putStrLn$ "Player " ++ show (playerId current) ++ " won the game!"
else
play (nexts ++ [current'])
else
putStrLn "Game over"

safeGetLine :: (Read a) => String ->  IO a
safeGetLine errorMessage = do
pt <- fmap readMaybe getLine
case pt of
Just p -> return p
Nothing -> do
putStrLn errorMessage
safeGetLine errorMessage

main :: IO()
main = do
decodedGame <- fmap decode $BStr.readFile "game1.txt" putStrLn "How many player wants to play?" n <- safeGetLine "You must specify a number" case decodedGame of Left err -> putStrLn err Right game -> playGame (map (\i -> Player (startPosition game) (0,0) i) [0..n]) game  RacetrackGameData.hs module RacetrackGameData (serializeGame, Game(..), Point, Cell(..), Player(..), playerIsInValidState, prettyGameOutput) where import Data.List import Data.Maybe import Data.Matrix import Data.Serialize import qualified Data.ByteString.Char8 as BStr type Point = (Int, Int) data Player = Player { position :: Point, velocity :: Point, playerId :: Int } deriving (Show) data Cell = Empty | Wall deriving (Show, Eq) data Game = Game { gameBoard :: Matrix Cell, startPosition :: Point, finishLine :: (Point, Point) } deriving (Show) instance Serialize Game where put = put . serializeGame get = fmap deserializeGame get serializeGame :: Game -> BStr.ByteString serializeGame (Game board start finish) = BStr.unlines$ (BStr.pack $show start) : (BStr.pack$ show finish) : serializeBoard
where
serializeBoard =
map (BStr.pack . map serializeCell) $toLists$ board
serializeCell Empty = '0'
serializeCell Wall = '1'

readBStr :: (Read a) => BStr.ByteString -> a
deserializeGame :: BStr.ByteString -> Game
deserializeGame str = Game getBoard (readBStr startPos) (readBStr line)
where
(startPos:line:board) = BStr.lines $BStr.filter (\x -> x /= '\r') str getBoard = fromLists$ map (map deserializeCell . BStr.unpack) $board deserializeCell '0' = Empty deserializeCell '1' = Wall deserializeCell e = error$ "The character "++ show e ++ " is invalid"

playerIsInValidState :: Player -> Matrix Cell -> Bool
playerIsInValidState player board =
let (x, y) = position player
in getElem x y board == Empty

prettyGameOutput :: [Player] -> Game -> String
prettyGameOutput players (Game board _ line)  =
unlines $toLists$ matrix (nrows board) (ncols board) (\(i,j)->printCell (getElem i j board) (i, j))
where
printCell cell pos =
getFirstOrDefault ' '
[(const 'F') <$> (elemIsFinishPoint pos), (const '+') <$> (whenMaybe (Wall ==) cell),
(head . show . playerId) <$> (find (\p -> pos == position p) players)] getFirstOrDefault defValue = fromJust . fromMaybe (Just defValue) . find isJust whenMaybe p x = if p x then Just x else Nothing elemIsFinishPoint = whenMaybe (\x-> (\(a,b)-> a==x||b==x)$ line)

• How do I run this? I tried runhaskell Racetrack.hs, but then Data.Serialize was missing, so I installed the cereal package. Then Data.Matrix was missing, so I installed the matrix package. Now I get Not in scope: '<$>'. – mkrieger1 Aug 25 '15 at 9:44 • Perhaps you're using an old version of GHC. In 7.10, <$> is in the prelude, so just import Data.Functor – Bruno Aug 28 '15 at 22:45

--- playGame

Your playGame function has this structure:

playGame players@(current:rest) = do
...
playGame (rest ++ current')


Note that the list concatenation as ++ bs is O(n) where n is the size of as. That is, as basically gets copied, so this method of rotating a list is not efficient.

In practice this probably won't matter since the players list will be small, but it is something to keep in mind. A data structure which amortizes the copying might work better in this case is a difference list such as is implemented by the dlist package.

Alternatively just use a Data.Map where the key is a player number, and keep track of whose turn it is with an Int modulo the number of players - much like you would do in a conventional language.

--- playerIsInValidState

You should have a bounds check here. If (x,y) is out of bounds then getElem will throw an exception.

--- general organization

Games typically have the following types and organization:

GameState  - a data type recording the state of the game
Move       - a type representing a possible move

step :: GameState -> Move -> GameState
-- apply the move to the game state returning the
-- new game state


If a move can produce simple output, perhaps use this form for step:

step :: GameState -> Move -> (GameState, String)


Note that step is a pure function which makes it very easy to test. You can create unit tests for your code which may be run automatically by your build process. Pure functions are also a lot easier to test directly in a ghci session.

Your game loop can now look like this:

gameLoop :: GameState -> IO ()
gameLoop state = do
move <- askPlayer state
let (state', output) = step state move
if (not $null output) then putStrLn output else return () if gameOver state then return () else gameLoop state'  where askPlayer and gameOver have the following signatures: askPlayer :: GameState -> IO Move -- ask the current player for a move gameOver :: GameState -> Bool -- return True if the game is over  • Nice! thanks a lot :) However, there is an easier way to write your conditions in the gameLoop function ... when (not$ null output) (putStrLn output) unless (gameOver state) (gameLoop state') – Bruno Aug 24 '15 at 16:56

I doubt this counts as a code review, but these are my observations when running the program:

1. User interface

After starting the game and answering how many players want to play, I am presented with a view of the racetrack. Somewhere on the track is a 0 which I guess is my current position.

I don't know what I am supposed to do now and press Enter. The game asks me to "type a tuple". But what should the meaning of that tuple be? I enter (10, 15) and the game now replies that I must "specify a new valid velocity". But what is a valid new velocity? What is my current velocity? Since this is my first move I guess that my velocity is currently (0, 0) and I enter (1, 0), which brings me to...

2. Bugs

After entering (1, 0) the game tells me that I have won. That's great ... But I barely made my first move, let alone completed a lap! This can't be right.