5. Keyboard events.md

5. Keyboard events

This is the last step we need to do before we have a working game! First off, let's install the Keyboard package:

elm package install elm-lang/keyboard

And import the package at the top of our file:

import Keyboard exposing (..)

Subscriptions

In order to receive keyboard events, we need add subscriptions for both the key up and key down events.

Before we do that, let's add two separate messages for those two events. Our Msg should look like this:

type Msg
    = Tick Float
    | KeyUp KeyCode
    | KeyDown KeyCode

Both the KeyUp and KeyDown types have an KeyCodevalue associated to them.

Now we can set up our subscriptions. In order to subscribe to multiple subscriptions, we need to use a function called Sub.batch. batch takes a list of subscriptions and returns one subscription which includes all of them:

subscriptions : Model -> Sub Msg
subscriptions model =
    Sub.batch
        [ Keyboard.downs KeyDown
        , Keyboard.ups KeyUp
        , AnimationFrame.diffs Tick
        ]

Here we bind the Keyboard.down events to the KeyDown message, and the Keyboard.ups to the KeyUp message. We also need to handle these Msgs in our update function. For now, we can just return the model unchanged.

update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    case msg of
        KeyDown key ->
            ( model, Cmd.none )

        KeyUp key ->
            ( model, Cmd.none )

Storing key downs

We want to keep track of which keys that are currently pressed, so that we can move our paddles accordingly. To do that we can add another field to our Model record that contains a Set of all the KeyCodes currently pressed. Our model should now look like this:

import Set exposing (Set)

...

type alias Model =
    { ball : Ball
    , paddleLeft : Paddle
    , paddleRight : Paddle
    , keysDown : Set KeyCode
    }

We also need to update our init function. Our initial model should just contain an empty set:

init : ( Model, Cmd Msg )
init =
    ( { ball = initBall
      , paddleLeft = initPaddle 20
      , paddleRight = initPaddle (boardWidth - 25)
      , keysDown = Set.empty
      }
    , Cmd.none
    )

In our update function we can now add or remove the currently pressed key from our model:

update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    case msg of
        KeyDown key ->
            ( { model | keysDown = Set.insert key model.keysDown }, Cmd.none )

        KeyUp key ->
            ( { model | keysDown = Set.remove key model.keysDown }, Cmd.none )

		...

Updating paddle direction

We need some way of mapping specific key codes to the movement of each paddle. We can use an Int to represent which direction the paddles are moving. Negative means up, positive means down, and zero means the paddle is standing still.

Let's create one function for each paddle. We want the left paddle to move up and down using w and s, while the right paddle should use the arrow keys:

paddleDirectionLeft : Set KeyCode -> Int
paddleDirectionLeft keysDown =
    if Set.member 87 keysDown then
        -1
    else if Set.member 83 keysDown then
        1
    else
        0


paddleDirectionRight : Set KeyCode -> Int
paddleDirectionRight keysDown =
    if Set.member 38 keysDown then
        -1
    else if Set.member 40 keysDown then
        1
    else
        0

Now that we have a way of getting the direction for a paddle we can pass this into the updatePaddle function so that we can move it in the right direction. We can do this by adding a direction parameter to the function and multiply that with the paddle velocity:

updatePaddle : Int -> Float -> Paddle -> Paddle
updatePaddle direction delta paddle =
    { paddle
        | y =
            clamp 0
                (boardHeight - paddle.height)
                (paddle.y + (paddle.vy * (toFloat direction)) * delta)
    }

We also need to change our update function to pass the paddle direction town to updatePaddle:

update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    case msg of
		...
        Tick delta ->
            ( { model
                | ball = updateBall delta model
                , paddleLeft = updatePaddle (paddleDirectionLeft model.keysDown) delta model.paddleLeft
                , paddleRight = updatePaddle (paddleDirectionRight model.keysDown) delta model.paddleRight
              }
            , Cmd.none
            )

And that's it! You should now have a fully functional game of Pong 👏👏

The full source code should look something like this:

module Main exposing (..)

import Html exposing (..)
import Svg exposing (..)
import Svg.Attributes exposing (..)
import AnimationFrame
import Keyboard exposing (..)
import Set exposing (Set)


boardWidth =
    500


boardHeight =
    300



-- MODEL


type alias Model =
    { ball : Ball
    , paddleLeft : Paddle
    , paddleRight : Paddle
    , keysDown : Set KeyCode
    }


type alias Ball =
    { x : Float
    , y : Float
    , vx : Float
    , vy : Float
    , radius : Float
    }


