{-# LANGUAGE ForeignFunctionInterface #-} module Init where import Affection as A import NanoVG hiding (V2(..), V3(..)) import NanoVG.Internal.Image (ImageFlags(..)) import Codec.Picture as CP import Codec.Picture.Extra import Control.Concurrent.STM import qualified Data.Set as S import qualified Data.Map.Strict as M import Data.ByteString.Lazy (toStrict) import System.Exit (exitFailure) import Foreign.C.Types (CInt(..)) import Types 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 } 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) -> mapM (\(num, i) -> 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 i) exitFailure Just resimg -> return (i, resimg) ) (zip [0..] ids) ) rids return $ concat ret