diff options
author | 3gg <3gg@shellblade.net> | 2023-03-10 09:03:32 -0800 |
---|---|---|
committer | 3gg <3gg@shellblade.net> | 2023-03-10 09:03:32 -0800 |
commit | 6e26564f4235eeea5dda386282e18081db6f8f07 (patch) | |
tree | 2c9c61f20d8f75385dbc8cdda1a3962de1a4c613 /demos/pong/Main.hs | |
parent | f688e3b624226ca843a7256987d9a76560a3ab9b (diff) |
Compile demos with main project.
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 | ||