mischief-render-0.1.0.0: examples/Animation.hs

{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Monad (void, when)
import Control.Monad.IO.Class
import Data.Data (Proxy (..))
import Data.Default
import Data.Foldable
import Data.IORef
import Data.Text (Text)
import Mischief.Animation (AnimationPlugin, Animator (..), input, shift)
import Mischief.Animation.Animations (selAnim)
import Mischief.Animation.Animator qualified as A
import Mischief.Animation.Spritesheet (Animation (..), noAnimation)
import Mischief.Assets
import Mischief.Assets.Image
import Mischief.ECS
import Mischief.ECS.Time qualified as Time
import Mischief.Input (InputPlugin)
import Mischief.Input.Keys (Keys)
import Mischief.Input.Keys qualified as Keys
import Mischief.Materials.Sprite
import Mischief.Math hiding (qd)
import Mischief.Math.Transform (Transform (..))
import Mischief.Math.Transform qualified as Transform
import Mischief.Render.Buffer
import Mischief.Render.Camera
import Mischief.Render.Core (RenderDevice, RenderQueue, RenderUpdate)
import Mischief.Render.Material (WithMaterial (WithMaterial), renderMaterial)
import Mischief.Render.Plugin
import Mischief.Render.Sprite.Common
import Mischief.SDL.Window

main :: IO ()
main = do
  app <- newApp
  setAssetSource "assets" app
  addPlugin @MainPlugin app
  runApp app

data MainPlugin

instance Plugin MainPlugin where
  init = do
    systems setup
      & schedule @Startup

    systems moveSprite
      & schedule @Update

    systems (renderMaterial @CustomMat def)
      & schedule @RenderUpdate

  deps = [dep @RenderPlugin, dep @InputPlugin, dep @TimePlugin, dep @AnimationPlugin, dep @FileWatcherPlugin]

setup :: System ()
setup = do
  void $ load @Image "characters.png"

  window <- spawn (Name "Window", Window, WindowFlags [WindowResizable])
  void $ spawn (Camera, Rel OutputTo window)

  let positions = [V2 0 0, V2 (-1) 0, V2 1 0, V2 0 1, V2 0 (-1)]
  let characters = [Pink, Beige, Green, Purple, Yellow]

  for_ (positions `zip` characters) $ \(V2 x y, c) -> do
    let spritePos = V3 (x * 150) (y * 150) (-1)
    e <-
      spawn
        ( Animator MyAnimator,
          def {translation = spritePos},
          WithMaterial @CustomMat
        )

    Just device <- res @RenderDevice
    Just queue <- res @RenderQueue
    buffer <- createBuffer @SomeColor device
    insert buffer e
    uploadBuffer queue buffer (SomeColor {color = V3 1 0 0})

    shift (ChangeCharacter c) e

moveSprite :: System ()
moveSprite = do
  sprites <- query [q|E, Transform / With Sprite|]
  Just keys <- res @Keys

  for_ sprites $ \(entity, sprite) -> do
    when (Keys.justPressed keys Keys.Space) $ shift DoJump entity

    delta <- Time.delta
    let speed = 150

    dir <- liftIO $ newIORef (V2 0 0)

    when (Keys.pressed keys Keys.A) $ do
      liftIO $ modifyIORef' dir (+ V2 (-1) 0)

    when (Keys.pressed keys Keys.D) $ do
      liftIO $ modifyIORef' dir (+ V2 1 0)

    when (Keys.pressed keys Keys.S) $ do
      liftIO $ modifyIORef' dir (+ V2 0 (-1))

    when (Keys.pressed keys Keys.W) $ do
      liftIO $ modifyIORef' dir (+ V2 0 1)

    dir <- liftIO $ (^* (delta * speed)) . normalize <$> readIORef dir

    let walk = norm dir > 0
    input @MyAnimator (\x -> x {walk}) entity

    if
      | dir.x < 0 -> insert SpriteFlip {x = True, y = False} entity
      | dir.x > 0 -> insert SpriteFlip {x = False, y = False} entity
      | otherwise -> pure ()

    insert (Transform.move (V3 dir.x dir.y 0) sprite) entity

data Character = Pink | Purple | Green | Beige | Yellow deriving (Component, Show, Eq)

characterName :: Character -> Text
characterName Pink = "pink"
characterName Beige = "beige"
characterName Purple = "purple"
characterName Green = "green"
characterName Yellow = "yellow"

data MyAnimator = MyAnimator

data CharacterAnimation = Idle | Walk | Jump

instance A.AnimatorTag MyAnimator where
  data State MyAnimator = Start | CA Character CharacterAnimation
  data Input MyAnimator = I {walk :: Bool} deriving (Generic, Default)
  data Shift MyAnimator = ChangeCharacter Character | DoJump

  animation :: A.State MyAnimator -> AssetRef Animation
  animation (CA x Jump) = selAnim "animations.kdl" (characterName x <> "_jump")
  animation (CA x Idle) = selAnim "animations.kdl" (characterName x <> "_idle")
  animation (CA x Walk) = selAnim "animations.kdl" (characterName x <> "_walk")
  animation Start = noAnimation

  transition Start _ (Just (ChangeCharacter x)) _ = Just $ CA x Idle
  transition (CA x _) _ (Just DoJump) _ = Just $ CA x Jump
  transition (CA x Jump) _ _ _ = Just $ CA x Idle
  transition (CA x Walk) (I {walk = False}) _ _ = Just $ CA x Idle
  transition (CA x Idle) (I {walk = True}) _ _ = Just $ CA x Walk
  transition _ _ _ _ = Nothing

  start = Start