tracer/src/Load.hs

360 lines
11 KiB
Haskell
Raw Normal View History

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
2018-07-19 04:51:07 +02:00
import qualified Data.Text as T
import Data.Ecstasy
import Data.Maybe
import System.Exit (exitFailure)
import NanoVG hiding (V2(..))
-- internal imports
import Types
2018-06-28 21:07:58 +02:00
import MainGame.WorldMap
import Util
loadLoad :: Affection UserData ()
loadLoad = do
2018-07-06 17:17:12 +02:00
ad <- A.get
ud <- getAffection
2018-07-19 04:51:07 +02:00
progress <- liftIO $ newMVar (0, "Starting up")
2018-09-02 10:44:33 +02:00
future <- liftIO newEmptyMVar
_ <- liftIO $ createFont (nano ud) "bedstead"
(FileName "assets/font/Bedstead-Semicondensed.ttf")
_ <- liftIO $ forkIO $
loadFork
(worldState ud)
2018-07-03 16:19:27 +02:00
(fromJust $ window ud)
(fromJust $ threadContext ud)
(nano ud)
future
progress
2018-07-06 17:17:12 +02:00
SDL.glMakeCurrent (fromJust $ window ud) (glContext ad)
putAffection ud
{ stateMVar = future
, stateProgress = progress
, state = Load
, assetFonts = M.fromList
[ (FontBedstead, "bedstead")
]
}
loadFork
2018-08-10 08:58:26 +02:00
:: SystemState Entity (AffectionState (AffectionData UserData) IO)
2018-07-03 16:19:27 +02:00
-> SDL.Window
-> SDL.GLContext
-> Context
2018-08-10 08:58:26 +02:00
-> MVar
( SystemState Entity (AffectionState (AffectionData UserData) IO)
, StateData
)
2018-07-19 04:51:07 +02:00
-> MVar (Float, T.Text)
-> IO ()
2018-07-03 16:19:27 +02:00
loadFork ws win glc nvg future progress = do
2018-08-12 06:28:31 +02:00
let stateSteps = 37
increment = 1 / stateSteps
SDL.glMakeCurrent win glc
2018-07-19 04:51:07 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading asset \"wall_asc\""
)))
mwallasc <- createImage nvg (FileName "assets/walls/wall_asc.png") 0
2018-07-19 04:51:07 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading asset \"wall_desc\""
)))
mwalldesc <- createImage nvg (FileName "assets/walls/wall_desc.png") 0
2018-07-19 04:51:07 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading asset \"wall_corner_n\""
)))
mwallcornern <- createImage nvg (FileName "assets/walls/wall_corner_n.png") 0
2018-07-19 04:51:07 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading asset \"wall_corner_e\""
)))
mwallcornere <- createImage nvg (FileName "assets/walls/wall_corner_e.png") 0
2018-07-19 04:51:07 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading asset \"wall_corner_s\""
)))
mwallcorners <- createImage nvg (FileName "assets/walls/wall_corner_s.png") 0
2018-07-19 04:51:07 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading asset \"wall_corner_w\""
)))
mwallcornerw <- createImage nvg (FileName "assets/walls/wall_corner_w.png") 0
2018-07-19 04:51:07 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading asset \"wall_t_ne\""
)))
mwalltne <- createImage nvg (FileName "assets/walls/wall_t_ne.png") 0
2018-07-19 04:51:07 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading asset \"wall_t_se\""
)))
mwalltse <- createImage nvg (FileName "assets/walls/wall_t_se.png") 0
2018-07-19 04:51:07 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading asset \"wall_t_sw\""
)))
mwalltsw <- createImage nvg (FileName "assets/walls/wall_t_sw.png") 0
2018-07-19 04:51:07 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading asset \"wall_t_nw\""
)))
mwalltnw <- createImage nvg (FileName "assets/walls/wall_t_nw.png") 0
2018-07-19 04:51:07 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading asset \"wall_cross\""
)))
mwallcross <- createImage nvg (FileName "assets/walls/wall_cross.png") 0
2018-07-19 04:51:07 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading asset \"box1\""
)))
mmiscbox1 <- createImage nvg (FileName "assets/misc/box1.png") 0
2018-07-19 04:51:07 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading asset \"table1\""
)))
2018-07-31 13:30:17 +02:00
mtable1 <- createImage nvg (FileName "assets/table/table1.png") 0
2018-07-19 04:51:07 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading asset \"table2\""
)))
2018-07-31 13:30:17 +02:00
mtable2 <- createImage nvg (FileName "assets/table/table2.png") 0
2018-07-19 04:51:07 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading asset \"table3\""
)))
2018-07-31 13:30:17 +02:00
mtable3 <- createImage nvg (FileName "assets/table/table3.png") 0
2018-07-19 04:51:07 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
2018-07-30 21:10:42 +02:00
, "Loading asset \"table4\""
2018-07-19 04:51:07 +02:00
)))
2018-07-31 13:30:17 +02:00
mtable4 <- createImage nvg (FileName "assets/table/table4.png") 0
2018-07-30 21:10:42 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading asset \"tableC1\""
)))
2018-07-31 13:30:17 +02:00
mtablec1 <- createImage nvg (FileName "assets/table/tablec1.png") 0
2018-07-30 21:10:42 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading asset \"tableC2\""
)))
2018-07-31 13:30:17 +02:00
mtablec2 <- createImage nvg (FileName "assets/table/tablec2.png") 0
2018-07-30 21:10:42 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading asset \"tableC3\""
)))
2018-07-31 13:30:17 +02:00
mtablec3 <- createImage nvg (FileName "assets/table/tablec3.png") 0
2018-07-30 21:10:42 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading asset \"tableC4\""
)))
2018-07-31 13:30:17 +02:00
mtablec4 <- createImage nvg (FileName "assets/table/tablec4.png") 0
2018-07-19 04:51:07 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading asset \"tableCorner\""
)))
2018-07-31 13:30:17 +02:00
mtableC <- createImage nvg (FileName "assets/table/tableCorner.png") 0
2018-07-30 15:34:45 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading asset \"flipchart\""
)))
mmiscFlipchart <- createImage nvg (FileName "assets/misc/flipchart.png") 0
2018-07-31 13:30:17 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading asset \"plant1\""
)))
mmiscPlant1 <- createImage nvg (FileName "assets/misc/plant1.png") 0
2018-07-31 22:59:25 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading asset \"plant2\""
)))
mmiscPlant2 <- createImage nvg (FileName "assets/misc/plant2.png") 0
2018-07-19 04:51:07 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
2018-08-07 14:04:49 +02:00
, "Loading asset \"watercooler\""
2018-07-19 04:51:07 +02:00
)))
2018-08-07 14:04:49 +02:00
mmiscWatercooler <- createImage nvg (FileName "assets/misc/watercooler.png") 0
let mimgs =
[ mwallasc, mwalldesc
, mwallcornern, mwallcornere, mwallcorners, mwallcornerw
, mwalltne, mwalltse, mwalltsw, mwalltnw, mwallcross
, mmiscbox1
, mtable1, mtable2, mtable3, mtable4, mtableC
, mtablec1, mtablec2, mtablec3, mtablec4
, mmiscFlipchart
, mmiscPlant1, mmiscPlant2
, mmiscWatercooler
]
when (any isNothing mimgs) $ do
liftIO $logIO Error "Failed to load image assets"
exitFailure
2018-08-07 14:04:49 +02:00
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])
2018-07-21 06:43:26 +02:00
let imgs = zipWith (\a b -> (a, fromJust b))
[ ImgWallAsc
2018-08-07 14:04:49 +02:00
.. ImgMiscWatercooler
2018-07-21 06:43:26 +02:00
]
mimgs
directions = [E .. N] ++ [NE]
standIds var = map (AnimId var "standing") directions
walkIds var = map (AnimId var "walking") directions
standConfigs = map
2018-07-21 06:43:26 +02:00
(\i -> AnimationConfig (0, i * 74) (64, 74) (64, 0) 1 0 APLoop)
[0 .. length (standIds "intruder") - 1]
walkConfigs = map
2018-07-21 06:43:26 +02:00
(\i -> AnimationConfig (64, i * 74) (64, 74) (64, 0) 6 1.5 APLoop)
[0 .. length (walkIds "intruder") - 1]
playerStanding <- loadAnimationSprites "assets/intruder.png" nvg
2018-07-21 06:43:26 +02:00
(zip (standIds "intruder") standConfigs)
2018-07-19 04:51:07 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading Animation \"intruder: walking\""
)))
playerWalking <- loadAnimationSprites "assets/intruder.png" nvg
2018-07-21 06:43:26 +02:00
(zip (walkIds "intruder") walkConfigs)
2018-07-19 04:51:07 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading Animation \"jdoem: standing\""
)))
jdoemStanding <- loadAnimationSprites "assets/jdoem.png" nvg
2018-07-21 06:43:26 +02:00
(zip (standIds "jdoem") standConfigs)
2018-07-19 04:51:07 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading Animation \"jdoem: walking\""
)))
jdoemWalking <- loadAnimationSprites "assets/jdoem.png" nvg
2018-07-21 06:43:26 +02:00
(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\""
)))
2018-07-30 14:34:46 +02:00
copierCopy <- loadAnimationSprites "assets/misc/copier.png" nvg
2018-07-21 06:43:26 +02:00
[ ( AnimId "copier" "copy" N
, AnimationConfig (64, 0) (64, 74) (64, 0) 4 1 APLoop
2018-07-21 06:43:26 +02:00
)
]
2018-07-30 14:34:46 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading Animation \"computer: off\""
)))
computerOff <- loadAnimationSprites "assets/misc/tableCornerComputer.png" nvg
[ ( AnimId "computer" "off" N
, AnimationConfig (0, 0) (64, 74) (64, 0) 2 2 APLoop
)
]
2018-08-12 06:28:31 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading Animation \"computer: on\""
)))
computerOn <- loadAnimationSprites "assets/misc/tableCornerComputer.png" nvg
[ ( AnimId "computer" "on" N
, AnimationConfig (128, 0) (64, 74) (0, 0) 1 0 APLoop
)
]
2018-08-11 11:51:20 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading Animation \"computer: hack\""
)))
computerHack <- loadAnimationSprites "assets/misc/tableCornerComputer.png" nvg
[ ( AnimId "computer" "hack" N
, AnimationConfig (0, 74) (64, 74) (64, 0) 4 2 APLoop
)
]
2018-07-31 22:59:25 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Loading Animation \"toilet: free\""
)))
toiletFree <- loadAnimationSprites "assets/misc/toilet.png" nvg
[ ( AnimId "toilet" "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 "toilet" "occupied" N
, AnimationConfig (64, 0) (64, 74) (0, 0) 1 0 APLoop
)
]
2018-07-19 04:51:07 +02:00
modifyMVar_ progress (return . (\(p, _) ->
( p + increment
, "Handing over"
)))
finish
putMVar future
( ws
, LoadData
{ loadAssetImages = M.fromList imgs
, loadAssetAnims = M.fromList
2018-07-21 06:43:26 +02:00
( playerStanding ++
playerWalking ++
jdoemStanding ++
jdoemWalking ++
copierStand ++
2018-07-30 14:34:46 +02:00
copierCopy ++
2018-07-31 22:59:25 +02:00
computerOff ++
2018-08-12 06:28:31 +02:00
computerOn ++
2018-08-11 11:51:20 +02:00
computerHack ++
2018-07-31 22:59:25 +02:00
toiletFree ++
toiletOccupied
2018-07-21 06:43:26 +02:00
)
}
)
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
2018-06-28 21:07:58 +02:00
, state = Main WorldMap
, stateData = None
}
loadMap
2018-07-03 16:19:27 +02:00
Nothing ->
return ()