Camera.hs

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
  { projectionPerspective :: Transform
  , projectionOrthoUI     :: Transform
  }
  deriving (Show)

instance Semigroup Projection where
  _a <> b = Projection
    { projectionPerspective = projectionPerspective b
    , projectionOrthoUI     = projectionOrthoUI     b
    }

instance Monoid Projection where
  mempty = Projection mempty mempty

type ProjectionProcess = Worker.Cell ProjectionInput Projection

data ProjectionInput = ProjectionInput
  { projectionFovRads :: Float
  , projectionScreen  :: Vk.Extent2D
  }
  deriving (Show)

mkProjection :: ProjectionInput -> Projection
mkProjection ProjectionInput{..} = Projection{..}
  where
    -- BUG: infinitePerspective gives huge clipping and effective FoV is different
    -- projectionPerspective = Projection.infinitePerspective projectionFovRads width height
    projectionPerspective = Projection.perspective
      projectionFovRads
      PROJECTION_NEAR
      PROJECTION_FAR
      width
      height

    projectionOrthoUI = Projection.orthoOffCenter 0 1 width height

    Vk.Extent2D{width, height} = projectionScreen

pattern PROJECTION_NEAR :: (Eq a, Num a, Fractional a) => a
pattern PROJECTION_NEAR = 0x0.02 -- i.e. 1/2048

pattern PROJECTION_FAR :: (Eq a, Num a) => a
pattern PROJECTION_FAR = 16384

-- * View

data View = View
  { viewTransform    :: Transform
  , viewTransformInv :: Transform
  , viewPosition     :: Vec3
  , viewDirection    :: Vec3
  }
  deriving (Show)

type ViewProcess = Worker.Cell ViewOrbitalInput View

-- | Camera orbiting its target
data ViewOrbitalInput = ViewOrbitalInput
  { orbitAzimuth  :: Float
  , orbitAscent   :: Float
  , orbitDistance :: Float
  , orbitScale    :: Float
  , orbitTarget   :: Vec3
  }
  deriving (Show)

mkViewOrbital :: Vec3 -> ViewOrbitalInput -> View
mkViewOrbital cameraTarget ViewOrbitalInput{..} = View{..}
  where
    viewTransform = View.lookAt viewPosition cameraTarget axisUp
    viewTransformInv = Transform.inverse viewTransform

    viewPosition =
      orbitTarget +
      Quaternion.rotate
        ( Quaternion.axisAngle axisUp orbitAzimuth *
          Quaternion.axisAngle axisRight orbitAscent
        )
        (vec3 0 0 $ orbitDistance * orbitScale)

    viewDirection = Vec3.normalize $ cameraTarget - viewPosition

    axisUp    = vec3 0 (-1) 0
    axisRight = vec3 1 0 0

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