type alias Paddle =
    { x : Float
    , y : Float
    , vx : Float
    , vy : Float
    , width : Float
    , height : Float
    }


init : ( Model, Cmd Msg )
init =
    ( { ball = initBall
      , paddleLeft = initPaddle 20
      , paddleRight = initPaddle (boardWidth - 25)
      , keysDown = Set.empty
      }
    , Cmd.none
    )


initBall : Ball
initBall =
    { x = boardWidth / 2
    , y = boardHeight / 2
    , vx = 0.3
    , vy = 0.3
    , radius = 8
    }


initPaddle : Float -> Paddle
initPaddle x =
    { x = x
    , y = 0
    , vx = 0.4
    , vy = 0.4
    , width = 5
    , height = 80
    }



-- UPDATE


type Msg
    = Tick Float
    | KeyUp KeyCode
    | KeyDown KeyCode


update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    case msg of
        KeyDown key ->
            ( { model | keysDown = Set.insert key model.keysDown }, Cmd.none )

        KeyUp key ->
            ( { model | keysDown = Set.remove key model.keysDown }, Cmd.none )

        Tick delta ->
            ( { model
                | ball = updateBall delta model
                , paddleLeft = updatePaddle (paddleDirectionLeft model.keysDown) delta model.paddleLeft
                , paddleRight = updatePaddle (paddleDirectionRight model.keysDown) delta model.paddleRight
              }
            , Cmd.none
            )


updatePaddle : Int -> Float -> Paddle -> Paddle
updatePaddle direction delta paddle =
    { paddle
        | y =
            clamp 0
                (boardHeight - paddle.height)
                (paddle.y + (paddle.vy * (toFloat direction)) * delta)
    }


updateBall : Float -> Model -> Ball
updateBall delta {ball, paddleLeft, paddleRight} =
    if ball.x < -ball.radius || ball.x > boardWidth + ball.radius then
        { ball
            | x = boardWidth / 2
            , y = boardHeight / 2
        }
    else
        let
            vx =
                if within ball paddleLeft then
                    abs ball.vx
                else if within ball paddleRight then
                    -(abs ball.vx)
                else
                    ball.vx

            vy =
                if ball.y < ball.radius then
                    abs ball.vy
                else if ball.y > boardHeight - ball.radius then
                    -(abs ball.vy)
                else
                    ball.vy
        in
            { ball
                | x = ball.x + vx * delta
                , y = ball.y + vy * delta
                , vx = vx
                , vy = vy
            }


near : Float -> Float -> Float -> Bool
near a spacing b =
    b >= a - spacing && b <= a + spacing


within : Ball -> Paddle -> Bool
within ball paddle =
    near (paddle.x + paddle.width / 2) (paddle.width / 2 + ball.radius) ball.x
        && near (paddle.y + paddle.height / 2) (paddle.height / 2 + ball.radius) ball.y


paddleDirectionLeft : Set KeyCode -> Int
paddleDirectionLeft keysDown =
    if Set.member 87 keysDown then
        -1
    else if Set.member 83 keysDown then
        1
    else
        0


paddleDirectionRight : Set KeyCode -> Int
paddleDirectionRight keysDown =
    if Set.member 38 keysDown then
        -1
    else if Set.member 40 keysDown then
        1
    else
        0



-- VIEW


view : Model -> Html Msg
view model =
    svg
        [ width (toString boardWidth)
        , height (toString boardHeight)
        ]
        [ rect
            [ width (toString boardWidth)
            , height (toString boardHeight)
            , fill "black"
            ]
            []
        , ballView model.ball
        , paddleView model.paddleLeft
        , paddleView model.paddleRight
        ]


ballView : Ball -> Svg Msg
ballView model =
    circle
        [ cx (toString model.x)
        , cy (toString model.y)
        , r (toString model.radius)
        , fill "white"
        ]
        []


paddleView : Paddle -> Svg Msg
paddleView model =
    rect
        [ width (toString model.width)
        , height (toString model.height)
        , x (toString model.x)
        , y (toString model.y)
        , fill "white"
        ]
        []



-- SUBSCRIPTIONS


subscriptions : Model -> Sub Msg
subscriptions model =
    Sub.batch
        [ Keyboard.downs KeyDown
        , Keyboard.ups KeyUp
        , AnimationFrame.diffs Tick
        ]



-- MAIN


main =
    Html.program
        { init = init
        , update = update
        , view = view
        , subscriptions = subscriptions
        }