module Game.Sprites ( SpriteSheet, Sprite, frameCount, load, get, render, ) where import Control.Monad import Data.List (find) import Foreign.C.Types (CInt) import qualified Game.Utils as U import qualified SDL import SDL.Vect (V2 (..)) import Text.JSON -- | Sprite sheet contains description of the different sprites. -- -- Load a sprite sheet from JSON with `load`. -- Use `get` to get a specific sprite. data SpriteSheet = SpriteSheet Sprites SDL.Texture -- | A sprite description that can be rendered. -- -- Can be rendered with `render`. data Sprite = Sprite [[SDL.Rectangle CInt]] SDL.Texture frameCount :: Sprite -> Int -> Int frameCount (Sprite frames _) set = length $ frames !! set newtype SpriteData = SpriteData [[SDL.Rectangle CInt]] deriving (Show) newtype Sprites = Sprites [(String, SpriteData)] deriving (Show) data Frame = Frame Int Int Int Int deriving (Show) setsToRects :: [Frame] -> [Int] -> [SDL.Rectangle CInt] setsToRects frames = map ( \s -> do case frames !! s of Frame x y w h -> U.rect x y w h ) instance JSON Frame where showJSON = undefined readJSON (JSObject obj) = do Frame <$> valFromObj "x" obj <*> valFromObj "y" obj <*> valFromObj "width" obj <*> valFromObj "height" obj readJSON _ = mzero instance JSON SpriteData where showJSON = undefined readJSON (JSObject obj) = do frames <- valFromObj "frames" obj sets <- valFromObj "sets" obj Ok $ SpriteData $ map (setsToRects frames) sets readJSON _ = mzero instance JSON Sprites where showJSON = undefined readJSON obj = Sprites <$> decJSDict "sprites" obj -- | Loads a spritesheet described on a JSON file. load :: String -> SDL.Texture -> IO SpriteSheet load filename tex = do d <- readFile filename case decode d :: Result Sprites of Ok s -> pure $ SpriteSheet s tex Error e -> error e -- | Gets a named sprite from the spritesheet. get :: SpriteSheet -> String -> IO Sprite get (SpriteSheet (Sprites sprites) tex) sid = case fmap snd (find (\(name, _) -> name == sid) sprites) of Nothing -> error $ "sprite '" ++ sid ++ "' not found" Just (SpriteData frames) -> pure $ Sprite frames tex -- | Renders a sprite on position (x, y) selecting a set and a frame within that set. render :: SDL.Renderer -> Sprite -> Int -> Int -> Int -> Int -> IO () render renderer (Sprite frames tex) x y set frame = do let src = (frames !! set) !! frame dst = case src of SDL.Rectangle _ (V2 w h) -> U.rect x y (fromIntegral w) (fromIntegral h) SDL.copy renderer tex (Just src) (Just dst)