{-# 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 init :: IO UserData init = do subs <- Subsystems <$> (Window <$> newTVarIO []) <*> (Mouse <$> newTVarIO []) <*> (Keyboard <$> newTVarIO []) _ <- glewInit (ws, _) <- yieldSystemT (0, defStorage) (return ()) nvg <- createGL3 (S.fromList [NanoVG.Debug, Antialias, StencilStrokes]) return UserData { state = Load , subsystems = subs , assetImages = M.empty , assetAnimations = M.empty , assetFonts = M.empty , nano = nvg , uuid = [] , worldState = ws , stateData = None , threadContext = Nothing , mainContext = Nothing } 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