Antimatroid, The

Introduction

A couple months back I wrote about a shoot’em up game that I was planning on making in Haskell. My goal was to make something a little more elaborate than my previous games and also take my understanding of Haskell further. Ultimately, I did not use Haskell and instead decided to use C# for the final product (main reason was productivity). Nonetheless, I felt it was worthwhile to post the work that was done on the prototype and talk a bit about the development process.

To get started, here is a quick demo of the features that were implemented in the prototype, namely, the user’s ability to navigate the ship and fire its weapons using the keyboard.

As others have put it, programming in Haskell is like writing a proof, so in similar vein I’m going to present the core modules of the prototype and then build upon those to present the more complicated ones (which follows more or less the development process). The code that is posted here was authored in Leksah, which replaces a lot of common syntax with “source candy”, so hopefully you will be able to deduce the formal syntax.

Mathematics Module

Since I didn’t have a lot experience in designing a game like this in Haskell, I decided I’d start with the basic mathematical model of the game. I thought about the concepts that were needed to represent bodies in a universe and settled on points, vectors and shapes to represent the ideas I had brewing in my head.

Point

The Point data type represents a single coordinate pair on the Euclidean Plane.

type Coordinate = Float

data Point = Point Coordinate Coordinate

pointZero :: Point
pointZero = Point 0.0 0.0

type Distance = Float

pointDistance :: Point →  Point →  Distance
pointDistance (Point x y) (Point u v) = sqrt ((x - u)↑2 + (y - v)↑2)

Vector

The Vector data type serves two purposes: the first is to describe the translation of points along the plane and the second is to describe the direction in which bodies are moving. The usual set of operations on Euclidean Vectors were implemented.

data Vector = Vector Coordinate Coordinate

instance Eq Vector where
    (Vector x y) ≡ (Vector u v) = (x ≡ u) ∧ (y ≡ v)
    (Vector x y) ≠ (Vector u v) = (x ≠ u) ∨ (y ≠ v)

vectorZero :: Vector
vectorZero = Vector 0.0 0.0

vectorUp :: Vector
vectorUp = Vector 0 1

vectorLeft :: Vector
vectorLeft = Vector (-1) 0

vectorDown :: Vector
vectorDown = Vector 0 (-1)

vectorRight :: Vector
vectorRight = Vector 1 0

vectorIdentity :: Vector →  Vector
vectorIdentity (Vector x y) = Vector x y

vectorAdd :: Vector →  Vector →  Vector
vectorAdd (Vector x y) (Vector x' y') = Vector (x + x') (y + y')

vectorDotProduct :: Vector →  Vector →  Float
vectorDotProduct (Vector x y) (Vector x' y') = (x * x') + (y * y')

vectorScale :: Float →  Vector →  Vector
vectorScale a (Vector x' y') = Vector (a * x') (a * y')

vectorMinus :: Vector →  Vector →  Vector
vectorMinus (Vector x y) (Vector x' y') = Vector (x - x') (y - y')

vectorMagnitude :: Vector →  Float
vectorMagnitude (u) = sqrt $ vectorDotProduct u u

vectorNormalize :: Vector →  Vector
vectorNormalize (u)
    | vectorMagnitude u ≡ 0 = Vector 0 0
    | otherwise = vectorScale (1.0 / (vectorMagnitude u)) u

pointAdd :: Point →  Vector →  Point
pointAdd (Point x y) (Vector u v) = Point (x + u) (y + v)

Shape

Bodies are represented as simple shapes. In the initial round of design, rectangles and ellipses were considered, but for the purpose of developing a prototype, I settled on circles. The benefit is that determining the minimum distance between two circles is simpler and consequently so is detecting collisions.

data Shape =
    Circle {
        center :: Point,
        radius :: Distance
    }

unitCircle :: Shape
unitCircle = Circle {
    center = pointZero,
    radius = 1.0
    }

shapeDistance :: Shape →  Shape →  Distance
shapeDistance (Circle c r) (Circle c' r') = (pointDistance c c') - (r + r')

shapeCollide :: Shape →  Shape →  Bool
shapeCollide a b = distance ≤ 0
    where
        distance = shapeDistance a b

Physics Module

Now that I had a mathematical model of the objects that would be considered, it made sense to tackle the physics model of the game. Bodies in the game are treated as simple Rigid Bodies with non-rotational Kinematics.

Movement

