tracer/src/Init.hs

95 lines
2.3 KiB
Haskell
Raw Normal View History

2018-02-07 00:18:16 +00:00
{-# 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(..))
2018-05-20 22:40:40 +00:00
import NanoVG.Internal.Image (ImageFlags(..))
2018-02-07 00:18:16 +00:00
2018-05-30 14:20:58 +00:00
import Linear hiding (E(..))
2018-02-07 00:18:16 +00:00
2018-05-20 22:40:40 +00:00
import Codec.Picture as CP
import Codec.Picture.Extra
2018-02-25 09:30:13 +00:00
import Control.Monad (when)
2018-02-07 00:18:16 +00:00
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
2018-02-25 09:30:13 +00:00
import Data.Maybe
2018-05-20 22:40:40 +00:00
import Data.ByteString.Lazy (toStrict)
2018-02-25 09:30:13 +00:00
import System.Exit (exitFailure)
2018-02-07 00:18:16 +00:00
import Foreign.C.Types (CInt(..))
import Types
2018-02-15 18:42:07 +00:00
import Floorplan
import Debug.Trace
2018-02-07 00:18:16 +00:00
foreign import ccall unsafe "glewInit"
glewInit :: IO CInt
init :: IO UserData
init = do
2018-02-07 00:18:16 +00:00
subs <- Subsystems
<$> (Window <$> newTVarIO [])
<*> (Mouse <$> newTVarIO [])
2018-06-23 22:42:39 +00:00
<*> (Keyboard <$> newTVarIO [])
2018-06-07 22:29:46 +00:00
_ <- glewInit
2018-05-17 11:06:13 +00:00
(ws, _) <- yieldSystemT (0, defStorage) (return ())
nvg <- createGL3 (S.fromList [NanoVG.Debug, Antialias, StencilStrokes])
2018-02-07 00:18:16 +00:00
return UserData
{ state = Load
2018-05-30 14:20:58 +00:00
, subsystems = subs
, assetImages = M.empty
, assetAnimations = M.empty
, assetFonts = M.empty
2018-05-30 14:20:58 +00:00
, nano = nvg
, uuid = []
, worldState = ws
, stateData = None
, threadContext = Nothing
, mainContext = Nothing
2018-02-07 00:18:16 +00:00
}
2018-05-20 22:40:40 +00:00
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
2018-05-30 14:20:58 +00:00
mresimg <-
createImageMem nvg (ImagePremultiplied) (toStrict $ encodePng cr)
2018-05-20 22:40:40 +00:00
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