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 routeObjEvents: Input and Logic bundled togetherState: the logical object states (position, velocity etc.) produced after each step which are used for collision detection and renderingObjOutput: 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:
- Reason about the previous object state (if any) and generate logical events like collisions etc.
- 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!
.
