Skip to content

Yampa/SDL program stub

I just completed my first Yampa/SDL program stub. This stub is meant to provide a quickstart for using Yampa with SDL and explains the basic Yampa functions needed for game development in the most minimalistic way I could think of. You can also download the whole source file.

The “game” basically is a player object (black square) which can move around on a 3×3 field and an obstacle object (blue square) which gets killed on collision.

To get an overview of Yampa reactimate have a look at the diagrams of my 2 recent posts Activity diagram of Yampa reactimate and Dataflow diagram of Yampa reactimate.

definitions

At first we are defining some types:

  • Input: non-deterministic events from input devices which have to come from an IO task.
  • Logic: deterministic events from object preprocessor in route
  • ObjEvents: Input and Logic bundled together
  • State: the logical object states (position, velocity etc.) produced after each step which are used for collision detection and rendering
  • ObjOutput: the overall object output consisting of State and the produced kill- and respawn requests.
  • ObjOutput: just an abstract signal function type which takes the events and produces an output.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
module Main where

import IdentityList

import Maybe
import Control.Monad.Loops

import FRP.Yampa              as Yampa
import FRP.Yampa.Geometry
import Graphics.UI.SDL        as SDL
import Graphics.UI.SDL.Events as SDL.Events
import Graphics.UI.SDL.Keysym as SDL.Keysym

type Position2 = Point2  Double
type Velocity2 = Vector2 Double

type Input = [SDL.Event]    -- non-deterministic events from input devices
type Logic = Yampa.Event () -- deterministic events from object processor

data ObjEvents = ObjEvents
    { oeInput :: Input
    , oeLogic :: Logic
    } deriving (Show)

data State = Rectangle Position2 SDL.Rect SDL.Pixel | Debug String
     deriving (Show)

data ObjOutput = ObjOutput
    { ooState         :: State
    , ooKillRequest   :: Yampa.Event ()       -- NoEvent|Event ()
    , ooSpawnRequests :: Yampa.Event [Object]
    }

defaultObjOutput = ObjOutput
    { ooState         = undefined
    , ooKillRequest   = Yampa.NoEvent
    , ooSpawnRequests = Yampa.NoEvent
    }

type Object = SF ObjEvents ObjOutput

instance (Show a) => Show (Yampa.Event a) where
    show (Yampa.Event a) = "LogicEvent: " ++ (show a)
    show Yampa.NoEvent   = "NoEvent"

instance Show (SF a b) where
    show sf = "SF"

“IdentityList” is taken from the Yampa SpaceInvaders example which you can get via cabal unpack spaceinvaders.

main

