module Engine.Camera
  ( ProjectionKind(..)
  , Projection(..)
  , ProjectionParams
  , ProjectionInput(..)
  , ProjectionProcess
  , spawnPerspective
  , mkTransformPerspective

  , spawnOrthoPixelsCentered
  , mkTransformOrthoPixelsCentered
  , trackOrthoPixelsCentered

  , spawnProjectionWith

  , spawnProjection
  , pattern PROJECTION_NEAR
  , pattern PROJECTION_FAR

  , View(..)
  , ViewProcess
  , ViewOrbitalInput(..)
  , initialOrbitalInput
  , mkViewOrbital
  , mkViewOrbital_
  ) where

import RIO

import Geomancy (Transform(..), Vec3, vec2, vec3)
import Geomancy.Layout.Box (Box(..))
import Geomancy.Quaternion qualified as Quaternion
import Geomancy.Transform qualified as Transform
import Geomancy.Vec3 qualified as Vec3
import Geomancy.Vulkan.Projection qualified as Projection
import Geomancy.Vulkan.View qualified as View
import RIO.App (App)
import UnliftIO.Resource (MonadResource)
import Vulkan.Core10 qualified as Vk
import Vulkan.NamedType ((:::))

import Engine.Types qualified as Engine
import Engine.Worker qualified as Worker

-- * Projection

