diff options
-rw-r--r-- | Demos/Pong/Main.hs | 55 |
1 files changed, 38 insertions, 17 deletions
diff --git a/Demos/Pong/Main.hs b/Demos/Pong/Main.hs index ee0f8d8..0644f9d 100644 --- a/Demos/Pong/Main.hs +++ b/Demos/Pong/Main.hs | |||
@@ -1,10 +1,9 @@ | |||
1 | {-# LANGUAGE ImportQualifiedPost #-} | ||
2 | |||
3 | module Main where | 1 | module Main where |
4 | 2 | ||
5 | import Data.Maybe (mapMaybe) | 3 | import Data.Maybe (mapMaybe) |
6 | import Graphics.Rendering.OpenGL.GL (($=)) | 4 | import Graphics.Rendering.OpenGL.GL (($=)) |
7 | import qualified Graphics.Rendering.OpenGL.GL as GL | 5 | import qualified Graphics.Rendering.OpenGL.GL as GL |
6 | import Graphics.Rendering.OpenGL.GL.VertexSpec (currentColor) | ||
8 | import Pong | 7 | import Pong |
9 | import Spear.App | 8 | import Spear.App |
10 | import Spear.Game | 9 | import Spear.Game |
@@ -23,12 +22,7 @@ main = | |||
23 | loop step | 22 | loop step |
24 | 23 | ||
25 | initGame :: Window -> Game () GameState | 24 | initGame :: Window -> Game () GameState |
26 | initGame window = do | 25 | initGame window = return $ GameState window newWorld |
27 | gameIO $ do | ||
28 | GL.clearColor $= GL.Color4 0.7 0.5 0.7 1.0 | ||
29 | GL.matrixMode $= GL.Modelview 0 | ||
30 | GL.loadIdentity | ||
31 | return $ GameState window newWorld | ||
32 | 26 | ||
33 | step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool | 27 | step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool |
34 | step elapsed dt inputEvents = do | 28 | step elapsed dt inputEvents = do |
@@ -43,9 +37,29 @@ step elapsed dt inputEvents = do | |||
43 | return (not $ exitRequested inputEvents) | 37 | return (not $ exitRequested inputEvents) |
44 | 38 | ||
45 | render world = do | 39 | render world = do |
40 | -- Clear the background to a different colour than the playable area to make | ||
41 | -- the latter distinguishable. | ||
42 | GL.clearColor $= GL.Color4 0.2 0.2 0.2 0.0 | ||
46 | GL.clear [GL.ColorBuffer] | 43 | GL.clear [GL.ColorBuffer] |
44 | GL.matrixMode $= GL.Modelview 0 | ||
45 | GL.loadIdentity | ||
46 | renderBackground | ||
47 | -- Draw objects. | ||
48 | GL.currentColor $= GL.Color4 1.0 1.0 1.0 1.0 | ||
47 | mapM_ renderGO world | 49 | mapM_ renderGO world |
48 | 50 | ||
51 | renderBackground :: IO () | ||
52 | renderBackground = | ||
53 | let pmin = 0 :: Float | ||
54 | pmax = 1 :: Float | ||
55 | in do | ||
56 | GL.currentColor $= GL.Color4 0.7 0.5 0.7 1.0 | ||
57 | GL.renderPrimitive GL.TriangleStrip $ do | ||
58 | GL.vertex (GL.Vertex2 pmin pmax) | ||
59 | GL.vertex (GL.Vertex2 pmin pmin) | ||
60 | GL.vertex (GL.Vertex2 pmax pmax) | ||
61 | GL.vertex (GL.Vertex2 pmax pmin) | ||
62 | |||
49 | renderGO :: GameObject -> IO () | 63 | renderGO :: GameObject -> IO () |
50 | renderGO go = do | 64 | renderGO go = do |
51 | let (AABB2 (Vector2 xmin' ymin') (Vector2 xmax' ymax')) = aabb go | 65 | let (AABB2 (Vector2 xmin' ymin') (Vector2 xmax' ymax')) = aabb go |
@@ -61,12 +75,19 @@ renderGO go = do | |||
61 | 75 | ||
62 | process = mapM_ procEvent | 76 | process = mapM_ procEvent |
63 | 77 | ||
64 | procEvent (Resize w h) = do | 78 | procEvent (Resize w h) = |
65 | GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral w) (fromIntegral h)) | 79 | let r = (fromIntegral w) / (fromIntegral h) |
66 | GL.matrixMode $= GL.Projection | 80 | pad = if r > 1 then (r-1) / 2 else (1/r - 1) / 2 |
67 | GL.loadIdentity | 81 | left = if r > 1 then -pad else 0 |
68 | GL.ortho 0 1 0 1 (-1) 1 | 82 | right = if r > 1 then 1 + pad else 1 |
69 | GL.matrixMode $= GL.Modelview 0 | 83 | bottom = if r > 1 then 0 else -pad |
84 | top = if r > 1 then 1 else 1 + pad | ||
85 | in do | ||
86 | GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral w) (fromIntegral h)) | ||
87 | GL.matrixMode $= GL.Projection | ||
88 | GL.loadIdentity | ||
89 | GL.ortho left right bottom top (-1) 1 | ||
90 | GL.matrixMode $= GL.Modelview 0 | ||
70 | procEvent _ = return () | 91 | procEvent _ = return () |
71 | 92 | ||
72 | translate = mapMaybe translate' | 93 | translate = mapMaybe translate' |