{-# LANGUAGE UnicodeSyntax, FlexibleContexts #-}
module GraphRewriting.Layout.RotPortSpec
	(module GraphRewriting.Layout.RotPortSpec,
	 module GraphRewriting.Layout.Position,
	 module GraphRewriting.Layout.Rotation,
	 module GraphRewriting.Layout.PortSpec,
	 module GraphRewriting.Layout.Geometry,
	 module Data.Vector.V2,
	 module Data.View)
where


import GraphRewriting.Graph
import GraphRewriting.Graph.Read
import GraphRewriting.Layout.Position
import GraphRewriting.Layout.Rotation
import GraphRewriting.Layout.PortSpec
import GraphRewriting.Layout.Geometry
import GraphRewriting.Pattern ()
import Data.Vector.V2
import Data.View
import Control.Monad


rotPortSpec ∷ (PortSpec n, View Rotation n) ⇒ n → [(Vector2, Vector2)]
rotPortSpec :: forall n.
(PortSpec n, View Rotation n) =>
n -> [(Vector2, Vector2)]
rotPortSpec n
n = ((Vector2, Vector2) -> (Vector2, Vector2))
-> [(Vector2, Vector2)] -> [(Vector2, Vector2)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Vector2
v, Vector2
u) → (Vector2 -> Vector2
rot Vector2
v, Vector2 -> Vector2
rot Vector2
u)) (n -> [(Vector2, Vector2)]
forall n. PortSpec n => n -> [(Vector2, Vector2)]
portSpec n
n)
	where rot :: Vector2 -> Vector2
rot = Angle -> Vector2 -> Vector2
rotate ((Rotation -> Angle) -> n -> Angle
forall v n field. View v n => (v -> field) -> n -> field
examine Rotation -> Angle
rotation n
n)

relRotPortPos ∷ (PortSpec n, View Rotation n) ⇒ n → [Vector2]
relRotPortPos :: forall n. (PortSpec n, View Rotation n) => n -> [Vector2]
relRotPortPos = ((Vector2, Vector2) -> Vector2)
-> [(Vector2, Vector2)] -> [Vector2]
forall a b. (a -> b) -> [a] -> [b]
map (Vector2, Vector2) -> Vector2
forall a b. (a, b) -> a
fst ([(Vector2, Vector2)] -> [Vector2])
-> (n -> [(Vector2, Vector2)]) -> n -> [Vector2]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> [(Vector2, Vector2)]
forall n.
(PortSpec n, View Rotation n) =>
n -> [(Vector2, Vector2)]
rotPortSpec

absRotPortSpec ∷ (PortSpec n, View Position n, View Rotation n) ⇒ n → [(Vector2, Vector2)]
absRotPortSpec :: forall n.
(PortSpec n, View Position n, View Rotation n) =>
n -> [(Vector2, Vector2)]
absRotPortSpec n
n = ((Vector2, Vector2) -> (Vector2, Vector2))
-> [(Vector2, Vector2)] -> [(Vector2, Vector2)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Vector2
p,Vector2
d) → ((Position -> Vector2) -> n -> Vector2
forall v n field. View v n => (v -> field) -> n -> field
examine Position -> Vector2
position n
n Vector2 -> Vector2 -> Vector2
forall a. Num a => a -> a -> a
+ Vector2
p, Vector2
d)) ([(Vector2, Vector2)] -> [(Vector2, Vector2)])
-> [(Vector2, Vector2)] -> [(Vector2, Vector2)]
forall a b. (a -> b) -> a -> b
$ n -> [(Vector2, Vector2)]
forall n.
(PortSpec n, View Rotation n) =>
n -> [(Vector2, Vector2)]
rotPortSpec n
n

absRotPortPos ∷ (PortSpec n, View Position n, View Rotation n) ⇒ n → [Vector2]
absRotPortPos :: forall n.
(PortSpec n, View Position n, View Rotation n) =>
n -> [Vector2]
absRotPortPos = ((Vector2, Vector2) -> Vector2)
-> [(Vector2, Vector2)] -> [Vector2]
forall a b. (a -> b) -> [a] -> [b]
map (Vector2, Vector2) -> Vector2
forall a b. (a, b) -> a
fst ([(Vector2, Vector2)] -> [Vector2])
-> (n -> [(Vector2, Vector2)]) -> n -> [Vector2]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> [(Vector2, Vector2)]
forall n.
(PortSpec n, View Position n, View Rotation n) =>
n -> [(Vector2, Vector2)]
absRotPortSpec

