{-# LANGUAGE UnicodeSyntax #-}
module GraphRewriting.Layout.Rotation
	(module GraphRewriting.Layout.Rotation,
	 module Data.View)
where

import Prelude.Unicode
import Data.Vector.Class
import Data.Vector.V2
import Data.View
import GraphRewriting.Layout.Geometry


newtype Rotation = Rotation {Rotation -> Scalar
rotation ∷ Angle}

type Angle = Double -- ∊ [-π,π]
type Impulse = Angle → Angle
type Momentum = Impulse → Rotation → Rotation

v01 :: Vector2
v01 = Scalar -> Scalar -> Vector2
Vector2 Scalar
0 Scalar
1

meanAngle ∷ [Angle] → Angle
meanAngle :: [Scalar] -> Scalar
meanAngle [Scalar]
as = Vector2 -> Vector2 -> Scalar
angle Vector2
v01 (Vector2 -> Scalar) -> Vector2 -> Scalar
forall a b. (a -> b) -> a -> b
$ [Vector2] -> Vector2
focalPoint [Scalar -> Vector2 -> Vector2
rotate Scalar
a (Vector2 -> Vector2) -> Vector2 -> Vector2
forall a b. (a -> b) -> a -> b
$ Vector2
v01 | Scalar
a ← [Scalar]
as]

momSum ∷ [Momentum] → Momentum
momSum :: [Momentum] -> Momentum
momSum [] Impulse
impulse Rotation
r = Rotation
r
momSum [Momentum]
as Impulse
impulse Rotation
r = Scalar -> Rotation
Rotation (Scalar -> Rotation) -> Scalar -> Rotation
forall a b. (a -> b) -> a -> b
$ [Scalar] -> Scalar
meanAngle [Rotation -> Scalar
rotation (Momentum
a Impulse
impulse Rotation
r) | Momentum
a ← [Momentum]
as]

approach ∷ Rotation → Momentum
approach :: Rotation -> Momentum
approach Rotation
target Impulse
impulse Rotation
current = Scalar -> Momentum
momentum (Vector2 -> Vector2 -> Scalar
angle Vector2
currentV Vector2
targetV) Impulse
impulse Rotation
current where
	targetV :: Vector2
targetV = Scalar -> Vector2 -> Vector2
rotate (Rotation -> Scalar
rotation Rotation
target) Vector2
v01
	currentV :: Vector2
currentV = Scalar -> Vector2 -> Vector2
rotate (Rotation -> Scalar
rotation Rotation
current) Vector2
v01

momentum ∷ Angle → Momentum
momentum :: Scalar -> Momentum
momentum Scalar
a Impulse
impulse = Scalar -> Rotation
Rotation (Scalar -> Rotation)
-> (Rotation -> Scalar) -> Rotation -> Rotation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scalar -> Impulse
forall a. Num a => a -> a -> a
(+) (Impulse
forall a. Num a => a -> a
signum Scalar
a Scalar -> Impulse
forall a. Num a => a -> a -> a
* Impulse
impulse (Impulse
forall a. Num a => a -> a
abs Scalar
a)) Impulse -> (Rotation -> Scalar) -> Rotation -> Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rotation -> Scalar
rotation

angle ∷ Vector2 → Vector2 → Angle
angle :: Vector2 -> Vector2 -> Scalar
angle Vector2
u Vector2
v = Scalar
sign Scalar -> Impulse
forall a. Num a => a -> a -> a
⋅ (Impulse
forall a. Floating a => a -> a
acos Impulse -> Impulse
forall a b. (a -> b) -> a -> b
$ Impulse
forall {a}. (Ord a, Num a) => a -> a
bound Impulse -> Impulse
forall a b. (a -> b) -> a -> b
$ Vector2 -> Vector2 -> Scalar
forall v. Vector v => v -> v -> Scalar
vdot Vector2
a Vector2
b) where
	sign :: Scalar
sign = Impulse
forall a. Num a => a -> a
signum Impulse -> Impulse
forall a b. (a -> b) -> a -> b
$ Vector2 -> Scalar
v2y Vector2
b Scalar -> Impulse
forall a. Num a => a -> a -> a
⋅ Vector2 -> Scalar
v2x Vector2
a Scalar -> Impulse
forall a. Num a => a -> a -> a
- Vector2 -> Scalar
v2y Vector2
a Scalar -> Impulse
forall a. Num a => a -> a -> a
⋅ Vector2 -> Scalar
v2x Vector2
b
	a :: Vector2
a = Vector2 -> Vector2
forall v. Vector v => v -> v
vnormalise Vector2
u
	b :: Vector2
b = Vector2 -> Vector2
forall v. Vector v => v -> v
vnormalise Vector2
v
	bound :: a -> a
bound a
x = a -> a -> a
forall a. Ord a => a -> a -> a
max (-a
1) (a -> a -> a
forall a. Ord a => a -> a -> a
min a
1 a
x) -- due to a rounding error in (vdot a b), acos might yield NaN

rotate ∷ Angle → Vector2 → Vector2
rotate :: Scalar -> Vector2 -> Vector2
rotate Scalar
a (Vector2 Scalar
x Scalar
y) = Scalar -> Scalar -> Vector2
Vector2 (Scalar
x Scalar -> Impulse
forall a. Num a => a -> a -> a
⋅ Impulse
forall a. Floating a => a -> a
cos Scalar
a Scalar -> Impulse
forall a. Num a => a -> a -> a
- Scalar
y Scalar -> Impulse
forall a. Num a => a -> a -> a
⋅ Impulse
forall a. Floating a => a -> a
sin Scalar
a) (Scalar
x Scalar -> Impulse
forall a. Num a => a -> a -> a
⋅ Impulse
forall a. Floating a => a -> a
sin Scalar
a Scalar -> Impulse
forall a. Num a => a -> a -> a
+ Scalar
y Scalar -> Impulse
forall a. Num a => a -> a -> a
⋅ Impulse
forall a. Floating a => a -> a
cos Scalar
a)