Don’t get scared by the long definition, it mostly consists of object bindings. I split main into 2 definitions which can be run seperately by uncommenting them (line 4-5). mainLoop runs the complete game: move via [Arrow] keys and quit with [Esc]. mainSteps runs each step individually and in isolation which should help to understand what is going on and how the types are passed around and transformed. The steps are commented in the source, try to understand them by reading the highlighted lines, the object bindings and the output they produce!

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
main :: IO ()
main = do
    -- Uncomment 'mainSteps' or 'mainLoop'!
    --mainLoop  -- Runs the complete reactimate loop.
    --mainSteps -- Tests each reactimate step individually.
  where
    mainLoop :: IO ()
    mainLoop = do
        reactimate initialize input output (process objs)
        SDL.quit
       where
         playerObj   = playerObject (Point2 16 16)
                                    (SDL.Rect (-8) (-8) 8 8)
                                    (SDL.Pixel 0x00000000)
         obstacleObj = staticObject (Point2 48 48)
                                    (SDL.Rect (-8) (-8) 8 8)
                                    (SDL.Pixel 0x000000FF)
         objs = (listToIL [playerObj, obstacleObj])

    mainSteps :: IO ()
    mainSteps = do
        -- initialize :: IO Input
        -- Poll first 'SDL.Event's (should only be 'LostFocus').
        events <- initialize

        -- input :: IO (DTime, Maybe Input)
        -- Poll 'SDL.Event's at each step (probably []).
        events <- input False

        -- hits :: [(ILKey, State)] -> [ILKey]
        -- Testing player over obstacle => collision event.
        putStrLn $ "hits 1: " ++ (show $ hits $ assocsIL $ fmap ooState oos1)

        -- Testing player over enemy => no event.
        putStrLn $ "hits 2: " ++ (show $ hits $ assocsIL $ fmap ooState oos2)

        -- route :: (Input, IL ObjOutput) -> IL sf -> IL (ObjEvents, sf)
        -- Routes 'key' SDL.Event to all 'Object's and
        -- previous object 'State's, if there are any.

        -- First routing step.
        -- No collision events are checked as there are no 'State's yet.
        putStrLn "first route: "
        --mapM putStrLn $ showILObjEvents $ route ([key], emptyIL) objs
        putStrLn $ show $ assocsIL $ route ([key], emptyIL) objs

        -- Intermediate routing step.
        -- Assuming player over obstacle object => create collision event.
        putStrLn "route step: "
        putStrLn $ show $ assocsIL $ route ([key], oos1) objs

        -- killAndSpawn :: (Input, IL ObjOutput)
        --              -> (Yampa.Event (IL Object -> IL Object))
        -- Kill and spawn new objects corresponding to 'ObjOutput' requests.
    -- Note how 'ooObstacle' defined a kill and spawn request
        putStr "objs before kill&Spawn: "
        putStrLn $ show $ keysIL objs
        putStr "objs after kill&Spawn: "
        putStrLn $ show $ keysIL $
            case (killAndSpawn (([], emptyIL), oos1)) of
                (Event d) -> d objs
                _         -> objs

        -- output :: IL ObjOutput -> IO Bool
        -- Just render the 'State's or quit if there is none.
        o1 <- output False oos1
        putStrLn $ show o1
        o2 <- output False oos2
        putStrLn $ show o2
        o3 <- output False emptyIL
        putStrLn $ show o3

        SDL.quit
      where
        key = KeyDown (Keysym
            { symKey = SDL.SDLK_RIGHT
            , symModifiers = []
            , symUnicode = '\0'
            })
        playerObj   = playerObject (Point2 16 16)
                                   (SDL.Rect (-8) (-8) 8 8)
                                   (SDL.Pixel 0x00000000)
        obstacleObj = staticObject (Point2 48 48)
                                   (SDL.Rect (-8) (-8) 8 8)
                                   (SDL.Pixel 0x000000FF)
        objs = (listToIL [playerObj, obstacleObj])

        enemyObj = staticObject (Point2 80 80)
                                (SDL.Rect (-8) (-8) 8 8)
                                (SDL.Pixel 0x00FF0000)
        ooPlayer = defaultObjOutput
            { ooState = Rectangle (Point2 48 48)
                                  (SDL.Rect (-8) (-8) 8 8)
                                  (SDL.Pixel 0x00000000)
            }
        ooObstacle = defaultObjOutput
            { ooState = Rectangle (Point2 48 48)
                                  (SDL.Rect (-8) (-8) 8 8)
                                  (SDL.Pixel 0x000000FF)
            , ooKillRequest   = Event ()
            , ooSpawnRequests = Event [enemyObj]
            }
        ooEnemy = defaultObjOutput
            { ooState = Rectangle (Point2 80 80)
                                  (SDL.Rect (-8) (-8) 8 8)
                                  (SDL.Pixel 0x00FF0000)
            }
        oos1 = listToIL [ooPlayer, ooObstacle]
        oos2 = listToIL [ooPlayer, ooEnemy]

output from mainSteps

…slightly modified for better readability.

0 = playerObject, 1 = obstacleObject, 2 = enemyObject

initialize (sense): [LostFocus [MouseFocus]]
input (sense): []

hits 1: [1,0]
hits 2: []

first route:
[(1, (ObjEvents { oeInput = [KeyDown (Keysym { symKey = SDLK_RIGHT, ... })]
                , oeLogic = NoEvent
                }, SF)),
 (0, (ObjEvents {oeInput = [KeyDown (Keysym { symKey = SDLK_RIGHT, ... })],
                , oeLogic = NoEvent
                }, SF))]

route step:
[(1, (ObjEvents { oeInput = [KeyDown (Keysym { symKey = SDLK_RIGHT, ... })]
                , oeLogic = LogicEvent: ()
                }, SF)),
 (0, (ObjEvents {oeInput = [KeyDown (Keysym { symKey = SDLK_RIGHT, ... })]
                , oeLogic = LogicEvent: ()
                }, SF))]

objs before kill&Spawn: [1,0]
objs after kill&Spawn:  [2,0]

output (actuate) + 500ms delay: False
output (actuate) + 500ms delay: False
output (actuate) + 500ms delay: True

reactimation IO (sense and actuate)