data ProjectionKind
  = Perspective
  | Orthographic
  deriving (ProjectionKind -> ProjectionKind -> Bool
(ProjectionKind -> ProjectionKind -> Bool)
-> (ProjectionKind -> ProjectionKind -> Bool) -> Eq ProjectionKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProjectionKind -> ProjectionKind -> Bool
== :: ProjectionKind -> ProjectionKind -> Bool
$c/= :: ProjectionKind -> ProjectionKind -> Bool
/= :: ProjectionKind -> ProjectionKind -> Bool
Eq, Eq ProjectionKind
Eq ProjectionKind
-> (ProjectionKind -> ProjectionKind -> Ordering)
-> (ProjectionKind -> ProjectionKind -> Bool)
-> (ProjectionKind -> ProjectionKind -> Bool)
-> (ProjectionKind -> ProjectionKind -> Bool)
-> (ProjectionKind -> ProjectionKind -> Bool)
-> (ProjectionKind -> ProjectionKind -> ProjectionKind)
-> (ProjectionKind -> ProjectionKind -> ProjectionKind)
-> Ord ProjectionKind
ProjectionKind -> ProjectionKind -> Bool
ProjectionKind -> ProjectionKind -> Ordering
ProjectionKind -> ProjectionKind -> ProjectionKind
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ProjectionKind -> ProjectionKind -> Ordering
compare :: ProjectionKind -> ProjectionKind -> Ordering
$c< :: ProjectionKind -> ProjectionKind -> Bool
< :: ProjectionKind -> ProjectionKind -> Bool
$c<= :: ProjectionKind -> ProjectionKind -> Bool
<= :: ProjectionKind -> ProjectionKind -> Bool
$c> :: ProjectionKind -> ProjectionKind -> Bool
> :: ProjectionKind -> ProjectionKind -> Bool
$c>= :: ProjectionKind -> ProjectionKind -> Bool
>= :: ProjectionKind -> ProjectionKind -> Bool
$cmax :: ProjectionKind -> ProjectionKind -> ProjectionKind
max :: ProjectionKind -> ProjectionKind -> ProjectionKind
$cmin :: ProjectionKind -> ProjectionKind -> ProjectionKind
min :: ProjectionKind -> ProjectionKind -> ProjectionKind
Ord, Int -> ProjectionKind -> ShowS
[ProjectionKind] -> ShowS
ProjectionKind -> String
(Int -> ProjectionKind -> ShowS)
-> (ProjectionKind -> String)
-> ([ProjectionKind] -> ShowS)
-> Show ProjectionKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProjectionKind -> ShowS
showsPrec :: Int -> ProjectionKind -> ShowS
$cshow :: ProjectionKind -> String
show :: ProjectionKind -> String
$cshowList :: [ProjectionKind] -> ShowS
showList :: [ProjectionKind] -> ShowS
Show, Int -> ProjectionKind
ProjectionKind -> Int
ProjectionKind -> [ProjectionKind]
ProjectionKind -> ProjectionKind
ProjectionKind -> ProjectionKind -> [ProjectionKind]
ProjectionKind
-> ProjectionKind -> ProjectionKind -> [ProjectionKind]
(ProjectionKind -> ProjectionKind)
-> (ProjectionKind -> ProjectionKind)
-> (Int -> ProjectionKind)
-> (ProjectionKind -> Int)
-> (ProjectionKind -> [ProjectionKind])
-> (ProjectionKind -> ProjectionKind -> [ProjectionKind])
-> (ProjectionKind -> ProjectionKind -> [ProjectionKind])
-> (ProjectionKind
    -> ProjectionKind -> ProjectionKind -> [ProjectionKind])
-> Enum ProjectionKind
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ProjectionKind -> ProjectionKind
succ :: ProjectionKind -> ProjectionKind
$cpred :: ProjectionKind -> ProjectionKind
pred :: ProjectionKind -> ProjectionKind
$ctoEnum :: Int -> ProjectionKind
toEnum :: Int -> ProjectionKind
$cfromEnum :: ProjectionKind -> Int
fromEnum :: ProjectionKind -> Int
$cenumFrom :: ProjectionKind -> [ProjectionKind]
enumFrom :: ProjectionKind -> [ProjectionKind]
$cenumFromThen :: ProjectionKind -> ProjectionKind -> [ProjectionKind]
enumFromThen :: ProjectionKind -> ProjectionKind -> [ProjectionKind]
$cenumFromTo :: ProjectionKind -> ProjectionKind -> [ProjectionKind]
enumFromTo :: ProjectionKind -> ProjectionKind -> [ProjectionKind]
$cenumFromThenTo :: ProjectionKind
-> ProjectionKind -> ProjectionKind -> [ProjectionKind]
enumFromThenTo :: ProjectionKind
-> ProjectionKind -> ProjectionKind -> [ProjectionKind]
Enum, ProjectionKind
ProjectionKind -> ProjectionKind -> Bounded ProjectionKind
forall a. a -> a -> Bounded a
$cminBound :: ProjectionKind
minBound :: ProjectionKind
$cmaxBound :: ProjectionKind
maxBound :: ProjectionKind
Bounded, (forall x. ProjectionKind -> Rep ProjectionKind x)
-> (forall x. Rep ProjectionKind x -> ProjectionKind)
-> Generic ProjectionKind
forall x. Rep ProjectionKind x -> ProjectionKind
forall x. ProjectionKind -> Rep ProjectionKind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProjectionKind -> Rep ProjectionKind x
from :: forall x. ProjectionKind -> Rep ProjectionKind x
$cto :: forall x. Rep ProjectionKind x -> ProjectionKind
to :: forall x. Rep ProjectionKind x -> ProjectionKind
Generic)

