module Graphics.Camera( Camera(Camera)
, cameraPosition, rawCameraNormal, rawViewUp
, viewPlaneDepth, nearDist, farDist, screenDimensions
, cameraNormal, viewUp
, cameraTransform, worldToView
, toViewPort, perspectiveProjection, rotateCoordSystem
, flipAxes
) where
import Control.Lens
import Data.Geometry.Matrix
import Data.Geometry.Point
import Data.Geometry.Transformation
import Data.Geometry.Vector
data Camera r = Camera { Camera r -> Point 3 r
_cameraPosition :: !(Point 3 r)
, Camera r -> Vector 3 r
_rawCameraNormal :: !(Vector 3 r)
, Camera r -> Vector 3 r
_rawViewUp :: !(Vector 3 r)
, Camera r -> r
_viewPlaneDepth :: !r
, Camera r -> r
_nearDist :: !r
, Camera r -> r
_farDist :: !r
, Camera r -> Vector 2 r
_screenDimensions :: !(Vector 2 r)
} deriving (Int -> Camera r -> ShowS
[Camera r] -> ShowS
Camera r -> String
(Int -> Camera r -> ShowS)
-> (Camera r -> String) -> ([Camera r] -> ShowS) -> Show (Camera r)
forall r. Show r => Int -> Camera r -> ShowS
forall r. Show r => [Camera r] -> ShowS
forall r. Show r => Camera r -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Camera r] -> ShowS
$cshowList :: forall r. Show r => [Camera r] -> ShowS
show :: Camera r -> String
$cshow :: forall r. Show r => Camera r -> String
showsPrec :: Int -> Camera r -> ShowS
$cshowsPrec :: forall r. Show r => Int -> Camera r -> ShowS
Show,Camera r -> Camera r -> Bool
(Camera r -> Camera r -> Bool)
-> (Camera r -> Camera r -> Bool) -> Eq (Camera r)
forall r. Eq r => Camera r -> Camera r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Camera r -> Camera r -> Bool
$c/= :: forall r. Eq r => Camera r -> Camera r -> Bool
== :: Camera r -> Camera r -> Bool
$c== :: forall r. Eq r => Camera r -> Camera r -> Bool
Eq,Eq (Camera r)
Eq (Camera r)
-> (Camera r -> Camera r -> Ordering)
-> (Camera r -> Camera r -> Bool)
-> (Camera r -> Camera r -> Bool)
-> (Camera r -> Camera r -> Bool)
-> (Camera r -> Camera r -> Bool)
-> (Camera r -> Camera r -> Camera r)
-> (Camera r -> Camera r -> Camera r)
-> Ord (Camera r)
Camera r -> Camera r -> Bool
Camera r -> Camera r -> Ordering
Camera r -> Camera r -> Camera r
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
forall r. Ord r => Eq (Camera r)
forall r. Ord r => Camera r -> Camera r -> Bool
forall r. Ord r => Camera r -> Camera r -> Ordering
forall r. Ord r => Camera r -> Camera r -> Camera r
min :: Camera r -> Camera r -> Camera r
$cmin :: forall r. Ord r => Camera r -> Camera r -> Camera r
max :: Camera r -> Camera r -> Camera r
$cmax :: forall r. Ord r => Camera r -> Camera r -> Camera r
>= :: Camera r -> Camera r -> Bool
$c>= :: forall r. Ord r => Camera r -> Camera r -> Bool
> :: Camera r -> Camera r -> Bool
$c> :: forall r. Ord r => Camera r -> Camera r -> Bool
<= :: Camera r -> Camera r -> Bool
$c<= :: forall r. Ord r => Camera r -> Camera r -> Bool
< :: Camera r -> Camera r -> Bool
$c< :: forall r. Ord r => Camera r -> Camera r -> Bool
compare :: Camera r -> Camera r -> Ordering
$ccompare :: forall r. Ord r => Camera r -> Camera r -> Ordering
$cp1Ord :: forall r. Ord r => Eq (Camera r)
Ord)
cameraPosition :: Lens' (Camera r) (Point 3 r)
cameraPosition :: (Point 3 r -> f (Point 3 r)) -> Camera r -> f (Camera r)
cameraPosition = (Camera r -> Point 3 r)
-> (Camera r -> Point 3 r -> Camera r)
-> Lens (Camera r) (Camera r) (Point 3 r) (Point 3 r)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Camera r -> Point 3 r
forall r. Camera r -> Point 3 r
_cameraPosition (\Camera r
cam Point 3 r
p -> Camera r
cam{_cameraPosition :: Point 3 r
_cameraPosition=Point 3 r
p})
rawCameraNormal :: Lens' (Camera r) (Vector 3 r)
rawCameraNormal :: (Vector 3 r -> f (Vector 3 r)) -> Camera r -> f (Camera r)
rawCameraNormal = (Camera r -> Vector 3 r)
-> (Camera r -> Vector 3 r -> Camera r)
-> Lens (Camera r) (Camera r) (Vector 3 r) (Vector 3 r)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Camera r -> Vector 3 r
forall r. Camera r -> Vector 3 r
_rawCameraNormal (\Camera r
cam Vector 3 r
r -> Camera r
cam{_rawCameraNormal :: Vector 3 r
_rawCameraNormal=Vector 3 r
r})
rawViewUp :: Lens' (Camera r) (Vector 3 r)
rawViewUp :: (Vector 3 r -> f (Vector 3 r)) -> Camera r -> f (Camera r)
rawViewUp = (Camera r -> Vector 3 r)
-> (Camera r -> Vector 3 r -> Camera r)
-> Lens (Camera r) (Camera r) (Vector 3 r) (Vector 3 r)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Camera r -> Vector 3 r
forall r. Camera r -> Vector 3 r
_rawViewUp (\Camera r
cam Vector 3 r
r -> Camera r
cam{_rawViewUp :: Vector 3 r
_rawViewUp=Vector 3 r
r})
viewPlaneDepth :: Lens' (Camera r) r
viewPlaneDepth :: (r -> f r) -> Camera r -> f (Camera r)
viewPlaneDepth = (Camera r -> r)
-> (Camera r -> r -> Camera r) -> Lens (Camera r) (Camera r) r r
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Camera r -> r
forall r. Camera r -> r
_viewPlaneDepth (\Camera r
cam r
v -> Camera r
cam{_viewPlaneDepth :: r
_viewPlaneDepth=r
v})
nearDist :: Lens' (Camera r) r
nearDist :: (r -> f r) -> Camera r -> f (Camera r)
nearDist = (Camera r -> r)
-> (Camera r -> r -> Camera r) -> Lens (Camera r) (Camera r) r r
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Camera r -> r
forall r. Camera r -> r
_nearDist (\Camera r
cam r
n -> Camera r
cam{_nearDist :: r
_nearDist=r
n})
farDist :: Lens' (Camera r) r
farDist :: (r -> f r) -> Camera r -> f (Camera r)
farDist = (Camera r -> r)
-> (Camera r -> r -> Camera r) -> Lens (Camera r) (Camera r) r r
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Camera r -> r
forall r. Camera r -> r
_farDist (\Camera r
cam r
f -> Camera r
cam{_farDist :: r
_farDist=r
f})
screenDimensions :: Lens' (Camera r) (Vector 2 r)
screenDimensions :: (Vector 2 r -> f (Vector 2 r)) -> Camera r -> f (Camera r)
screenDimensions = (Camera r -> Vector 2 r)
-> (Camera r -> Vector 2 r -> Camera r)
-> Lens (Camera r) (Camera r) (Vector 2 r) (Vector 2 r)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Camera r -> Vector 2 r
forall r. Camera r -> Vector 2 r
_screenDimensions (\Camera r
cam Vector 2 r
d -> Camera r
cam{_screenDimensions :: Vector 2 r
_screenDimensions=Vector 2 r
d})
cameraNormal :: Floating r => Lens' (Camera r) (Vector 3 r)
cameraNormal :: Lens' (Camera r) (Vector 3 r)
cameraNormal = (Camera r -> Vector 3 r)
-> (Camera r -> Vector 3 r -> Camera r)
-> Lens' (Camera r) (Vector 3 r)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Camera r -> Vector 3 r
forall r. Camera r -> Vector 3 r
_rawCameraNormal (\Camera r
c Vector 3 r
n -> Camera r
c { _rawCameraNormal :: Vector 3 r
_rawCameraNormal = Vector 3 r -> Vector 3 r
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm Vector 3 r
n} )
viewUp :: Floating r => Lens' (Camera r) (Vector 3 r)
viewUp :: Lens' (Camera r) (Vector 3 r)
viewUp = (Camera r -> Vector 3 r)
-> (Camera r -> Vector 3 r -> Camera r)
-> Lens' (Camera r) (Vector 3 r)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Camera r -> Vector 3 r
forall r. Camera r -> Vector 3 r
_rawViewUp (\Camera r
c Vector 3 r
n -> Camera r
c { _rawViewUp :: Vector 3 r
_rawViewUp = Vector 3 r -> Vector 3 r
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm Vector 3 r
n})
cameraTransform :: Fractional r => Camera r -> Transformation 3 r
cameraTransform :: Camera r -> Transformation 3 r
cameraTransform Camera r
c = Camera r -> Transformation 3 r
forall r. Fractional r => Camera r -> Transformation 3 r
toViewPort Camera r
c
Transformation 3 r -> Transformation 3 r -> Transformation 3 r
forall r (d :: Nat).
(Num r, Arity (d + 1)) =>
Transformation d r -> Transformation d r -> Transformation d r
|.| Camera r -> Transformation 3 r
forall r. Fractional r => Camera r -> Transformation 3 r
perspectiveProjection Camera r
c
Transformation 3 r -> Transformation 3 r -> Transformation 3 r
forall r (d :: Nat).
(Num r, Arity (d + 1)) =>
Transformation d r -> Transformation d r -> Transformation d r
|.| Camera r -> Transformation 3 r
forall r. Fractional r => Camera r -> Transformation 3 r
worldToView Camera r
c
worldToView :: Fractional r => Camera r -> Transformation 3 r
worldToView :: Camera r -> Transformation 3 r
worldToView Camera r
c = Camera r -> Transformation 3 r
forall r. Num r => Camera r -> Transformation 3 r
rotateCoordSystem Camera r
c Transformation 3 r -> Transformation 3 r -> Transformation 3 r
forall r (d :: Nat).
(Num r, Arity (d + 1)) =>
Transformation d r -> Transformation d r -> Transformation d r
|.| Vector 3 r -> Transformation 3 r
forall r (d :: Nat).
(Num r, Arity d, Arity (d + 1)) =>
Vector d r -> Transformation d r
translation ((-r
1) r -> Vector 3 r -> Vector 3 r
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ Camera r
cCamera r
-> Getting (Vector 3 r) (Camera r) (Vector 3 r) -> Vector 3 r
forall s a. s -> Getting a s a -> a
^.(Point 3 r -> Const (Vector 3 r) (Point 3 r))
-> Camera r -> Const (Vector 3 r) (Camera r)
forall r. Lens' (Camera r) (Point 3 r)
cameraPosition((Point 3 r -> Const (Vector 3 r) (Point 3 r))
-> Camera r -> Const (Vector 3 r) (Camera r))
-> ((Vector 3 r -> Const (Vector 3 r) (Vector 3 r))
-> Point 3 r -> Const (Vector 3 r) (Point 3 r))
-> Getting (Vector 3 r) (Camera r) (Vector 3 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vector 3 r -> Const (Vector 3 r) (Vector 3 r))
-> Point 3 r -> Const (Vector 3 r) (Point 3 r)
forall (d :: Nat) r r'.
Lens (Point d r) (Point d r') (Vector d r) (Vector d r')
vector)
toViewPort :: Fractional r => Camera r -> Transformation 3 r
toViewPort :: Camera r -> Transformation 3 r
toViewPort Camera r
c = Matrix 4 4 r -> Transformation 3 r
forall (d :: Nat) r. Matrix (d + 1) (d + 1) r -> Transformation d r
Transformation (Matrix 4 4 r -> Transformation 3 r)
-> (Vector 4 (Vector 4 r) -> Matrix 4 4 r)
-> Vector 4 (Vector 4 r)
-> Transformation 3 r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector 4 (Vector 4 r) -> Matrix 4 4 r
forall (n :: Nat) (m :: Nat) r.
Vector n (Vector m r) -> Matrix n m r
Matrix
(Vector 4 (Vector 4 r) -> Transformation 3 r)
-> Vector 4 (Vector 4 r) -> Transformation 3 r
forall a b. (a -> b) -> a -> b
$ Vector 4 r
-> Vector 4 r -> Vector 4 r -> Vector 4 r -> Vector 4 (Vector 4 r)
forall r. r -> r -> r -> r -> Vector 4 r
Vector4 (r -> r -> r -> r -> Vector 4 r
forall r. r -> r -> r -> r -> Vector 4 r
Vector4 (r
wr -> r -> r
forall a. Fractional a => a -> a -> a
/r
2) r
0 r
0 r
0)
(r -> r -> r -> r -> Vector 4 r
forall r. r -> r -> r -> r -> Vector 4 r
Vector4 r
0 (r
hr -> r -> r
forall a. Fractional a => a -> a -> a
/r
2) r
0 r
0)
(r -> r -> r -> r -> Vector 4 r
forall r. r -> r -> r -> r -> Vector 4 r
Vector4 r
0 r
0 (r
1r -> r -> r
forall a. Fractional a => a -> a -> a
/r
2) (r
1r -> r -> r
forall a. Fractional a => a -> a -> a
/r
2))
(r -> r -> r -> r -> Vector 4 r
forall r. r -> r -> r -> r -> Vector 4 r
Vector4 r
0 r
0 r
0 r
1)
where
Vector2 r
w r
h = Camera r
cCamera r
-> Getting (Vector 2 r) (Camera r) (Vector 2 r) -> Vector 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Vector 2 r) (Camera r) (Vector 2 r)
forall r. Lens' (Camera r) (Vector 2 r)
screenDimensions
perspectiveProjection :: Fractional r => Camera r -> Transformation 3 r
perspectiveProjection :: Camera r -> Transformation 3 r
perspectiveProjection Camera r
c = Matrix 4 4 r -> Transformation 3 r
forall (d :: Nat) r. Matrix (d + 1) (d + 1) r -> Transformation d r
Transformation (Matrix 4 4 r -> Transformation 3 r)
-> (Vector 4 (Vector 4 r) -> Matrix 4 4 r)
-> Vector 4 (Vector 4 r)
-> Transformation 3 r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector 4 (Vector 4 r) -> Matrix 4 4 r
forall (n :: Nat) (m :: Nat) r.
Vector n (Vector m r) -> Matrix n m r
Matrix (Vector 4 (Vector 4 r) -> Transformation 3 r)
-> Vector 4 (Vector 4 r) -> Transformation 3 r
forall a b. (a -> b) -> a -> b
$
Vector 4 r
-> Vector 4 r -> Vector 4 r -> Vector 4 r -> Vector 4 (Vector 4 r)
forall r. r -> r -> r -> r -> Vector 4 r
Vector4 (r -> r -> r -> r -> Vector 4 r
forall r. r -> r -> r -> r -> Vector 4 r
Vector4 (-r
nr -> r -> r
forall a. Fractional a => a -> a -> a
/r
rx) r
0 r
0 r
0)
(r -> r -> r -> r -> Vector 4 r
forall r. r -> r -> r -> r -> Vector 4 r
Vector4 r
0 (-r
nr -> r -> r
forall a. Fractional a => a -> a -> a
/r
ry) r
0 r
0)
(r -> r -> r -> r -> Vector 4 r
forall r. r -> r -> r -> r -> Vector 4 r
Vector4 r
0 r
0 (-(r
nr -> r -> r
forall a. Num a => a -> a -> a
+r
f)r -> r -> r
forall a. Fractional a => a -> a -> a
/(r
nr -> r -> r
forall a. Num a => a -> a -> a
-r
f)) (-r
2r -> r -> r
forall a. Num a => a -> a -> a
*r
nr -> r -> r
forall a. Num a => a -> a -> a
*r
fr -> r -> r
forall a. Fractional a => a -> a -> a
/(r
nr -> r -> r
forall a. Num a => a -> a -> a
-r
f)))
(r -> r -> r -> r -> Vector 4 r
forall r. r -> r -> r -> r -> Vector 4 r
Vector4 r
0 r
0 r
1 r
0)
where
n :: r
n = Camera r
cCamera r -> Getting r (Camera r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Camera r) r
forall r. Lens' (Camera r) r
nearDist
f :: r
f = Camera r
cCamera r -> Getting r (Camera r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Camera r) r
forall r. Lens' (Camera r) r
farDist
Vector2 r
rx r
ry = (r -> r -> r
forall a. Fractional a => a -> a -> a
/r
2) (r -> r) -> Vector 2 r -> Vector 2 r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Camera r
cCamera r
-> Getting (Vector 2 r) (Camera r) (Vector 2 r) -> Vector 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Vector 2 r) (Camera r) (Vector 2 r)
forall r. Lens' (Camera r) (Vector 2 r)
screenDimensions
rotateCoordSystem :: Num r => Camera r -> Transformation 3 r
rotateCoordSystem :: Camera r -> Transformation 3 r
rotateCoordSystem Camera r
c = Vector 3 (Vector 3 r) -> Transformation 3 r
forall r. Num r => Vector 3 (Vector 3 r) -> Transformation 3 r
rotateTo (Vector 3 (Vector 3 r) -> Transformation 3 r)
-> Vector 3 (Vector 3 r) -> Transformation 3 r
forall a b. (a -> b) -> a -> b
$ Vector 3 r -> Vector 3 r -> Vector 3 r -> Vector 3 (Vector 3 r)
forall r. r -> r -> r -> Vector 3 r
Vector3 Vector 3 r
u Vector 3 r
v Vector 3 r
n
where
u :: Vector 3 r
u = (Camera r
cCamera r
-> Getting (Vector 3 r) (Camera r) (Vector 3 r) -> Vector 3 r
forall s a. s -> Getting a s a -> a
^.Getting (Vector 3 r) (Camera r) (Vector 3 r)
forall r. Lens' (Camera r) (Vector 3 r)
rawViewUp) Vector 3 r -> Vector 3 r -> Vector 3 r
forall r. Num r => Vector 3 r -> Vector 3 r -> Vector 3 r
`cross` Vector 3 r
n
v :: Vector 3 r
v = Vector 3 r
n Vector 3 r -> Vector 3 r -> Vector 3 r
forall r. Num r => Vector 3 r -> Vector 3 r -> Vector 3 r
`cross` Vector 3 r
u
n :: Vector 3 r
n = (-r
1) r -> Vector 3 r -> Vector 3 r
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ Camera r
cCamera r
-> Getting (Vector 3 r) (Camera r) (Vector 3 r) -> Vector 3 r
forall s a. s -> Getting a s a -> a
^.Getting (Vector 3 r) (Camera r) (Vector 3 r)
forall r. Lens' (Camera r) (Vector 3 r)
rawCameraNormal
flipAxes :: Num r => Transformation 3 r
flipAxes :: Transformation 3 r
flipAxes = Matrix 4 4 r -> Transformation 3 r
forall (d :: Nat) r. Matrix (d + 1) (d + 1) r -> Transformation d r
Transformation (Matrix 4 4 r -> Transformation 3 r)
-> (Vector 4 (Vector 4 r) -> Matrix 4 4 r)
-> Vector 4 (Vector 4 r)
-> Transformation 3 r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector 4 (Vector 4 r) -> Matrix 4 4 r
forall (n :: Nat) (m :: Nat) r.
Vector n (Vector m r) -> Matrix n m r
Matrix
(Vector 4 (Vector 4 r) -> Transformation 3 r)
-> Vector 4 (Vector 4 r) -> Transformation 3 r
forall a b. (a -> b) -> a -> b
$ Vector 4 r
-> Vector 4 r -> Vector 4 r -> Vector 4 r -> Vector 4 (Vector 4 r)
forall r. r -> r -> r -> r -> Vector 4 r
Vector4 (r -> r -> r -> r -> Vector 4 r
forall r. r -> r -> r -> r -> Vector 4 r
Vector4 r
1 r
0 r
0 r
0)
(r -> r -> r -> r -> Vector 4 r
forall r. r -> r -> r -> r -> Vector 4 r
Vector4 r
0 r
0 r
1 r
0)
(r -> r -> r -> r -> Vector 4 r
forall r. r -> r -> r -> r -> Vector 4 r
Vector4 r
0 r
1 r
0 r
0)
(r -> r -> r -> r -> Vector 4 r
forall r. r -> r -> r -> r -> Vector 4 r
Vector4 r
0 r
0 r
0 r
1)