mischief-render-0.1.0.0: examples/Transform.hs

{-# LANGUAGE MultiWayIf #-}

module Main where

import Control.Monad (void)
import Data.Text (Text)
import Mischief.Animation
import Mischief.Assets
import Mischief.ECS
import Mischief.ECS.Time qualified as Time
import Mischief.Input
import Mischief.Input.Keys qualified as Keys
import Mischief.Materials.Sprite (SpriteMaterial)
import Mischief.Math
import Mischief.Math.Transform qualified as Transform
import Mischief.Render

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 move
      & schedule @Update

    systems (renderMaterial @SpriteMaterial def)
      & schedule @RenderUpdate

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

data Player = Player deriving (Component)

data SecondPlayer = SecondPlayer deriving (Component)

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

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

  pink <-
    spawn
      ( Animator MyAnimator,
        WithMaterial @SpriteMaterial,
        Player
      )
  shift (ChangeCharacter Pink) pink

  green <-
    spawn
      ( Animator MyAnimator,
        WithMaterial @SpriteMaterial,
        def {translation = V3 50 50 0},
        Rel ChildOf pink,
        SecondPlayer
      )
  shift (ChangeCharacter Green) green

  spawn
    ( Animator MyAnimator,
      WithMaterial @SpriteMaterial,
      def {translation = V3 100 100 0},
      Rel ChildOf green
    )
    >>= shift (ChangeCharacter Beige)

move :: System ()
move = do
  Just keys <- res @Keys
  Just (entity, sprite) <-
    if not $ Keys.pressed keys Keys.LShift
      then
        single [q|E, Transform / With Sprite, With Player|]
      else
        single [q|E, Transform / With Sprite, With SecondPlayer|]

  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 rotation =
        if
          | Keys.pressed keys Keys.Q -> 0.5 * delta
          | Keys.pressed keys Keys.E -> -(0.5 * delta)
          | otherwise -> 0

  insertIfNeq (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 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 (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