{-# OPTIONS -Wall #-}

module Raylib.Util.Camera
  ( getCameraForward,
    getCameraUp,
    getCameraRight,
    cameraMove,
    cameraMoveForward,
    cameraMoveUp,
    cameraMoveRight,
    cameraRotate,
    cameraYaw,
    cameraPitch,
    cameraRoll,
    getCameraViewMatrix,
    getCameraProjectionMatrix,
  )
where

import Raylib.Types (Camera, Camera3D (..), CameraProjection (CameraOrthographic, CameraPerspective), Matrix, Vector3 (..))
import Raylib.Util.Math (Vector (..), clamp, deg2Rad, matrixLookAt, matrixOrtho, matrixPerspective, vector3Angle, vector3CrossProduct, vector3RotateByAxisAngle)

-- | The camera's forward vector (normalized)

getCameraForward :: Camera -> Vector3
getCameraForward :: Camera -> Vector3
getCameraForward Camera
cam = forall a. Vector a => a -> a
vectorNormalize forall a b. (a -> b) -> a -> b
$ Camera -> Vector3
camera3D'target Camera
cam forall a. Vector a => a -> a -> a
|-| Camera -> Vector3
camera3D'position Camera
cam

-- | The camera's up vector (normalized)

getCameraUp :: Camera -> Vector3
getCameraUp :: Camera -> Vector3
getCameraUp Camera
cam = forall a. Vector a => a -> a
vectorNormalize forall a b. (a -> b) -> a -> b
$ Camera -> Vector3
camera3D'up Camera
cam

-- | The camera's right vector (normalized)

getCameraRight :: Camera -> Vector3
getCameraRight :: Camera -> Vector3
getCameraRight Camera
cam = Vector3 -> Vector3 -> Vector3
vector3CrossProduct (Camera -> Vector3
getCameraForward Camera
cam) (Camera -> Vector3
getCameraUp Camera
cam)

-- | Move the camera by a specific vector

cameraMove :: Camera -> Vector3 -> Camera
cameraMove :: Camera -> Vector3 -> Camera
cameraMove Camera
cam Vector3
dir =
  Camera
cam {camera3D'position :: Vector3
camera3D'position = Camera -> Vector3
camera3D'position Camera
cam forall a. Vector a => a -> a -> a
|+| Vector3
dir, camera3D'target :: Vector3
camera3D'target = Camera -> Vector3
camera3D'target Camera
cam forall a. Vector a => a -> a -> a
|+| Vector3
dir}

-- | Move the camera in its forward direction

cameraMoveForward ::
  Camera ->
  -- | Distance to move

  Float ->
  -- | Move in world plane (i.e. no vertical movement if enabled)

  Bool ->
  Camera
cameraMoveForward :: Camera -> Float -> Bool -> Camera
cameraMoveForward Camera
cam Float
distance Bool
moveInWorldPlane =
  Camera -> Vector3 -> Camera
cameraMove Camera
cam (Vector3
forward forall a. Vector a => a -> Float -> a
|* Float
distance)
  where
    forward :: Vector3
forward = if Bool
moveInWorldPlane then Vector3
camForward {vector3'y :: Float
vector3'y = Float
0} else Vector3
camForward
    camForward :: Vector3
camForward = Camera -> Vector3
getCameraForward Camera
cam

-- | Move the camera in its up direction

cameraMoveUp ::
  Camera ->
  -- | Distance to move

  Float ->
  Camera
cameraMoveUp :: Camera -> Float -> Camera
cameraMoveUp Camera
cam Float
distance =
  Camera -> Vector3 -> Camera
cameraMove Camera
cam (Vector3
up forall a. Vector a => a -> Float -> a
|* Float
distance)
  where
    up :: Vector3
up = Camera -> Vector3
getCameraUp Camera
cam

-- | Move the camera in its right direction

cameraMoveRight ::
  Camera ->
  -- | Distance to move

  Float ->
  -- | Move in world plane (i.e. no vertical movement if enabled)

  Bool ->
  Camera
cameraMoveRight :: Camera -> Float -> Bool -> Camera
cameraMoveRight Camera
cam Float
distance Bool
moveInWorldPlane =
  Camera -> Vector3 -> Camera
cameraMove Camera
cam (Vector3
right forall a. Vector a => a -> Float -> a
|* Float
distance)
  where
    right :: Vector3
right = if Bool
moveInWorldPlane then Vector3
camRight {vector3'y :: Float
vector3'y = Float
0} else Vector3
camRight
    camRight :: Vector3
camRight = Camera -> Vector3
getCameraRight Camera
cam

-- | Rotate the camera using an axis and angle

cameraRotate ::
  Camera ->
  -- | Axis of rotation

  Vector3 ->
  -- | Angle to rotate by

  Float ->
  -- | Rotate around target (if false, the camera rotates around its position)

  Bool ->
  Camera
cameraRotate :: Camera -> Vector3 -> Float -> Bool -> Camera
cameraRotate Camera
cam Vector3
axis Float
angle Bool
rotateAroundTarget =
  Camera
cam
    { camera3D'position :: Vector3
camera3D'position = if Bool
rotateAroundTarget then Vector3
target forall a. Vector a => a -> a -> a
|-| Vector3
viewRot else Vector3
pos,
      camera3D'target :: Vector3
camera3D'target = if Bool
rotateAroundTarget then Vector3
target else Vector3
pos forall a. Vector a => a -> a -> a
|+| Vector3
viewRot
    }
  where
    viewVec :: Vector3
viewVec = Vector3
target forall a. Vector a => a -> a -> a
|-| Vector3
pos
    viewRot :: Vector3
viewRot = Vector3 -> Vector3 -> Float -> Vector3
vector3RotateByAxisAngle Vector3
viewVec Vector3
axis Float
angle
    pos :: Vector3
pos = Camera -> Vector3
camera3D'position Camera
cam
    target :: Vector3
target = Camera -> Vector3
camera3D'target Camera
cam

-- | Rotate the camera around its up vector.

--   Yaw is "looking left and right".

cameraYaw ::
  Camera ->
  -- | Angle in radians

  Float ->
  -- | Rotate around target (if false, the camera rotates around its position)

  Bool ->
  Camera
cameraYaw :: Camera -> Float -> Bool -> Camera
cameraYaw Camera
cam Float
angle Bool
rotateAroundTarget =
  Camera
cam
    { camera3D'position :: Vector3
camera3D'position = if Bool
rotateAroundTarget then Vector3
target forall a. Vector a => a -> a -> a
|-| Vector3
viewRot else Vector3
pos,
      camera3D'target :: Vector3
camera3D'target = if Bool
rotateAroundTarget then Vector3
target else Vector3
pos forall a. Vector a => a -> a -> a
|+| Vector3
viewRot
    }
  where
    viewVec :: Vector3
viewVec = Vector3
target forall a. Vector a => a -> a -> a
|-| Vector3
pos
    viewRot :: Vector3
viewRot = Vector3 -> Vector3 -> Float -> Vector3
vector3RotateByAxisAngle Vector3
viewVec (Camera -> Vector3
getCameraUp Camera
cam) Float
angle
    pos :: Vector3
pos = Camera -> Vector3
camera3D'position Camera
cam
    target :: Vector3
target = Camera -> Vector3
camera3D'target Camera
cam

-- | Rotate the camera around its right vector.

--   Pitch is "looking up and down".

cameraPitch ::
  Camera ->
  -- | Angle in radians

  Float ->
  -- | Lock view (prevents camera overrotation, aka "somersaults")

  Bool ->
  -- | Rotate around target (if false, the camera rotates around its position)

  Bool ->
  -- | Rotate the camera's up vector to match the new pitch

  Bool ->
  Camera
cameraPitch :: Camera -> Float -> Bool -> Bool -> Bool -> Camera
cameraPitch Camera
cam Float
angle Bool
lockView Bool
rotateAroundTarget Bool
rotateUp =
  Camera
cam
    { camera3D'position :: Vector3
camera3D'position = if Bool
rotateAroundTarget then Vector3
target forall a. Vector a => a -> a -> a
|-| Vector3
viewRot else Vector3
pos,
      camera3D'target :: Vector3
camera3D'target = if Bool
rotateAroundTarget then Vector3
target else Vector3
pos forall a. Vector a => a -> a -> a
|+| Vector3
viewRot,
      camera3D'up :: Vector3
camera3D'up = if Bool -> Bool
not Bool
rotateUp then Vector3
up else Vector3 -> Vector3 -> Float -> Vector3
vector3RotateByAxisAngle Vector3
up Vector3
right Float
angle'
    }
  where
    angle' :: Float
angle' = if Bool -> Bool
not Bool
lockView then Float
angle else Float -> Float -> Float -> Float
clamp Float
angle Float
maxAngleDown Float
maxAngleUp
    maxAngleUp :: Float
maxAngleUp = Vector3 -> Vector3 -> Float
vector3Angle Vector3
up Vector3
viewVec forall a. Num a => a -> a -> a
- Float
0.001
    maxAngleDown :: Float
maxAngleDown = (- Vector3 -> Vector3 -> Float
vector3Angle (forall a. Vector a => a -> a
additiveInverse Vector3
up) Vector3
viewVec) forall a. Num a => a -> a -> a
+ Float
0.001

    viewVec :: Vector3
viewVec = Vector3
target forall a. Vector a => a -> a -> a
|-| Vector3
pos
    viewRot :: Vector3
viewRot = Vector3 -> Vector3 -> Float -> Vector3
vector3RotateByAxisAngle Vector3
viewVec Vector3
right Float
angle'

    pos :: Vector3
pos = Camera -> Vector3
camera3D'position Camera
cam
    target :: Vector3
target = Camera -> Vector3
camera3D'target Camera
cam
    up :: Vector3
up = Camera -> Vector3
getCameraUp Camera
cam
    right :: Vector3
right = Camera -> Vector3
getCameraRight Camera
cam

-- | Rotates the camera around its forward vector.

--   Roll is "turning your head sideways to the left or right".

cameraRoll ::
  Camera ->
  -- | Angle in radians

  Float ->
  Camera
cameraRoll :: Camera -> Float -> Camera
cameraRoll Camera
cam Float
angle =
  Camera
cam
    { camera3D'up :: Vector3
camera3D'up = Vector3 -> Vector3 -> Float -> Vector3
vector3RotateByAxisAngle Vector3
up Vector3
forward Float
angle
    }
  where
    forward :: Vector3
forward = Camera -> Vector3
getCameraForward Camera
cam
    up :: Vector3
up = Camera -> Vector3
getCameraUp Camera
cam

-- | View matrix from camera

getCameraViewMatrix :: Camera -> Matrix
getCameraViewMatrix :: Camera -> Matrix
getCameraViewMatrix Camera
cam = Vector3 -> Vector3 -> Vector3 -> Matrix
matrixLookAt (Camera -> Vector3
camera3D'position Camera
cam) (Camera -> Vector3
camera3D'target Camera
cam) (Camera -> Vector3
camera3D'up Camera
cam)

-- | Projection matrix from camera

getCameraProjectionMatrix ::
  Camera ->
  -- | Aspect ratio

  Float ->
  -- | Near clipping plane distance (recommended: 0.01)

  Float ->
  -- | Far clipping plane distance (recommended: 1000)

  Float ->
  Matrix
getCameraProjectionMatrix :: Camera -> Float -> Float -> Float -> Matrix
getCameraProjectionMatrix Camera
cam Float
aspect Float
near Float
far =
  case Camera -> CameraProjection
camera3D'projection Camera
cam of
    CameraProjection
CameraPerspective -> Float -> Float -> Float -> Float -> Matrix
matrixPerspective (Camera -> Float
camera3D'fovy Camera
cam forall a. Num a => a -> a -> a
* Float
deg2Rad) Float
aspect Float
near Float
far
    CameraProjection
CameraOrthographic -> Float -> Float -> Float -> Float -> Float -> Float -> Matrix
matrixOrtho (- Float
right) Float
right (- Float
top) Float
top Float
near Float
far
      where
        top :: Float
top = Camera -> Float
camera3D'fovy Camera
cam forall a. Fractional a => a -> a -> a
/ Float
2
        right :: Float
right = Float
top forall a. Num a => a -> a -> a
* Float
aspect