Iteration 4

Iteration 4: Keyboard Controls

Previous: Iteration 3: Introducing Animation

The source code for this iteration can be found here.

All the changes from the previous iteration can be viewed in diff format here.

Wrapping the GLUT Event Callback

When using GLUT, the only way to access keyboard events is with a callback that is called for each key press and release. This obviously causes problems in our current design, as the event callback can't access our game state data in any way. It would be nicer if we could just pass the current state of the keyboard to our game state's pure tick function.

To achieve this, we'll introduce a new data type that contains the keys that are currently held down.

Haskeroids/Keyboard.hs

import Data.Set (Set)
import qualified Data.Set as Set
import Graphics.UI.GLUT (Key(..), KeyState(..))

-- | Set of all keys that are currently held down
newtype Keyboard = Keyboard (Set Key)

When we receive keyboard events from GLUT, we update the Keyboard data accordingly, adding keys when they are pressed down (KeyState Down) and removing them when they are lifted (KeyState Up).

-- | Record a key state change in the given Keyboard
handleKeyEvent :: Key -> KeyState -> Keyboard -> Keyboard
handleKeyEvent k ks (Keyboard s) = case ks of
    Up   -> Keyboard $ Set.delete k s
    Down -> Keyboard $ Set.insert k s

We also add utility methods for initializing an empty Keyboard data and for testing wether a certain key is currently down.

-- | Create a new Keyboard
initKeyboard :: Keyboard
initKeyboard = Keyboard Set.empty

-- | Test if a key is currently held down in the given Keyboard
isKeyDown :: Keyboard -> Key -> Bool
isKeyDown (Keyboard s) k = Set.member k s

Sharing Keyboard State via IORef

We now have a nice inteface for accessing the keyboard events, but we still have the problem that we receive keyboard event callbacks in one callback function and need to access them in another. For sharing the same Keyboard data between the two callback functions, we are going to use an IORef. It allows us to share a mutable reference between several functions in the IO monad.

Haskeroids/Callbacks.hs

import Data.IORef
import Haskeroids.Keyboard

type KeyboardRef = IORef Keyboard

-- | Update the Keyboard state according to the event
handleKeyboard :: KeyboardRef -> KeyboardMouseCallback
handleKeyboard kb k ks _ _ = modifyIORef kb (handleKeyEvent k ks)

The type KeyboardMouseCallback is an alias from GLUT for Key -> KeyState -> Modifiers -> Position -> IO (), so essentially our callback takes a shared Keyboard reference, Key and KeyState and ignores the Modifiers and Position data. It then updates the shared keyboard reference using the handleKeyEvent function that we defined in the Haskeroids.Keyboard module.

Now we can access up-to-date keyboard state from our logicTick function with these modifications.

-- | Periodical logic tick
logicTick :: (LineRenderable t, Tickable t) => KeyboardRef -> t -> IO ()
logicTick kb t = do
    keys <- readIORef kb
    let newTickable = tick keys t
    displayCallback $= renderViewport newTickable
    addTimerCallback 33 $ logicTick kb newTickable
    postRedisplay Nothing

We first read the actual Keyboard data from the IORef and then pass that to the tick method so that the game state can act according to the player's input.

Now we just need to initialize the IORef and set both logicTick and handleKeyboard to use the same reference.

Haskeroids/Initialize.hs

-- | Set up GLUT callbacks
initializeCallbacks = do
    kb <- newIORef initKeyboard
    keyboardMouseCallback $= Just (handleKeyboard kb)
    displayCallback $= renderViewport initialGameState
    addTimerCallback 0 $ logicTick kb initialGameState

Reacting to Keyboard State in Tick

In order to use the Keyboard data in our tickable state, we first need to modify the Tickacble type class to accept the keyboard state as a parameter.

Haskeroids/Tick.hs

import Haskeroids.Keyboard (Keyboard)

class Tickable t where
    tick :: Keyboard -> t -> t

The GameState just forwards the keyboard data to the player object.

Haskeroids/State.hs

-- | Tick state into a new game state
tickState :: Keyboard -> GameState -> GameState
tickState kb (GameState pl) = GameState $ tick kb pl

Then we act upon the keyboard state in our Player instance.

Haskeroids/Player.hs

instance Tickable Player where
    tick kb (Player b) | isKeyDown kb turnRight = Player $ rotate 0.2 b
                       | isKeyDown kb turnLeft  = Player $ rotate (-0.2) b
    tick _ p = p

For convenience, the shortcuts for the controls are defined in Haskeroids/Controls.hs.

module Haskeroids.Controls (
    turnRight,
    turnLeft,
    ) where

import Graphics.UI.GLUT (Key(..), SpecialKey(..))

turnRight = SpecialKey KeyRight
turnLeft  = SpecialKey KeyLeft

And that's it. Now we can rotate the ship left and right using the arrow keys.

Next: Iteration 5: Ship Movement