module Load where import Affection as A import qualified SDL import Graphics.Rendering.OpenGL.GL.FlushFinish (finish) import Control.Concurrent (forkIO) import Control.Concurrent.MVar import Control.Monad (when) import qualified Data.Map as M import qualified Data.Text as T import Data.Ecstasy import Data.Maybe import Data.String import System.Exit (exitFailure) import NanoVG hiding (V2(..)) -- internal imports import Menu.Connect import Types import Util loadLoad :: Affection UserData () loadLoad = do ad <- A.get ud <- getAffection progress <- liftIO $ newMVar (0, "Starting up") future <- liftIO newEmptyMVar _ <- liftIO $ createFont (nano ud) "bedstead" (FileName "assets/font/Bedstead-Semicondensed.ttf") _ <- liftIO $ forkIO $ loadFork (worldState ud) (fromJust $ window ud) (fromJust $ threadContext ud) (nano ud) future progress SDL.glMakeCurrent (fromJust $ window ud) (snd $ head $ glContext ad) putAffection ud { stateMVar = future , stateProgress = progress , state = Load , assetFonts = M.fromList [ (FontBedstead, "bedstead") ] } loadFork :: SystemState Entity (AffectionState (AffectionData UserData) IO) -> SDL.Window -> SDL.GLContext -> Context -> MVar ( SystemState Entity (AffectionState (AffectionData UserData) IO) , StateData ) -> MVar (Float, T.Text) -> IO () loadFork ws win glc nvg future progress = do let stateSteps = 57 increment = 1 / stateSteps SDL.glMakeCurrent win glc modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading icon \"conntroller_blue\"" ))) mcontrblue <- createImage nvg (FileName "assets/icons/controller_blue.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading icon \"controller_blue\"" ))) mcontrgreen <- createImage nvg (FileName "assets/icons/controller_green.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading icon \"controller_green\"" ))) mkbdblue <- createImage nvg (FileName "assets/icons/keyboard_blue.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading icon \"keyboard_blue\"" ))) mkbdgreen <- createImage nvg (FileName "assets/icons/keyboard_green.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading icon \"keyboard_green\"" ))) marrow <- createImage nvg (FileName "assets/icons/arrow.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"wall_asc\"" ))) mwallasc <- createImage nvg (FileName "assets/walls/wall_asc.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"wall_desc\"" ))) mwalldesc <- createImage nvg (FileName "assets/walls/wall_desc.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"wall_corner_n\"" ))) mwallcornern <- createImage nvg (FileName "assets/walls/wall_corner_n.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"wall_corner_e\"" ))) mwallcornere <- createImage nvg (FileName "assets/walls/wall_corner_e.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"wall_corner_s\"" ))) mwallcorners <- createImage nvg (FileName "assets/walls/wall_corner_s.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"wall_corner_w\"" ))) mwallcornerw <- createImage nvg (FileName "assets/walls/wall_corner_w.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"wall_t_ne\"" ))) mwalltne <- createImage nvg (FileName "assets/walls/wall_t_ne.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"wall_t_se\"" ))) mwalltse <- createImage nvg (FileName "assets/walls/wall_t_se.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"wall_t_sw\"" ))) mwalltsw <- createImage nvg (FileName "assets/walls/wall_t_sw.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"wall_t_nw\"" ))) mwalltnw <- createImage nvg (FileName "assets/walls/wall_t_nw.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"wall_cross\"" ))) mwallcross <- createImage nvg (FileName "assets/walls/wall_cross.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"box1\"" ))) mmiscbox1 <- createImage nvg (FileName "assets/misc/box1.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"tableSW\"" ))) mtableSW <- createImage nvg (FileName "assets/table/tableSW.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"tableSE\"" ))) mtableSE <- createImage nvg (FileName "assets/table/tableSE.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"tableNE\"" ))) mtableNE <- createImage nvg (FileName "assets/table/tableNE.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"tableNW\"" ))) mtableNW <- createImage nvg (FileName "assets/table/tableNW.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"tableC1\"" ))) mtablec1 <- createImage nvg (FileName "assets/table/tablec1.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"tableC2\"" ))) mtablec2 <- createImage nvg (FileName "assets/table/tablec2.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"tableC3\"" ))) mtablec3 <- createImage nvg (FileName "assets/table/tablec3.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"tableC4\"" ))) mtablec4 <- createImage nvg (FileName "assets/table/tablec4.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"tableCorner\"" ))) mtableC <- createImage nvg (FileName "assets/table/tableCorner.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"flipchart\"" ))) mmiscFlipchart <- createImage nvg (FileName "assets/misc/flipchart.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"plant1\"" ))) mmiscPlant1 <- createImage nvg (FileName "assets/misc/plant1.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"plant2\"" ))) mmiscPlant2 <- createImage nvg (FileName "assets/misc/plant2.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"watercooler\"" ))) mmiscWatercooler <- createImage nvg (FileName "assets/misc/watercooler.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"vending machine\"" ))) mmiscVending <- createImage nvg (FileName "assets/misc/vending.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"Cabinet with Coffee machine SW\"" ))) mcabCoffeeSW <- createImage nvg (FileName "assets/cabinet/cabCoffeeSW.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"Cabinet with Coffee machine SE\"" ))) mcabCoffeeSE <- createImage nvg (FileName "assets/cabinet/cabCoffeeSE.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"Cabinet with sink SW\"" ))) mcabSinkSW <- createImage nvg (FileName "assets/cabinet/cabSinkSW.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"Cabinet with sink SE\"" ))) mcabSinkSE <- createImage nvg (FileName "assets/cabinet/cabSinkSE.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"Cabinet with stove SW\"" ))) mcabStoveSW <- createImage nvg (FileName "assets/cabinet/cabStoveSW.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"Cabinet with stove SE\"" ))) mcabStoveSE <- createImage nvg (FileName "assets/cabinet/cabStoveSE.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"cabinet SW\"" ))) mcabinetSW <- createImage nvg (FileName "assets/cabinet/cabinetSW.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"cabinet SE\"" ))) mcabinetSE <- createImage nvg (FileName "assets/cabinet/cabinetSE.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"cabinet corner\"" ))) mcabinetCorner <- createImage nvg (FileName "assets/cabinet/cabinetCorner.png") 0 let micons = [ mcontrblue, mcontrgreen, mkbdblue, mkbdgreen, marrow ] when (any isNothing micons) $ do liftIO $logIO Error "Failed to load icon assets" exitFailure let mimgs = [ mwallasc, mwalldesc , mwallcornern, mwallcornere, mwallcorners, mwallcornerw , mwalltne, mwalltse, mwalltsw, mwalltnw, mwallcross , mmiscbox1 , mtableSW, mtableNW, mtableNE, mtableSE, mtableC , mtablec1, mtablec2, mtablec3, mtablec4 , mmiscFlipchart , mmiscPlant1, mmiscPlant2 , mmiscWatercooler, mmiscVending , mcabCoffeeSW, mcabCoffeeSE , mcabSinkSW, mcabSinkSE , mcabStoveSW, mcabStoveSE , mcabinetSW, mcabinetSE, mcabinetCorner ] when (any isNothing mimgs) $ do liftIO $logIO Error "Failed to load image assets" exitFailure modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading Animation \"intruder: standing\"" ))) -- 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 .. ImgCabinetCorner ] mimgs icons = zipWith (\a b -> (a, fromJust b)) [ IconContrBlue .. IconArrow ] micons directions = [E .. N] ++ [NE] standIds var = map (AnimId var "standing") directions walkIds var = map (AnimId var "walking") directions standConfigs = map (\i -> AnimationConfig (0, i * 74) (64, 74) (64, 0) 1 0 APLoop) [0 .. length (standIds AnimIntruder) - 1] walkConfigs = map (\i -> AnimationConfig (64, i * 74) (64, 74) (64, 0) 6 1.5 APLoop) [0 .. length (walkIds AnimIntruder) - 1] playerStanding <- loadAnimationSprites "assets/intruder.png" nvg (zip (standIds AnimIntruder) standConfigs) modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading Animation \"intruder: walking\"" ))) playerWalking <- loadAnimationSprites "assets/intruder.png" nvg (zip (walkIds AnimIntruder) walkConfigs) modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading Animation \"jdoem: standing\"" ))) jdoemStanding <- loadAnimationSprites "assets/jdoem.png" nvg (zip (standIds AnimJDoeM) standConfigs) modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading Animation \"jdoem: walking\"" ))) jdoemWalking <- loadAnimationSprites "assets/jdoem.png" nvg (zip (walkIds AnimJDoeM) walkConfigs) modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading Animation \"copier: stand\"" ))) copierStand <- loadAnimationSprites "assets/misc/copier.png" nvg $ zip (map (\name -> AnimId AnimCopier name N) ["closed", "open"]) (map (\i -> AnimationConfig (0, i * 74) (64, 74) (0, 0) 1 0 APLoop) [0, 1] ) modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading Animation \"copier: copy\"" ))) copierCopy <- loadAnimationSprites "assets/misc/copier.png" nvg [ ( AnimId AnimCopier "copy" N , AnimationConfig (64, 0) (64, 74) (64, 0) 4 1 APLoop ) ] modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading Animation \"cornerComputer: off\"" ))) cornerComputerOff <- loadAnimationSprites "assets/misc/tableCornerComputer.png" nvg [ ( AnimId AnimComputer "off" N , AnimationConfig (0, 0) (64, 74) (64, 0) 2 2 APLoop ) ] modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading Animation \"cornerComputer: on\"" ))) cornerComputerOn <- loadAnimationSprites "assets/misc/tableCornerComputer.png" nvg [ ( AnimId AnimComputer "on" N , AnimationConfig (128, 0) (64, 74) (0, 0) 1 0 APLoop ) ] modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading Animation \"cornerComputer: hack\"" ))) cornerComputerHack <- loadAnimationSprites "assets/misc/tableCornerComputer.png" nvg [ ( AnimId AnimComputer "hack" N , AnimationConfig (0, 74) (64, 74) (64, 0) 4 2 APLoop ) ] modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading Animation \"neComputer: off\"" ))) neComputerOff <- loadAnimationSprites "assets/misc/tableSWComputer.png" nvg [ ( AnimId AnimComputer "off" NE , AnimationConfig (0, 0) (64, 74) (64, 0) 2 2 APLoop ) ] modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading Animation \"neComputer: on\"" ))) neComputerOn <- loadAnimationSprites "assets/misc/tableSWComputer.png" nvg [ ( AnimId AnimComputer "on" NE , AnimationConfig (128, 0) (64, 74) (0, 0) 1 0 APLoop ) ] modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading Animation \"neComputer: hack\"" ))) neComputerHack <- loadAnimationSprites "assets/misc/tableSWComputer.png" nvg [ ( AnimId AnimComputer "hack" NE , AnimationConfig (0, 74) (64, 74) (64, 0) 4 2 APLoop ) ] modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading Animation \"nwComputer: off\"" ))) nwComputerOff <- loadAnimationSprites "assets/misc/tableSEComputer.png" nvg [ ( AnimId AnimComputer "off" NW , AnimationConfig (0, 0) (64, 74) (64, 0) 2 2 APLoop ) ] modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading Animation \"nwComputer: on\"" ))) nwComputerOn <- loadAnimationSprites "assets/misc/tableSEComputer.png" nvg [ ( AnimId AnimComputer "on" NW , AnimationConfig (128, 0) (64, 74) (0, 0) 1 0 APLoop ) ] modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading Animation \"nwComputer: hack\"" ))) nwComputerHack <- loadAnimationSprites "assets/misc/tableSEComputer.png" nvg [ ( AnimId AnimComputer "hack" NW , AnimationConfig (0, 74) (64, 74) (64, 0) 4 2 APLoop ) ] modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading Animation \"toilet: free\"" ))) toiletFree <- loadAnimationSprites "assets/misc/toilet.png" nvg [ ( AnimId AnimToilet "free" N , AnimationConfig (0, 0) (64, 74) (0, 0) 1 0 APLoop ) ] modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading Animation \"toilet: occupied\"" ))) toiletOccupied <- loadAnimationSprites "assets/misc/toilet.png" nvg [ ( AnimId AnimToilet "occupied" N , AnimationConfig (64, 0) (64, 74) (0, 0) 1 0 APLoop ) ] modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading Animation \"neDoor0: open\"" ))) neDoor0open <- loadAnimationSprites "assets/doors/door_desc_0.png" nvg [ ( AnimId AnimDoor0 "open" NE , AnimationConfig (0, 0) (64, 74) (0, 74) 5 0.25 APOnce ) ] modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading Animation \"neDoor0: shut\"" ))) neDoor0shut <- loadAnimationSprites "assets/doors/door_desc_0.png" nvg [ ( AnimId AnimDoor0 "shut" NE , AnimationConfig (0, 4*74) (64, 74) (0, -74) 5 0.25 APOnce ) ] modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading Animation \"nwDoor0: open\"" ))) nwDoor0open <- loadAnimationSprites "assets/doors/door_asc_0.png" nvg [ ( AnimId AnimDoor0 "open" NW , AnimationConfig (0, 0) (64, 74) (0, 74) 5 0.25 APOnce ) ] modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading Animation \"nwDoor0: shut\"" ))) nwDoor0shut <- loadAnimationSprites "assets/doors/door_asc_0.png" nvg [ ( AnimId AnimDoor0 "shut" NW , AnimationConfig (0, 4*74) (64, 74) (0, -74) 5 0.25 APOnce ) ] modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Handing over" ))) finish putMVar future ( ws , LoadData { loadAssetImages = M.fromList imgs , loadAssetAnims = M.fromList ( playerStanding ++ playerWalking ++ jdoemStanding ++ jdoemWalking ++ copierStand ++ copierCopy ++ cornerComputerOff ++ cornerComputerOn ++ cornerComputerHack ++ neComputerOff ++ neComputerOn ++ neComputerHack ++ nwComputerOff ++ nwComputerOn ++ nwComputerHack ++ toiletFree ++ toiletOccupied ++ neDoor0shut ++ neDoor0open ++ nwDoor0shut ++ nwDoor0open ) , loadAssetIcons = M.fromList icons } ) drawLoad :: Affection UserData () drawLoad = do ud <- getAffection 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 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 } -- loadMap loadMenu Nothing -> return ()