I recently revisited my project to bring concepts from Jason Gregory's Game Engine Architecture into Haskell and found that they are translating quite well. The relational ideas I've been playing around with mesh nicely though there are still some rough edges. This is not a highly efficient implementation but I think that the code allows for some nice possible optimizations.

I decided that I wanted to implement skeletal animation since I figured that even a great set of free game sprites would only go so far. Fortunately GEA has a great description of this with a precise set of terminology, and helped me get this implementation going. I apologize ahead of time for any butchering of terminology that will likely happen.

As most of you know, skeletal animation binds meshes to a system of joints, so that manipulating the joints will deform the meshes. This allows you to get your characters into different poses without drawing them from scratch, and later, poses can also be blended to get combinations of movements, like running and shooting. I will skip most of the math specifics since there are a lot of resources that go into the details.

So far my code just gets from this:

To this:

But eventually this should let me get a lot of movement out of the characters from a small set of base art.

I'm still using a similar setup to Experimenting with Game Concepts in Haskell. So an entity like a player is split up into several components, and they are only associated with each other by a shared id. After using this for a while I feel that the single shared id is too limiting and a more standard relational design would work better, but the single id is a good starting point.

As before the entire game state is stored in a single value that is updated in a purely functional way. The game state value is stored in a transactional variable (TVar) that is updated on each game step.

data GameState = GameState { player :: HaskQuery.Relation (Component Player) (HaskQuery.IntIndex.IntIndex), position :: HaskQuery.Relation (Component Position) (HaskQuery.IntIndex.IntIndex), texture :: HaskQuery.Relation (Component Texture) (HaskQuery.IntIndex.IntIndex), renderer :: HaskQuery.Relation (Component Renderer) (HaskQuery.IntIndex.IntIndex), axisAlignedBoundingBox :: HaskQuery.Relation (Component AxisAlignedBoundingBox) (HaskQuery.IntIndex.IntIndex), skeleton :: HaskQuery.Relation (Component Skeleton) (HaskQuery.IntIndex.IntIndex), flatSkeleton :: HaskQuery.Relation (Component (FlatSkeleton Bone)) (HaskQuery.IntIndex.IntIndex), flatSkeletonJoint :: HaskQuery.Relation (Component (FlatSkeleton Joint)) (HaskQuery.IntIndex.IntIndex), _globalPose :: HaskQuery.Relation (Component GlobalSkeletonPose) (HaskQuery.IntIndex.IntIndex), _mesh :: HaskQuery.Relation (Component Mesh) (HaskQuery.IntIndex.IntIndex), _meshSkeletonBinding :: HaskQuery.Relation (Component MeshSkeletonBinding) (HaskQuery.IntIndex.IntIndex), _animationClip :: HaskQuery.Relation (Component AnimationClip) (HaskQuery.IntIndex.IntIndex), _animationState :: HaskQuery.Relation (Component AnimationState) (HaskQuery.IntIndex.IntIndex), currentId :: GameEntityIdentifier }

The key fields that are used for posing are:

position :: HaskQuery.Relation (Component Position) (HaskQuery.IntIndex.IntIndex), flatSkeletonJoint :: HaskQuery.Relation (Component (FlatSkeleton Joint)) (HaskQuery.IntIndex.IntIndex), _globalPose :: HaskQuery.Relation (Component GlobalSkeletonPose) (HaskQuery.IntIndex.IntIndex), _mesh :: HaskQuery.Relation (Component Mesh) (HaskQuery.IntIndex.IntIndex), _meshSkeletonBinding :: HaskQuery.Relation (Component MeshSkeletonBinding) (HaskQuery.IntIndex.IntIndex),

In this setup a skeleton is a tree of joints. Joints are affine transformations so linear transformation + translation or a 4x3 matrix. A lot of game engines don't store the full 4x3 matrix and store the joint as a Scale, Rotation (Quaternion) and Translation. I used the excellent Linear library for a lot of data structures and math functions.

So we take the base joints, add a notion of a primary key and parent id, then collect them in a relation using the relation library I've been experimenting with in Building Gtk2HS guis with queries.

data Joint = Joint { _transform :: Linear.V3 (OpenGL.GLdouble), --This will need to be renamed later _scale :: (OpenGL.GLdouble), _quaternion :: Linear.Quaternion (OpenGL.GLdouble)} deriving (Show) data ComponentWithParent a = BoneWithParent { _parentId :: Int, _boneId :: Int, _bone :: a} deriving (Show) data FlatSkeleton a = FlatSkeleton { _rootId :: Int, _bones :: HaskQuery.Relation (ComponentWithParent a) (HaskQuery.IntIndex.IntIndex) } deriving (Show)

Here's the skeleton that we're using, which is shown by the yellow lines in the images at the start.

