module Diagrams.TwoD.Deform where

import           Control.Lens

import           Diagrams.Deform

import           Linear.V2
import           Linear.Vector

-- | The parallel projection onto the plane x=0
parallelX0 :: (R1 v, Num n) => Deformation v v n
parallelX0 :: Deformation v v n
parallelX0 = (Point v n -> Point v n) -> Deformation v v n
forall (v :: * -> *) (u :: * -> *) n.
(Point v n -> Point u n) -> Deformation v u n
Deformation ((n -> Identity n) -> Point v n -> Identity (Point v n)
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x ((n -> Identity n) -> Point v n -> Identity (Point v n))
-> n -> Point v n -> Point v n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ n
0)

-- | The perspective division onto the plane x=1 along lines going
-- through the origin.
perspectiveX1 :: (R1 v, Functor v, Fractional n) => Deformation v v n
perspectiveX1 :: Deformation v v n
perspectiveX1 = (Point v n -> Point v n) -> Deformation v v n
forall (v :: * -> *) (u :: * -> *) n.
(Point v n -> Point u n) -> Deformation v u n
Deformation ((Point v n -> Point v n) -> Deformation v v n)
-> (Point v n -> Point v n) -> Deformation v v n
forall a b. (a -> b) -> a -> b
$ \Point v n
p -> Point v n
p Point v n -> n -> Point v n
forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ (Point v n
p Point v n -> Getting n (Point v n) n -> n
forall s a. s -> Getting a s a -> a
^. Getting n (Point v n) n
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x)

-- | The parallel projection onto the plane y=0
parallelY0 :: (R2 v, Num n) => Deformation v v n
parallelY0 :: Deformation v v n
parallelY0 = (Point v n -> Point v n) -> Deformation v v n
forall (v :: * -> *) (u :: * -> *) n.
(Point v n -> Point u n) -> Deformation v u n
Deformation ((n -> Identity n) -> Point v n -> Identity (Point v n)
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y ((n -> Identity n) -> Point v n -> Identity (Point v n))
-> n -> Point v n -> Point v n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ n
0)

-- | The perspective division onto the plane y=1 along lines going
-- through the origin.
perspectiveY1 :: (R2 v, Functor v, Floating n) => Deformation v v n
perspectiveY1 :: Deformation v v n
perspectiveY1 = (Point v n -> Point v n) -> Deformation v v n
forall (v :: * -> *) (u :: * -> *) n.
(Point v n -> Point u n) -> Deformation v u n
Deformation ((Point v n -> Point v n) -> Deformation v v n)
-> (Point v n -> Point v n) -> Deformation v v n
forall a b. (a -> b) -> a -> b
$ \Point v n
p -> Point v n
p Point v n -> n -> Point v n
forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ (Point v n
p Point v n -> Getting n (Point v n) n -> n
forall s a. s -> Getting a s a -> a
^. Getting n (Point v n) n
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y)

-- | The viewing transform for a viewer facing along the positive X
-- axis.  X coördinates stay fixed, while Y coördinates are compressed
-- with increasing distance.  @asDeformation (translation unitX) <>
-- parallelX0 <> frustrumX = perspectiveX1@
facingX :: (R1 v, Functor v, Fractional n) => Deformation v v n
facingX :: Deformation v v n
facingX = (Point v n -> Point v n) -> Deformation v v n
forall (v :: * -> *) (u :: * -> *) n.
(Point v n -> Point u n) -> Deformation v u n
Deformation ((Point v n -> Point v n) -> Deformation v v n)
-> (Point v n -> Point v n) -> Deformation v v n
forall a b. (a -> b) -> a -> b
$
  \Point v n
p -> let x :: n
x = Point v n
p Point v n -> Getting n (Point v n) n -> n
forall s a. s -> Getting a s a -> a
^. Getting n (Point v n) n
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x
        in  Point v n
p Point v n -> n -> Point v n
forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ n
x Point v n -> (Point v n -> Point v n) -> Point v n
forall a b. a -> (a -> b) -> b
& (n -> Identity n) -> Point v n -> Identity (Point v n)
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x ((n -> Identity n) -> Point v n -> Identity (Point v n))
-> n -> Point v n -> Point v n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ n
x

facingY :: (R2 v, Functor v, Fractional n) => Deformation v v n
facingY :: Deformation v v n
facingY = (Point v n -> Point v n) -> Deformation v v n
forall (v :: * -> *) (u :: * -> *) n.
(Point v n -> Point u n) -> Deformation v u n
Deformation ((Point v n -> Point v n) -> Deformation v v n)
-> (Point v n -> Point v n) -> Deformation v v n
forall a b. (a -> b) -> a -> b
$
  \Point v n
p -> let y :: n
y = Point v n
p Point v n -> Getting n (Point v n) n -> n
forall s a. s -> Getting a s a -> a
^. Getting n (Point v n) n
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y
        in  Point v n
p Point v n -> n -> Point v n
forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ n
y Point v n -> (Point v n -> Point v n) -> Point v n
forall a b. a -> (a -> b) -> b
& (n -> Identity n) -> Point v n -> Identity (Point v n)
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y ((n -> Identity n) -> Point v n -> Identity (Point v n))
-> n -> Point v n -> Point v n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ n
y