data Projection (pk :: ProjectionKind) = Projection
  { forall (pk :: ProjectionKind). Projection pk -> Transform
projectionTransform :: Transform
  , forall (pk :: ProjectionKind). Projection pk -> Transform
projectionInverse   :: ~Transform
  }
  deriving (Int -> Projection pk -> ShowS
[Projection pk] -> ShowS
Projection pk -> String
(Int -> Projection pk -> ShowS)
-> (Projection pk -> String)
-> ([Projection pk] -> ShowS)
-> Show (Projection pk)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (pk :: ProjectionKind). Int -> Projection pk -> ShowS
forall (pk :: ProjectionKind). [Projection pk] -> ShowS
forall (pk :: ProjectionKind). Projection pk -> String
$cshowsPrec :: forall (pk :: ProjectionKind). Int -> Projection pk -> ShowS
showsPrec :: Int -> Projection pk -> ShowS
$cshow :: forall (pk :: ProjectionKind). Projection pk -> String
show :: Projection pk -> String
$cshowList :: forall (pk :: ProjectionKind). [Projection pk] -> ShowS
showList :: [Projection pk] -> ShowS
Show, (forall x. Projection pk -> Rep (Projection pk) x)
-> (forall x. Rep (Projection pk) x -> Projection pk)
-> Generic (Projection pk)
forall x. Rep (Projection pk) x -> Projection pk
forall x. Projection pk -> Rep (Projection pk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (pk :: ProjectionKind) x.
Rep (Projection pk) x -> Projection pk
forall (pk :: ProjectionKind) x.
Projection pk -> Rep (Projection pk) x
$cfrom :: forall (pk :: ProjectionKind) x.
Projection pk -> Rep (Projection pk) x
from :: forall x. Projection pk -> Rep (Projection pk) x
$cto :: forall (pk :: ProjectionKind) x.
Rep (Projection pk) x -> Projection pk
to :: forall x. Rep (Projection pk) x -> Projection pk
Generic)

type ProjectionProcess pk = Worker.Cell (ProjectionInput pk) (Projection pk)

data ProjectionInput (pk :: ProjectionKind) = ProjectionInput
  { forall (pk :: ProjectionKind).
ProjectionInput pk -> ProjectionParams pk
projectionParams :: ProjectionParams pk
  , forall (pk :: ProjectionKind). ProjectionInput pk -> Float
projectionNear   :: Float
  , forall (pk :: ProjectionKind). ProjectionInput pk -> Float
projectionFar    :: Float
  }

-- XXX: undecidable
-- deriving instance (Show (ProjectionParams pk)) => Show (ProjectionInput pk)

type family ProjectionParams (pk :: ProjectionKind) where
  ProjectionParams 'Perspective = "fov-v" ::: Float
  ProjectionParams 'Orthographic = ()

spawnProjection
  :: ( MonadReader (App Engine.GlobalHandles st) m
     , MonadResource m
     , MonadUnliftIO m
     )
  => (Vk.Extent2D -> ProjectionInput pk -> Transform)
  -> ProjectionParams pk
  -> m (ProjectionProcess pk)
spawnProjection :: forall st (m :: * -> *) (pk :: ProjectionKind).
(MonadReader (App GlobalHandles st) m, MonadResource m,
 MonadUnliftIO m) =>
(Extent2D -> ProjectionInput pk -> Transform)
-> ProjectionParams pk -> m (ProjectionProcess pk)
spawnProjection Extent2D -> ProjectionInput pk -> Transform
mkTransform ProjectionParams pk
params =
  (Extent2D -> ProjectionInput pk -> Transform)
-> ProjectionInput pk -> m (ProjectionProcess pk)
forall st (m :: * -> *) (pk :: ProjectionKind).
(MonadReader (App GlobalHandles st) m, MonadResource m,
 MonadUnliftIO m) =>
(Extent2D -> ProjectionInput pk -> Transform)
-> ProjectionInput pk -> m (ProjectionProcess pk)
spawnProjectionWith Extent2D -> ProjectionInput pk -> Transform
mkTransform ProjectionInput
    { $sel:projectionNear:ProjectionInput :: Float
projectionNear    = Float
forall a. (Eq a, Num a, Fractional a) => a
PROJECTION_NEAR
    , $sel:projectionFar:ProjectionInput :: Float
projectionFar     = Float
forall a. (Eq a, Num a) => a
PROJECTION_FAR
    , $sel:projectionParams:ProjectionInput :: ProjectionParams pk
projectionParams  = ProjectionParams pk
params
    }

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

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

spawnProjectionWith
  :: ( MonadReader (App Engine.GlobalHandles st) m
     , MonadResource m
     , MonadUnliftIO m
     )
  => (Vk.Extent2D -> ProjectionInput pk -> Transform)
  -> ProjectionInput pk
  -> m (ProjectionProcess pk)
spawnProjectionWith :: forall st (m :: * -> *) (pk :: ProjectionKind).
(MonadReader (App GlobalHandles st) m, MonadResource m,
 MonadUnliftIO m) =>
(Extent2D -> ProjectionInput pk -> Transform)
-> ProjectionInput pk -> m (ProjectionProcess pk)
spawnProjectionWith Extent2D -> ProjectionInput pk -> Transform
mkTransform ProjectionInput pk
projectionInput = do
  Var Extent2D
screen <- m (Var Extent2D)
forall st (m :: * -> *).
MonadReader (App GlobalHandles st) m =>
m (Var Extent2D)
Engine.askScreenVar
  Var (ProjectionInput pk)
input <- ProjectionInput pk -> m (Var (ProjectionInput pk))
forall (m :: * -> *) a. MonadUnliftIO m => a -> m (Var a)
Worker.newVar ProjectionInput pk
projectionInput
  (Merge (Projection pk) -> ProjectionProcess pk)
-> m (Merge (Projection pk)) -> m (ProjectionProcess pk)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Var (ProjectionInput pk)
input,) (m (Merge (Projection pk)) -> m (ProjectionProcess pk))
-> m (Merge (Projection pk)) -> m (ProjectionProcess pk)
forall a b. (a -> b) -> a -> b
$
    (GetOutput (Var Extent2D)
 -> GetOutput (Var (ProjectionInput pk)) -> Projection pk)