let originalSkeleton = TestGame.Skeleton.flatSkeleton (-1) [ TestGame.Types.BoneWithParent {TestGame.Types._parentId = -1, TestGame.Types._boneId =0, TestGame.Types._bone = TestGame.Skeleton.defaultJoint {TestGame.Types._quaternion = Linear.axisAngle (Linear.V3 0 0 1) (0.00)} }, TestGame.Types.BoneWithParent {TestGame.Types._parentId = 0, TestGame.Types._boneId =1, TestGame.Types._bone = (TestGame.Skeleton.defaultJoint) {TestGame.Types._transform = Linear.V3 100 0 0, TestGame.Types._quaternion = Linear.axisAngle (Linear.V3 0 0 1) 0 }}, TestGame.Types.BoneWithParent {TestGame.Types._parentId = 1, TestGame.Types._boneId =2, TestGame.Types._bone = (TestGame.Skeleton.defaultJoint) {TestGame.Types._transform = Linear.V3 100 0 0, TestGame.Types._quaternion = Linear.axisAngle (Linear.V3 0 0 1) (0) }}, TestGame.Types.BoneWithParent {TestGame.Types._parentId = -1, TestGame.Types._boneId =3, TestGame.Types._bone = (TestGame.Skeleton.defaultJoint) {TestGame.Types._quaternion = Linear.axisAngle (Linear.V3 0 0 1) (-pi)} }, TestGame.Types.BoneWithParent {TestGame.Types._parentId = 3, TestGame.Types._boneId =4, TestGame.Types._bone = (TestGame.Skeleton.defaultJoint) {TestGame.Types._transform = Linear.V3 100 0 0, TestGame.Types._quaternion = Linear.axisAngle (Linear.V3 0 0 1) (0.0) }}, TestGame.Types.BoneWithParent {TestGame.Types._parentId = 4, TestGame.Types._boneId =5, TestGame.Types._bone = (TestGame.Skeleton.defaultJoint) {TestGame.Types._transform = Linear.V3 100 0 0, TestGame.Types._quaternion = Linear.axisAngle (Linear.V3 0 0 1) (0.0) }}, TestGame.Types.BoneWithParent {TestGame.Types._parentId = -1, TestGame.Types._boneId =6, TestGame.Types._bone = (TestGame.Skeleton.defaultJoint) {TestGame.Types._quaternion = Linear.axisAngle (Linear.V3 0 0 1) (-0.5*pi)} }, TestGame.Types.BoneWithParent {TestGame.Types._parentId = 6, TestGame.Types._boneId = 7, TestGame.Types._bone = (TestGame.Skeleton.defaultJoint) {TestGame.Types._transform = Linear.V3 100 0 0, TestGame.Types._quaternion = Linear.axisAngle (Linear.V3 0 0 1) (-0.25*pi)} }, TestGame.Types.BoneWithParent {TestGame.Types._parentId = 6, TestGame.Types._boneId =8, TestGame.Types._bone = (TestGame.Skeleton.defaultJoint) {TestGame.Types._transform = Linear.V3 100 0 0, TestGame.Types._quaternion = Linear.axisAngle (Linear.V3 0 0 1) (0.25*pi)} }, TestGame.Types.BoneWithParent {TestGame.Types._parentId = -1, TestGame.Types._boneId =9, TestGame.Types._bone = (TestGame.Skeleton.defaultJoint) {TestGame.Types._quaternion = Linear.axisAngle (Linear.V3 0 0 1) (0.50*pi)} } ]

The skeleton then has to be attached to meshes, in this image is a mesh for each arm, then one for the neck/head. The skeleton has an initial pose called the bind pose that is fixed when the meshes are attached. The mesh vertices will be transformed from where they are relative to the bind pose to where they are relative to the current pose.

Here is one of the purple arm meshes, which is a triangle strip in entityId order. I will omit the other meshes for the remaining discussion.

TestGame.Types.MeshComponent $ TestGame.Mesh.mesh $ \ meshRelation -> HaskQuery.insertRows meshRelation [ TestGame.Types.Component { TestGame.Types._entityId = 1, TestGame.Types._component = TestGame.Mesh.vertex3 0 25 0 }, TestGame.Types.Component { TestGame.Types._entityId = 2, TestGame.Types._component = TestGame.Mesh.vertex3 0 (-25) 0}, TestGame.Types.Component { TestGame.Types._entityId = 3, TestGame.Types._component = TestGame.Mesh.vertex3 100 (25) 0}, TestGame.Types.Component { TestGame.Types._entityId = 4, TestGame.Types._component = TestGame.Mesh.vertex3 100 (-25) 0}, TestGame.Types.Component { TestGame.Types._entityId = 5, TestGame.Types._component = TestGame.Mesh.vertex3 200 (25) 0}, TestGame.Types.Component { TestGame.Types._entityId = 6, TestGame.Types._component = TestGame.Mesh.vertex3 200 (-25) 0}, TestGame.Types.Component { TestGame.Types._entityId = 7, TestGame.Types._component = TestGame.Mesh.vertex3 300 (0) 0} ]

