aboutsummaryrefslogtreecommitdiff
path: root/Demos
diff options
context:
space:
mode:
Diffstat (limited to 'Demos')
-rw-r--r--Demos/Pong/Main.hs55
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
3module Main where 1module Main where
4 2
5import Data.Maybe (mapMaybe) 3import Data.Maybe (mapMaybe)
6import Graphics.Rendering.OpenGL.GL (($=)) 4import Graphics.Rendering.OpenGL.GL (($=))
7import qualified Graphics.Rendering.OpenGL.GL as GL 5import qualified Graphics.Rendering.OpenGL.GL as GL
6import Graphics.Rendering.OpenGL.GL.VertexSpec (currentColor)
8import Pong 7import Pong
9import Spear.App 8import Spear.App
10import Spear.Game 9import Spear.Game
@@ -23,12 +22,7 @@ main =
23 loop step 22 loop step
24 23
25initGame :: Window -> Game () GameState 24initGame :: Window -> Game () GameState
26initGame window = do 25initGame 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
33step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool 27step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool
34step elapsed dt inputEvents = do 28step 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
45render world = do 39render 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
51renderBackground :: IO ()
52renderBackground =
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
49renderGO :: GameObject -> IO () 63renderGO :: GameObject -> IO ()
50renderGO go = do 64renderGO 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
62process = mapM_ procEvent 76process = mapM_ procEvent
63 77
64procEvent (Resize w h) = do 78procEvent (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
70procEvent _ = return () 91procEvent _ = return ()
71 92
72translate = mapMaybe translate' 93translate = mapMaybe translate'