{-# 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 Control.Concurrent.MVar 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]) UserData <$> newMVar Load <*> pure subs <*> newMVar M.empty <*> newMVar M.empty <*> newMVar M.empty <*> newMVar M.empty <*> newMVar NoController <*> newMVar NoTranslation <*> pure nvg <*> newMVar [] <*> newEmptyMVar <*> newMVar None <*> newEmptyMVar <*> newMVar (0, "foobar!") <*> newMVar Nothing <*> newMVar Nothing <*> newMVar [] <*> newEmptyMVar 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