Spritesheet.hs

module Mischief.Animation.Spritesheet where

import Control.Applicative
import Data.List (find, (!?))
import Data.Text (Text)
import GHC.Stack
import GHC.TypeLits
import KDL qualified
import Linear (V2 (V2))
import Mischief.Assets
import Mischief.Assets.Image
import Mischief.ECS
import Mischief.ECS.Utils
import Mischief.Render.Sprite
import Mischief.Render.Sprite.Common

data Spritesheet = Spritesheet
  { frameSize :: V2 Int,
    padding :: V2 Int,
    size :: V2 Int,
    image :: AssetRef Image
  }
  deriving (Component, Show)

noSpritesheet :: KdlRef Spritesheet
noSpritesheet = KdlValue $ Spritesheet {frameSize = V2 0 0, padding = V2 0 0, size = V2 0 0, image = NullRef}

sheetCoords :: Int -> Spritesheet -> (V2 Int, V2 Int)
sheetCoords index sheet = do
  let boxSize = sheet.padding + sheet.frameSize
  let framesPerRow = sheet.size.x `div` boxSize.x
  let start = V2 (index `mod` framesPerRow) (index `div` framesPerRow)
  (start * (sheet.frameSize + 1), sheet.frameSize)

data AnimationFrames = RangedFrames Int Int | ManualFrames [Int] deriving (Show)

data AnimationTime = FpsTime Float | TotalTime Float deriving (Show)

data Animation = Animation {dummy :: Bool, time :: AnimationTime, frames :: AnimationFrames, loop :: Bool, spritesheet :: KdlRef Spritesheet} deriving (Component, Show)

noAnimation :: AssetRef Animation
noAnimation = pure $ Animation {dummy = True, time = TotalTime 0, frames = ManualFrames [0], loop = False, spritesheet = noSpritesheet}

nframes :: Animation -> Int
nframes Animation {frames = RangedFrames start end} = end - start + 1
nframes Animation {frames = ManualFrames f} = length f

animFrameIndex :: Int -> AnimationFrames -> Maybe Int
animFrameIndex frame (RangedFrames start end) =
  let f = start + frame
   in if f <= end then Just f else Nothing
animFrameIndex frame (ManualFrames f) = f !? frame

animFrameCoords :: Int -> Animation -> System (Maybe SpriteSlice)
animFrameCoords frame animation = do
  let index = animFrameIndex frame animation.frames
  case index of
    Nothing -> pure Nothing
    Just index -> do
      sheet <- asset $ toRef animation.spritesheet
      case sheet of
        Nothing -> pure Nothing
        Just sheet -> do
          pure $ Just $ uncurry SpriteSlice $ sheetCoords index sheet

qanimFrameCoords :: Int -> Animation -> Query System (Maybe SpriteSlice)
qanimFrameCoords frame animation = do
  let index = animFrameIndex frame animation.frames
  case index of
    Nothing -> pure Nothing
    Just index ->
      Just <$> do
        sheet <- qasset $ kdlToAssetRef animation.spritesheet
        pure $ uncurry SpriteSlice $ sheetCoords index sheet

qanimImage :: Animation -> Query System Entity
qanimImage animation = do
  sheet <- qasset $ kdlToAssetRef animation.spritesheet
  qmaybe =<< qlift (getRefEntity sheet.image)

instance Asset Spritesheet where
  type Saveable Spritesheet = False
  loadAsset = loadKdl "spritesheet"

instance KdlAsset Spritesheet where
  decodeKdl path = KDL.children $ do
    frameSize <- KDL.node "frameSize"
    padding <- KDL.node "padding"
    size <- KDL.node "size"
    image <- KDL.nodeWith "image" $ decodeKdl path

    pure $ Spritesheet {frameSize, padding, size, image}

instance Asset Animation where
  type Saveable Animation = False
  loadAsset = loadKdl "animation"

instance KdlAsset Animation where
  decodeKdl path = KDL.children $ do
    time <- animationTimeDecoder
    frames <- animationFramesDecoder
    loop <- animationLoopDecoder
    spritesheet <- KDL.nodeWith "spritesheet" $ decodeKdl path
    pure $ Animation {dummy = False, time, frames, loop, spritesheet}

animationTimeDecoder :: KDL.NodeListDecoder AnimationTime
animationTimeDecoder = f1 <|> f2
  where
    f1 = FpsTime <$> KDL.argAt "fps"
    f2 = TotalTime <$> KDL.argAt "time"

animationFramesDecoder :: KDL.NodeListDecoder AnimationFrames
animationFramesDecoder = f1 <|> f2
  where
    f1 = do
      KDL.nodeWith "range" $ do
        start <- KDL.arg
        RangedFrames start <$> KDL.arg
    f2 = ManualFrames <$> KDL.argsAt "frames"

animationLoopDecoder :: KDL.NodeListDecoder Bool
animationLoopDecoder = f1 <|> f2
  where
    f1 = KDL.argAt "loop"
    f2 = pure False