Now we need to attach this mesh to the original bind pose. The bind pose will always be used to determine the initial relationship between a joint and a vertex. This relation is a mapping from vertices to joints with a weight attached. So the vertices around the elbow will be jointly determined by the two parts of the arm joint. This is a natural fit for a relational model, though I am using a lot of manual id manipulation which I hope to reduce.

TestGame.Types.MeshSkeletonComponent $ TestGame.Mesh.meshSkeleton $ \ meshSkeletonBinding -> HaskQuery.insertRows meshSkeletonBinding [ TestGame.Types.VertexJointBinding { TestGame.Types._vertexId = 1, TestGame.Types._jointId=0, TestGame.Types._bindWeight=1}, TestGame.Types.VertexJointBinding { TestGame.Types._vertexId = 2, TestGame.Types._jointId=0, TestGame.Types._bindWeight=1}, TestGame.Types.VertexJointBinding { TestGame.Types._vertexId = 3, TestGame.Types._jointId=0, TestGame.Types._bindWeight=0.5}, TestGame.Types.VertexJointBinding { TestGame.Types._vertexId = 3, TestGame.Types._jointId=1, TestGame.Types._bindWeight=0.5}, TestGame.Types.VertexJointBinding { TestGame.Types._vertexId = 4, TestGame.Types._jointId=0, TestGame.Types._bindWeight=0.5}, TestGame.Types.VertexJointBinding { TestGame.Types._vertexId = 4, TestGame.Types._jointId=1, TestGame.Types._bindWeight=0.5}, TestGame.Types.VertexJointBinding { TestGame.Types._vertexId = 5, TestGame.Types._jointId=1, TestGame.Types._bindWeight=1}, TestGame.Types.VertexJointBinding { TestGame.Types._vertexId = 6, TestGame.Types._jointId=1, TestGame.Types._bindWeight=1}, TestGame.Types.VertexJointBinding { TestGame.Types._vertexId = 7, TestGame.Types._jointId=2, TestGame.Types._bindWeight=1}]

Now we have our skeleton in bind pose bound to the meshes. Now we want to change the skeleton pose and transform the mesh appropriately.

Let's create the new pose with some help from the lens library:

let pose = originalSkeleton & (TestGame.Types.bones %~ (\ uBones -> HaskQuery.update uBones (( == 0) . TestGame.Types._boneId ) (TestGame.Types.bone %~ (\bone -> bone { TestGame.Types._quaternion = Linear.axisAngle (Linear.V3 0 0 1) (-0.25) } )))) & (TestGame.Types.bones %~ (\ uBones -> HaskQuery.update uBones (( == 1) . TestGame.Types._boneId ) (TestGame.Types.bone %~ (\bone -> bone { TestGame.Types._quaternion = Linear.axisAngle (Linear.V3 0 0 1) (1) } )))) & (TestGame.Types.bones %~ (\ uBones -> HaskQuery.update uBones (( == 2) . TestGame.Types._boneId ) (TestGame.Types.bone %~ (\bone -> bone { TestGame.Types._quaternion = Linear.axisAngle (Linear.V3 0 0 1) (0.75) } ))))

So now for the math, which I'll only cover at a high level. The skeleton in bind pose is a tree of transformations, each one relative to its parent. We need to turn this into a set of transformations, each one relative to the root coordinate system, instead of its parent.

To do this we traverse the tree, multiplying the transformations as we go down and collecting all the results. This is a recursive query on the bind pose relation.

flatJointSkeletonToGlobalPose :: FlatSkeleton Joint -> GlobalSkeletonPose flatJointSkeletonToGlobalPose flatSkeletonJointPose = let emptyGlobalSkeletonPose = HaskQuery.reindex HaskQuery.empty (HaskQuery.IntIndex.intIndex _boneId) in HaskQuery.insertInto emptyGlobalSkeletonPose $ do rootJoint <- HaskQuery.selectWithIndex (HaskQuery.IntIndex.intIndexSelector) (_bones flatSkeletonJointPose) (_rootId flatSkeletonJointPose) selectGlobalPoses (rootJoint { _bone = jointToMatrix $ (_bone rootJoint)}) flatSkeletonJointPose

Here we multiply the current local joint by the accumulated global joint.

selectGlobalPoses :: GlobalJointPose -> FlatSkeleton Joint -> HaskQuery.Cont (b -> b) GlobalJointPose selectGlobalPoses joint flatSkeleton = do let parentGlobalJointPoseMatrix = (_bone joint) produceAndRecurse joint $ do b <- HaskQuery.selectWithIndex (HaskQuery.IntIndex.intIndexSelector) (_bones flatSkeleton) (_boneId joint) let globalJoint = b { _bone = parentGlobalJointPoseMatrix Linear.!*! (jointToMatrix $ (_bone b))} selectGlobalPoses globalJoint flatSkeleton

