1 files changed, 51 insertions, 48 deletions
diff --git a/demos/pong/Main.hs b/demos/pong/Main.hs
index d0664b7..3563c30 100644
--- a/demos/pong/Main.hs
+++ b/demos/pong/Main.hs
@@ -1,79 +1,82 @@
 module Main where
+import Data.Maybe (mapMaybe)
+import Graphics.Rendering.OpenGL.GL (($=))
+import qualified Graphics.Rendering.OpenGL.GL as GL
 import Pong
+import Spear.Game
 import Spear.Math.AABB
 import Spear.Math.Spatial2
 import Spear.Math.Vector
-import Spear.Game
 import Spear.Window
-import Data.Maybe (mapMaybe)
-import qualified Graphics.Rendering.OpenGL.GL as GL
-import Graphics.Rendering.OpenGL.GL (($=))
 data GameState = GameState
-     { wnd     :: Window
+  { window :: Window,
-     , world   :: [GameObject]
+    world :: [GameObject]
-     }
+  }
-main = run
+main =
-     $ withWindow (640,480) [] Window (2,0) (Just "Pong") initGame
+  withWindow (900, 600) (2, 0) (Just "Pong") initGame $
-     $ loop (Just 30) step
+    loop step
-initGame wnd = do
+initGame :: Window -> Game () GameState
-         gameIO $ do
+initGame window = do
-                GL.clearColor $= GL.Color4 0.7 0.5 0.7 1.0
+  gameIO $ do
-                GL.matrixMode $= GL.Modelview 0
+    GL.clearColor $= GL.Color4 0.7 0.5 0.7 1.0
-                GL.loadIdentity
+    GL.matrixMode $= GL.Modelview 0
-         return $ GameState wnd newWorld
+    GL.loadIdentity
+  return $ GameState window newWorld
 step :: Elapsed -> Dt -> Game GameState Bool
 step elapsed dt = do
-     gs <- getGameState
+  --gameIO $ putStrLn "Tick"
-     evts <- events (wnd gs)
+  gs <- getGameState
-     gameIO . process $ evts
+  evts <- events (window gs)
-     let evts' = translate evts
+  gameIO . process $ evts
-     modifyGameState $ \ gs -> gs
+  let evts' = translate evts
-                     { world = stepWorld elapsed dt evts' (world gs) }
+  modifyGameState $ \gs ->
-     getGameState >>= \gs -> gameIO . render $ world gs
+    gs
-     return (not $ exitRequested evts)
+      { world = stepWorld elapsed dt evts' (world gs)
+      }
+  getGameState >>= \gs -> gameIO . render $ world gs
+  return (not $ exitRequested evts)
 render world = do
-       GL.clear [GL.ColorBuffer]
+  GL.clear [GL.ColorBuffer]
-       mapM_ renderGO world
+  mapM_ renderGO world
-       swapBuffers
 renderGO :: GameObject -> IO ()
 renderGO go = do
-         let (AABB2 (Vector2 xmin' ymin') (Vector2 xmax' ymax')) = aabb go
+  let (AABB2 (Vector2 xmin' ymin') (Vector2 xmax' ymax')) = aabb go
-             (Vector2 xcenter ycenter) = pos go
+      (Vector2 xcenter ycenter) = pos go
-             (xmin,ymin,xmax,ymax) = (f2d xmin', f2d ymin', f2d xmax', f2d ymax')
+      (xmin, ymin, xmax, ymax) = (f2d xmin', f2d ymin', f2d xmax', f2d ymax')
-         GL.preservingMatrix $ do
+  GL.preservingMatrix $ do
-            GL.translate (GL.Vector3 (f2d xcenter) (f2d ycenter) 0)
+    GL.translate (GL.Vector3 (f2d xcenter) (f2d ycenter) 0)
-            GL.renderPrimitive (GL.TriangleStrip) $ do
+    GL.renderPrimitive (GL.TriangleStrip) $ do
-               GL.vertex (GL.Vertex2 xmin ymax)
+      GL.vertex (GL.Vertex2 xmin ymax)
-               GL.vertex (GL.Vertex2 xmin ymin)
+      GL.vertex (GL.Vertex2 xmin ymin)
-               GL.vertex (GL.Vertex2 xmax ymax)
+      GL.vertex (GL.Vertex2 xmax ymax)
-               GL.vertex (GL.Vertex2 xmax ymin)
+      GL.vertex (GL.Vertex2 xmax ymin)
 process = mapM_ procEvent
 procEvent (Resize w h) = do
-          GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral w) (fromIntegral h))
+  GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral w) (fromIntegral h))
-          GL.matrixMode $= GL.Projection
+  GL.matrixMode $= GL.Projection
-          GL.loadIdentity
+  GL.loadIdentity
-          GL.ortho 0 1 0 1 (-1) 1
+  GL.ortho 0 1 0 1 (-1) 1
-          GL.matrixMode $= GL.Modelview 0
+  GL.matrixMode $= GL.Modelview 0
 procEvent _ = return ()
 translate = mapMaybe translate'
-translate' (KeyDown KEY_LEFT)  = Just MoveLeft
+translate' (KeyDown KEY_LEFT) = Just MoveLeft
 translate' (KeyDown KEY_RIGHT) = Just MoveRight
-translate' (KeyUp   KEY_LEFT)  = Just StopLeft
+translate' (KeyUp KEY_LEFT) = Just StopLeft
-translate' (KeyUp   KEY_RIGHT) = Just StopRight
+translate' (KeyUp KEY_RIGHT) = Just StopRight
 translate' _ = Nothing
-exitRequested = any (==(KeyDown KEY_ESC))
+exitRequested = any (== (KeyDown KEY_ESC))
 f2d :: Float -> GL.GLdouble
 f2d = realToFrac

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