{-# LANGUAGE Arrows #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeApplications #-}

module Aztecs.Camera
  ( Camera (..),
    CameraTarget (..),
    addCameraTargets,
  )
where

import Aztecs.ECS
import qualified Aztecs.ECS.Access as A
import qualified Aztecs.ECS.Query.Reader as Q
import qualified Aztecs.ECS.System as S
import Aztecs.Window (Window)
import Control.Arrow (Arrow (..))
import Control.DeepSeq
import GHC.Generics (Generic)
import Linear (V2 (..))

-- | Camera component.
data Camera = Camera
  { -- | Camera viewport size.
    Camera -> V2 Int
cameraViewport :: !(V2 Int),
    -- | Camera scale factor.
    Camera -> V2 Float
cameraScale :: !(V2 Float)
  }
  deriving (Int -> Camera -> ShowS
[Camera] -> ShowS
Camera -> String
(Int -> Camera -> ShowS)
-> (Camera -> String) -> ([Camera] -> ShowS) -> Show Camera
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Camera -> ShowS
showsPrec :: Int -> Camera -> ShowS
$cshow :: Camera -> String
show :: Camera -> String
$cshowList :: [Camera] -> ShowS
showList :: [Camera] -> ShowS
Show, (forall x. Camera -> Rep Camera x)
-> (forall x. Rep Camera x -> Camera) -> Generic Camera
forall x. Rep Camera x -> Camera
forall x. Camera -> Rep Camera x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Camera -> Rep Camera x
from :: forall x. Camera -> Rep Camera x
$cto :: forall x. Rep Camera x -> Camera
to :: forall x. Rep Camera x -> Camera
Generic, Camera -> ()
(Camera -> ()) -> NFData Camera
forall a. (a -> ()) -> NFData a
$crnf :: Camera -> ()
rnf :: Camera -> ()
NFData)

instance Component Camera

-- | Camera target component.
newtype CameraTarget = CameraTarget
  { -- | This camera's target window.
    CameraTarget -> EntityID
cameraTargetWindow :: EntityID
  }
  deriving (CameraTarget -> CameraTarget -> Bool
(CameraTarget -> CameraTarget -> Bool)
-> (CameraTarget -> CameraTarget -> Bool) -> Eq CameraTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CameraTarget -> CameraTarget -> Bool
== :: CameraTarget -> CameraTarget -> Bool
$c/= :: CameraTarget -> CameraTarget -> Bool
/= :: CameraTarget -> CameraTarget -> Bool
Eq, Int -> CameraTarget -> ShowS
[CameraTarget] -> ShowS
CameraTarget -> String
(Int -> CameraTarget -> ShowS)
-> (CameraTarget -> String)
-> ([CameraTarget] -> ShowS)
-> Show CameraTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CameraTarget -> ShowS
showsPrec :: Int -> CameraTarget -> ShowS
$cshow :: CameraTarget -> String
show :: CameraTarget -> String
$cshowList :: [CameraTarget] -> ShowS
showList :: [CameraTarget] -> ShowS
Show, (forall x. CameraTarget -> Rep CameraTarget x)
-> (forall x. Rep CameraTarget x -> CameraTarget)
-> Generic CameraTarget
forall x. Rep CameraTarget x -> CameraTarget
forall x. CameraTarget -> Rep CameraTarget x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CameraTarget -> Rep CameraTarget x
from :: forall x. CameraTarget -> Rep CameraTarget x
$cto :: forall x. Rep CameraTarget x -> CameraTarget
to :: forall x. Rep CameraTarget x -> CameraTarget
Generic, CameraTarget -> ()
(CameraTarget -> ()) -> NFData CameraTarget
forall a. (a -> ()) -> NFData a
$crnf :: CameraTarget -> ()
rnf :: CameraTarget -> ()
NFData)

instance Component CameraTarget

-- | Add `CameraTarget` components to entities with a new `Draw` component.
addCameraTargets ::
  ( ArrowQueryReader qr,
    ArrowDynamicQueryReader qr,
    ArrowReaderSystem qr arr,
    ArrowQueueSystem b m arr
  ) =>
  arr () ()
addCameraTargets :: forall (qr :: * -> * -> *) (arr :: * -> * -> *) b (m :: * -> *).
(ArrowQueryReader qr, ArrowDynamicQueryReader qr,
 ArrowReaderSystem qr arr, ArrowQueueSystem b m arr) =>
arr () ()
addCameraTargets = proc () -> do
  [(EntityID, Window)]
windows <- qr () (EntityID, Window) -> arr () [(EntityID, Window)]
forall i a. qr i a -> arr i [a]
forall (q :: * -> * -> *) (arr :: * -> * -> *) i a.
ArrowReaderSystem q arr =>
q i a -> arr i [a]
S.all (qr () EntityID
forall (arr :: * -> * -> *).
ArrowDynamicQueryReader arr =>
arr () EntityID
Q.entity qr () EntityID -> qr () Window -> qr () (EntityID, Window)
forall b c c'. qr b c -> qr b c' -> qr b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall (arr :: * -> * -> *) a.
(ArrowQueryReader arr, Component a) =>
arr () a
Q.fetch @_ @Window) -< ()
  [(EntityID, Camera)]
newCameras <- qr () (EntityID, Camera)
-> QueryFilter -> arr () [(EntityID, Camera)]
forall a. qr () a -> QueryFilter -> arr () [a]
forall (q :: * -> * -> *) (arr :: * -> * -> *) a.
ArrowReaderSystem q arr =>
q () a -> QueryFilter -> arr () [a]
S.filter (qr () EntityID
forall (arr :: * -> * -> *).
ArrowDynamicQueryReader arr =>
arr () EntityID
Q.entity qr () EntityID -> qr () Camera -> qr () (EntityID, Camera)
forall b c c'. qr b c -> qr b c' -> qr b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall (arr :: * -> * -> *) a.
(ArrowQueryReader arr, Component a) =>
arr () a
Q.fetch @_ @Camera) (forall a. Component a => QueryFilter
without @CameraTarget) -< ()
  (([(EntityID, Camera)], [(EntityID, Window)]) -> m ())
-> arr ([(EntityID, Camera)], [(EntityID, Window)]) ()
forall i. (i -> m ()) -> arr i ()
forall b (m :: * -> *) (arr :: * -> * -> *) i.
ArrowQueueSystem b m arr =>
(i -> m ()) -> arr i ()
S.queue
    ( \([(EntityID, Camera)]
newCameras, [(EntityID, Window)]
windows) -> case [(EntityID, Window)]
windows of
        (EntityID
windowEId, Window
_) : [(EntityID, Window)]
_ -> ((EntityID, Camera) -> m ()) -> [(EntityID, Camera)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(EntityID
eId, Camera
_) -> EntityID -> CameraTarget -> m ()
forall a. Component a => EntityID -> a -> m ()
forall b (m :: * -> *) a.
(MonadAccess b m, Component a) =>
EntityID -> a -> m ()
A.insert EntityID
eId (CameraTarget -> m ()) -> CameraTarget -> m ()
forall a b. (a -> b) -> a -> b
$ EntityID -> CameraTarget
CameraTarget EntityID
windowEId) [(EntityID, Camera)]
newCameras
        [(EntityID, Window)]
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    )
    -<
      ([(EntityID, Camera)]
newCameras, [(EntityID, Window)]
windows)