{-# LANGUAGE DeriveFunctor        #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE UndecidableInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.Direction
-- Copyright   :  (c) 2014 diagrams-lib team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- Type for representing directions, polymorphic in vector space
--
-----------------------------------------------------------------------------

module Diagrams.Direction
       ( Direction
       , _Dir
       , direction, dir, fromDirection, fromDir
       , angleBetweenDirs
       , dirBetween
       ) where

import           Control.Lens   (Iso', iso)

import           Diagrams.Angle
import           Diagrams.Core

import           Linear.Affine
import           Linear.Metric
import           Linear.Vector

--------------------------------------------------------------------------------
-- Direction

-- | A vector is described by a @Direction@ and a magnitude.  So we
-- can think of a @Direction@ as a vector that has forgotten its
-- magnitude.  @Direction@s can be used with 'fromDirection' and the
-- lenses provided by its instances.
newtype Direction v n = Dir (v n)
  deriving (ReadPrec [Direction v n]
ReadPrec (Direction v n)
Int -> ReadS (Direction v n)
ReadS [Direction v n]
(Int -> ReadS (Direction v n))
-> ReadS [Direction v n]
-> ReadPrec (Direction v n)
-> ReadPrec [Direction v n]
-> Read (Direction v n)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (v :: * -> *) n. Read (v n) => ReadPrec [Direction v n]
forall (v :: * -> *) n. Read (v n) => ReadPrec (Direction v n)
forall (v :: * -> *) n. Read (v n) => Int -> ReadS (Direction v n)
forall (v :: * -> *) n. Read (v n) => ReadS [Direction v n]
$creadsPrec :: forall (v :: * -> *) n. Read (v n) => Int -> ReadS (Direction v n)
readsPrec :: Int -> ReadS (Direction v n)
$creadList :: forall (v :: * -> *) n. Read (v n) => ReadS [Direction v n]
readList :: ReadS [Direction v n]
$creadPrec :: forall (v :: * -> *) n. Read (v n) => ReadPrec (Direction v n)
readPrec :: ReadPrec (Direction v n)
$creadListPrec :: forall (v :: * -> *) n. Read (v n) => ReadPrec [Direction v n]
readListPrec :: ReadPrec [Direction v n]
Read, Int -> Direction v n -> ShowS
[Direction v n] -> ShowS
Direction v n -> String
(Int -> Direction v n -> ShowS)
-> (Direction v n -> String)
-> ([Direction v n] -> ShowS)
-> Show (Direction v n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (v :: * -> *) n. Show (v n) => Int -> Direction v n -> ShowS
forall (v :: * -> *) n. Show (v n) => [Direction v n] -> ShowS
forall (v :: * -> *) n. Show (v n) => Direction v n -> String
$cshowsPrec :: forall (v :: * -> *) n. Show (v n) => Int -> Direction v n -> ShowS
showsPrec :: Int -> Direction v n -> ShowS
$cshow :: forall (v :: * -> *) n. Show (v n) => Direction v n -> String
show :: Direction v n -> String
$cshowList :: forall (v :: * -> *) n. Show (v n) => [Direction v n] -> ShowS
showList :: [Direction v n] -> ShowS
Show, Direction v n -> Direction v n -> Bool
(Direction v n -> Direction v n -> Bool)
-> (Direction v n -> Direction v n -> Bool) -> Eq (Direction v n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (v :: * -> *) n.
Eq (v n) =>
Direction v n -> Direction v n -> Bool
$c== :: forall (v :: * -> *) n.
Eq (v n) =>
Direction v n -> Direction v n -> Bool
== :: Direction v n -> Direction v n -> Bool
$c/= :: forall (v :: * -> *) n.
Eq (v n) =>
Direction v n -> Direction v n -> Bool
/= :: Direction v n -> Direction v n -> Bool
Eq, Eq (Direction v n)
Eq (Direction v n) =>
(Direction v n -> Direction v n -> Ordering)
-> (Direction v n -> Direction v n -> Bool)
-> (Direction v n -> Direction v n -> Bool)
-> (Direction v n -> Direction v n -> Bool)
-> (Direction v n -> Direction v n -> Bool)
-> (Direction v n -> Direction v n -> Direction v n)
-> (Direction v n -> Direction v n -> Direction v n)
-> Ord (Direction v n)
Direction v n -> Direction v n -> Bool
Direction v n -> Direction v n -> Ordering
Direction v n -> Direction v n -> Direction v n
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 (v :: * -> *) n. Ord (v n) => Eq (Direction v n)
forall (v :: * -> *) n.
Ord (v n) =>
Direction v n -> Direction v n -> Bool
forall (v :: * -> *) n.
Ord (v n) =>
Direction v n -> Direction v n -> Ordering
forall (v :: * -> *) n.
Ord (v n) =>
Direction v n -> Direction v n -> Direction v n
$ccompare :: forall (v :: * -> *) n.
Ord (v n) =>
Direction v n -> Direction v n -> Ordering
compare :: Direction v n -> Direction v n -> Ordering
$c< :: forall (v :: * -> *) n.
Ord (v n) =>
Direction v n -> Direction v n -> Bool
< :: Direction v n -> Direction v n -> Bool
$c<= :: forall (v :: * -> *) n.
Ord (v n) =>
Direction v n -> Direction v n -> Bool
<= :: Direction v n -> Direction v n -> Bool
$c> :: forall (v :: * -> *) n.
Ord (v n) =>
Direction v n -> Direction v n -> Bool
> :: Direction v n -> Direction v n -> Bool
$c>= :: forall (v :: * -> *) n.
Ord (v n) =>
Direction v n -> Direction v n -> Bool
>= :: Direction v n -> Direction v n -> Bool
$cmax :: forall (v :: * -> *) n.
Ord (v n) =>
Direction v n -> Direction v n -> Direction v n
max :: Direction v n -> Direction v n -> Direction v n
$cmin :: forall (v :: * -> *) n.
Ord (v n) =>
Direction v n -> Direction v n -> Direction v n
min :: Direction v n -> Direction v n -> Direction v n
Ord, (forall a b. (a -> b) -> Direction v a -> Direction v b)
-> (forall a b. a -> Direction v b -> Direction v a)
-> Functor (Direction v)
forall a b. a -> Direction v b -> Direction v a
forall a b. (a -> b) -> Direction v a -> Direction v b
forall (v :: * -> *) a b.
Functor v =>
a -> Direction v b -> Direction v a
forall (v :: * -> *) a b.
Functor v =>
(a -> b) -> Direction v a -> Direction v b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (v :: * -> *) a b.
Functor v =>
(a -> b) -> Direction v a -> Direction v b
fmap :: forall a b. (a -> b) -> Direction v a -> Direction v b
$c<$ :: forall (v :: * -> *) a b.
Functor v =>
a -> Direction v b -> Direction v a
<$ :: forall a b. a -> Direction v b -> Direction v a
Functor) -- todo: special instances

type instance V (Direction v n) = v
type instance N (Direction v n) = n

instance (V (v n) ~ v, N (v n) ~ n, Transformable (v n)) => Transformable (Direction v n) where
  transform :: Transformation (V (Direction v n)) (N (Direction v n))
-> Direction v n -> Direction v n
transform Transformation (V (Direction v n)) (N (Direction v n))
t (Dir v n
v) = v n -> Direction v n
forall (v :: * -> *) n. v n -> Direction v n
Dir (Transformation (V (v n)) (N (v n)) -> v n -> v n
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform Transformation (V (v n)) (N (v n))
Transformation (V (Direction v n)) (N (Direction v n))
t v n
v)

instance HasTheta v => HasTheta (Direction v) where
  _theta :: forall n. RealFloat n => Lens' (Direction v n) (Angle n)
_theta = (v n -> f (v n)) -> Direction v n -> f (Direction v n)
forall (v :: * -> *) n (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (v n) (f (v n)) -> p (Direction v n) (f (Direction v n))
_Dir ((v n -> f (v n)) -> Direction v n -> f (Direction v n))
-> ((Angle n -> f (Angle n)) -> v n -> f (v n))
-> (Angle n -> f (Angle n))
-> Direction v n
-> f (Direction v n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Angle n -> f (Angle n)) -> v n -> f (v n)
forall n. RealFloat n => Lens' (v n) (Angle n)
Lens' (v n) (Angle n)
forall (t :: * -> *) n.
(HasTheta t, RealFloat n) =>
Lens' (t n) (Angle n)
_theta

instance HasPhi v => HasPhi (Direction v) where
  _phi :: forall n. RealFloat n => Lens' (Direction v n) (Angle n)
_phi = (v n -> f (v n)) -> Direction v n -> f (Direction v n)
forall (v :: * -> *) n (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (v n) (f (v n)) -> p (Direction v n) (f (Direction v n))
_Dir ((v n -> f (v n)) -> Direction v n -> f (Direction v n))
-> ((Angle n -> f (Angle n)) -> v n -> f (v n))
-> (Angle n -> f (Angle n))
-> Direction v n
-> f (Direction v n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Angle n -> f (Angle n)) -> v n -> f (v n)
forall n. RealFloat n => Lens' (v n) (Angle n)
Lens' (v n) (Angle n)
forall (t :: * -> *) n.
(HasPhi t, RealFloat n) =>
Lens' (t n) (Angle n)
_phi

-- | _Dir is provided to allow efficient implementations of functions
--   in particular vector-spaces, but should be used with care as it
--   exposes too much information.
_Dir :: Iso' (Direction v n) (v n)
_Dir :: forall (v :: * -> *) n (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (v n) (f (v n)) -> p (Direction v n) (f (Direction v n))
_Dir = (Direction v n -> v n)
-> (v n -> Direction v n)
-> Iso (Direction v n) (Direction v n) (v n) (v n)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(Dir v n
v) -> v n
v) v n -> Direction v n
forall (v :: * -> *) n. v n -> Direction v n
Dir

-- | @direction v@ is the direction in which @v@ points.  Returns an
--   unspecified value when given the zero vector as input.
direction :: v n -> Direction v n
direction :: forall (v :: * -> *) n. v n -> Direction v n
direction = v n -> Direction v n
forall (v :: * -> *) n. v n -> Direction v n
Dir

-- | Synonym for 'direction'.
dir :: v n -> Direction v n
dir :: forall (v :: * -> *) n. v n -> Direction v n
dir = v n -> Direction v n
forall (v :: * -> *) n. v n -> Direction v n
Dir

-- | @fromDirection d@ is the unit vector in the direction @d@.
fromDirection :: (Metric v, Floating n) => Direction v n -> v n
fromDirection :: forall (v :: * -> *) n.
(Metric v, Floating n) =>
Direction v n -> v n
fromDirection (Dir v n
v) = v n -> v n
forall a. Floating a => v a -> v a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm v n
v

-- | Synonym for 'fromDirection'.
fromDir :: (Metric v, Floating n) => Direction v n -> v n
fromDir :: forall (v :: * -> *) n.
(Metric v, Floating n) =>
Direction v n -> v n
fromDir (Dir v n
v) = v n -> v n
forall a. Floating a => v a -> v a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm v n
v

-- | compute the positive angle between the two directions in their common plane
angleBetweenDirs :: (Metric v, Floating n, Ord n)
  => Direction v n -> Direction v n -> Angle n
angleBetweenDirs :: forall (v :: * -> *) n.
(Metric v, Floating n, Ord n) =>
Direction v n -> Direction v n -> Angle n
angleBetweenDirs Direction v n
d1 Direction v n
d2 = v n -> v n -> Angle n
forall (v :: * -> *) n.
(Metric v, Floating n, Ord n) =>
v n -> v n -> Angle n
angleBetween (Direction v n -> v n
forall (v :: * -> *) n.
(Metric v, Floating n) =>
Direction v n -> v n
fromDirection Direction v n
d1) (Direction v n -> v n
forall (v :: * -> *) n.
(Metric v, Floating n) =>
Direction v n -> v n
fromDirection Direction v n
d2)

-- | @dirBetween p q@ returns the direction from @p@ to @q@.
dirBetween :: (Additive v, Num n) => Point v n -> Point v n -> Direction v n
dirBetween :: forall (v :: * -> *) n.
(Additive v, Num n) =>
Point v n -> Point v n -> Direction v n
dirBetween Point v n
p Point v n
q = v n -> Direction v n
forall (v :: * -> *) n. v n -> Direction v n
dir (v n -> Direction v n) -> v n -> Direction v n
forall a b. (a -> b) -> a -> b
$ Point v n
q Point v n -> Point v n -> Diff (Point v) n
forall a. Num a => Point v a -> Point v a -> Diff (Point v) a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point v n
p