The IO steps are very simple. initialize and inputjust collect the input events (line 10, 22) and output defines the rendering to draw a rectangle or print a debug string and maps over the object output states to draw them.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
initialize :: IO Input
initialize = do
    SDL.init [SDL.InitVideo]
    screen <- SDL.setVideoMode windowWidth windowHeight
                               windowDepth [SDL.HWSurface]
    SDL.setCaption windowCaption []

    SDL.fillRect screen Nothing (SDL.Pixel 0x006495ED) -- 0x00RRGGBB
    SDL.flip screen
    events <- unfoldWhileM (/= SDL.NoEvent) SDL.pollEvent

    putStrLn $ "initialize (sense): " ++ show events
    return events
  where
    windowWidth   = 96
    windowHeight  = 96
    windowDepth   = 32
    windowCaption = "Yampa/SDL Stub"

input :: Bool -> IO (DTime, Maybe Input)
input _ = do
    events <- unfoldWhileM (/= SDL.NoEvent) SDL.pollEvent
    putStrLn $ "input (sense): " ++ show events
    return (1.0, Just events)

output :: Bool -> IL ObjOutput -> IO Bool
output _ oos = do
    putStrLn $ "output (actuate) + " ++ (show delayMs) ++ "ms delay: "

    screen <- SDL.getVideoSurface
    SDL.fillRect screen Nothing (SDL.Pixel 0x006495ED) -- Pixel 0x--RRGGBB

    mapM_ (\oo -> render (ooState oo) screen) (elemsIL oos) -- render 'State'!

    SDL.flip screen
    SDL.delay delayMs

    return $ null $ keysIL oos
  where
    delayMs = 500

    render :: State -> SDL.Surface -> IO ()
    render (Rectangle pos rect color) screen = do
        SDL.fillRect screen gRect color
        return ()
      where
        -- center rectangle around position
        x0 = round (point2X pos) + (rectX rect)
        y0 = round (point2Y pos) + (rectY rect)
        x1 = round (point2X pos) + (rectW rect)
        y1 = round (point2Y pos) + (rectH rect)
        gRect = Just (SDL.Rect x0 y0 (x1 - x0) (y1 - y0))
    render (Debug s) screen = putStrLn s

reactimation process (SF)

This is the most important step in reactimate (in -> SF in out -> out) and took me a while to understand. Again, try to get an overview first with the Activity diagram and Dataflow diagram!

process actually just wraps the core to be consistent with the reactimate signature and also feeds the previous output states back into core. The last expression is very interesting as it applies a list of insertIL and deleteIL functions (which are composited together in killAndSpawn) to the object list and switches into the new core. We can say the core is valid as long as the same objects exist.

1
2
3
4
5
6
7
process :: IL Object -> SF Input (IL ObjOutput)
process objs0 = proc input -> do
    rec
        -- 'process' stores the 'State's (note: rec) and
        -- passes them over to core
        oos <- core objs0 -< (input, oos)
    returnA -< oos

Note that core actually takes Input AND the previous object states (IL ObjOutput) as input signals. The dpSwitch is performed on a SF collection (hence parallel and the ‘p’) and the result is observable and applied at the next step (hence delayed and the ‘d’).

1
2
3
4
5
core :: IL Object -> SF (Input, IL ObjOutput) (IL ObjOutput)
core objs = dpSwitch route
                     objs
                     (arr killAndSpawn >>> notYet)
                     (\sfs' f -> core (f sfs'))

The route function actually has 2 tasks:

  1. Reason about the previous object state (if any) and generate logical events like collisions etc.
  2. Distribute input- and logical-events to the corresponding objects.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
route :: (Input, IL ObjOutput) -> IL sf -> IL (ObjEvents, sf)
route (input, oos) objs = mapIL routeAux objs
  where
    hs = hits (assocsIL (fmap ooState oos)) -- process all object 'State's
    routeAux (k, obj) = (ObjEvents
        { oeInput = input
        -- hit events are only routed to the objects they belong to (hence: routing)
        , oeLogic = if k `elem` hs then Event () else Yampa.NoEvent
        }, obj)

hits :: [(ILKey, State)] -> [ILKey]
hits kooss = concat (hitsAux kooss)
  where
    hitsAux [] = []
    -- Check each object 'State' against each other
    hitsAux ((k,oos):kooss) =
        [ [k, k'] | (k', oos') <- kooss, oos `hit` oos' ]
        ++ hitsAux kooss

    hit :: State -> State -> Bool
    (Rectangle p1 _ _) `hit` (Rectangle p2 _ _) = p1 == p2
    _ `hit` _ = False

killAndSpawn is actually pretty simply once you know what it is doing. It just looks up every object for kill and spawn requests and produces a function composition of deleteIL and insertIL which – in case of a event – is performed on the objects. Remember the expression from core: (\sfs' f -> core (f sfs'))

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
killAndSpawn :: ((Input, IL ObjOutput), IL ObjOutput)
             -> Yampa.Event (IL Object -> IL Object)
