Sprite.hs

{-# OPTIONS_GHC -Wno-partial-fields #-}

module Mischief.Render.Sprite where

import Data.Text qualified as T
import Linear.V4
import Mischief.ECS
import Mischief.Materials.Sprite (Bindings (..), SpriteData (..))
import Mischief.Math hiding (qd)
import Mischief.Math.Quat qualified as Quat
import Mischief.Math.Transform
import Mischief.Render.Buffer
import Mischief.Render.Camera
import Mischief.Render.Core
import Mischief.Render.Image
import Mischief.Render.Material.Definition
import Mischief.Render.Sprite.Common
import Mischief.Render.Texture

data SpritePlugin

instance Plugin SpritePlugin where
  init = do
    systems updateSpriteData
      & schedule @RenderPrepare
  deps = [dep @ImageUploadingPlugin]

updateSpriteData :: System ()
updateSpriteData = query_ $ do
  (sprite, Sprite {image}, GlobalTransform spriteT, slice', SpriteFlip {x = flipX, y = flipY}, buffer, Anchor anchor) <-
    [q|Entity, Sprite, GlobalTransform, Maybe SpriteSlice, SpriteFlip, Maybe (Buffer SpriteData), Anchor
      / Without (Buffer SpriteData) || Changed GlobalTransform || Changed Sprite || Changed SpriteSlice || Changed SpriteFlip || Changed Anchor|]

  ImageTexture Texture {desc} <- qget image [qd|ImageTexture|]

  queue <- qres
  device <- qres

  qlift $ do
    buffer <- case buffer of
      Just b -> pure b
      Nothing -> do
        buffer <- createBuffer @SpriteData device
        insert buffer sprite
        pure buffer

    let scale = V2 spriteT.scale.x spriteT.scale.y

    let size = case slice' of
          Just SpriteSlice {size = V2 x y} -> V2 (fromIntegral x) (fromIntegral y) * scale
          Nothing -> V2 (fromIntegral desc.width) (fromIntegral desc.height) * scale

    let slice = case slice' of
          Just SpriteSlice {start, size} ->
            V4
              (fromIntegral start.x / fromIntegral desc.width)
              (fromIntegral start.y / fromIntegral desc.height)
              (fromIntegral size.x / fromIntegral desc.width)
              (fromIntegral size.y / fromIntegral desc.height)
          Nothing -> V4 0 0 1 1

    let calcFlip x = if x then 1 else 0
    let flip = V2 (calcFlip flipY) (calcFlip flipX)

    let anchorOffset = (anchor - V2 0.5 0.5) * size
    let rotation = transpose $ Quat.toMat3 spriteT.rotation

    uploadBuffer queue buffer (SpriteData {coords = spriteT.translation + V3 anchorOffset.x anchorOffset.y 0, size, slice, flip, rotation})

fetchSpriteBindings :: FetchBindings Bindings
fetchSpriteBindings =
  FetchBindings
    ( \camera -> do
        (DefaultSampler sampler) <- qres @DefaultSampler
        CameraMatrices matrices <- qget camera [qd|CameraMatrices|]
        pure (matrices, sampler)
    )
    ( \sprite -> do
        (Sprite {image}, buffer) <- qget sprite [qd|Sprite, (Buffer SpriteData)|]
        ImageTextureView texture <- qget image [qd|ImageTextureView|]
        pure (buffer, texture)
    )
    (\(matrices, sampler) (buffer, texture) -> Bindings {matrices, sampler, sprite = buffer, texture})

-- newtype SpriteBuffer = SpriteBuffer (Buffer SpriteData) deriving anyclass (Component)