The beginnings of a real-time strategy game in Haskell

As a grad student, I spend most of my time doing math, and the rest of my time feeling guilty for not doing math. One of my friends who has “been there” suggested I should do something besides math during break. Other friends said I should use this as a chance to do a ton of math. Compromise: hang out in Seattle playing Grand Theft Auto IV and goofing off in Haskell.

So while the controller wasn’t in my hands (it was my host’s XBox, after all), I thought it’d be fun to see how succinctly I could get a real-time strategy game expressed in Haskell. I’m still working on it, but I figured I’d post what I have for now. This is literate Haskell, so you can dump this post into ghci and it’ll be ready to rock.

If you pay close attention, you’ll see that we have (something close to) knot-tying going on (we use integers to identify objects, and tie the knot using them as a lookup key) as well as some usage of software transactional memory.


In this post, we are going to write a real-time strategy game. We won’t give it
a GUI; instead, we are going to use a command-line interface, typing commands to
tell our army what to do.

The usual module imports:

> import Control.Concurrent
> import Control.Concurrent.STM
> import Control.Monad.State
> import Data.Complex
> import Data.List
> import Data.Maybe

We will have three types of units:

> data UnitType = Builder | Refinery | Fighter
>	deriving (Show, Eq)

Each type has its own initial health:

> type Health = Int
> defaultHealth :: UnitType -> Health
> defaultHealth Builder  = 55
> defaultHealth Refinery = 8
> defaultHealth Fighter  = 13

We need a notion of location. I’m going to use complex numbers for everything
since they come with a lot of functionality.

> type Location = Complex Double
> type Velocity = Complex Double
> type Speed = Double

There are a few commands we can give our units:

> data Command = Attack Unit | Mine | Build UnitType | Go Location | Idle
>   deriving Eq
> instance Show Command where
>  show (Attack _) = "Attack"
>  show Mine = "Mine"
>  show (Build ut) = "Build " ++ (show ut)
>  show (Go l) = "Go " ++ (show l)
>  show Idle = "Idle"

Units need to have some attributes:

> type UnitID = Int
> data Unit = Unit { ident   :: UnitID,
>		     owner   :: Player,
>		     utype   :: UnitType,
>		     pos     :: Location,
>		     health  :: Health,
>		     cmd     :: Command }
>  deriving Show
> instance Eq Unit where
>  u == v = ident u == ident v

Not all units can travel at the same speed. Here’s a function that tells us how
fast units move:

> speed :: Unit -> Double
> speed u = case (utype u) of
>		Builder  -> 1
>		Refinery -> 2
>		Fighter  -> 3

Not all units cause the same amount of damage:

> damage :: Unit -> Health
> damage u | utype u == Builder  = 0
>	   | utype u == Refinery = 0
>	   | utype u == Fighter  = 3

We need a notion of player. Players have units:

> type Name = String
> data Player = Player Name
>	deriving (Eq, Show)

And a notion of game:

> data Game = Game { units :: [Unit],
>		     players :: [Player],
>		     idents :: [UnitID],
>		     msgs :: [ (Unit, Command) ] }
> instance Show Game where
>  show g = "Players: " ++ (show $ players g) ++ "\nUnits: " ++ (show $ units g)
> makeGame :: [Player] -> Game
> makeGame ps = Game [] ps [1 .. ] []

We’re going to use the State monad for, well, managing the state of the game.
But let’s give it a fancy name, just to keep things clear:

> type GameSt a = State Game a

We need a command for adding a unit to the game.

> addUnit :: Player -> UnitType -> Location -> GameSt Unit
> addUnit p ut l
>     = do g@Game{units=us, idents=i:is} <- get
>	   let u = Unit { ident = i, owner = p, utype = ut, pos = l,
>			  health = defaultHealth ut, cmd = Idle }
>	   put g{units=u:us, idents=is}
>	   return u

We also need a command for telling units what to do.

> command :: Unit -> Command -> GameSt ()
> command u c = do g <- get
>		   put g{ msgs = (u,c):(msgs g) }
>		   return ()

Now we need a method for “ticking” the game. First, we say that a player is
dead when they have no builders left.

> playerIsAlive :: Game -> Player -> Bool
> playerIsAlive g p = foldl (\t -> \u -> t || isBuilder u) False (units g)
>	where isBuilder u = (owner u == p) && (utype u == Builder)

A game tick consists of ticking each of the units, then leaving only the players
who still are alive.

> tick :: GameSt (Maybe Player)
> tick = do g@Game{ players = ps, units = us } <- get
>	    let g' = g{ units   = (mapMaybe (tickUnit g g') us),
>			players = (filter (playerIsAlive g) ps),
>			msgs = [] }
>	    put g'
>	    if (length $ players g') == 1 then return (Just $ head $ players g')
>					  else return Nothing

Unit ticking is the trickiest part. Since the collection of units is a directed
cyclic graph (units can attack each other), it is the case that we need to “tie
the knot.” To do this, the tickUnit function needs to know what the updated
game state is, so that it can create references to the newly updated targets.
Luckily we are in a lazy evaluation situation, so this is completely reasonable.

