Initial import

1 files changed, 88 insertions, 0 deletions

diff --git a/src/Game/Sprites.hs b/src/Game/Sprites.hs
new file mode 100644
index 0000000..de949b5
--- /dev/null
+++ b/src/Game/Sprites.hs
@@ -0,0 +1,88 @@
+module Game.Sprites
+  ( SpriteSheet,
+    Sprite,
+    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
+
+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)