module Engine.Camera where

import RIO

import Geomancy (Transform(..), Vec3, vec3)
import Geomancy.Transform qualified as Transform
import Geomancy.Quaternion qualified as Quaternion
import Geomancy.Vec3 qualified as Vec3
import Geomancy.Vulkan.Projection qualified as Projection
import Geomancy.Vulkan.View qualified as View
import Vulkan.Core10 qualified as Vk

import Engine.Worker qualified as Worker

-- * Projection

data Projection = Projection
  { Projection -> Transform
projectionPerspective :: Transform
  , Projection -> Transform
projectionOrthoUI     :: Transform
  }
  deriving (Int -> Projection -> ShowS
[Projection] -> ShowS
Projection -> String
(Int -> Projection -> ShowS)
-> (Projection -> String)
-> ([Projection] -> ShowS)
-> Show Projection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Projection] -> ShowS
$cshowList :: [Projection] -> ShowS
show :: Projection -> String
$cshow :: Projection -> String
showsPrec :: Int -> Projection -> ShowS
$cshowsPrec :: Int -> Projection -> ShowS
Show)

instance Semigroup Projection where
  Projection
_a <> :: Projection -> Projection -> Projection
<> Projection
b = Projection :: Transform -> Transform -> Projection
Projection
    { $sel:projectionPerspective:Projection :: Transform
projectionPerspective = Projection -> Transform
projectionPerspective Projection
b
    , $sel:projectionOrthoUI:Projection :: Transform
projectionOrthoUI     = Projection -> Transform
projectionOrthoUI     Projection
b
    }

instance Monoid Projection where
  mempty :: Projection
mempty = Transform -> Transform -> Projection
Projection Transform
forall a. Monoid a => a
mempty Transform
forall a. Monoid a => a
mempty

type ProjectionProcess = Worker.Cell ProjectionInput Projection

data ProjectionInput = ProjectionInput
  { ProjectionInput -> Float
projectionFovRads :: Float
  , ProjectionInput -> Extent2D
projectionScreen  :: Vk.Extent2D
  }
  deriving (Int -> ProjectionInput -> ShowS
[ProjectionInput] -> ShowS
ProjectionInput -> String
(Int -> ProjectionInput -> ShowS)
-> (ProjectionInput -> String)
-> ([ProjectionInput] -> ShowS)
-> Show ProjectionInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProjectionInput] -> ShowS
$cshowList :: [ProjectionInput] -> ShowS
show :: ProjectionInput -> String
$cshow :: ProjectionInput -> String
showsPrec :: Int -> ProjectionInput -> ShowS
$cshowsPrec :: Int -> ProjectionInput -> ShowS
Show)

mkProjection :: ProjectionInput -> Projection
mkProjection :: ProjectionInput -> Projection
mkProjection ProjectionInput{Float
Extent2D
projectionScreen :: Extent2D
projectionFovRads :: Float
$sel:projectionScreen:ProjectionInput :: ProjectionInput -> Extent2D
$sel:projectionFovRads:ProjectionInput :: ProjectionInput -> Float
..} = Projection :: Transform -> Transform -> Projection
Projection{Transform
projectionOrthoUI :: Transform
projectionPerspective :: Transform
$sel:projectionOrthoUI:Projection :: Transform
$sel:projectionPerspective:Projection :: Transform
..}
  where
    -- BUG: infinitePerspective gives huge clipping and effective FoV is different
    -- projectionPerspective = Projection.infinitePerspective projectionFovRads width height
    projectionPerspective :: Transform
projectionPerspective = Float -> Float -> Float -> Word32 -> Word32 -> Transform
forall side.
Integral side =>
Float -> Float -> Float -> side -> side -> Transform
Projection.perspective
      Float
projectionFovRads
      Float
forall a. (Eq a, Num a, Fractional a) => a
PROJECTION_NEAR
      Float
forall a. (Eq a, Num a) => a
PROJECTION_FAR
      Word32
width
      Word32
height

    projectionOrthoUI :: Transform
projectionOrthoUI = Float -> Float -> Word32 -> Word32 -> Transform
forall side.
Integral side =>
Float -> Float -> side -> side -> Transform
Projection.orthoOffCenter Float
0 Float
1 Word32
width Word32
height

    Vk.Extent2D{Word32
$sel:width:Extent2D :: Extent2D -> Word32
width :: Word32
width, Word32
$sel:height:Extent2D :: Extent2D -> Word32
height :: Word32
height} = Extent2D
projectionScreen

