{-# 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 Data.String 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 <$> (SubWindow <$> newTVarIO []) <*> (SubMouse <$> newTVarIO []) <*> (SubKeyboard <$> newTVarIO []) <*> (SubJoypad <$> newTVarIO []) <*> (SubTranslator <$> newTVarIO []) _ <- glewInit nvg <- createGL3 (S.fromList [NanoVG.Debug, Antialias, StencilStrokes]) return UserData { state = Load , subsystems = subs , assetImages = M.empty , assetAnimations = M.empty , assetFonts = M.empty , assetIcons = M.empty , nano = nvg , uuid = [] , stateData = None , threadContext = Nothing , controls = NoController , translation = NoTranslation , joyCache = [] } 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 (fromString 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: " <> fromString fp <> " " <> fromString (show i) ) exitFailure Just resimg -> return (i, resimg) ) (zip [0..] ids) ) rids return $ concat ret