haskelloids/src/Init.hs

83 lines
2.2 KiB
Haskell
Raw Normal View History

2017-12-19 05:49:41 +00:00
{-# LANGUAGE ForeignFunctionInterface #-}
2017-12-16 10:55:30 +00:00
module Init where
2017-12-16 18:06:36 +00:00
import Affection as A
2017-12-16 10:55:30 +00:00
import SDL (($=))
2017-12-22 08:12:04 +00:00
import qualified SDL
2017-12-16 10:55:30 +00:00
2017-12-19 20:53:07 +00:00
import qualified Graphics.Rendering.OpenGL as GL
2018-01-01 16:05:05 +00:00
import NanoVG hiding (V2(..))
2017-12-16 10:55:30 +00:00
import qualified Data.Set as S
import Data.Maybe
2017-12-16 18:06:36 +00:00
import Control.Monad (when)
2017-12-19 05:49:41 +00:00
import Control.Concurrent.STM
2020-05-04 19:17:06 +00:00
import Control.Concurrent.MVar
2017-12-16 18:06:36 +00:00
2017-12-19 05:49:41 +00:00
import System.Exit (exitFailure)
2017-12-16 18:06:36 +00:00
import Linear
2017-12-16 10:55:30 +00:00
2017-12-19 05:49:41 +00:00
import Foreign.C.Types (CInt(..))
2017-12-16 10:55:30 +00:00
-- Internal imports
import Types
2017-12-19 05:49:41 +00:00
foreign import ccall unsafe "glewInit"
glewInit :: IO CInt
2017-12-16 10:55:30 +00:00
load :: IO UserData
load = do
2017-12-20 03:58:24 +00:00
-- liftIO $ logIO A.Debug "Let's drop some Hints for SDL"
-- SDL.HintRenderDriver $= SDL.OpenGL
2017-12-22 08:12:04 +00:00
SDL.cursorVisible $= False
2017-12-21 12:09:15 +00:00
GL.clearColor $= GL.Color4 0 0 0.1 1
2017-12-19 05:49:41 +00:00
liftIO $ logIO A.Debug "init GLEW"
_ <- glewInit
2017-12-16 18:06:36 +00:00
liftIO $ logIO A.Debug "loading state"
2017-12-19 05:49:41 +00:00
liftIO $ logIO A.Debug "create context"
2017-12-20 03:58:24 +00:00
nvgCtx <- createGL3 (S.fromList [Antialias, StencilStrokes, NanoVG.Debug])
2017-12-16 18:06:36 +00:00
liftIO $ logIO A.Debug "load ship image"
2017-12-19 05:49:41 +00:00
mshipImage <- createImage nvgCtx (FileName "assets/ship.png") 0
when (isNothing mshipImage) $ do
2017-12-19 20:53:07 +00:00
logIO Error "Failed to load asset ship"
2017-12-19 05:49:41 +00:00
exitFailure
2017-12-19 20:53:07 +00:00
mhaskImage <- liftIO $
createImage nvgCtx (FileName "assets/haskelloid.png") 0
when (isNothing mhaskImage) $
liftIO $ logIO Error "Failed to load asset haskelloid"
2017-12-19 16:30:44 +00:00
mfont <- createFont nvgCtx "modulo" (FileName "assets/Modulo.ttf")
when (isNothing mfont) $ do
logIO Error "Failed to load font"
exitFailure
liftIO $ logIO A.Debug "Initializing subsystems"
2017-12-19 05:49:41 +00:00
subs <- Subsystems
2018-12-27 12:49:12 +00:00
<$> (SubWindow <$> newTVarIO [])
<*> (SubKeyboard <$> newTVarIO [])
2017-12-19 20:53:07 +00:00
liftIO $ logIO A.Debug "Setting viewport"
GL.viewport $= (GL.Position 0 0, GL.Size 800 600)
liftIO $ logIO A.Debug "Returning UserData"
2020-05-04 19:17:06 +00:00
UserData
<$> newMVar (Ship
2017-12-16 10:55:30 +00:00
{ sPos = V2 400 300
, sVel = V2 0 0
, sRot = 0
2017-12-16 18:06:36 +00:00
, sImg = fromJust mshipImage
2018-01-11 07:31:14 +00:00
, sThrust = False
2020-05-04 19:17:06 +00:00
})
<*> newMVar []
<*> newMVar []
<*> newMVar Nothing
<*> newMVar Menu
<*> newMVar (FadeIn 1)
<*> return nvgCtx
<*> return (fromJust mfont)
<*> return subs
<*> return (fromJust mhaskImage)
<*> newMVar (UUIDClean [] [])
<*> newMVar True