To capture the kinematics of the bodies, the Movement data type captures the location, velocity and acceleration of a body. The heart of the physics engine is captured in movementEvolved- it is responsible for updating the location, velocity and acceleration over a slice of time.

type Velocity = Vector

type Acceleration = Vector

data Movement = Movement {
    location :: Point,
    velocity :: Velocity,
    acceleration :: Acceleration
    }

movementZero :: Movement
movementZero = Movement {
    location = pointZero,
    velocity = vectorZero,
    acceleration = vectorZero
    }

type Time = Float

movementEvolve :: Movement →  Time →  Movement
movementEvolve (Movement l v a) t = Movement l' v' a'
    where a' = vectorIdentity a
          v' = vectorAdd (vectorScale t a) v
          l' = pointAdd l (vectorAdd (vectorScale (t * t / 2.0) a) (vectorScale t v))

Body

Each physical body in the universe has a mass, shape and movement. The second key component of the physics engine is the process of detecting collisions. bodiesCollide is responsible for taking a collection of bodies and for each one, collecting the bodies that collide with it and then supplying that body and its contacts to a function that determines the outcome of the collision.

type Mass = Float

data Body a = Body {
        shape :: Shape,
        mass :: Mass,
        movement :: Movement,
        description :: a
    }

bodyAddMass :: Body a →  Mass →  Body a
bodyAddMass (Body s m mo d) amount = Body {
        shape = s,
        mass = m + amount,
        movement = mo,
        description = d
    }

bodiesCollide :: [Body a] →  (Body a →  [Body a] →  [Body a]) →  [Body a]
bodiesCollide xs f = apply [] xs f

apply :: [Body a] →  [Body a] →  (Body a →  [Body a] →  [Body a]) →  [Body a]
apply _ [] _ = []
apply leftList (item:rightList) mapping = processed ⊕ remaining
    where
        processed =
            if null collisions
            then [item]
            else mapping item collisions
        collisions = filter (λx →  bodyCollide (item, x)) (leftList ⊕ rightList)
        remaining = apply (leftList ⊕ [item]) rightList mapping

bodyCollide :: (Body a, Body a) →  Bool
bodyCollide (a, b) = shapeCollide (shape a) (shape b)

