mischief-render-0.1.0.0: examples/YSort.hs

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

module Main where

import Control.Monad (void, when)
import Data.Default
import Data.Foldable
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.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 qualified as Transform
import Mischief.Render.Camera
import Mischief.Render.Core (RenderUpdate)
import Mischief.Render.Material (WithMaterial (WithMaterial), renderSortedMaterial)
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 (renderSortedMaterial @SpriteMaterial def getSpriteKey)
      & schedule @RenderUpdate

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

getSpriteKey :: Entity -> Query System Float
getSpriteKey sprite = do
  transform <- qget sprite [qd|Transform|]
  pure $ -transform.translation.y

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

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

  spawn
    ( Animator MyAnimator,
      def {translation = V3 (-100) (-100) (-1)},
      Anchor $ V2 0.5 1,
      WithMaterial @SpriteMaterial
    )
    >>= shift (ChangeCharacter Beige)

  spawn
    ( Animator MyAnimator,
      def {translation = V3 100 100 (-1)},
      Anchor $ V2 0.5 1,
      WithMaterial @SpriteMaterial
    )
    >>= shift (ChangeCharacter Green)

  spawn
    ( Animator MyAnimator,
      def {translation = V3 100 (-100) (-1)},
      Anchor $ V2 0.5 1,
      WithMaterial @SpriteMaterial
    )
    >>= shift (ChangeCharacter Purple)

  spawn
    ( Animator MyAnimator,
      def {translation = V3 (-100) 100 (-1)},
      Anchor $ V2 0.5 1,
      WithMaterial @SpriteMaterial
    )
    >>= shift (ChangeCharacter Yellow)

  spawn
    ( Animator MyAnimator,
      def {translation = V3 0 0 (-1), scale = V3 1 1 1},
      Anchor $ V2 0.5 1,
      WithMaterial @SpriteMaterial,
      Player
    )
    >>= shift (ChangeCharacter Pink)

data Player = Player deriving (Component)

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

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

    delta <- Time.delta
    let speed = 150

    let dirX =
          if
            | Keys.pressed keys Keys.A -> V2 (-1) 0
            | Keys.pressed keys Keys.D -> V2 1 0
            | otherwise -> V2 0 0

    let dirY =
          if
            | Keys.pressed keys Keys.S -> V2 0 (-1)
            | Keys.pressed keys Keys.W -> V2 0 1
            | otherwise -> V2 0 0

    let dir = normalize (dirX + dirY) ^* delta * speed

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

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

    let rotation =
          if
            | Keys.pressed keys Keys.Q -> 0.5 * delta
            | Keys.pressed keys Keys.E -> -(0.5 * delta)
            | otherwise -> 0

    insert (Transform.rotateZ rotation $ 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