killAndSpawn ((input, _), oos) =
    if any checkEscKey input
        then Event (\_ -> emptyIL) -- kill all 'State' on [Esc] => quit
        else foldl (mergeBy (.)) noEvent events
  where
    events :: [Yampa.Event (IL Object -> IL Object)]
    events = [ mergeBy (.)
                      (ooKillRequest oo `tag` (deleteIL k))
                      (fmap  (foldl (.) id . map insertIL_)
                             (ooSpawnRequests oo))
             | (k, oo) <- assocsIL oos ]
    checkEscKey (SDL.KeyDown (SDL.Keysym SDL.SDLK_ESCAPE  _ _)) = True
    checkEscKey _ = False

objects

The interesting parts here are that a Object can take parameters just like any other function to produce signal functions. Here it is used to specify the initial position for example. The actual position is calculated by a simple integrator based on the user input.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
playerObject :: Position2 -> SDL.Rect -> SDL.Pixel -> Object
playerObject p0 rect color = proc objEvents -> do
    -- .+^ is Point-Vector-addition
    -- ^+^ is Vector-Vector addition
    -- here we sum up all vectors based on the possibly multiple
    -- user inputs, thus allowing diagonal moves
    p <- (p0 .+^) ^<< integral -<
        foldl (^+^) (vector2 0 0) $ mapMaybe checkKey (oeInput objEvents)
    returnA -< defaultObjOutput { ooState = Rectangle p rect color }
    where
        checkKey (SDL.KeyUp (SDL.Keysym SDL.SDLK_UP    _ _)) =
            Just $ vector2    0 (-32)
        checkKey (SDL.KeyUp (SDL.Keysym SDL.SDLK_LEFT  _ _)) =
            Just $ vector2 (-32)   0
        checkKey (SDL.KeyUp (SDL.Keysym SDL.SDLK_DOWN  _ _)) =
            Just $ vector2    0   32
        checkKey (SDL.KeyUp (SDL.Keysym SDL.SDLK_RIGHT _ _)) =
            Just $ vector2   32    0
        checkKey _ = Nothing

staticObject :: Position2 -> SDL.Rect -> SDL.Pixel -> Object
staticObject p0 rect color = proc objEvents -> do
    returnA -< defaultObjOutput { ooState         = Rectangle p0 rect color
                                , ooKillRequest   = (oeLogic objEvents)
                                , ooSpawnRequests = (debugIfKilled objEvents)
                                }
  where
    debugIfKilled objEvents =
        case (oeLogic objEvents) of
            Yampa.Event () -> Event [debugObject "hit"]
            _              -> Event []

debugObject :: String -> Object
debugObject s = proc objEvents -> do
    returnA -< defaultObjOutput { ooState       = Debug s
                                , ooKillRequest = Event ()
                                }

Download the whole source file! (.hs)

Please let me know if the tutorial was helpful or if you didn’t understand something!

Tagged with , , , , , .

4 comments

By Gerold Meisinger – June 14, 2010

4 Responses

Stay in touch with the conversation, subscribe to the RSS feed for comments on this post.

  1. paul says

    Hello,

    I’ve tried to compile your example but:
    – the only place I found IdentityList was in frag
    – I didn’t find the function playerObject

    could you provide the sources?

    July 18, 2010, 20:25
  2. Gerold Meisinger says

    I added the objects and a link to the whole source file. The IdentityList ist taken from SpaceInvaders. Thank you paul!

    July 19, 2010, 20:44
  3. Jeffrey says

    I tried to compile this code, and I got this error:

    SDLStub.hs:233:27: parse error on input `->’

    referring to the line

    process objs0 = proc input -> do
    [...]

    It seems like acceptable arrow notation, so I’m not sure what the problem is. I’m using GHC 6.12.3. Have I neglected to install something I need?

    February 10, 2011, 05:37
  4. Jeffrey says

    Wow, just kidding, I just needed to compile it with the -XArrows flag. My bad.

    February 10, 2011, 05:47



Some HTML is OK

or, reply to this post via trackback.

« »