pattern PROJECTION_NEAR :: (Eq a, Num a, Fractional a) => a
pattern $bPROJECTION_NEAR :: a
$mPROJECTION_NEAR :: forall r a.
(Eq a, Num a, Fractional a) =>
a -> (Void# -> r) -> (Void# -> r) -> r
PROJECTION_NEAR = 0x0.02 -- i.e. 1/2048

pattern PROJECTION_FAR :: (Eq a, Num a) => a
pattern $bPROJECTION_FAR :: a
$mPROJECTION_FAR :: forall r a. (Eq a, Num a) => a -> (Void# -> r) -> (Void# -> r) -> r
PROJECTION_FAR = 16384

-- * View

data View = View
  { View -> Transform
viewTransform    :: Transform
  , View -> Transform
viewTransformInv :: Transform
  , View -> Vec3
viewPosition     :: Vec3
  , View -> Vec3
viewDirection    :: Vec3
  }
  deriving (Int -> View -> ShowS
[View] -> ShowS
View -> String
(Int -> View -> ShowS)
-> (View -> String) -> ([View] -> ShowS) -> Show View
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [View] -> ShowS
$cshowList :: [View] -> ShowS
show :: View -> String
$cshow :: View -> String
showsPrec :: Int -> View -> ShowS
$cshowsPrec :: Int -> View -> ShowS
Show)

type ViewProcess = Worker.Cell ViewOrbitalInput View

-- | Camera orbiting its target
data ViewOrbitalInput = ViewOrbitalInput
  { ViewOrbitalInput -> Float
orbitAzimuth  :: Float
  , ViewOrbitalInput -> Float
orbitAscent   :: Float
  , ViewOrbitalInput -> Float
orbitDistance :: Float
  , ViewOrbitalInput -> Float
orbitScale    :: Float
  , ViewOrbitalInput -> Vec3
orbitTarget   :: Vec3
  }
  deriving (Int -> ViewOrbitalInput -> ShowS
[ViewOrbitalInput] -> ShowS
ViewOrbitalInput -> String
(Int -> ViewOrbitalInput -> ShowS)
-> (ViewOrbitalInput -> String)
-> ([ViewOrbitalInput] -> ShowS)
-> Show ViewOrbitalInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ViewOrbitalInput] -> ShowS
$cshowList :: [ViewOrbitalInput] -> ShowS
show :: ViewOrbitalInput -> String
$cshow :: ViewOrbitalInput -> String
showsPrec :: Int -> ViewOrbitalInput -> ShowS
$cshowsPrec :: Int -> ViewOrbitalInput -> ShowS
Show)

mkViewOrbital :: Vec3 -> ViewOrbitalInput -> View
mkViewOrbital :: Vec3 -> ViewOrbitalInput -> View
mkViewOrbital Vec3
cameraTarget ViewOrbitalInput{Float
Vec3
orbitTarget :: Vec3
orbitScale :: Float
orbitDistance :: Float
orbitAscent :: Float
orbitAzimuth :: Float
$sel:orbitTarget:ViewOrbitalInput :: ViewOrbitalInput -> Vec3
$sel:orbitScale:ViewOrbitalInput :: ViewOrbitalInput -> Float
$sel:orbitDistance:ViewOrbitalInput :: ViewOrbitalInput -> Float
$sel:orbitAscent:ViewOrbitalInput :: ViewOrbitalInput -> Float
$sel:orbitAzimuth:ViewOrbitalInput :: ViewOrbitalInput -> Float
..} = View :: Transform -> Transform -> Vec3 -> Vec3 -> View
View{Transform
Vec3
viewDirection :: Vec3
viewPosition :: Vec3
viewTransformInv :: Transform
viewTransform :: Transform
$sel:viewDirection:View :: Vec3
$sel:viewPosition:View :: Vec3
$sel:viewTransformInv:View :: Transform
$sel:viewTransform:View :: Transform
..}
  where
    viewTransform :: Transform
viewTransform = Vec3 -> Vec3 -> Vec3 -> Transform
View.lookAt Vec3
viewPosition Vec3
cameraTarget Vec3
axisUp
    viewTransformInv :: Transform
viewTransformInv = Transform -> Transform
forall a. (Coercible Mat4 a, Coercible Mat4 a) => a -> a
Transform.inverse Transform
viewTransform

    viewPosition :: Vec3
viewPosition =
      Vec3
orbitTarget Vec3 -> Vec3 -> Vec3
forall a. Num a => a -> a -> a
+
      Quaternion -> Vec3 -> Vec3
Quaternion.rotate
        ( Vec3 -> Float -> Quaternion
Quaternion.axisAngle Vec3
axisUp Float
orbitAzimuth Quaternion -> Quaternion -> Quaternion
forall a. Num a => a -> a -> a
*
          Vec3 -> Float -> Quaternion
Quaternion.axisAngle Vec3
axisRight Float
orbitAscent
        )
        (Float -> Float -> Float -> Vec3
vec3 Float
0 Float
0 (Float -> Vec3) -> Float -> Vec3
forall a b. (a -> b) -> a -> b
$ Float
orbitDistance Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
orbitScale)

    viewDirection :: Vec3
viewDirection = Vec3 -> Vec3
Vec3.normalize (Vec3 -> Vec3) -> Vec3 -> Vec3
forall a b. (a -> b) -> a -> b
$ Vec3
cameraTarget Vec3 -> Vec3 -> Vec3
forall a. Num a => a -> a -> a
- Vec3
viewPosition

    axisUp :: Vec3
axisUp    = Float -> Float -> Float -> Vec3
vec3 Float
0 (-Float
1) Float
0
    axisRight :: Vec3
axisRight = Float -> Float -> Float -> Vec3
vec3 Float
1 Float
0 Float
0

{-# INLINE mkViewOrbital_ #-}
mkViewOrbital_ :: ViewOrbitalInput -> View
mkViewOrbital_ :: ViewOrbitalInput -> View
mkViewOrbital_ ViewOrbitalInput
voi = Vec3 -> ViewOrbitalInput -> View
mkViewOrbital (ViewOrbitalInput -> Vec3
orbitTarget ViewOrbitalInput
voi) ViewOrbitalInput
voi