> tickUnit :: Game -> Game -> Unit -> Maybe Unit
> tickUnit g@Game{ units = us } Game{ units = us' } u
>   = (takeDamage $ deliverMsgs $ procCmd u) >>= checkPlayer
>  where procCmd u = case (cmd u) of
>			Idle -> u
>			Go l -> goTo l u
>			Attack v ->
>			  maybe u{ cmd = Idle }
>				(\v' -> (goNear u $ pos v'){ cmd = Attack v' })
>				(find (v ==) us)
>			Mine    -> u
>			Build _ -> u
>	 goTo l u = let vec = (l - (pos u))
>			vel = vec / (0 :+ ((magnitude vec) * (speed u)))
>		    in if (magnitude vec) > 2 then u{ pos = l + vel } else u
>	 goNear u l = let dist = magnitude $ (pos u) - l
>		      in if dist > attackRange then (goTo l u) else u
>	 takeDamage u = let h' = foldl (checkAttack) (health u) us
>			in if h' <= 0 then Nothing else Just u{ health = h' }
>	 checkAttack h v = let dist = magnitude $ (pos u) - (pos v)
>			       d    = if isAttacking then (-1) else 0
>			       isAttacking = (dist <= attackRange) &&
>					     (cmd v == Attack u)
>			   in (d * damage v)+h
>	 attackRange = 10
>	 deliverMsgs u = case (filter ((==) u . fst) (msgs g)) of
>				((_,c):_) -> u{ cmd = c }
>				[]	  -> u
>	 checkPlayer u = if (playerIsAlive g $ owner u) then Just u else Nothing

Here’s a function that, given a game, plays it for n turns. If there’s a winner
by then, the winner gets returned. If not, it returns Nothing.

> play :: Int -> GameSt (Maybe Player)
> play n = if n == 0 then return Nothing
>		     else do mp <- tick
>			     case mp of
>				Nothing -> play $ max (-1) (n-1)
>				Just p  -> return $ Just p

Here is what the game looks like:

> tim   = Player "Tim"
> chris = Player "Chris"
> cyndi = Player "Cyndi"
> (w,g) = runState (
>		     do tim_builder   <- addUnit tim Builder (0 :+ 0)
>			chris_builder <- addUnit chris Builder (100 :+ 50)
>			cyndi_builder <- addUnit cyndi Builder (75 :+ 5)
>			tim_f1 <- addUnit tim  Fighter ((-3) :+ 0)
>			tim_f2 <- addUnit tim  Fighter (0 :+ 0)



>			chr_f1 <- addUnit chris Fighter (0 :+ 0)
>			command tim_f1 (Attack chris_builder)
>			command tim_f2 (Attack cyndi_builder)
>			command chr_f1 (Attack tim_f2)
>			play 100
>		    )
>		    (makeGame [tim, chris, cyndi])

If you play the above game, there won’t be a winner because chr_f1 will kill
tim_f2 before tim_f2 can finish killing cyndi_builder. If you take out the
command to chr_f1, then tim will win.

This is all pretty cool, but we still don’t have any type of interactivity.
Once we start the game, it just kinda does its thing. It’d be much better if
we could feed commands in during the simulation. To do this, we need to
introduce some concurrency. We will have one thread that plays the game, and
another to feed commands into it. We will use Software Transactional Memory to
manage the shared game object.

> makeSharedGame :: [Player] -> IO (TVar Game)
> makeSharedGame = atomically . newTVar . makeGame

> playSharedGame :: (TVar Game) -> IO Player
> playSharedGame tvg = do w <- atomically $
>				do g <- readTVar tvg
>				   let (w,g') = runState tick g
>				   writeTVar tvg g'
>				   return w
>			  case w of
>				Nothing -> do threadDelay 1000
>					      playSharedGame tvg
>				Just p  -> return p

We’ve got a bunch of commands for modifying game state. Here’s a function that
applies them to the shared game state thingy.

> applyCommand :: (TVar Game) -> (GameSt a) -> IO a
> applyCommand tvg c = atomically $
>			do g <- readTVar tvg
>			   let (a,g') = runState c g
>			   writeTVar tvg g'
>			   return a

Here’s an example of how we use this from ghci. No special extensions needed:

shared <- makeSharedGame [tim, chris, cyndi]

tim_builder <- applyCommand shared $ addUnit tim Builder (0 :+ 0)
chr_builder <- applyCommand shared $ addUnit chris Builder (0 :+ 0)
cyn_builder <- applyCommand shared $ addUnit cyndi Builder (0 :+ 0)

forkIO $ (playSharedGame shared) >>= (putStrLn . ("Winner: " ++) . show)

tim_f1 <- applyCommand shared $ addUnit tim Fighter ((-3) :+ 0)
tim_f2 <- applyCommand shared $ addUnit tim  Fighter (0 :+ 0)

applyCommand shared $ command tim_f1 (Attack chr_builder)
applyCommand shared $ command tim_f2 (Attack cyn_builder)

For instance, here’s what this looks like in ghci:

An interactive session in ghci

An interactive session in ghci

Now to get around to adding some more unit functionality, along with a graphical display of the game world!

Some day I’ll be a language designer

…and then I’ll understand why so many Haskell examples are examples of language interpreters. Until then, seriously, no one actually writes that kinda stuff, so honestly, it’s a silly example that we’ve really beaten to death. Give it up already. For real.