bump module Load to affection 0.0.0.10

This commit is contained in:
nek0 2020-05-05 09:13:39 +02:00
parent eea0ec07fd
commit a33fec68d4

View file

@ -7,7 +7,7 @@ import Graphics.Rendering.OpenGL.GL.FlushFinish (finish)
import Control.Concurrent (forkIO)
import Control.Concurrent.MVar
import Control.Monad (when)
import Control.Monad
import qualified Data.Map as M
import qualified Data.Text as T
@ -25,39 +25,39 @@ import Menu.Connect
import Types
import Util
loadLoad :: Affection UserData ()
loadLoad = do
loadLoad :: UserData -> Affection ()
loadLoad ud = do
ad <- A.get
ud <- getAffection
progress <- liftIO $ newMVar (0, "Starting up")
future <- liftIO newEmptyMVar
wState <- liftIO $ readMVar (worldState ud)
curWin <- liftIO $ readMVar (window ud)
tContext <- liftIO $ readMVar (threadContext ud)
let progress = (0, "Starting up")
void $ liftIO $ swapMVar (stateProgress ud) progress
void $ liftIO $ tryReadMVar (stateMVar ud)
_ <- liftIO $ createFont (nano ud) "bedstead"
(FileName "assets/font/Bedstead-Semicondensed.ttf")
_ <- liftIO $ forkIO $
loadFork
(worldState ud)
(fromJust $ window ud)
(fromJust $ threadContext ud)
wState
(fromJust curWin)
(fromJust tContext)
(nano ud)
future
progress
SDL.glMakeCurrent (fromJust $ window ud) (snd $ head $ glContext ad)
putAffection ud
{ stateMVar = future
, stateProgress = progress
, state = Load
, assetFonts = M.fromList
(stateMVar ud)
(stateProgress ud)
SDL.glMakeCurrent (fromJust curWin) (snd $ head $ glContext ad)
void $ liftIO $ swapMVar (state ud) Load
void $ liftIO $ swapMVar (assetFonts ud) (M.fromList
[ (FontBedstead, "bedstead")
]
}
)
loadFork
:: SystemState Entity (AffectionState (AffectionData UserData) IO)
:: SystemState Entity (AffectionState (AffectionData) IO)
-> SDL.Window
-> SDL.GLContext
-> Context
-> MVar
( SystemState Entity (AffectionState (AffectionData UserData) IO)
( SystemState Entity (AffectionState (AffectionData) IO)
, StateData
)
-> MVar (Float, T.Text)
@ -525,30 +525,24 @@ loadFork ws win glc nvg future progress = do
}
)
drawLoad :: Affection UserData ()
drawLoad = do
ud <- getAffection
drawLoad :: UserData -> Affection ()
drawLoad ud = do
progress <- liftIO $ readMVar (stateProgress ud)
liftIO $ do
logIO A.Verbose ("LoadProgress: " <> fromString (show progress))
drawLoadScreen ud progress
updateLoad :: Double -> Affection UserData ()
updateLoad _ = do
ud <- getAffection
updateLoad :: UserData -> Double -> Affection ()
updateLoad ud _ = do
mwsld <- liftIO $ tryTakeMVar (stateMVar ud)
case mwsld of
Just (_, ld) -> do
liftIO $ logIO A.Debug "loaded assets, entering menu"
putAffection ud
{ assetImages = loadAssetImages ld
, assetAnimations = loadAssetAnims ld
, assetIcons = loadAssetIcons ld
-- , state = Main WorldMap
-- , state = Menu Connect
, stateData = None
}
void $ liftIO $ swapMVar (assetImages ud) (loadAssetImages ld)
void $ liftIO $ swapMVar (assetAnimations ud) (loadAssetAnims ld)
void $ liftIO $ swapMVar (assetIcons ud) (loadAssetIcons ld)
void $ liftIO $ swapMVar (stateData ud) None
-- loadMap
loadMenu
loadMenu ud
Nothing ->
return ()