Plugin.hs

{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

module Mischief.Math.Transform.Plugin where

import Mischief.ECS
import Mischief.ECS.App.Schedules (First)
import Mischief.ECS.Relationships.ChildOf qualified as ChildOf
import Mischief.Math.Transform (GlobalTransform (GlobalTransform), Transform, composeTransforms)

data TransformPlugin

instance Plugin TransformPlugin where
  init = do
    schedule @First $ systems propTransform

propTransform :: System ()
propTransform = do
  query_ qiterTransform

qiterTransform :: Query System ()
qiterTransform = do
  root <- [q|Entity / Without ChildOf -> *|]
  dirty <- qlift $ check [qf|Changed Transform|] root
  if dirty
    then do
      trans <- qget root [qd|Transform|]
      qlift $ insert (GlobalTransform trans) root
      child <- qiterE =<< qlift (ChildOf.children root)
      qpropTransformRec child (GlobalTransform trans)
    else
      qiterTransformRec root

-- | Recursively iterates downwards and starts propagating the transform when finding a dirty entity.
qiterTransformRec :: Entity -> Query System ()
qiterTransformRec entity = do
  child <- qiterE =<< qlift (ChildOf.children entity)
  dirty <- qlift $ check [qf|Changed Transform|] child

  if dirty
    then do
      global <- qget entity [qd|GlobalTransform|]
      qpropTransformRec child global
    else do
      qiterTransformRec child

-- | Given an entity and its parent's Global Transform, propagates the Global Transform downwards.
qpropTransformRec :: Entity -> GlobalTransform -> Query System ()
qpropTransformRec entity (GlobalTransform global) = do
  transform <- qget entity [qd|Transform|]

  let global' = global `composeTransforms` transform
  qlift $ insert (GlobalTransform global') entity

  child <- qiterE =<< qlift (ChildOf.children entity)
  qpropTransformRec child (GlobalTransform global')