aboutsummaryrefslogtreecommitdiff
path: root/src/Game/Sprites.hs
blob: de949b55d2e05881e486b1852a68dbefd2bde8d5 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
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)