blob: 3e8c195747938437f260c47313ab7a87ac06bee6 (
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
89
90
91
92
|
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)
|
