diff options
Diffstat (limited to 'demos/pong/Main.hs')
| -rw-r--r-- | demos/pong/Main.hs | 81 |
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 @@ | |||
| 1 | module Main where | ||
| 2 | |||
| 3 | import Data.Maybe (mapMaybe) | ||
| 4 | import Graphics.Rendering.OpenGL.GL (($=)) | ||
| 5 | import qualified Graphics.Rendering.OpenGL.GL as GL | ||
| 6 | import Pong | ||
| 7 | import Spear.App | ||
| 8 | import Spear.Game | ||
| 9 | import Spear.Math.AABB | ||
| 10 | import Spear.Math.Spatial2 | ||
| 11 | import Spear.Math.Vector | ||
| 12 | import Spear.Window | ||
| 13 | |||
| 14 | data GameState = GameState | ||
| 15 | { window :: Window, | ||
| 16 | world :: [GameObject] | ||
| 17 | } | ||
| 18 | |||
| 19 | main = | ||
| 20 | withWindow (900, 600) (2, 0) (Just "Pong") initGame $ | ||
| 21 | loop step | ||
| 22 | |||
| 23 | initGame :: Window -> Game () GameState | ||
| 24 | initGame 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 | |||
| 31 | step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool | ||
| 32 | step 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 | |||
| 43 | render world = do | ||
| 44 | GL.clear [GL.ColorBuffer] | ||
| 45 | mapM_ renderGO world | ||
| 46 | |||
| 47 | renderGO :: GameObject -> IO () | ||
| 48 | renderGO 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 | |||
| 60 | process = mapM_ procEvent | ||
| 61 | |||
| 62 | procEvent (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 | ||
| 68 | procEvent _ = return () | ||
| 69 | |||
| 70 | translate = mapMaybe translate' | ||
| 71 | |||
| 72 | translate' (KeyDown KEY_LEFT) = Just MoveLeft | ||
| 73 | translate' (KeyDown KEY_RIGHT) = Just MoveRight | ||
| 74 | translate' (KeyUp KEY_LEFT) = Just StopLeft | ||
| 75 | translate' (KeyUp KEY_RIGHT) = Just StopRight | ||
| 76 | translate' _ = Nothing | ||
| 77 | |||
| 78 | exitRequested = any (== (KeyDown KEY_ESC)) | ||
| 79 | |||
| 80 | f2d :: Float -> GL.GLdouble | ||
| 81 | f2d = realToFrac | ||
