--------------------------------------------------------------------------------
-- |
-- Module      :  Camera
-- Copyright   :  (c) Vladimir Lopatin 2022
-- License     :  BSD-3-Clause
--
-- Maintainer  :  Vladimir Lopatin <madjestic13@gmail.com>
-- Stability   :  provisional
-- Portability :  portable
--
-- A basic camera structure.
--
--------------------------------------------------------------------------------


{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE Arrows #-}

module Graphics.RedViz.Camera
  ( Camera (..)
  , defaultCam
  , controller
  , mouseS
  , keyboardRS
  , keyboardTS
  , defaultCamController
  ) where

import Control.Lens
import Linear                    (V4 (..))
import Linear.V3

import Graphics.RedViz.Controllable
import Graphics.RedViz.Input.Keyboard

-- import Debug.Trace as DT

data Camera =
     Camera
     { Camera -> String
_name       :: String
     , Camera -> Double
_apt        :: Double
     , Camera -> Double
_foc        :: Double 
     , Camera -> Controllable
_controller :: Controllable
     , Camera -> V3 Double
_mouseS     :: V3 Double -- mouse    "sensitivity"
     , Camera -> V3 Double
_keyboardRS :: V3 Double -- keyboard "rotation sensitivity"
     , Camera -> V3 Double
_keyboardTS :: V3 Double -- keyboard "translation sensitivity"
     } 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
showList :: [Camera] -> ShowS
$cshowList :: [Camera] -> ShowS
show :: Camera -> String
$cshow :: Camera -> String
showsPrec :: Int -> Camera -> ShowS
$cshowsPrec :: Int -> Camera -> ShowS
Show

$(makeLenses ''Camera)

defaultCam :: Camera
defaultCam :: Camera
defaultCam =
  String
-> Double
-> Double
-> Controllable
-> V3 Double
-> V3 Double
-> V3 Double
-> Camera
Camera
  String
"PlayerCamera" -- Player Camera
  Double
50.0
  Double
100.0
  Controllable
defaultCamController
  V3 Double
1.0
  V3 Double
1.0
  V3 Double
1.0

defaultCamController :: Controllable
defaultCamController :: Controllable
defaultCamController =
  ( (Double, Double)
-> M44 Double -> V3 Double -> V3 Double -> Device -> Controllable
Controller
    (Double
0,Double
0)
    -- (transpose (identity :: M44 Double))
    (
      (V4 Double -> V4 Double -> V4 Double -> V4 Double -> M44 Double
forall a. a -> a -> a -> a -> V4 a
V4
        (Double -> Double -> Double -> Double -> V4 Double
forall a. a -> a -> a -> a -> V4 a
V4 Double
1 Double
0 Double
0 Double
0)
        (Double -> Double -> Double -> Double -> V4 Double
forall a. a -> a -> a -> a -> V4 a
V4 Double
0 Double
1 Double
0 Double
0) -- <- . . . y ...
        (Double -> Double -> Double -> Double -> V4 Double
forall a. a -> a -> a -> a -> V4 a
V4 Double
0 Double
0 Double
1 Double
0) -- <- . . . z-component of transform
        (Double -> Double -> Double -> Double -> V4 Double
forall a. a -> a -> a -> a -> V4 a
V4 Double
0 Double
0 Double
0 Double
1)))
    (Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
0 Double
0 Double
0) -- velocity
    (Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
0 Double
0 Double
0) -- rotation
    (Keyboard -> Mouse -> Device
Device (Keys -> [V3 Double] -> Keyboard
Keyboard Keys
keys0 [V3 Double]
kvs0) (Maybe (Double, Double)
-> Maybe (Double, Double)
-> (Double, Double)
-> (Double, Double)
-> Bool
-> [V3 Double]
-> Mouse
Mouse Maybe (Double, Double)
forall a. Maybe a
Nothing Maybe (Double, Double)
forall a. Maybe a
Nothing (Double
0,Double
0) (Double
0.0, Double
0.0) Bool
False [V3 Double]
forall a. [a]
mvs0 )))
  where
    mvs0 :: [a]
mvs0   = [] --undefined
    -- mvs0 - mouse vectors
    keys0 :: Keys
keys0  = ( Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Keys
Keys Bool
False Bool
False Bool
False Bool
False Bool
False Bool
False Bool
False Bool
False Bool
False Bool
False Bool
False Bool
False Bool
False Bool
False Bool
False Bool
False Bool
False )
    -- kvs0 - key vectors keyVecs
    kvs0 :: [V3 Double]
kvs0   = [ V3 Double
fVel, V3 Double
bVel, V3 Double
lVel, V3 Double
rVel, V3 Double
uVel, V3 Double
dVel, V3 Double
pPitch, V3 Double
nPitch, V3 Double
pYaw, V3 Double
nYaw, V3 Double
pRoll, V3 Double
nRoll ]
    fVel :: V3 Double
fVel   = Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 ( Double
0  )( Double
0  )( Double
0.1)   -- forwards  velocity
    bVel :: V3 Double
bVel   = Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 ( Double
0  )( Double
0  )(-Double
0.1)   -- backwards velocity
    lVel :: V3 Double
lVel   = Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 ( Double
0.1)( Double
0  )( Double
0  )   -- left      velocity
    rVel :: V3 Double
rVel   = Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 (-Double
0.1)( Double
0  )( Double
0  )   -- right     velocity
    uVel :: V3 Double
uVel   = Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 ( Double
0  )(-Double
0.1)( Double
0  )   -- right     velocity
    dVel :: V3 Double
dVel   = Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 ( Double
0  )( Double
0.1)( Double
0  )   -- right     velocity
    pPitch :: V3 Double
pPitch = Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 (-Double
1.0)( Double
0  )( Double
0  )   -- positive  pitch
    nPitch :: V3 Double
nPitch = Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 ( Double
1.0)( Double
0  )( Double
0  )   -- negative  pitch
    pYaw :: V3 Double
pYaw   = Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 ( Double
0  )(-Double
1.0)( Double
0  )   -- positive  yaw
    nYaw :: V3 Double
nYaw   = Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 ( Double
0  )( Double
1.0)( Double
0  )   -- negative  yaw
    pRoll :: V3 Double
pRoll  = Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 ( Double
0  )(  Double
0 )(-Double
1.0)   -- positive  roll
    nRoll :: V3 Double
nRoll  = Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 ( Double
0  )(  Double
0 )( Double
1.0)   -- negative  roll