module Load where import Affection as A import Control.Concurrent (forkIO) import Control.Concurrent.MVar import Control.Monad (when) import qualified Data.Map as M import Data.Ecstasy import Data.Maybe import System.Exit (exitFailure) import NanoVG hiding (V2(..)) -- internal imports import Types import Test import Util loadLoad :: Affection UserData () loadLoad = do ud <- getAffection progress <- liftIO $ newMVar 0 future <- liftIO $ newEmptyMVar _ <- liftIO $ loadFork (worldState ud) (nano ud) future progress putAffection ud { stateMVar = future , stateProgress = progress , state = Load } loadFork :: (SystemState Entity IO) -> Context -> MVar (SystemState Entity IO, StateData) -> MVar Float -> IO () loadFork ws nvg future progress = do let stateSteps = 20 increment = 1 / stateSteps _ <- createFont nvg "bedstead" (FileName "assets/font/Bedstead-Semicondensed.ttf") modifyMVar_ progress (return . (+ increment)) mwallasc <- createImage nvg (FileName "assets/walls/wall_asc.png") 0 modifyMVar_ progress (return . (+ increment)) mwalldesc <- createImage nvg (FileName "assets/walls/wall_desc.png") 0 modifyMVar_ progress (return . (+ increment)) mwallcornern <- createImage nvg (FileName "assets/walls/wall_corner_n.png") 0 modifyMVar_ progress (return . (+ increment)) mwallcornere <- createImage nvg (FileName "assets/walls/wall_corner_e.png") 0 modifyMVar_ progress (return . (+ increment)) mwallcorners <- createImage nvg (FileName "assets/walls/wall_corner_s.png") 0 modifyMVar_ progress (return . (+ increment)) mwallcornerw <- createImage nvg (FileName "assets/walls/wall_corner_w.png") 0 modifyMVar_ progress (return . (+ increment)) mwalltne <- createImage nvg (FileName "assets/walls/wall_t_ne.png") 0 modifyMVar_ progress (return . (+ increment)) mwalltse <- createImage nvg (FileName "assets/walls/wall_t_se.png") 0 modifyMVar_ progress (return . (+ increment)) mwalltsw <- createImage nvg (FileName "assets/walls/wall_t_sw.png") 0 modifyMVar_ progress (return . (+ increment)) mwalltnw <- createImage nvg (FileName "assets/walls/wall_t_nw.png") 0 modifyMVar_ progress (return . (+ increment)) mwallcross <- createImage nvg (FileName "assets/walls/wall_cross.png") 0 modifyMVar_ progress (return . (+ increment)) mmiscbox1 <- createImage nvg (FileName "assets/misc/box1.png") 0 modifyMVar_ progress (return . (+ increment)) mmisctable1 <- createImage nvg (FileName "assets/misc/table1.png") 0 modifyMVar_ progress (return . (+ increment)) mmisctable2 <- createImage nvg (FileName "assets/misc/table2.png") 0 modifyMVar_ progress (return . (+ increment)) mmisctable3 <- createImage nvg (FileName "assets/misc/table3.png") 0 modifyMVar_ progress (return . (+ increment)) mmisctable4 <- createImage nvg (FileName "assets/misc/table4.png") 0 modifyMVar_ progress (return . (+ increment)) mmisctableC <- createImage nvg (FileName "assets/misc/tableCorner.png") 0 modifyMVar_ progress (return . (+ increment)) let mimgs = [ mwallasc, mwalldesc, mwallcornern, mwallcornere, mwallcorners, mwallcornerw, mwalltne, mwalltse, mwalltsw, mwalltnw, mwallcross, mmiscbox1, mmisctable1, mmisctable2, mmisctable3, mmisctable4, mmisctableC ] when (any isNothing mimgs) $ do liftIO $logIO Error "Failed to load image assets" exitFailure -- playerImgs <- loadPlayerSprite "assets/intruder.png" 64 74 nvg -- (zipWith (\a b -> (a, [b])) [0..] $ [ImgIntrE .. ImgIntrN] ++ [ImgIntrNE]) let imgs = zipWith (\a b -> (a, fromJust b)) [ImgWallAsc ..] mimgs directions = [E .. N] ++ [NE] standIds = map (AnimId 0 "standing") directions walkIds = map (AnimId 0 "walking") directions standConfigs = map (\i -> AnimationConfig (0, i * 74) (64, 74) 1 0 APLoop) [0 .. length standIds - 1] walkConfigs = map (\i -> AnimationConfig (64, i * 74) (64, 74) 6 1.5 APLoop) [0 .. length walkIds - 1] playerStanding <- loadAnimationSprites "assets/intruder.png" nvg (zip standIds standConfigs) liftIO $modifyMVar_ progress (return . (+ increment)) playerWalking <- loadAnimationSprites "assets/intruder.png" nvg (zip walkIds walkConfigs) modifyMVar_ progress (return . (+ increment)) putMVar future ( ws , LoadData { loadAssetImages = M.fromList imgs , loadAssetAnims = M.fromList (playerStanding ++ playerWalking) , loadAssetFonts = M.fromList [ (FontBedstead, "bedstead") ] } ) drawLoad :: Affection UserData () drawLoad = do ud <- getAffection let ctx = nano ud progress <- liftIO $ readMVar (stateProgress ud) liftIO $ drawLoadScreen ud progress updateLoad :: Double -> Affection UserData () updateLoad _ = do ud <- getAffection 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 , assetFonts = loadAssetFonts ld , state = Menu , stateData = None } loadMap Nothing -> do return ()