diff --git a/src/Floorplan.hs b/src/Floorplan.hs index e2d5be2..72bb8db 100644 --- a/src/Floorplan.hs +++ b/src/Floorplan.hs @@ -5,6 +5,7 @@ import qualified Data.Matrix as M import Data.Maybe import Control.Monad (foldM) +import Control.Concurrent.MVar import System.Random @@ -12,17 +13,30 @@ import Types.Map import Debug.Trace -buildHallFloorIO :: FloorConfig -> IO (Matrix TileState, [Graph]) -buildHallFloorIO fc = do +buildHallFloorIO + :: FloorConfig + -> MVar Float + -> Float + -> IO (Matrix TileState, [Graph]) +buildHallFloorIO fc progress increment = do rand <- newStdGen + modifyMVar_ progress (return . (+ increment)) let empty = emptyFloor fc - (g1, withElv) = buildElevator fc (placeHalls rand fc empty) - (g2, withIW) = buildInnerWalls g1 withElv - withOW = buildOuterWalls withIW - closed = closeOffices withOW - doorgraph = buildDoorsGraph closed + modifyMVar_ progress (return . (+ increment)) + let (g1, withElv) = buildElevator fc (placeHalls rand fc empty) + modifyMVar_ progress (return . (+ increment)) + let (g2, withIW) = buildInnerWalls g1 withElv + modifyMVar_ progress (return . (+ increment)) + let withOW = buildOuterWalls withIW + modifyMVar_ progress (return . (+ increment)) + let closed = closeOffices withOW + modifyMVar_ progress (return . (+ increment)) + let doorgraph = buildDoorsGraph closed + modifyMVar_ progress (return . (+ increment)) doors <- buildDoors closed doorgraph + modifyMVar_ progress (return . (+ increment)) let (_, facils) = buildFacilities g2 fc doors + modifyMVar_ progress (return . (+ increment)) return (facils, doorgraph) emptyFloor :: FloorConfig -> Matrix TileState diff --git a/src/Init.hs b/src/Init.hs index f66693e..4b75ac8 100644 --- a/src/Init.hs +++ b/src/Init.hs @@ -41,107 +41,26 @@ import Debug.Trace foreign import ccall unsafe "glewInit" glewInit :: IO CInt -load :: IO UserData -load = do +init :: IO UserData +init = do subs <- Subsystems <$> (Window <$> newTVarIO []) <*> (Mouse <$> newTVarIO []) _ <- glewInit - nvg <- createGL3 (S.fromList [Antialias, StencilStrokes]) - _ <- createFont nvg "bedstead" - (FileName "assets/font/Bedstead-Semicondensed.ttf") (ws, _) <- yieldSystemT (0, defStorage) (return ()) - mwallasc <- createImage nvg (FileName "assets/walls/wall_asc.png") 0 - mwalldesc <- createImage nvg (FileName "assets/walls/wall_desc.png") 0 - mwallcornern <- createImage nvg (FileName "assets/walls/wall_corner_n.png") 0 - mwallcornere <- createImage nvg (FileName "assets/walls/wall_corner_e.png") 0 - mwallcorners <- createImage nvg (FileName "assets/walls/wall_corner_s.png") 0 - mwallcornerw <- createImage nvg (FileName "assets/walls/wall_corner_w.png") 0 - mwalltne <- createImage nvg (FileName "assets/walls/wall_t_ne.png") 0 - mwalltse <- createImage nvg (FileName "assets/walls/wall_t_se.png") 0 - mwalltsw <- createImage nvg (FileName "assets/walls/wall_t_sw.png") 0 - mwalltnw <- createImage nvg (FileName "assets/walls/wall_t_nw.png") 0 - mwallcross <- createImage nvg (FileName "assets/walls/wall_cross.png") 0 - mmiscbox1 <- createImage nvg (FileName "assets/misc/box1.png") 0 - mmisctable1 <- createImage nvg (FileName "assets/misc/table1.png") 0 - mmisctable2 <- createImage nvg (FileName "assets/misc/table2.png") 0 - mmisctable3 <- createImage nvg (FileName "assets/misc/table3.png") 0 - mmisctable4 <- createImage nvg (FileName "assets/misc/table4.png") 0 - mmisctableC <- createImage nvg (FileName "assets/misc/tableCorner.png") 0 - let mimgs = [ mwallasc, mwalldesc, - mwallcornern, mwallcornere, mwallcorners, mwallcornerw, - mwalltne, mwalltse, mwalltsw, mwalltnw, mwallcross, - mmiscbox1, - mmisctable1, mmisctable2, mmisctable3, mmisctable4, mmisctableC - ] - when (any isNothing mimgs) $ do - 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) - playerWalking <- loadAnimationSprites "assets/intruder.png" nvg - (zip walkIds walkConfigs) + nvg <- createGL3 (S.fromList [NanoVG.Debug, Antialias, StencilStrokes]) return UserData - { state = Menu + { state = Load , subsystems = subs - , assetImages = M.fromList imgs - , assetAnimations = M.fromList - (playerStanding ++ playerWalking) - , assetFonts = M.fromList - [ (FontBedstead, "bedstead") - ] + , assetImages = M.empty + , assetAnimations = M.empty + , assetFonts = M.empty , nano = nvg , uuid = [] , worldState = ws , stateData = None } -loadAnimationSprites - :: FilePath -- Path to Sprite map - -> Context -- NanoVG context - -> [(AnimId, AnimationConfig)] - -> IO [(AnimId, Animation)] -loadAnimationSprites fp nvg idconfs = do - eimg <- readImage fp - case eimg of - Left err -> do - logIO Error err - exitFailure - Right dimg -> do - let img = convertRGBA8 dimg - mapM - (\(id, (AnimationConfig (xoffs, yoffs) (w, h) count dur pb)) -> do - let crs = map - (\i -> crop (xoffs + (i * w)) yoffs w h img) - [0 .. (count - 1)] - mresimgs <- mapM - (\cr -> - createImageMem nvg (ImagePremultiplied) (toStrict $ encodePng cr)) - crs - imgs <- if any isNothing mresimgs - then do - logIO Error ("failed to load: " ++ fp ++ " " ++ show id) - exitFailure - else - return $ catMaybes mresimgs - return $ - ( id - , Animation dur imgs pb - ) - ) idconfs - loadPlayerSprite :: FilePath -- Path to spritemap -> Int -- width of single sprite diff --git a/src/Load.hs b/src/Load.hs new file mode 100644 index 0000000..d4a574e --- /dev/null +++ b/src/Load.hs @@ -0,0 +1,143 @@ +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 $ forkIO $ 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 () diff --git a/src/Main.hs b/src/Main.hs index b34da26..1349430 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -27,11 +27,11 @@ main = do } } , canvasSize = Nothing - , preLoop = pre >> smLoad Menu + , preLoop = pre >> smLoad Load , eventLoop = handle , updateLoop = update , drawLoop = draw - , loadState = load + , loadState = Init.init , cleanUp = const (return ()) , initScreenMode = SDL.Windowed } diff --git a/src/StateMachine.hs b/src/StateMachine.hs index aa78f00..221b15f 100644 --- a/src/StateMachine.hs +++ b/src/StateMachine.hs @@ -6,15 +6,22 @@ import Affection import Types +import Load import Test instance StateMachine State UserData where smLoad Menu = loadMap + smLoad Load = loadLoad + smUpdate Menu = updateMap + smUpdate Load = updateLoad + smDraw Menu = drawMap + smDraw Load = drawLoad + smEvent _ evs = do Subsystems w m <- subsystems <$> getAffection _ <- consumeSDLEvents w =<< consumeSDLEvents m evs diff --git a/src/Test.hs b/src/Test.hs index 346a10e..6b9c8f2 100644 --- a/src/Test.hs +++ b/src/Test.hs @@ -39,29 +39,29 @@ loadMap = do ctx = nano ud uu <- partSubscribe m movePlayer future <- liftIO $ newEmptyMVar - _ <- liftIO $ forkIO $ loadMapFork ud future - -- liftIO $ whileM_ (isJust <$> tryTakeMVar future) $ do - -- beginFrame (nano ud) 1280 720 1 - -- fontSize ctx 100 - -- fontFace ctx (assetFonts ud Map.! FontBedstead) - -- textAlign ctx (S.fromList [AlignCenter,AlignTop]) - -- fillColor ctx (rgb 255 128 0) - -- textBox ctx 0 300 1280 ("Loading") - -- endFrame (nano ud) - -- (nws, mendat) <- liftIO $ takeMVar future + progress <- liftIO $ newMVar 0 + _ <- liftIO $ forkIO $ loadMapFork ud future progress putAffection ud { stateData = None , uuid = [uu] - , menuMVar = future + , stateMVar = future + , stateProgress = progress } -loadMapFork :: UserData -> MVar (SystemState Entity IO, StateData) -> IO () -loadMapFork ud future = do - let fc = FloorConfig +loadMapFork + :: UserData + -> MVar (SystemState Entity IO, StateData) + -> MVar Float + -> IO () +loadMapFork ud future progress = do + let loadSteps = 16 + fc = FloorConfig (10, 10) [] (50, 50) - (mat, gr) <- buildHallFloorIO fc + _ <- liftIO $ swapMVar progress (1 / loadSteps) + (mat, gr) <- buildHallFloorIO fc progress (1 / loadSteps) + _ <- liftIO $ swapMVar progress (11 / loadSteps) let imgmat = convertTileToImg mat exits = Prelude.foldl (\acc coord@(r, c) -> if imgmat M.! coord == Just ImgEmpty @@ -70,10 +70,13 @@ loadMapFork ud future = do ) [] ((,) <$> [1 .. nrows mat] <*> [1 .. ncols mat]) + _ <- liftIO $ swapMVar progress (12 / loadSteps) (inter, rps) <- placeInteriorIO mat imgmat exits gr + _ <- liftIO $ swapMVar progress (13 / loadSteps) logIO A.Debug ("number of reachpoints: " ++ show (length rps)) let nnex = Prelude.filter (\p -> pointType p /= RoomExit) rps npcposs <- placeNPCs inter mat rps gr 50 -- (length nnex) + _ <- liftIO $ swapMVar progress (14 / loadSteps) A.logIO A.Debug $ "number of placed NPCs: " ++ show (length npcposs) (nws, _) <- yieldSystemT (worldState ud) $ do void $ createEntity $ newEntity @@ -83,6 +86,7 @@ loadMapFork ud future = do , rot = Just SE , anim = Just $ AnimState (AnimId 0 "standing" SE) 0 0 } + void $ liftIO $ swapMVar progress (15 / loadSteps) void $ mapM_ (\npcpos@(V2 nr nc) -> do fact <- liftIO $ randomRIO (0.5, 1.5) future <- liftIO newEmptyMVar @@ -96,6 +100,7 @@ loadMapFork ud future = do , anim = Just $ AnimState (AnimId 0 "standing" SE) 0 0 } ) npcposs + void $ liftIO $ swapMVar progress (16 / loadSteps) putMVar future (nws, MenuData { mapMat = mat , imgMat = M.fromList (nrows inter) (ncols inter) $ @@ -145,13 +150,8 @@ drawMap = do let ctx = nano ud case stateData ud of None -> liftIO $ do - beginFrame (nano ud) 1280 720 1 - fontSize ctx 100 - fontFace ctx (assetFonts ud Map.! FontBedstead) - textAlign ctx (S.fromList [AlignCenter,AlignTop]) - fillColor ctx (rgb 255 128 0) - textBox ctx 0 300 1280 ("Loading") - endFrame (nano ud) + progress <- readMVar (stateProgress ud) + drawLoadScreen ud progress _ -> do dt <- getDelta (_, (playerPos, posanims)) <- liftIO $ yieldSystemT (worldState ud) $ do @@ -295,10 +295,11 @@ drawTile ud ctx posanims pr pc row col img = updateMap :: Double -> Affection UserData () updateMap dt = do ud <- getAffection - isFut <- liftIO $ isEmptyMVar (menuMVar ud) + isFut <- liftIO $ isEmptyMVar (stateMVar ud) if not isFut && stateData ud == None then do - Just (nws, mendat) <- liftIO $ tryTakeMVar (menuMVar ud) + liftIO $ logIO A.Debug "Loaded game data" + Just (nws, mendat) <- liftIO $ tryTakeMVar (stateMVar ud) putAffection ud { worldState = nws , stateData = mendat diff --git a/src/Types.hs b/src/Types.hs index dd8f431..13300e8 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -7,6 +7,7 @@ import Types.Map as T import Types.Interior as T import Types.ReachPoint as T import Types.ImgId as T +import Types.FontId as T import Types.Direction as T import Types.StateData as T import Types.Animation as T diff --git a/src/Types/Animation.hs b/src/Types/Animation.hs index 938f73c..2d3e1b9 100644 --- a/src/Types/Animation.hs +++ b/src/Types/Animation.hs @@ -16,17 +16,19 @@ data AnimState = AnimState , asCurrentFrame :: Int , asElapsedTime :: Double } - deriving (Show) + deriving (Show, Eq) data AnimPlayback = APLoop | APOnce + deriving (Show, Eq) data Animation = Animation { animDuration :: Double , animSprites :: [Image] , animPlay :: AnimPlayback } + deriving (Show, Eq) data AnimationConfig = AnimationConfig { animConfOffset :: (Int, Int) @@ -35,3 +37,4 @@ data AnimationConfig = AnimationConfig , animConfDuration :: Double , animConfPlay :: AnimPlayback } + deriving (Show, Eq) diff --git a/src/Types/FontId.hs b/src/Types/FontId.hs new file mode 100644 index 0000000..0b2556a --- /dev/null +++ b/src/Types/FontId.hs @@ -0,0 +1,5 @@ +module Types.FontId where + +data FontId + = FontBedstead + deriving (Show, Eq, Ord, Enum) diff --git a/src/Types/StateData.hs b/src/Types/StateData.hs index f732e37..9f6183e 100644 --- a/src/Types/StateData.hs +++ b/src/Types/StateData.hs @@ -1,13 +1,24 @@ module Types.StateData where import Data.Matrix +import Data.Map +import Data.Text + +import NanoVG import Types.ReachPoint import Types.Map import Types.ImgId +import Types.FontId +import Types.Animation data StateData = None + | LoadData + { loadAssetImages :: Map ImgId Image + , loadAssetAnims :: Map AnimId Animation + , loadAssetFonts :: Map FontId Text + } | MenuData { mapMat :: Matrix TileState , initCoords :: (Int, Int) diff --git a/src/Types/UserData.hs b/src/Types/UserData.hs index e77e3d4..ee9a7fd 100644 --- a/src/Types/UserData.hs +++ b/src/Types/UserData.hs @@ -19,6 +19,7 @@ import Control.Concurrent.MVar import Types.Map import Types.StateData import Types.ImgId +import Types.FontId import Types.Direction import Types.Animation @@ -32,17 +33,15 @@ data UserData = UserData , uuid :: [UUID] , worldState :: SystemState Entity IO , stateData :: StateData - , menuMVar :: MVar (SystemState Entity IO, StateData) + , stateMVar :: MVar (SystemState Entity IO, StateData) + , stateProgress :: MVar Float } data State - = Menu + = Load + | Menu | Test -data FontId - = FontBedstead - deriving (Show, Eq, Ord, Enum) - data Entity f = Entity { pos :: Component f 'Field (V2 Double) , gridPos :: Component f 'Field (V2 Int) diff --git a/src/Util.hs b/src/Util.hs index aa74520..6a7c911 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -4,14 +4,25 @@ import Affection as A import Data.Matrix as M import qualified Data.HashSet as HS +import qualified Data.Set as S +import qualified Data.Map as Map +import Data.ByteString.Lazy (toStrict) import Data.Graph.AStar -import Data.Maybe (fromMaybe) +import Data.Maybe import qualified SDL import qualified Graphics.Rendering.OpenGL as GL hiding (get) +import System.Exit (exitFailure) + import Linear +import NanoVG hiding (V2(..)) +import NanoVG.Internal.Image (ImageFlags(..)) + +import Codec.Picture as CP +import Codec.Picture.Extra + -- internal imports import Types @@ -161,3 +172,48 @@ naviGraph imgmat (V2 r c) = [] [(-1, -1), (-1, 1), (1, -1), (1, 1)] in HS.fromList (list1 ++ list2) + +drawLoadScreen :: UserData -> Float -> IO () +drawLoadScreen ud progress = do + let ctx = nano ud + -- fontSize ctx 100 + -- fontFace ctx (assetFonts ud Map.! FontBedstead) + -- textAlign ctx (S.fromList [AlignCenter, AlignTop]) + fillColor ctx (rgb 255 128 0) + rect ctx + (640 - 640 * realToFrac progress) 450 (1280 * realToFrac progress) 20 + fill ctx + +loadAnimationSprites + :: FilePath -- Path to Sprite map + -> Context -- NanoVG context + -> [(AnimId, AnimationConfig)] + -> IO [(AnimId, Animation)] +loadAnimationSprites fp nvg idconfs = do + eimg <- readImage fp + case eimg of + Left err -> do + logIO Error err + exitFailure + Right dimg -> do + let img = convertRGBA8 dimg + mapM + (\(id, (AnimationConfig (xoffs, yoffs) (w, h) count dur pb)) -> do + let crs = map + (\i -> crop (xoffs + (i * w)) yoffs w h img) + [0 .. (count - 1)] + mresimgs <- mapM + (\cr -> + createImageMem nvg (ImagePremultiplied) (toStrict $ encodePng cr)) + crs + imgs <- if any isNothing mresimgs + then do + logIO Error ("failed to load: " ++ fp ++ " " ++ show id) + exitFailure + else + return $ catMaybes mresimgs + return $ + ( id + , Animation dur imgs pb + ) + ) idconfs diff --git a/tracer-game.cabal b/tracer-game.cabal index f49d962..5a6e2c2 100644 --- a/tracer-game.cabal +++ b/tracer-game.cabal @@ -24,12 +24,14 @@ executable tracer-game , Types.ReachPoint , Types.Direction , Types.ImgId + , Types.FontId , Types.StateData , Types.Animation , StateMachine , Floorplan , Interior , Init + , Load , Test , Navigation , NPC