module Main where import Pong import Spear.App import Spear.Game import Spear.Math.AABB import Spear.Math.Matrix4 as Matrix4 hiding (position) import Spear.Math.Spatial import Spear.Math.Spatial2 import Spear.Math.Vector import Spear.Render.Core.Pipeline import Spear.Render.Core.State import Spear.Render.Immediate import Spear.Window import Control.Monad (when) import Data.Maybe (mapMaybe) data GameState = GameState { window :: Window , renderCoreState :: RenderCoreState , immRenderState :: ImmRenderState , viewProjection :: Matrix4 , world :: [GameObject] } app = App step render resize main = withWindow (1920, 1200) (Just "Pong") initGame endGame $ loop app initGame :: Window -> Game () GameState initGame window = do (immRenderState, renderCoreState) <- runSiblingGame newImmRenderer newRenderCoreState return $ GameState window renderCoreState immRenderState Matrix4.id newWorld endGame :: Game GameState () endGame = do game <- getGameState runSubGame' (deleteImmRenderer $ immRenderState game) (renderCoreState game) step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool step elapsed dt inputEvents = do gs <- getGameState events <- processInput (window gs) --when (events /= []) $ gameIO . putStrLn $ show events modifyGameState $ \gs -> gs { world = stepWorld (realToFrac elapsed) (realToFrac dt) events (world gs) } return (not $ exitRequested inputEvents) processInput :: Window -> Game GameState [GameEvent] processInput window = processKeys window [ (KEY_A, MoveLeft) , (KEY_D, MoveRight) ] exitRequested = elem (KeyDown KEY_ESC) render :: Game GameState () render = do gameState <- getGameState immRenderState' <- flip execSubGame (immRenderState gameState) $ do immStart immSetViewProjectionMatrix (viewProjection gameState) -- Clear the background to a different colour than the playable area to make -- the latter distinguishable. gameIO $ do setClearColour (0.2, 0.2, 0.2, 0.0) clearBuffers [ColourBuffer] render' $ world gameState immEnd saveGameState $ gameState { immRenderState = immRenderState' } render' :: [GameObject] -> Game ImmRenderState () render' world = do immLoadIdentity renderBackground -- Draw objects. immSetColour (vec4 1.0 1.0 1.0 1.0) mapM_ renderGO world renderBackground :: Game ImmRenderState () renderBackground = let pmin = 0 :: Float pmax = 1 :: Float in do immSetColour (vec4 0.6 0.35 0.6 1.0) immDrawQuads2d [ (vec2 pmin pmin ,vec2 pmax pmin ,vec2 pmax pmax ,vec2 pmin pmax)] renderGO :: GameObject -> Game ImmRenderState () renderGO go = do let (AABB2 (Vector2 xmin ymin) (Vector2 xmax ymax)) = aabb go (Vector2 xcenter ycenter) = position go immPreservingMatrix $ do immTranslate (vec3 xcenter ycenter 0) immDrawQuads2d [ (vec2 xmin ymin ,vec2 xmax ymin ,vec2 xmax ymax ,vec2 xmin ymax)] resize :: WindowEvent -> Game GameState () resize (ResizeEvent w h) = let r = fromIntegral w / fromIntegral h pad = if r > 1 then (r-1) / 2 else (1/r - 1) / 2 left = if r > 1 then -pad else 0 right = if r > 1 then 1 + pad else 1 bottom = if r > 1 then 0 else -pad top = if r > 1 then 1 else 1 + pad in do gameIO $ setViewport 0 0 w h modifyGameState $ \state -> state { viewProjection = Matrix4.ortho left right bottom top (-1) 1 }