276 lines
8.4 KiB
Haskell
276 lines
8.4 KiB
Haskell
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 System.Exit (exitFailure)
|
|
|
|
import NanoVG hiding (V2(..))
|
|
|
|
-- internal imports
|
|
|
|
import Types
|
|
import MainGame.WorldMap
|
|
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) (glContext ad)
|
|
putAffection ud
|
|
{ stateMVar = future
|
|
, stateProgress = progress
|
|
, state = Load
|
|
, assetFonts = M.fromList
|
|
[ (FontBedstead, "bedstead")
|
|
]
|
|
}
|
|
|
|
loadFork
|
|
:: (SystemState Entity IO)
|
|
-> SDL.Window
|
|
-> SDL.GLContext
|
|
-> Context
|
|
-> MVar (SystemState Entity IO, StateData)
|
|
-> MVar (Float, T.Text)
|
|
-> IO ()
|
|
loadFork ws win glc nvg future progress = do
|
|
let stateSteps = 24
|
|
increment = 1 / stateSteps
|
|
SDL.glMakeCurrent win glc
|
|
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 \"table1\""
|
|
)))
|
|
mmisctable1 <- createImage nvg (FileName "assets/misc/table1.png") 0
|
|
modifyMVar_ progress (return . (\(p, _) ->
|
|
( p + increment
|
|
, "Loading asset \"table2\""
|
|
)))
|
|
mmisctable2 <- createImage nvg (FileName "assets/misc/table2.png") 0
|
|
modifyMVar_ progress (return . (\(p, _) ->
|
|
( p + increment
|
|
, "Loading asset \"table3\""
|
|
)))
|
|
mmisctable3 <- createImage nvg (FileName "assets/misc/table3.png") 0
|
|
modifyMVar_ progress (return . (\(p, _) ->
|
|
( p + increment
|
|
, "Loading asset \"wall_table4\""
|
|
)))
|
|
mmisctable4 <- createImage nvg (FileName "assets/misc/table4.png") 0
|
|
modifyMVar_ progress (return . (\(p, _) ->
|
|
( p + increment
|
|
, "Loading asset \"tableCorner\""
|
|
)))
|
|
mmisctableC <- createImage nvg (FileName "assets/misc/tableCorner.png") 0
|
|
modifyMVar_ progress (return . (\(p, _) ->
|
|
( p + increment
|
|
, "Loading Animation \"intruder: standing\""
|
|
)))
|
|
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
|
|
, ImgWallDesc
|
|
, ImgWallCornerN
|
|
, ImgWallCornerE
|
|
, ImgWallCornerS
|
|
, ImgWallCornerW
|
|
, ImgWallTNE
|
|
, ImgWallTSE
|
|
, ImgWallTSW
|
|
, ImgWallTNW
|
|
, ImgWallCross
|
|
, ImgMiscBox1
|
|
, ImgMiscTable1
|
|
, ImgMiscTable2
|
|
, ImgMiscTable3
|
|
, ImgMiscTable4
|
|
, ImgMiscTableCorner
|
|
]
|
|
mimgs
|
|
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 "intruder") - 1]
|
|
walkConfigs = map
|
|
(\i -> AnimationConfig (64, i * 74) (64, 74) (64, 0) 6 1.5 APLoop)
|
|
[0 .. length (walkIds "intruder") - 1]
|
|
playerStanding <- loadAnimationSprites "assets/intruder.png" nvg
|
|
(zip (standIds "intruder") standConfigs)
|
|
modifyMVar_ progress (return . (\(p, _) ->
|
|
( p + increment
|
|
, "Loading Animation \"intruder: walking\""
|
|
)))
|
|
playerWalking <- loadAnimationSprites "assets/intruder.png" nvg
|
|
(zip (walkIds "intruder") walkConfigs)
|
|
modifyMVar_ progress (return . (\(p, _) ->
|
|
( p + increment
|
|
, "Loading Animation \"jdoem: standing\""
|
|
)))
|
|
jdoemStanding <- loadAnimationSprites "assets/jdoem.png" nvg
|
|
(zip (standIds "jdoem") standConfigs)
|
|
modifyMVar_ progress (return . (\(p, _) ->
|
|
( p + increment
|
|
, "Loading Animation \"jdoem: walking\""
|
|
)))
|
|
jdoemWalking <- loadAnimationSprites "assets/jdoem.png" nvg
|
|
(zip (walkIds "jdoem") walkConfigs)
|
|
modifyMVar_ progress (return . (\(p, _) ->
|
|
( p + increment
|
|
, "Loading Animation \"copier: stand\""
|
|
)))
|
|
copierStand <- loadAnimationSprites "assets/misc/copier.png" nvg $ zip
|
|
(map (\name -> AnimId "copier" 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 "copier" "copy" N
|
|
, AnimationConfig (64, 0) (64, 74) (64, 0) 4 1 APLoop
|
|
)
|
|
]
|
|
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
|
|
)
|
|
}
|
|
)
|
|
|
|
drawLoad :: Affection UserData ()
|
|
drawLoad = do
|
|
ud <- getAffection
|
|
progress <- liftIO $ readMVar (stateProgress ud)
|
|
liftIO $ do
|
|
logIO A.Verbose ("LoadProgress: " ++ 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
|
|
, state = Main WorldMap
|
|
, stateData = None
|
|
}
|
|
loadMap
|
|
Nothing ->
|
|
return ()
|