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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
|
{-# LANGUAGE MultiParamTypeClasses #-}
module Main where
import Pong
import Spear.App
import Spear.Game
import Spear.Math.AABB
import Spear.Math.Matrix4 as Matrix4 hiding (position)
import Spear.Math.Spatial
import Spear.Math.Spatial2
import Spear.Math.Vector
import Spear.Physics.Collision
import Spear.Render.Core.Pipeline
import Spear.Render.Core.State
import Spear.Render.Immediate
import Spear.Sound.Sound
import Spear.Sound.State
import Spear.Window
import Control.Monad (when)
import Data.Maybe (mapMaybe)
data Pong = Pong
{ immRenderState :: ImmRenderState
, viewProjection :: Matrix4
, backgroundMusic :: SoundSource
, world :: [GameObject]
}
type GameState = AppState Pong
options = defaultAppOptions { title = "Pong" }
app = App options initGame endGame step render resize
main :: IO ()
main = runApp app
initGame :: Game AppContext Pong
initGame = do
renderCoreState <- contextRenderCoreState <$> get
(immRenderState, renderCoreState') <- runSiblingGame renderCoreState newImmRenderer
-- TODO: This can work if we use FlexibleContexts and change the function signatures.
--immRenderState <- newImmRenderer
music <- siblingGame $ do
musicBuffer <- loadAudioFile "/home/jeanne/Casual Tiki Party Main.wav"
music <- makeSoundSource
setSoundSourceBuffer music musicBuffer
setSoundLoopMode music Loop
playSounds [music]
return music
return $ Pong immRenderState Matrix4.id music newWorld
endGame :: Game GameState ()
endGame = do
renderCoreState <- appRenderCoreState <$> get
game <- getGameState
exec' runSiblingGame renderCoreState (deleteImmRenderer $ immRenderState game)
step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool
step elapsed dt inputEvents = do
appState <- get
gameState <- getGameState
events <- processInput (appWindow appState)
--when (events /= []) $ liftIO . putStrLn $ show events
modifyGameState $ \pong -> pong
{ world = stepWorld (realToFrac elapsed) (realToFrac dt) events (world gameState)
}
return (not $ exitRequested inputEvents)
processInput :: Window -> Game GameState [GameEvent]
processInput window = processKeys window
[ (KEY_A, MoveLeft)
, (KEY_D, MoveRight)
]
exitRequested = elem (KeyDown KEY_ESC)
render :: Game GameState ()
render = do
gameState <- getGameState
immRenderState' <- exec runSiblingGame (immRenderState gameState) $ do
immStart
immSetViewProjectionMatrix (viewProjection gameState)
-- Clear the background to a different colour than the playable area to make
-- the latter distinguishable.
setClearColour (0.2, 0.2, 0.2, 0.0)
clearBuffers [ColourBuffer]
render' $ world gameState
immEnd
putGameState $ gameState { immRenderState = immRenderState' }
render' :: [GameObject] -> Game ImmRenderState ()
render' world = do
immLoadIdentity
renderBackground
-- Draw objects.
immSetColour (vec4 1.0 1.0 1.0 1.0)
mapM_ renderGO world
renderBackground :: Game ImmRenderState ()
renderBackground =
let pmin = 0 :: Float
pmax = 1 :: Float
in do
immSetColour (vec4 0.0 0.25 0.41 1.0)
immDrawQuads2d [
(vec2 pmin pmin
,vec2 pmax pmin
,vec2 pmax pmax
,vec2 pmin pmax)]
renderGO :: GameObject -> Game ImmRenderState ()
renderGO go =
let (AABB2Volume (AABB2 (Vector2 xmin ymin) (Vector2 xmax ymax))) = boundingVolume go
in
immDrawQuads2d [
(vec2 xmin ymin
,vec2 xmax ymin
,vec2 xmax ymax
,vec2 xmin ymax)]
resize :: WindowEvent -> Game GameState ()
resize (ResizeEvent w h) =
let r = fromIntegral w / fromIntegral h
pad = if r > 1 then (r-1) / 2 else (1/r - 1) / 2
left = if r > 1 then -pad else 0
right = if r > 1 then 1 + pad else 1
bottom = if r > 1 then 0 else -pad
top = if r > 1 then 1 else 1 + pad
in do
setViewport 0 0 w h
modifyGameState $ \pong -> pong {
viewProjection = Matrix4.ortho left right bottom top (-1) 1
}
|
