module Graphics.Rendering.Plot.Light.Internal.Geometry where
import Graphics.Rendering.Plot.Light.Internal.Types
data V2 a = V2 a a deriving (Eq, Show)
instance Num a => Monoid (V2 a) where
mempty = V2 0 0
(V2 a b) `mappend` (V2 c d) = V2 (a + b) (c + d)
class AdditiveGroup v where
zero :: v
(^+^) :: v -> v -> v
(^-^) :: v -> v -> v
instance Num a => AdditiveGroup (V2 a) where
zero = mempty
(^+^) = mappend
(V2 a b) ^-^ (V2 c d) = V2 (a c) (b d)
class AdditiveGroup v => VectorSpace v where
type Scalar v :: *
(.*) :: Scalar v -> v -> v
instance Num a => VectorSpace (V2 a) where
type Scalar (V2 a) = a
n .* (V2 vx vy) = V2 (n*vx) (n*vy)
class VectorSpace v => Hermitian v where
type InnerProduct v :: *
(<.>) :: v -> v -> InnerProduct v
instance Num a => Hermitian (V2 a) where
type InnerProduct (V2 a) = a
(V2 a b) <.> (V2 c d) = (a*c) + (b*d)
norm2 ::
(Hermitian v, Floating n, n ~ (InnerProduct v)) => v -> n
norm2 v = sqrt $ v <.> v
normalize2 :: (InnerProduct v ~ Scalar v, Floating (Scalar v), Hermitian v) =>
v -> v
normalize2 v = (1/norm2 v) .* v
mkV2fromEndpoints, (-.) :: Num a => Point a -> Point a -> V2 a
mkV2fromEndpoints (Point px py) (Point qx qy) = V2 (qxpx) (qypy)
(-.) = mkV2fromEndpoints
origin :: Num a => Point a
origin = Point 0 0
data Mat2 a = Mat2 a a a a deriving (Eq, Show)
class Hermitian v => LinearMap m v where
(#>) :: m -> v -> v
class MultiplicativeSemigroup m where
(##) :: m -> m -> m
instance Num a => MultiplicativeSemigroup (Mat2 a) where
Mat2 a00 a01 a10 a11 ## Mat2 b00 b01 b10 b11 = Mat2 (a00*b00+a01*b10) (a00*b01+a01*b11) (a10*b00+a11*b10) (a10*b01+a11*b11)
instance Num a => LinearMap (Mat2 a) (V2 a) where
(Mat2 a00 a01 a10 a11) #> (V2 vx vy) = V2 (a00 * vx + a01 * vy) (a10 * vx + a11 * vy)
diagMat2 :: Num a => a -> a -> Mat2 a
diagMat2 rx ry = Mat2 rx 0 0 ry
data DiagMat2 a = DMat2 a a deriving (Eq, Show)
class LinearMap m v => MatrixGroup m v where
(<\>) :: m -> v -> v
instance Num a => MultiplicativeSemigroup (DiagMat2 a) where
DMat2 a b ## DMat2 c d = DMat2 (a*c) (b*d)
instance Num a => LinearMap (DiagMat2 a) (V2 a) where
DMat2 d1 d2 #> V2 vx vy = V2 (d1 * vx) (d2 * vy)
instance Fractional a => MatrixGroup (DiagMat2 a) (V2 a) where
DMat2 d1 d2 <\> V2 vx vy = V2 (vx / d1) (vy / d2)
v2fromPoint :: Num a => Point a -> V2 a
v2fromPoint p = origin -. p
movePoint :: Num a => V2 a -> Point a -> Point a
movePoint (V2 vx vy) (Point px py) = Point (px + vx) (py + vy)
moveLabeledPointV2 :: Num a => V2 a -> LabeledPoint l a -> LabeledPoint l a
moveLabeledPointV2 = moveLabeledPoint . movePoint
toUnitSquare :: (Fractional a, MatrixGroup (Mat2 a) (V2 a)) =>
Frame a -> Point a -> Point a
toUnitSquare from p = movePoint vmove p
where
mm = diagMat2 (width from) (height from)
o1 = _fpmin from
vmove = mm <\> (p -. o1)
fromUnitSquare :: Num a => Frame a -> Point a -> Point a
fromUnitSquare to p = movePoint vmove p
where
mm = diagMat2 (width to) (height to)
vo = v2fromPoint (_fpmin to)
vmove = (mm #> v2fromPoint p) ^+^ vo
e1 :: Num a => V2 a
e1 = V2 1 0
e2 :: Num a => V2 a
e2 = V2 0 1