haskelloids/src/Init.hs

88 lines
2.1 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 (($=))
import qualified SDL
import qualified Data.Set as S
import Data.Maybe
2017-12-16 18:06:36 +00:00
import Control.Monad (when)
import Control.Monad.IO.Class (liftIO)
2017-12-19 05:49:41 +00:00
import Control.Concurrent.STM
2017-12-16 18:06:36 +00:00
2017-12-16 10:55:30 +00:00
import System.Random
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 NanoVG hiding (V2)
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-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"
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-16 10:55:30 +00:00
logIO Error "Failed loading image assets"
2017-12-19 05:49:41 +00:00
exitFailure
subs <- Subsystems
<$> (return . Window =<< newTVarIO [])
<*> (return . Keyboard =<< newTVarIO [])
2017-12-16 10:55:30 +00:00
return UserData
{ ship = Ship
{ sPos = V2 400 300
, sVel = V2 0 0
, sRot = 0
2017-12-16 18:06:36 +00:00
, sImg = fromJust mshipImage
2017-12-16 10:55:30 +00:00
}
, haskelloids = []
, wonlost = Nothing
, state = Menu
, fade = FadeIn 1
, nano = nvgCtx
2017-12-19 05:49:41 +00:00
, subsystems = subs
2017-12-16 10:55:30 +00:00
}
-- _ <- 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