angularMomentum ∷ (View Position n, PortSpec n, View Rotation n, View [Port] n) ⇒ Node → WithGraph n Momentum
angularMomentum :: forall n.
(View Position n, PortSpec n, View Rotation n, View [Port] n) =>
Node -> WithGraph n Momentum
angularMomentum Node
n = do
	n
nv ← Node -> ReaderT (Graph n) Identity n
forall n (m :: * -> *).
(MonadReader (Graph n) m, MonadFail m) =>
Node -> m n
readNode Node
n
	let npos :: Vector2
npos = (Position -> Vector2) -> n -> Vector2
forall v n field. View v n => (v -> field) -> n -> field
examine Position -> Vector2
position n
nv
	let edgePortions :: Port -> m [Momentum]
edgePortions Port
e = do
		let nps :: [Vector2]
nps = (n -> [Vector2]) -> Port -> n -> [Vector2]
forall n a. View [Port] n => (n -> [a]) -> Port -> n -> [a]
propOfPort n -> [Vector2]
forall n. PortSpec n => n -> [Vector2]
portDir Port
e n
nv
		[n]
ns ← (Node -> m n) -> [Node] -> m [n]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Node -> m n
forall n (m :: * -> *).
(MonadReader (Graph n) m, MonadFail m) =>
Node -> m n
readNode ([Node] -> m [n]) -> m [Node] -> m [n]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Node -> Port -> m [Node]
forall n (m :: * -> *).
(MonadReader (Graph n) m, MonadFail m) =>
Node -> Port -> m [Node]
adverseNodes Node
n Port
e
		let nsps :: [Vector2]
nsps = (n -> [Vector2]) -> [n] -> [Vector2]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((n -> [Vector2]) -> Port -> n -> [Vector2]
forall n a. View [Port] n => (n -> [a]) -> Port -> n -> [a]
propOfPort n -> [Vector2]
forall n.
(PortSpec n, View Position n, View Rotation n) =>
n -> [Vector2]
absRotPortPos Port
e) [n]
ns
		let angles :: [Angle]
angles = [Vector2 -> Vector2 -> Angle
angle Vector2
np (Vector2
nsp Vector2 -> Vector2 -> Vector2
forall a. Num a => a -> a -> a
- Vector2
npos) | Vector2
np ← [Vector2]
nps, Vector2
nsp ← [Vector2]
nsps]
		[Momentum] -> m [Momentum]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Momentum] -> m [Momentum]) -> [Momentum] -> m [Momentum]
forall a b. (a -> b) -> a -> b
$ (Angle -> Momentum) -> [Angle] -> [Momentum]
forall a b. (a -> b) -> [a] -> [b]
map (Rotation -> Momentum
approach (Rotation -> Momentum) -> (Angle -> Rotation) -> Angle -> Momentum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Angle -> Rotation
Rotation) [Angle]
angles
	([[Momentum]] -> Momentum)
-> ReaderT (Graph n) Identity [[Momentum]] -> WithGraph n Momentum
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ([Momentum] -> Momentum
momSum ([Momentum] -> Momentum)
-> ([[Momentum]] -> [Momentum]) -> [[Momentum]] -> Momentum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Momentum]] -> [Momentum]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) ((Port -> ReaderT (Graph n) Identity [Momentum])
-> [Port] -> ReaderT (Graph n) Identity [[Momentum]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Port -> ReaderT (Graph n) Identity [Momentum]
forall {m :: * -> *} {n}.
(MonadFail m, MonadReader (Graph n) m, PortSpec n, View [Port] n,
 View Position n, View Rotation n) =>
Port -> m [Momentum]
edgePortions ([Port] -> ReaderT (Graph n) Identity [[Momentum]])
-> ReaderT (Graph n) Identity [Port]
-> ReaderT (Graph n) Identity [[Momentum]]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Node -> ReaderT (Graph n) Identity [Port]
forall n (m :: * -> *).
(View [Port] n, MonadReader (Graph n) m, MonadFail m) =>
Node -> m [Port]
attachedEdges Node
n)