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
|
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
|
|
|
|
<$> (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 16:30:44 +00:00
|
|
|
, font = fromJust mfont
|
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
|