10
\$\begingroup\$

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 Text.Read(readMaybe)
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        
readBStr = read . BStr.unpack
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)
\$\endgroup\$
  • \$\begingroup\$ 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: '<$>'. \$\endgroup\$ – mkrieger1 Aug 25 '15 at 9:44
  • \$\begingroup\$ Perhaps you're using an old version of GHC. In 7.10, <$> is in the prelude, so just import Data.Functor \$\endgroup\$ – Bruno Aug 28 '15 at 22:45
4
\$\begingroup\$

--- 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
\$\endgroup\$
  • \$\begingroup\$ 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') \$\endgroup\$ – Bruno Aug 24 '15 at 16:56
1
\$\begingroup\$

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.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.