bodyEvolve :: Body a →  Time →  Body a
bodyEvolve (Body (Circle c r) mass m d) t = Body {
    shape = Circle (location m') r,
    mass = mass,
    movement = m',
    description = d
    }
    where
        m' = movementEvolve m t

Universe

The game universe spans the plane, contains a collection of bodies and a sense of time. The universe brings together the two main components of the physics engine and exposes a way to remove items from the universe.

data Universe a = Universe {
    bodies :: [Body a],
    time :: Time
    }

universeAddBodies :: Universe a →  [Body a] →  Universe a
universeAddBodies u bs = Universe {
        bodies = (bodies u) ⊕ bs,
        time = time u
    }

universeCollide :: Universe a →  (Body a →  [Body a] →  [Body a]) →  Universe a
universeCollide (Universe bs t) f = Universe {
    bodies = bodiesCollide bs f,
    time = t
    }

universeEvolve :: Universe a →  Time →  Universe a
universeEvolve u t = Universe {
    bodies = map (λb →  bodyEvolve b t) (bodies u),
    time = t + (time u)
    }

universeFilter :: (Universe a) →  (Body a →  Bool) →  (Universe a)
universeFilter u p = Universe {
        bodies = filter p (bodies u),
        time = time u
    }

Game Module

Now that the physics of the universe have been described, we can start describing specific aspects of the game.

Weapon

Each ship has some number of weapons capable of doing some amount of damage and can fire projectiles with a given acceleration.

data Weapon =
    Torpedo

type Damage = Int

weaponDamage :: Weapon →  Damage
weaponDamage Torpedo = 2
weaponDamage _ = defined

type Thrust = Float

weaponThrust :: Weapon →  Thrust
weaponThrust Torpedo = 0.5
weaponThrust _ = undefined

Engine

Each ship has some number of engines capable of providing some amount of acceleration.

data Engine =
    Rocket

engineThrust :: Engine →  Thrust
engineThrust Rocket = 0.05
engineThrust _ = undefined

Ship

A ship is any body in the universe, described here as either a Projectile or a Fighter. It is what will be captured in the parametric type of the Universe data type.

data Ship =
    Projectile Thrust Damage
    | Fighter Engine Weapon

shipEngines :: Ship →  [Engine]
shipEngines (Fighter e _) = [e]
shipEngines _ = []

shipThrust :: Ship →  Thrust
shipThrust s = sum $ map engineThrust (shipEngines s)

shipWeapons :: Ship →  [Weapon]
shipWeapons (Fighter _ w) = [w]
shipWeapons _ = []

shipFireWeapons :: Ship →  [Ship]
shipFireWeapons s = map newProjectile $ shipWeapons s

Projectile

A projectile is any body fired from a weapon.

newProjectile :: Weapon →  Ship
newProjectile w = Projectile (weaponThrust w) (weaponDamage w)

projectileToBody :: Ship →  Movement →  Body Ship
projectileToBody p@(Projectile t d) m@(Movement l v a) = Body {
        shape = Circle {
            center = pointAdd l (vectorScale 1.1 vectorUp),
            radius = 0.2
        },
        movement = Movement {
            location = pointAdd l (vectorScale 1.25 vectorUp),
            velocity = vectorScale t vectorUp,
            acceleration = vectorIdentity a
        },
        description = p,
        mass = 1
    }

Fighter

The Fighter represents the end user and has a number of functions for controlling it. Notably, firing of the weapons and navigating the plane.

shipIsFighter :: Ship →  Bool
shipIsFighter (Fighter _ _) = True
shipIsFighter _ = False

fighterDestroyed :: (Universe Ship) →  Bool
fighterDestroyed (Universe bs t) = null $ filter (λb →  shipIsFighter (description b)) bs

fighterMove :: Body Ship →  Vector →  [Body Ship]
fighterMove (Body s mass (Movement l v a) d) direction = [Body {
        movement = Movement {
            location = l,
            velocity = vectorAdd δ v,
            acceleration = a
        },
        mass = mass,
        shape = s,
        description = d
    }]
    where
        δ = vectorScale (shipThrust d) direction

fighterFire :: Body Ship →  [Body Ship]
fighterFire b@(Body s mass m d) = [b] ⊕ bs
   where
        bs = map (λx →  projectileToBody x m) $ projectiles
        projectiles = shipFireWeapons d
        direction = vectorUp

universeActOnFighter :: (Universe Ship) →  (Body Ship →  [Body Ship]) →  (Universe Ship)
universeActOnFighter u f = Universe {
        bodies = bodiesActOnFighter (bodies u) f,
        time = time u
    }

bodiesActOnFighter :: [Body Ship] →  (Body Ship →  [Body Ship]) →  [Body Ship]
bodiesActOnFighter [] _ = []
bodiesActOnFighter (b:bs) f = b' ⊕ bs'
    where
        b' = bodyActOnFighter b f
        bs' = bodiesActOnFighter bs f

bodyActOnFighter :: Body Ship →  (Body Ship →  [Body Ship]) →  [Body Ship]
bodyActOnFighter b f
    | shipIsFighter $ description b = f b
    | otherwise = [b]

Graphics Module

The Graphics module deals with mapping the above data types into their corresponding HOpenGL counterparts. (I looked at a number of Haskell’s graphics libraries and ultimately chose to go with HOpenGL since I was the most familiar with OpenGL.)

coordinateToGLfloat :: Coordinate →  GLfloat
coordinateToGLfloat c = realToFrac c

type OpenGLPoint = (GLfloat, GLfloat, GLfloat)

pointToOpenGLPoint :: Geometry.Point →  OpenGLPoint
pointToOpenGLPoint (Geometry.Point x y) = (x', y', 0.0::GLfloat)
    where
        x' = coordinateToGLfloat x
        y' = coordinateToGLfloat y

type OpenGLView = [OpenGLPoint]

shapeToView :: Shape →  OpenGLView
shapeToView (Circle c r) = map pointToOpenGLPoint points
    where
        points = map (λθ →  Geometry.Point (r * (cos θ)) (r * (sin θ))) degrees
        degrees = map (λn →  n * increment ) [0..steps - 1]
        increment = 2.0 * pi / steps
        steps = 16

shipToView :: Ship →  OpenGLView
shipToView (Projectile _ _) = [ ... ]
shipToView (Fighter _ _) = [ ... ]
shipToView _ = undefined

openGLPointTranslate :: OpenGLPoint →  OpenGLPoint →  OpenGLPoint
openGLPointTranslate (x, y, z) (dx, dy, dz) = (x + dx, y + dy, z + dz)

openGLViewTranslate :: OpenGLView →  OpenGLPoint →  OpenGLView
openGLViewTranslate xs d = map (openGLPointTranslate d) xs

openGLPointToIO :: OpenGLPoint →  IO ()
openGLPointToIO (x, y, z) = vertex $ Vertex3 x y z

openGLViewToIO :: OpenGLView →  IO ()
openGLViewToIO ps = mapM_ openGLPointToIO ps

displayBody :: Body Ship →  IO()
displayBody (Body s mass m d) =
    color (Color3 (1.0::GLfloat) 1.0 1.0) >>
    renderPrimitive LineLoop ioShip
    where
        ioBody = openGLViewToIO $ openGLViewTranslate (shapeToView s) dl
        ioShip = openGLViewToIO $ openGLViewTranslate (shipToView d) dl
        dl = pointToOpenGLPoint l
        l = location m

displayUniverse :: Universe Ship →  IO ()
displayUniverse universe = mapM_ displayBody $ bodies universe

Main Module

The Main Module is the glue that brings together all of the other modules. Much of the functions described here are for gluing together the OpenGL callbacks to the functions described above.

theUniverse :: Universe Ship
theUniverse = ...

main :: IO()
main = do
    (programName, _) ←  getArgsAndInitialize
    initialDisplayMode $= [ DoubleBuffered ]
    createWindow "Space Cowboy"
    universe ←  newIORef theUniverse
    displayCallback $= (display universe)
    idleCallback $= Just (idle universe)
    keyboardMouseCallback $= Just (keyboardMouse universe)
    mainLoop

display :: IORef (Universe Ship) →  IO ()
display ioRefUniverse = do
    clear [ ColorBuffer ]
    loadIdentity
    scale 0.2 0.2 (0.2::GLfloat)
    universe ←  get ioRefUniverse
    displayUniverse universe
    swapBuffers
    flush

idle :: IORef (Universe Ship) →  IO ()
idle ioRefUniverse = do
    universe ←  get ioRefUniverse
    ioRefUniverse $= stepUniverse universe game
    threadDelay 10
    postRedisplay Nothing

stepUniverse :: (Universe Ship) →  (Universe Ship)
stepUniverse u = collided
    where
        collided = universeCollide filtered collide
        filtered = universeFilter evolved inBounds
        evolved = universeEvolve u 0.1

collide :: Body Ship →  [Body Ship] →  [Body Ship]
collide b@(Body s mass m (Projectile d t)) xs = []
collide b _ = [b]

inBounds :: Body Ship →  Bool
inBounds b@(Body _ _ (Movement (Geometry.Point x y) _ _) d)
    | shipIsFighter d = True
    | otherwise = and [abs x < 10, abs y < 10]

keyboardMouse ioRefUniverse key state modifiers position =
    keyboard ioRefUniverse key state

keyboard :: IORef (Universe Ship) →  Key →  KeyState →  IO ()
keyboard ioRefUniverse (Char 'q') Down = do exitSuccess
keyboard ioRefUniverse (Char ' ') Down = fire ioRefUniverse
keyboard ioRefUniverse (SpecialKey KeyLeft) Down = navigate ioRefUniverse vectorLeft
keyboard ioRefUniverse (SpecialKey KeyRight) Down = navigate ioRefUniverse vectorRight
keyboard ioRefUniverse (SpecialKey KeyUp) Down = navigate ioRefUniverse vectorUp
keyboard ioRefUniverse (SpecialKey KeyDown) Down = navigate ioRefUniverse vectorDown
keyboard _ _ _ = return ()

fire :: IORef (Universe Ship) →  IO()
fire ioRefUniverse = do
    universe ←  get ioRefUniverse
    ioRefUniverse $= universeActOnFighter universe fighterFire

navigate :: IORef (Universe Ship) →  Vector →  IO ()
navigate ioRefUniverse direction = do
    universe ←  get ioRefUniverse
    ioRefUniverse $= universeActOnFighter universe (λf →  fighterMove f direction)

Wrap-up

For a month of on-again, off-again work, the prototype turned out reasonably well and I got a lot out of it. I think that as I continue to use Haskell, my brain will slowly switch from thinking in terms of structures of data to flows of data and I will ultimately be able to be more productive in Haskell. Until then, I’m going to stick with my current technology stack and continue to experiment with Haskell. Keep an eye for part three of this series which will go over the completed product.