94 lines
2.8 KiB
Haskell
94 lines
2.8 KiB
Haskell
{-# 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 -- state
|
|
<*> pure subs -- subsystems
|
|
<*> newMVar M.empty -- assetIcons
|
|
<*> newMVar M.empty -- assetImages
|
|
<*> newMVar M.empty -- assetFonts
|
|
<*> newMVar M.empty -- assetAnimations
|
|
<*> newMVar NoController -- controls
|
|
<*> newMVar NoTranslation -- translation
|
|
<*> pure nvg -- nano
|
|
<*> newMVar [] -- uuid
|
|
<*> newEmptyMVar -- worldState <-
|
|
<*> newMVar None -- stateData
|
|
<*> newEmptyMVar -- stateMVar <-
|
|
<*> newEmptyMVar -- stateProgress <-
|
|
<*> newMVar Nothing -- threadContext
|
|
<*> newMVar Nothing -- window
|
|
<*> newMVar [] -- joyCache
|
|
<*> newEmptyMVar -- joyUUID <-
|
|
<*> newMVar True -- doNextStep
|
|
|
|
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
|