diff --git a/haskelloids.cabal b/haskelloids.cabal index a1be398..e5aac0a 100644 --- a/haskelloids.cabal +++ b/haskelloids.cabal @@ -68,6 +68,7 @@ executable haskelloids build-depends: base >=4.9 && <4.11 , affection <= 0.0.0.7 , sdl2 >= 2.1.3.1 + , OpenGL , containers , random , linear diff --git a/src/Init.hs b/src/Init.hs index 5066505..fd72a07 100644 --- a/src/Init.hs +++ b/src/Init.hs @@ -6,6 +6,8 @@ import Affection as A import SDL (($=)) import qualified SDL +import qualified Graphics.Rendering.OpenGL as GL + import qualified Data.Set as S import Data.Maybe @@ -31,16 +33,22 @@ foreign import ccall unsafe "glewInit" load :: IO UserData load = do + liftIO $ logIO A.Debug "Let's drop some Hhnts for SDL" + SDL.HintRenderDriver $= SDL.OpenGL liftIO $ logIO A.Debug "init GLEW" _ <- glewInit liftIO $ logIO A.Debug "loading state" liftIO $ logIO A.Debug "create context" - nvgCtx <- createGL3 (S.fromList [Antialias, StencilStrokes, NanoVG.Debug]) + nvgCtx <- createGL3 (S.fromList [Antialias, StencilStrokes]) liftIO $ logIO A.Debug "load ship image" mshipImage <- createImage nvgCtx (FileName "assets/ship.png") 0 when (isNothing mshipImage) $ do - logIO Error "Failed loading image assets" + logIO Error "Failed to load asset ship" exitFailure + mhaskImage <- liftIO $ + createImage nvgCtx (FileName "assets/haskelloid.png") 0 + when (isNothing mhaskImage) $ + liftIO $ logIO Error "Failed to load asset haskelloid" mfont <- createFont nvgCtx "modulo" (FileName "assets/Modulo.ttf") when (isNothing mfont) $ do logIO Error "Failed to load font" @@ -49,6 +57,9 @@ load = do subs <- Subsystems <$> (return . Window =<< newTVarIO []) <*> (return . Keyboard =<< newTVarIO []) + liftIO $ logIO A.Debug "Setting viewport" + GL.viewport $= (GL.Position 0 0, GL.Size 800 600) + liftIO $ logIO A.Debug "Returning UserData" return UserData { ship = Ship { sPos = V2 400 300 @@ -63,31 +74,5 @@ load = do , nano = nvgCtx , font = fromJust mfont , subsystems = subs + , haskImage = fromJust mhaskImage } - - - - -- _ <- SDL.setMouseLocationMode SDL.RelativeLocation - -- GL.depthFunc $= ust GL.Less - -- pane <- GL.genObjectName - -- GL.BindVertexArrayObject $= Just pane - -- verts <- GL.genObejctName - -- let vertCoord = - -- [ (-1), (-1), 0 - -- , 1 , (-1), 0 - -- , (-1), 1 , 0 - -- , 1 , 1 , 0 - -- , (-1), 1 , 0 - -- , 1 , (-1), 0 - -- ] - -- withArray vertCoord $ \ptr - -- GL.bufferData GL.ArrayBuffer $= - -- ( fromIntegral $ length vertCoord * 3 * sizeOf (0 :: Double) - -- , ptr - -- , GL.StaticDraw - -- ) - -- GL.vertexAttribPointer (GL.AttribLocation 0) $= - -- ( GL.ToFloat - -- , GL.VertexArrayDescriptor 4 GL.Float 0 (plusPtr nullPtr 0) - -- ) - -- GL.vertexAttribArray (GL.AttribLocation 0) $= GL.Enabled diff --git a/src/Main.hs b/src/Main.hs index 3ae27e4..3992e57 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -4,12 +4,13 @@ module Main where import Affection as A import SDL (($=)) import qualified SDL +import qualified Graphics.Rendering.OpenGL as GL import qualified Data.Map as M import Linear as L -import NanoVG +import NanoVG hiding (V2(..)) import Control.Monad.IO.Class (liftIO) @@ -28,19 +29,31 @@ main = do , windowTitle = "Haskelloids" , windowConfig = SDL.defaultWindow { SDL.windowOpenGL = Just SDL.defaultOpenGL - { SDL.glProfile = SDL.Core SDL.Normal 3 3 + { SDL.glProfile = SDL.Core SDL.Normal 3 3 } } , initScreenMode = SDL.Windowed , canvasSize = Nothing , loadState = load - , preLoop = smLoad Menu + , preLoop = pre >> smLoad Menu , eventLoop = handle , updateLoop = update , drawLoop = draw , cleanUp = (\_ -> return ()) } +pre :: Affection UserData () +pre = do + subs <- subsystems <$> getAffection + liftIO $ logIO A.Debug "Setting global resize event listener" + _ <- partSubscribe (subWindow subs) $ \msg -> case msg of + MsgWindowResize _ _ (V2 w h) -> do + let nw = floor $ fromIntegral h * (800/600) + dw = floor $ (fromIntegral w - fromIntegral nw) / 2 + GL.viewport $= (GL.Position dw 0, GL.Size nw h) + _ -> return () + return () + update :: Double -> Affection UserData () update sec = do ud <- getAffection diff --git a/src/Menu.hs b/src/Menu.hs index d9b86f9..2436a6a 100644 --- a/src/Menu.hs +++ b/src/Menu.hs @@ -34,11 +34,7 @@ loadMenu :: Affection UserData () loadMenu = do liftIO $ logIO A.Debug "Loading Menu" ud <- getAffection - mhaskImage <- liftIO $ - createImage (nano ud) (FileName "assets/haskelloid.png") 0 - when (isNothing mhaskImage) $ - liftIO $ logIO Error "Failed to load asset haskelloid" - hs <- newHaskelloids (fromJust mhaskImage) + hs <- newHaskelloids (haskImage ud) _ <- partSubscribe (subKeyboard $ subsystems ud) (\kbdev -> case SDL.keysymKeycode (msgKbdKeysym kbdev) of SDL.KeycodeEscape -> do diff --git a/src/Types.hs b/src/Types.hs index 8d04303..c063c6b 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -22,6 +22,7 @@ data UserData = UserData , nano :: Context , font :: Font , subsystems :: Subsystems + , haskImage :: Image } data Ship = Ship