{-# LANGUAGE ForeignFunctionInterface #-} module Init where import Affection as A import SDL (($=)) import qualified SDL import qualified Graphics.Rendering.OpenGL as GL import NanoVG hiding (V2(..), V3(..)) import NanoVG.Internal.Image (ImageFlags(..)) import Linear hiding (E(..)) import Codec.Picture as CP import Codec.Picture.Extra import Control.Monad (when) import Control.Monad.IO.Class (liftIO) import Control.Concurrent.STM import qualified Data.Set as S import qualified Data.Map.Strict as M import Data.Ecstasy import Data.Maybe import Data.ByteString.Lazy (toStrict) import System.Exit (exitFailure) import Foreign.C.Types (CInt(..)) import Types import Floorplan import Debug.Trace foreign import ccall unsafe "glewInit" glewInit :: IO CInt load :: IO UserData load = do _ <- glewInit nvg <- createGL3 (S.fromList [Antialias, StencilStrokes]) subs <- Subsystems <$> (Window <$> newTVarIO []) <*> (Mouse <$> newTVarIO []) (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 _ <- createFont nvg "bedstead" (FileName "assets/font/Bedstead-Semicondensed.ttf") 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 APLoop) [0 .. length walkIds - 1] playerStanding <- loadAnimationSprites "assets/intruder.png" nvg (zip standIds standConfigs) playerWalking <- loadAnimationSprites "assets/intruder.png" nvg (zip walkIds walkConfigs) return UserData { state = Menu , subsystems = subs , assetImages = M.fromList imgs , assetAnimations = M.fromList (playerStanding ++ playerWalking) , assetFonts = M.fromList [ (FontBedstead, "bedstead") ] , 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 -> Int -- height of single sprite -> Context -- Nanovg context -> [(Int, [ImgId])] -- [(picture row, Image IDs)] -> IO [(ImgId, NanoVG.Image)] loadPlayerSprite fp w h nvg rids = do eimg <- readImage fp case eimg of Left err -> do logIO Error err exitFailure Right dimg -> do let img = convertRGBA8 dimg ret <- mapM (\(row, ids) -> do mapM (\(num, id) -> do let cr = crop (num * w) (row * h) w h img mresimg <- createImageMem nvg (ImagePremultiplied) (toStrict $ encodePng cr) case mresimg of Nothing -> do logIO Error ("Failed to load: " ++ fp ++ " " ++ show id) exitFailure Just resimg -> return (id, resimg) ) (zip [0..] ids) ) rids return $ concat ret