When skinning, we are going to take the global pose of the bind pose, invert it, apply the inverse to the meshes, then apply the current pose to the meshes. If we think of a hand mesh vertex at (1,1,1) from a joint, assuming no scaling, then after inverting, the vertex will be (1,1,1). Then we need to move that hand mesh vertex to where the joint currently is, so we apply the current pose global transformation which should be (1,1,1) from the current joint. Please check GEA or other resources for a better explanation.

The GameState value allows multiple renderers to be associated with an entity.
There is a mesh renderer to render the skinned mesh in purple, and another one will render the skeleton in yellow.
The mesh renderer will find the bind pose **flatSkeletonJointComponent**, mesh **meshComponent** and current pose **globalPose** with queries.

For each mesh it will start a triangle strip, and for each vertex in the mesh it will find all joint bindings and apply the inverse global bind pose and current global pose to the vertex with appropriate weights. This code was originally written with the single mesh case, now that there are multiple meshes, reordering the queries and only calculating the inverse once would probably be a good idea.

flatSkeletonMeshGlobalPoseRenderer :: (OpenGL.ColorComponent a) => OpenGL.Color4 a -> Renderer flatSkeletonMeshGlobalPoseRenderer color entityId gameState = do OpenGL.color $ color _ <- HaskQuery.runQueryM $ do Component { _component = positionComponent } <- TestGame.GameState.selectEntityByIdM gameState position entityId Component { _entityId = _meshEntityId, _component = meshComponent} <- TestGame.GameState.selectEntityByIdM gameState _mesh entityId Component { _entityId = _meshEntityId, _component = flatSkeletonJointComponent} <- TestGame.GameState.selectEntityByIdM gameState flatSkeletonJoint entityId Component { _entityId = _meshEntityId, _component = globalPose} <- TestGame.GameState.selectEntityByIdM gameState _globalPose entityId HaskQuery.executeM $ do let skinningMatrices = TestGame.Skeleton.flatJoinSkeletonToInverseGlobalPose flatSkeletonJointComponent OpenGL.preservingMatrix $ do OpenGL.translate (OpenGL.Vector3 (fromIntegral (xPosition positionComponent)) (fromIntegral (yPosition positionComponent)) (0 :: OpenGL.GLdouble)) OpenGL.renderPrimitive OpenGL.TriangleStrip $ do _ <- HaskQuery.runQueryM $ do Component { _entityId = vertexId, _component = vertexComponent} <- HaskQuery.selectM (_meshVertices meshComponent) Component { _component = skeletonBinding } <- TestGame.GameState.selectEntityByIdM gameState _meshSkeletonBinding entityId HaskQuery.executeM $ do let collector :: (Linear.V4 OpenGL.GLdouble, (Linear.V4 OpenGL.GLdouble -> Linear.V4 OpenGL.GLdouble -> Linear.V4 OpenGL.GLdouble)) collector = ((Linear.V4 0 0 0 1), (\ vector result -> vector Linear.^+^ result)) let vertex = HaskQuery.runQueryWithCollector collector $ do VertexJointBinding {_jointId = jointId, _bindWeight = bindWeight} <- HaskQuery.selectWithIndex HaskQuery.IntIndex.intIndexSelector (_meshVertexBinding skeletonBinding) vertexId BoneWithParent { _bone = skinningMatrix} <- HaskQuery.selectWithIndex HaskQuery.IntIndex.intIndexSelector skinningMatrices jointId BoneWithParent { _bone = globalPoseMatrix } <- HaskQuery.selectWithIndex HaskQuery.IntIndex.intIndexSelector globalPose jointId let OpenGL.Vertex3 x y z = vertexComponent return $ bindWeight Linear.*^ ((globalPoseMatrix Linear.!*! skinningMatrix) Linear.!* (Linear.V4 x y z 1)) let Linear.V4 px py pz _ = vertex OpenGL.vertex $ OpenGL.Vertex3 px py pz return () return () return ()

While working on this I found a lot of advantages to representing data relationally. A recursive query gave a nice way of calculating global poses. VertexJointBinding which attaches meshes to bind pose skeletons was stored separately and did not change the definition of skeletons or meshes.

This code probably has a decent bit of overhead from using IntMaps under the hood everywhere, but the above queries could be used to build efficient Vectors to store static data. Data can be stored in a flexible format, then cooked down to more efficient representations for specific needs.

This is still experimental but I'm convinced that Haskell has a lot to offer for games development, and its tools for abstraction can make a lot of the complicated pieces of game development much easier to work with and reason about.