-> Var Extent2D
-> Var (ProjectionInput pk)
-> m (Merge (Projection pk))
forall (m :: * -> *) i1 i2 o.
(MonadUnliftIO m, MonadResource m, HasOutput i1, HasOutput i2) =>
(GetOutput i1 -> GetOutput i2 -> o) -> i1 -> i2 -> m (Merge o)
Worker.spawnMerge2
      (\GetOutput (Var Extent2D)
s GetOutput (Var (ProjectionInput pk))
i ->
          let
            transform :: Transform
transform = Extent2D -> ProjectionInput pk -> Transform
mkTransform Extent2D
GetOutput (Var Extent2D)
s GetOutput (Var (ProjectionInput pk))
ProjectionInput pk
i
          in
            Projection
              { $sel:projectionTransform:Projection :: Transform
projectionTransform = Transform
transform
              , $sel:projectionInverse:Projection :: Transform
projectionInverse   = Transform -> Transform
forall a. (Coercible Mat4 a, Coercible Mat4 a) => a -> a
Transform.inverse Transform
transform -- XXX: better provide an inverse directly
              }
      )
      Var Extent2D
screen
      Var (ProjectionInput pk)
input

-- | Spawn a perspective projection worker with initial FoV of 90 degrees.
spawnPerspective
  :: ( MonadReader (App Engine.GlobalHandles st) m
     , MonadResource m
     , MonadUnliftIO m
     )
  => m (ProjectionProcess 'Perspective)
spawnPerspective :: forall st (m :: * -> *).
(MonadReader (App GlobalHandles st) m, MonadResource m,
 MonadUnliftIO m) =>
m (ProjectionProcess 'Perspective)
spawnPerspective = (Extent2D -> ProjectionInput 'Perspective -> Transform)
-> ProjectionParams 'Perspective
-> m (ProjectionProcess 'Perspective)
forall st (m :: * -> *) (pk :: ProjectionKind).
(MonadReader (App GlobalHandles st) m, MonadResource m,
 MonadUnliftIO m) =>
(Extent2D -> ProjectionInput pk -> Transform)
-> ProjectionParams pk -> m (ProjectionProcess pk)
spawnProjection Extent2D -> ProjectionInput 'Perspective -> Transform
mkTransformPerspective (Float
τ Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
4)

mkTransformPerspective :: Vk.Extent2D -> ProjectionInput 'Perspective -> Transform
mkTransformPerspective :: Extent2D -> ProjectionInput 'Perspective -> Transform
mkTransformPerspective Vk.Extent2D{Word32
width :: Word32
$sel:width:Extent2D :: Extent2D -> Word32
width, Word32
height :: Word32
$sel:height:Extent2D :: Extent2D -> Word32
height} ProjectionInput{Float
ProjectionParams 'Perspective
$sel:projectionParams:ProjectionInput :: forall (pk :: ProjectionKind).
ProjectionInput pk -> ProjectionParams pk
$sel:projectionNear:ProjectionInput :: forall (pk :: ProjectionKind). ProjectionInput pk -> Float
$sel:projectionFar:ProjectionInput :: forall (pk :: ProjectionKind). ProjectionInput pk -> Float
projectionParams :: ProjectionParams 'Perspective
projectionNear :: Float
projectionFar :: Float
..} =
  Float -> Float -> Float -> Word32 -> Word32 -> Transform
forall side.
Integral side =>
Float -> Float -> Float -> side -> side -> Transform
Projection.perspective
    Float
ProjectionParams 'Perspective
projectionParams
    Float
projectionNear
    Float
projectionFar
    Word32
width
    Word32
height

spawnOrthoPixelsCentered
  :: ( MonadReader (App Engine.GlobalHandles st) m
     , MonadResource m
     , MonadUnliftIO m
     )
  => m (ProjectionProcess 'Orthographic)
spawnOrthoPixelsCentered :: forall st (m :: * -> *).
(MonadReader (App GlobalHandles st) m, MonadResource m,
 MonadUnliftIO m) =>
m (ProjectionProcess 'Orthographic)
spawnOrthoPixelsCentered = (Extent2D -> ProjectionInput 'Orthographic -> Transform)
-> ProjectionInput 'Orthographic
-> m (ProjectionProcess 'Orthographic)
forall st (m :: * -> *) (pk :: ProjectionKind).
(MonadReader (App GlobalHandles st) m, MonadResource m,
 MonadUnliftIO m) =>
(Extent2D -> ProjectionInput pk -> Transform)
-> ProjectionInput pk -> m (ProjectionProcess pk)
spawnProjectionWith Extent2D -> ProjectionInput 'Orthographic -> Transform
mkTransformOrthoPixelsCentered ProjectionInput
  { $sel:projectionNear:ProjectionInput :: Float
projectionNear   = Float
0
  , $sel:projectionFar:ProjectionInput :: Float
projectionFar    = Float
1
  , $sel:projectionParams:ProjectionInput :: ProjectionParams 'Orthographic
projectionParams = ()
  }

mkTransformOrthoPixelsCentered :: Vk.Extent2D -> ProjectionInput 'Orthographic -> Transform
mkTransformOrthoPixelsCentered :: Extent2D -> ProjectionInput 'Orthographic -> Transform
mkTransformOrthoPixelsCentered Vk.Extent2D{Word32
$sel:width:Extent2D :: Extent2D -> Word32
width :: Word32
width, Word32
$sel:height:Extent2D :: Extent2D -> Word32
height :: Word32
height} ProjectionInput{Float
ProjectionParams 'Orthographic
$sel:projectionParams:ProjectionInput :: forall (pk :: ProjectionKind).
ProjectionInput pk -> ProjectionParams pk
$sel:projectionNear:ProjectionInput :: forall (pk :: ProjectionKind). ProjectionInput pk -> Float
$sel:projectionFar:ProjectionInput :: forall (pk :: ProjectionKind). ProjectionInput pk -> Float
projectionParams :: ProjectionParams 'Orthographic
projectionNear :: Float
projectionFar :: Float
..} =
  Float -> Float -> Word32 -> Word32 -> Transform
forall side.
Integral side =>
Float -> Float -> side -> side -> Transform
Projection.orthoOffCenter Float
projectionNear Float
projectionFar Word32
width Word32
height

trackOrthoPixelsCentered
  :: ( MonadReader (App Engine.GlobalHandles st) m
     , MonadResource m
     , MonadUnliftIO m
     )
  => m (Worker.Merge Box)
trackOrthoPixelsCentered :: forall st (m :: * -> *).
(MonadReader (App GlobalHandles st) m, MonadResource m,
 MonadUnliftIO m) =>
m (Merge Box)
trackOrthoPixelsCentered = do
  Var Extent2D
screen <- m (Var Extent2D)
forall st (m :: * -> *).
MonadReader (App GlobalHandles st) m =>
m (Var Extent2D)
Engine.askScreenVar
  (GetOutput (Var Extent2D) -> Box) -> Var Extent2D -> m (Merge Box)
forall (m :: * -> *) i o.
(MonadUnliftIO m, MonadResource m, HasOutput i) =>
(GetOutput i -> o) -> i -> m (Merge o)
Worker.spawnMerge1 Extent2D -> Box
GetOutput (Var Extent2D) -> Box
mkBox Var Extent2D
screen
  where
    mkBox :: Extent2D -> Box
mkBox Vk.Extent2D{Word32
$sel:width:Extent2D :: Extent2D -> Word32
width :: Word32
width, Word32
$sel:height:Extent2D :: Extent2D -> Word32
height :: Word32
height} = Box
      { position :: Vec2
position =
          -- XXX: Assuming projection uses center of the screen as origin.
          Vec2
0
      , size :: Vec2
size =
          Float -> Float -> Vec2
vec2 (Word32 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
width) (Word32 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
height)
      }


-- * 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
$cshowsPrec :: Int -> View -> ShowS
showsPrec :: Int -> View -> ShowS
$cshow :: View -> String
show :: View -> String
$cshowList :: [View] -> ShowS
showList :: [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
  , ViewOrbitalInput -> Vec3
orbitUp       :: Vec3
  , ViewOrbitalInput -> Vec3
orbitRight    :: 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
$cshowsPrec :: Int -> ViewOrbitalInput -> ShowS
showsPrec :: Int -> ViewOrbitalInput -> ShowS
$cshow :: ViewOrbitalInput -> String
show :: ViewOrbitalInput -> String
$cshowList :: [ViewOrbitalInput] -> ShowS
showList :: [ViewOrbitalInput] -> ShowS
Show)

initialOrbitalInput :: ViewOrbitalInput
initialOrbitalInput :: ViewOrbitalInput
initialOrbitalInput = ViewOrbitalInput
  { $sel:orbitAzimuth:ViewOrbitalInput :: Float
orbitAzimuth  = Float
0 -- τ/8
  , $sel:orbitAscent:ViewOrbitalInput :: Float
orbitAscent   = Float
τFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
7
  , $sel:orbitDistance:ViewOrbitalInput :: Float
orbitDistance = Float
8.0
  , $sel:orbitScale:ViewOrbitalInput :: Float
orbitScale    = Float
1
  , $sel:orbitTarget:ViewOrbitalInput :: Vec3
orbitTarget   = Vec3
0
  , $sel:orbitUp:ViewOrbitalInput :: Vec3
orbitUp       = Float -> Float -> Float -> Vec3
vec3 Float
0 (-Float
1) Float
0
  , $sel:orbitRight:ViewOrbitalInput :: Vec3
orbitRight    = Float -> Float -> Float -> Vec3
vec3 Float
1 Float
0 Float
0
  }

mkViewOrbital :: Vec3 -> ViewOrbitalInput -> View
mkViewOrbital :: Vec3 -> ViewOrbitalInput -> View
mkViewOrbital Vec3
cameraTarget ViewOrbitalInput{Float
Vec3
$sel:orbitAzimuth:ViewOrbitalInput :: ViewOrbitalInput -> Float
$sel:orbitAscent:ViewOrbitalInput :: ViewOrbitalInput -> Float
$sel:orbitDistance:ViewOrbitalInput :: ViewOrbitalInput -> Float
$sel:orbitScale:ViewOrbitalInput :: ViewOrbitalInput -> Float
$sel:orbitTarget:ViewOrbitalInput :: ViewOrbitalInput -> Vec3
$sel:orbitUp:ViewOrbitalInput :: ViewOrbitalInput -> Vec3
$sel:orbitRight:ViewOrbitalInput :: ViewOrbitalInput -> Vec3
orbitAzimuth :: Float
orbitAscent :: Float
orbitDistance :: Float
orbitScale :: Float
orbitTarget :: Vec3
orbitUp :: Vec3
orbitRight :: Vec3
..} = View{Vec3
Transform
$sel:viewTransform:View :: Transform
$sel:viewTransformInv:View :: Transform
$sel:viewPosition:View :: Vec3
$sel:viewDirection:View :: Vec3
viewTransform :: Transform
viewTransformInv :: Transform
viewPosition :: Vec3
viewDirection :: Vec3
..}
  where
    viewTransform :: Transform
viewTransform = Vec3 -> Vec3 -> Vec3 -> Transform
View.lookAt Vec3
viewPosition Vec3
cameraTarget Vec3
orbitUp
    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
orbitUp Float
orbitAzimuth Quaternion -> Quaternion -> Quaternion
forall a. Num a => a -> a -> a
*
          Vec3 -> Float -> Quaternion
Quaternion.axisAngle Vec3
orbitRight 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

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

τ :: Float
τ :: Float
τ = Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
forall a. Floating a => a
pi