I need to create more contexts to be threadsafe.

This commit is contained in:
nek0 2018-06-15 15:39:08 +02:00
parent ce48dd505e
commit bfeb8a6fde
6 changed files with 52 additions and 11 deletions

View file

@ -59,6 +59,8 @@ init = do
, uuid = []
, worldState = ws
, stateData = None
, threadContext = Nothing
, mainContext = Nothing
}
loadPlayerSprite

View file

@ -2,6 +2,8 @@ module Load where
import Affection as A
import qualified SDL
import Control.Concurrent (forkIO)
import Control.Concurrent.MVar
import Control.Monad (when)
@ -25,24 +27,38 @@ loadLoad = do
ud <- getAffection
progress <- liftIO $ newMVar 0
future <- liftIO $ newEmptyMVar
_ <- liftIO $ loadFork (worldState ud) (nano ud) future progress
_ <- liftIO $ createFont (nano ud) "bedstead"
(FileName "assets/font/Bedstead-Semicondensed.ttf")
_ <- liftIO $ forkIO $
loadFork
(worldState ud)
(window ud)
(threadContext ud)
(nano ud)
future
progress
SDL.glMakeCurrent (fromJust $ window ud) (fromJust $ mainContext ud)
putAffection ud
{ stateMVar = future
, stateProgress = progress
, state = Load
, assetFonts = M.fromList
[ (FontBedstead, "bedstead")
]
}
loadFork
:: (SystemState Entity IO)
-> Maybe SDL.Window
-> Maybe SDL.GLContext
-> Context
-> MVar (SystemState Entity IO, StateData)
-> MVar Float
-> IO ()
loadFork ws nvg future progress = do
loadFork ws (Just win) (Just glc) nvg future progress = do
let stateSteps = 20
increment = 1 / stateSteps
_ <- createFont nvg "bedstead"
(FileName "assets/font/Bedstead-Semicondensed.ttf")
SDL.glMakeCurrent win glc
modifyMVar_ progress (return . (+ increment))
mwallasc <- createImage nvg (FileName "assets/walls/wall_asc.png") 0
modifyMVar_ progress (return . (+ increment))
@ -111,9 +127,6 @@ loadFork ws nvg future progress = do
{ loadAssetImages = M.fromList imgs
, loadAssetAnims = M.fromList
(playerStanding ++ playerWalking)
, loadAssetFonts = M.fromList
[ (FontBedstead, "bedstead")
]
}
)
@ -122,7 +135,9 @@ drawLoad = do
ud <- getAffection
let ctx = nano ud
progress <- liftIO $ readMVar (stateProgress ud)
liftIO $ drawLoadScreen ud progress
liftIO $ do
logIO A.Verbose ("LoadProgress: " ++ show progress)
drawLoadScreen ud progress
updateLoad :: Double -> Affection UserData ()
updateLoad _ = do
@ -134,7 +149,6 @@ updateLoad _ = do
putAffection ud
{ assetImages = loadAssetImages ld
, assetAnimations = loadAssetAnims ld
, assetFonts = loadAssetFonts ld
, state = Menu
, stateData = None
}

View file

@ -1,19 +1,27 @@
{-# LANGUAGE ForeignFunctionInterface #-}
module Main where
import Affection as A
import qualified SDL
import qualified SDL.Raw.Video as SDL (glSetAttribute)
import qualified SDL.Raw.Enum as SDL
import NanoVG hiding (V2(..), V3(..))
import Linear
import Foreign.C.Types (CInt(..))
-- internal imports
import Types
import StateMachine ()
import Init
foreign import ccall unsafe "glewInit"
glewInit :: IO CInt
main :: IO ()
main = do
let config = AffectionConfig
@ -39,10 +47,19 @@ main = do
pre :: Affection UserData ()
pre = do
ad <- A.get
ud <- getAffection
_ <- SDL.glSetAttribute SDL.SDL_GL_SHARE_WITH_CURRENT_CONTEXT 1
threadContext <- SDL.glCreateContext (drawWindow ad)
SDL.glMakeCurrent (drawWindow ad) (glContext ad)
Subsystems w m <- subsystems <$> getAffection
_ <- partSubscribe w (fitViewport (1280/720))
_ <- partSubscribe w exitOnWindowClose
return ()
putAffection ud
{ threadContext = Just threadContext
, mainContext = Just (glContext ad)
, window = Just (drawWindow ad)
}
update :: Double -> Affection UserData ()
update dt = do

View file

@ -17,7 +17,6 @@ data StateData
| LoadData
{ loadAssetImages :: Map ImgId Image
, loadAssetAnims :: Map AnimId Animation
, loadAssetFonts :: Map FontId Text
}
| MenuData
{ mapMat :: Matrix TileState

View file

@ -7,6 +7,8 @@ import Affection
import Control.Concurrent.STM
import qualified SDL
import NanoVG hiding (V2(..), V3(..))
import qualified Data.Map.Strict as M
@ -35,6 +37,9 @@ data UserData = UserData
, stateData :: StateData
, stateMVar :: MVar (SystemState Entity IO, StateData)
, stateProgress :: MVar Float
, threadContext :: Maybe SDL.GLContext
, mainContext :: Maybe SDL.GLContext
, window :: Maybe SDL.Window
}
data State

View file

@ -176,14 +176,18 @@ naviGraph imgmat (V2 r c) =
drawLoadScreen :: UserData -> Float -> IO ()
drawLoadScreen ud progress = do
let ctx = nano ud
save ctx
fillColor ctx (rgb 255 128 0)
fontSize ctx 100
fontFace ctx (assetFonts ud Map.! FontBedstead)
textAlign ctx (S.fromList [AlignCenter, AlignTop])
textBox ctx 0 300 1280 "Loading"
beginPath ctx
rect ctx
(640 - 640 * realToFrac progress) 450 (1280 * realToFrac progress) 20
closePath ctx
fill ctx
restore ctx
loadAnimationSprites
:: FilePath -- Path to Sprite map