aboutsummaryrefslogtreecommitdiff
path: root/demos/pong/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'demos/pong/Main.hs')
-rw-r--r--demos/pong/Main.hs81
1 files changed, 0 insertions, 81 deletions
diff --git a/demos/pong/Main.hs b/demos/pong/Main.hs
deleted file mode 100644
index a9dfcdd..0000000
--- a/demos/pong/Main.hs
+++ /dev/null
@@ -1,81 +0,0 @@
1module Main where
2
3import Data.Maybe (mapMaybe)
4import Graphics.Rendering.OpenGL.GL (($=))
5import qualified Graphics.Rendering.OpenGL.GL as GL
6import Pong
7import Spear.App
8import Spear.Game
9import Spear.Math.AABB
10import Spear.Math.Spatial2
11import Spear.Math.Vector
12import Spear.Window
13
14data GameState = GameState
15 { window :: Window,
16 world :: [GameObject]
17 }
18
19main =
20 withWindow (900, 600) (2, 0) (Just "Pong") initGame $
21 loop step
22
23initGame :: Window -> Game () GameState
24initGame window = do
25 gameIO $ do
26 GL.clearColor $= GL.Color4 0.7 0.5 0.7 1.0
27 GL.matrixMode $= GL.Modelview 0
28 GL.loadIdentity
29 return $ GameState window newWorld
30
31step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool
32step elapsed dt inputEvents = do
33 gs <- getGameState
34 gameIO . process $ inputEvents
35 let events = translate inputEvents
36 modifyGameState $ \gs ->
37 gs
38 { world = stepWorld elapsed dt events (world gs)
39 }
40 getGameState >>= \gs -> gameIO . render $ world gs
41 return (not $ exitRequested inputEvents)
42
43render world = do
44 GL.clear [GL.ColorBuffer]
45 mapM_ renderGO world
46
47renderGO :: GameObject -> IO ()
48renderGO go = do
49 let (AABB2 (Vector2 xmin' ymin') (Vector2 xmax' ymax')) = aabb go
50 (Vector2 xcenter ycenter) = pos go
51 (xmin, ymin, xmax, ymax) = (f2d xmin', f2d ymin', f2d xmax', f2d ymax')
52 GL.preservingMatrix $ do
53 GL.translate (GL.Vector3 (f2d xcenter) (f2d ycenter) 0)
54 GL.renderPrimitive (GL.TriangleStrip) $ do
55 GL.vertex (GL.Vertex2 xmin ymax)
56 GL.vertex (GL.Vertex2 xmin ymin)
57 GL.vertex (GL.Vertex2 xmax ymax)
58 GL.vertex (GL.Vertex2 xmax ymin)
59
60process = mapM_ procEvent
61
62procEvent (Resize w h) = do
63 GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral w) (fromIntegral h))
64 GL.matrixMode $= GL.Projection
65 GL.loadIdentity
66 GL.ortho 0 1 0 1 (-1) 1
67 GL.matrixMode $= GL.Modelview 0
68procEvent _ = return ()
69
70translate = mapMaybe translate'
71
72translate' (KeyDown KEY_LEFT) = Just MoveLeft
73translate' (KeyDown KEY_RIGHT) = Just MoveRight
74translate' (KeyUp KEY_LEFT) = Just StopLeft
75translate' (KeyUp KEY_RIGHT) = Just StopRight
76translate' _ = Nothing
77
78exitRequested = any (== (KeyDown KEY_ESC))
79
80f2d :: Float -> GL.GLdouble
81f2d = realToFrac