module Graphics.Rendering.Chart.Geometry
(
Rect(..)
, Point(..)
, Vector(..)
, RectSize
, Range
, pointToVec
, mkrect
, rectPath
, pvadd
, pvsub
, psub
, vangle
, vlen
, vscale
, within
, intersectRect
, RectEdge(..)
, Limit(..)
, PointMapFn
, Path(..)
, lineTo, moveTo
, lineTo', moveTo'
, arc, arc'
, arcNeg, arcNeg'
, close
, foldPath
, makeLinesExplicit
, transformP, scaleP, rotateP, translateP
, Matrix(..)
, identity
, rotate, scale, translate
, scalarMultiply
, adjoint
, invert
) where
import qualified Prelude
import Prelude hiding ((^))
import Data.Monoid (Monoid (..))
import Data.Semigroup (Semigroup(..))
(^) :: Num a => a -> Integer -> a
^ :: a -> Integer -> a
(^) = a -> Integer -> a
forall a b. (Num a, Integral b) => a -> b -> a
(Prelude.^)
data Point = Point {
Point -> Double
p_x :: Double,
Point -> Double
p_y :: Double
} deriving Int -> Point -> ShowS
[Point] -> ShowS
Point -> String
(Int -> Point -> ShowS)
-> (Point -> String) -> ([Point] -> ShowS) -> Show Point
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Point] -> ShowS
$cshowList :: [Point] -> ShowS
show :: Point -> String
$cshow :: Point -> String
showsPrec :: Int -> Point -> ShowS
$cshowsPrec :: Int -> Point -> ShowS
Show
data Vector = Vector {
Vector -> Double
v_x :: Double,
Vector -> Double
v_y :: Double
} deriving Int -> Vector -> ShowS
[Vector] -> ShowS
Vector -> String
(Int -> Vector -> ShowS)
-> (Vector -> String) -> ([Vector] -> ShowS) -> Show Vector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Vector] -> ShowS
$cshowList :: [Vector] -> ShowS
show :: Vector -> String
$cshow :: Vector -> String
showsPrec :: Int -> Vector -> ShowS
$cshowsPrec :: Int -> Vector -> ShowS
Show
pointToVec :: Point -> Vector
pointToVec :: Point -> Vector
pointToVec (Point x :: Double
x y :: Double
y) = Double -> Double -> Vector
Vector Double
x Double
y
vangle :: Vector -> Double
vangle :: Vector -> Double
vangle (Vector x :: Double
x y :: Double
y)
| Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Double -> Double
forall a. Floating a => a -> a
atan (Double
yDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
x)
| Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = Double -> Double
forall a. Floating a => a -> a
atan (Double
yDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
x) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
forall a. Floating a => a
pi
| Bool
otherwise = if Double
y Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then Double
forall a. Floating a => a
piDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/2 else -Double
forall a. Floating a => a
piDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/2
vlen :: Vector -> Double
vlen :: Vector -> Double
vlen (Vector x :: Double
x y :: Double
y) = Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double
xDouble -> Integer -> Double
forall a. Num a => a -> Integer -> a
^2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
yDouble -> Integer -> Double
forall a. Num a => a -> Integer -> a
^2
vscale :: Double -> Vector -> Vector
vscale :: Double -> Vector -> Vector
vscale c :: Double
c (Vector x :: Double
x y :: Double
y) = Double -> Double -> Vector
Vector (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
c) (Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
c)
pvadd :: Point -> Vector -> Point
pvadd :: Point -> Vector -> Point
pvadd (Point x1 :: Double
x1 y1 :: Double
y1) (Vector x2 :: Double
x2 y2 :: Double
y2) = Double -> Double -> Point
Point (Double
x1Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
x2) (Double
y1Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
y2)
pvsub :: Point -> Vector -> Point
pvsub :: Point -> Vector -> Point
pvsub (Point x1 :: Double
x1 y1 :: Double
y1) (Vector x2 :: Double
x2 y2 :: Double
y2) = Double -> Double -> Point
Point (Double
x1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
x2) (Double
y1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
y2)
psub :: Point -> Point -> Vector
psub :: Point -> Point -> Vector
psub (Point x1 :: Double
x1 y1 :: Double
y1) (Point x2 :: Double
x2 y2 :: Double
y2) = Double -> Double -> Vector
Vector (Double
x1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
x2) (Double
y1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
y2)
data Limit a = LMin | LValue a | LMax
deriving Int -> Limit a -> ShowS
[Limit a] -> ShowS
Limit a -> String
(Int -> Limit a -> ShowS)
-> (Limit a -> String) -> ([Limit a] -> ShowS) -> Show (Limit a)
forall a. Show a => Int -> Limit a -> ShowS
forall a. Show a => [Limit a] -> ShowS
forall a. Show a => Limit a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Limit a] -> ShowS
$cshowList :: forall a. Show a => [Limit a] -> ShowS
show :: Limit a -> String
$cshow :: forall a. Show a => Limit a -> String
showsPrec :: Int -> Limit a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Limit a -> ShowS
Show
type PointMapFn x y = (Limit x, Limit y) -> Point
data Rect = Rect Point Point
deriving Int -> Rect -> ShowS
[Rect] -> ShowS
Rect -> String
(Int -> Rect -> ShowS)
-> (Rect -> String) -> ([Rect] -> ShowS) -> Show Rect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rect] -> ShowS
$cshowList :: [Rect] -> ShowS
show :: Rect -> String
$cshow :: Rect -> String
showsPrec :: Int -> Rect -> ShowS
$cshowsPrec :: Int -> Rect -> ShowS
Show
data RectEdge = E_Top | E_Bottom | E_Left | E_Right
mkrect :: Point -> Point -> Point -> Point -> Rect
mkrect :: Point -> Point -> Point -> Point -> Rect
mkrect (Point x1 :: Double
x1 _) (Point _ y2 :: Double
y2) (Point x3 :: Double
x3 _) (Point _ y4 :: Double
y4) =
Point -> Point -> Rect
Rect (Double -> Double -> Point
Point Double
x1 Double
y2) (Double -> Double -> Point
Point Double
x3 Double
y4)
within :: Point -> Rect -> Bool
within :: Point -> Rect -> Bool
within (Point x :: Double
x y :: Double
y) (Rect (Point x1 :: Double
x1 y1 :: Double
y1) (Point x2 :: Double
x2 y2 :: Double
y2)) =
Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
x1 Bool -> Bool -> Bool
&& Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
x2 Bool -> Bool -> Bool
&& Double
y Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
y1 Bool -> Bool -> Bool
&& Double
y Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
y2
intersectRect :: Limit Rect -> Limit Rect -> Limit Rect
intersectRect :: Limit Rect -> Limit Rect -> Limit Rect
intersectRect LMax r :: Limit Rect
r = Limit Rect
r
intersectRect r :: Limit Rect
r LMax = Limit Rect
r
intersectRect LMin _ = Limit Rect
forall a. Limit a
LMin
intersectRect _ LMin = Limit Rect
forall a. Limit a
LMin
intersectRect (LValue (Rect (Point x11 :: Double
x11 y11 :: Double
y11) (Point x12 :: Double
x12 y12 :: Double
y12)))
(LValue (Rect (Point x21 :: Double
x21 y21 :: Double
y21) (Point x22 :: Double
x22 y22 :: Double
y22))) =
let p1 :: Point
p1@(Point x1 :: Double
x1 y1 :: Double
y1) = Double -> Double -> Point
Point (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
x11 Double
x21) (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
y11 Double
y21)
p2 :: Point
p2@(Point x2 :: Double
x2 y2 :: Double
y2) = Double -> Double -> Point
Point (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
x12 Double
x22) (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
y12 Double
y22)
in if Double
x2 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
x1 Bool -> Bool -> Bool
|| Double
y2 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
y1
then Limit Rect
forall a. Limit a
LMin
else Rect -> Limit Rect
forall a. a -> Limit a
LValue (Rect -> Limit Rect) -> Rect -> Limit Rect
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Rect
Rect Point
p1 Point
p2
type Range = (Double,Double)
type RectSize = (Double,Double)
rectPath :: Rect -> Path
rectPath :: Rect -> Path
rectPath (Rect p1 :: Point
p1@(Point x1 :: Double
x1 y1 :: Double
y1) p3 :: Point
p3@(Point x2 :: Double
x2 y2 :: Double
y2)) =
let p2 :: Point
p2 = Double -> Double -> Point
Point Double
x1 Double
y2
p4 :: Point
p4 = Double -> Double -> Point
Point Double
x2 Double
y1
in Point -> Path
moveTo Point
p1 Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Point -> Path
lineTo Point
p2 Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Point -> Path
lineTo Point
p3 Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Point -> Path
lineTo Point
p4 Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
close
data Path = MoveTo Point Path
| LineTo Point Path
| Arc Point Double Double Double Path
| ArcNeg Point Double Double Double Path
| End
| Close
instance Semigroup Path where
p1 :: Path
p1 <> :: Path -> Path -> Path
<> p2 :: Path
p2 = case Path
p1 of
MoveTo p :: Point
p path :: Path
path -> Point -> Path -> Path
MoveTo Point
p (Path -> Path) -> Path -> Path
forall a b. (a -> b) -> a -> b
$ Path
path Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
p2
LineTo p :: Point
p path :: Path
path -> Point -> Path -> Path
LineTo Point
p (Path -> Path) -> Path -> Path
forall a b. (a -> b) -> a -> b
$ Path
path Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
p2
Arc p :: Point
p r :: Double
r a1 :: Double
a1 a2 :: Double
a2 path :: Path
path -> Point -> Double -> Double -> Double -> Path -> Path
Arc Point
p Double
r Double
a1 Double
a2 (Path -> Path) -> Path -> Path
forall a b. (a -> b) -> a -> b
$ Path
path Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
p2
ArcNeg p :: Point
p r :: Double
r a1 :: Double
a1 a2 :: Double
a2 path :: Path
path -> Point -> Double -> Double -> Double -> Path -> Path
ArcNeg Point
p Double
r Double
a1 Double
a2 (Path -> Path) -> Path -> Path
forall a b. (a -> b) -> a -> b
$ Path
path Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
p2
End -> Path
p2
Close -> Path
Close
instance Monoid Path where
mappend :: Path -> Path -> Path
mappend = Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
(<>)
mempty :: Path
mempty = Path
End
moveTo :: Point -> Path
moveTo :: Point -> Path
moveTo p :: Point
p = Point -> Path -> Path
MoveTo Point
p Path
forall a. Monoid a => a
mempty
moveTo' :: Double -> Double -> Path
moveTo' :: Double -> Double -> Path
moveTo' x :: Double
x y :: Double
y = Point -> Path
moveTo (Point -> Path) -> Point -> Path
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Point
Point Double
x Double
y
lineTo :: Point -> Path
lineTo :: Point -> Path
lineTo p :: Point
p = Point -> Path -> Path
LineTo Point
p Path
forall a. Monoid a => a
mempty
lineTo' :: Double -> Double -> Path
lineTo' :: Double -> Double -> Path
lineTo' x :: Double
x y :: Double
y = Point -> Path
lineTo (Point -> Path) -> Point -> Path
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Point
Point Double
x Double
y
arc :: Point
-> Double
-> Double
-> Double
-> Path
arc :: Point -> Double -> Double -> Double -> Path
arc p :: Point
p r :: Double
r a1 :: Double
a1 a2 :: Double
a2 = Point -> Double -> Double -> Double -> Path -> Path
Arc Point
p Double
r Double
a1 Double
a2 Path
forall a. Monoid a => a
mempty
arc' :: Double -> Double -> Double -> Double -> Double -> Path
arc' :: Double -> Double -> Double -> Double -> Double -> Path
arc' x :: Double
x y :: Double
y r :: Double
r a1 :: Double
a1 a2 :: Double
a2 = Point -> Double -> Double -> Double -> Path -> Path
Arc (Double -> Double -> Point
Point Double
x Double
y) Double
r Double
a1 Double
a2 Path
forall a. Monoid a => a
mempty
arcNeg :: Point -> Double -> Double -> Double -> Path
arcNeg :: Point -> Double -> Double -> Double -> Path
arcNeg p :: Point
p r :: Double
r a1 :: Double
a1 a2 :: Double
a2 = Point -> Double -> Double -> Double -> Path -> Path
ArcNeg Point
p Double
r Double
a1 Double
a2 Path
forall a. Monoid a => a
mempty
arcNeg' :: Double -> Double -> Double -> Double -> Double -> Path
arcNeg' :: Double -> Double -> Double -> Double -> Double -> Path
arcNeg' x :: Double
x y :: Double
y r :: Double
r a1 :: Double
a1 a2 :: Double
a2 = Point -> Double -> Double -> Double -> Path -> Path
ArcNeg (Double -> Double -> Point
Point Double
x Double
y) Double
r Double
a1 Double
a2 Path
forall a. Monoid a => a
mempty
close :: Path
close :: Path
close = Path
Close
foldPath :: (Monoid m)
=> (Point -> m)
-> (Point -> m)
-> (Point -> Double -> Double -> Double -> m)
-> (Point -> Double -> Double -> Double -> m)
-> m
-> Path
-> m
foldPath :: (Point -> m)
-> (Point -> m)
-> (Point -> Double -> Double -> Double -> m)
-> (Point -> Double -> Double -> Double -> m)
-> m
-> Path
-> m
foldPath moveTo_ :: Point -> m
moveTo_ lineTo_ :: Point -> m
lineTo_ arc_ :: Point -> Double -> Double -> Double -> m
arc_ arcNeg_ :: Point -> Double -> Double -> Double -> m
arcNeg_ close_ :: m
close_ path :: Path
path =
let restF :: Path -> m
restF = (Point -> m)
-> (Point -> m)
-> (Point -> Double -> Double -> Double -> m)
-> (Point -> Double -> Double -> Double -> m)
-> m
-> Path
-> m
forall m.
Monoid m =>
(Point -> m)
-> (Point -> m)
-> (Point -> Double -> Double -> Double -> m)
-> (Point -> Double -> Double -> Double -> m)
-> m
-> Path
-> m
foldPath Point -> m
moveTo_ Point -> m
lineTo_ Point -> Double -> Double -> Double -> m
arc_ Point -> Double -> Double -> Double -> m
arcNeg_ m
close_
in case Path
path of
MoveTo p :: Point
p rest :: Path
rest -> Point -> m
moveTo_ Point
p m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` Path -> m
restF Path
rest
LineTo p :: Point
p rest :: Path
rest -> Point -> m
lineTo_ Point
p m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` Path -> m
restF Path
rest
Arc p :: Point
p r :: Double
r a1 :: Double
a1 a2 :: Double
a2 rest :: Path
rest -> Point -> Double -> Double -> Double -> m
arc_ Point
p Double
r Double
a1 Double
a2 m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` Path -> m
restF Path
rest
ArcNeg p :: Point
p r :: Double
r a1 :: Double
a1 a2 :: Double
a2 rest :: Path
rest -> Point -> Double -> Double -> Double -> m
arcNeg_ Point
p Double
r Double
a1 Double
a2 m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` Path -> m
restF Path
rest
End -> m
forall a. Monoid a => a
mempty
Close -> m
close_
makeLinesExplicit :: Path -> Path
makeLinesExplicit :: Path -> Path
makeLinesExplicit (Arc c :: Point
c r :: Double
r s :: Double
s e :: Double
e rest :: Path
rest) =
Point -> Double -> Double -> Double -> Path -> Path
Arc Point
c Double
r Double
s Double
e (Path -> Path) -> Path -> Path
forall a b. (a -> b) -> a -> b
$ Path -> Path
makeLinesExplicit' Path
rest
makeLinesExplicit (ArcNeg c :: Point
c r :: Double
r s :: Double
s e :: Double
e rest :: Path
rest) =
Point -> Double -> Double -> Double -> Path -> Path
ArcNeg Point
c Double
r Double
s Double
e (Path -> Path) -> Path -> Path
forall a b. (a -> b) -> a -> b
$ Path -> Path
makeLinesExplicit' Path
rest
makeLinesExplicit path :: Path
path = Path -> Path
makeLinesExplicit' Path
path
makeLinesExplicit' :: Path -> Path
makeLinesExplicit' :: Path -> Path
makeLinesExplicit' End = Path
End
makeLinesExplicit' Close = Path
Close
makeLinesExplicit' (Arc c :: Point
c r :: Double
r s :: Double
s e :: Double
e rest :: Path
rest) =
let p :: Point
p = Vector -> Point -> Point
translateP (Point -> Vector
pointToVec Point
c) (Point -> Point) -> Point -> Point
forall a b. (a -> b) -> a -> b
$ Double -> Point -> Point
rotateP Double
s (Point -> Point) -> Point -> Point
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Point
Point Double
r 0
in Point -> Path
lineTo Point
p Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Point -> Double -> Double -> Double -> Path
arc Point
c Double
r Double
s Double
e Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path -> Path
makeLinesExplicit' Path
rest
makeLinesExplicit' (ArcNeg c :: Point
c r :: Double
r s :: Double
s e :: Double
e rest :: Path
rest) =
let p :: Point
p = Vector -> Point -> Point
translateP (Point -> Vector
pointToVec Point
c) (Point -> Point) -> Point -> Point
forall a b. (a -> b) -> a -> b
$ Double -> Point -> Point
rotateP Double
s (Point -> Point) -> Point -> Point
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Point
Point Double
r 0
in Point -> Path
lineTo Point
p Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Point -> Double -> Double -> Double -> Path
arcNeg Point
c Double
r Double
s Double
e Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path -> Path
makeLinesExplicit' Path
rest
makeLinesExplicit' (MoveTo p0 :: Point
p0 rest :: Path
rest) =
Point -> Path -> Path
MoveTo Point
p0 (Path -> Path) -> Path -> Path
forall a b. (a -> b) -> a -> b
$ Path -> Path
makeLinesExplicit' Path
rest
makeLinesExplicit' (LineTo p0 :: Point
p0 rest :: Path
rest) =
Point -> Path -> Path
LineTo Point
p0 (Path -> Path) -> Path -> Path
forall a b. (a -> b) -> a -> b
$ Path -> Path
makeLinesExplicit' Path
rest
transformP :: Matrix -> Point -> Point
transformP :: Matrix -> Point -> Point
transformP t :: Matrix
t (Point x :: Double
x y :: Double
y) = Double -> Double -> Point
Point
(Matrix -> Double
xx Matrix
t Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Matrix -> Double
xy Matrix
t Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Matrix -> Double
x0 Matrix
t)
(Matrix -> Double
yx Matrix
t Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Matrix -> Double
yy Matrix
t Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Matrix -> Double
y0 Matrix
t)
rotateP :: Double -> Point -> Point
rotateP :: Double -> Point -> Point
rotateP a :: Double
a = Matrix -> Point -> Point
transformP (Double -> Matrix -> Matrix
rotate Double
a 1)
scaleP :: Vector -> Point -> Point
scaleP :: Vector -> Point -> Point
scaleP s :: Vector
s = Matrix -> Point -> Point
transformP (Vector -> Matrix -> Matrix
scale Vector
s 1)
translateP :: Vector -> Point -> Point
translateP :: Vector -> Point -> Point
translateP = (Point -> Vector -> Point) -> Vector -> Point -> Point
forall a b c. (a -> b -> c) -> b -> a -> c
flip Point -> Vector -> Point
pvadd
data Matrix = Matrix { Matrix -> Double
xx :: !Double, Matrix -> Double
yx :: !Double,
Matrix -> Double
xy :: !Double, Matrix -> Double
yy :: !Double,
Matrix -> Double
x0 :: !Double, Matrix -> Double
y0 :: !Double }
deriving Int -> Matrix -> ShowS
[Matrix] -> ShowS
Matrix -> String
(Int -> Matrix -> ShowS)
-> (Matrix -> String) -> ([Matrix] -> ShowS) -> Show Matrix
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Matrix] -> ShowS
$cshowList :: [Matrix] -> ShowS
show :: Matrix -> String
$cshow :: Matrix -> String
showsPrec :: Int -> Matrix -> ShowS
$cshowsPrec :: Int -> Matrix -> ShowS
Show
instance Num Matrix where
* :: Matrix -> Matrix -> Matrix
(*) (Matrix xx_ :: Double
xx_ yx_ :: Double
yx_ xy_ :: Double
xy_ yy_ :: Double
yy_ x0_ :: Double
x0_ y0_ :: Double
y0_)
(Matrix xx'_ :: Double
xx'_ yx'_ :: Double
yx'_ xy'_ :: Double
xy'_ yy'_ :: Double
yy'_ x0'_ :: Double
x0'_ y0'_ :: Double
y0'_) =
Double -> Double -> Double -> Double -> Double -> Double -> Matrix
Matrix (Double
xx_ Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
xx'_ Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
yx_ Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
xy'_)
(Double
xx_ Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
yx'_ Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
yx_ Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
yy'_)
(Double
xy_ Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
xx'_ Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
yy_ Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
xy'_)
(Double
xy_ Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
yx'_ Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
yy_ Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
yy'_)
(Double
x0_ Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
xx'_ Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
y0_ Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
xy'_ Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x0'_)
(Double
x0_ Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
yx'_ Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
y0_ Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
yy'_ Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
y0'_)
+ :: Matrix -> Matrix -> Matrix
(+) = (Double -> Double -> Double) -> Matrix -> Matrix -> Matrix
pointwise2 Double -> Double -> Double
forall a. Num a => a -> a -> a
(+)
(-) = (Double -> Double -> Double) -> Matrix -> Matrix -> Matrix
pointwise2 (-)
negate :: Matrix -> Matrix
negate = (Double -> Double) -> Matrix -> Matrix
pointwise Double -> Double
forall a. Num a => a -> a
negate
abs :: Matrix -> Matrix
abs = (Double -> Double) -> Matrix -> Matrix
pointwise Double -> Double
forall a. Num a => a -> a
abs
signum :: Matrix -> Matrix
signum = (Double -> Double) -> Matrix -> Matrix
pointwise Double -> Double
forall a. Num a => a -> a
signum
fromInteger :: Integer -> Matrix
fromInteger n :: Integer
n = Double -> Double -> Double -> Double -> Double -> Double -> Matrix
Matrix (Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
n) 0 0 (Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
n) 0 0
{-# INLINE pointwise #-}
pointwise :: (Double -> Double) -> Matrix -> Matrix
pointwise :: (Double -> Double) -> Matrix -> Matrix
pointwise f :: Double -> Double
f (Matrix xx_ :: Double
xx_ yx_ :: Double
yx_ xy_ :: Double
xy_ yy_ :: Double
yy_ x0_ :: Double
x0_ y0_ :: Double
y0_) =
Double -> Double -> Double -> Double -> Double -> Double -> Matrix
Matrix (Double -> Double
f Double
xx_) (Double -> Double
f Double
yx_) (Double -> Double
f Double
xy_) (Double -> Double
f Double
yy_) (Double -> Double
f Double
x0_) (Double -> Double
f Double
y0_)
{-# INLINE pointwise2 #-}
pointwise2 :: (Double -> Double -> Double) -> Matrix -> Matrix -> Matrix
pointwise2 :: (Double -> Double -> Double) -> Matrix -> Matrix -> Matrix
pointwise2 f :: Double -> Double -> Double
f (Matrix xx_ :: Double
xx_ yx_ :: Double
yx_ xy_ :: Double
xy_ yy_ :: Double
yy_ x0_ :: Double
x0_ y0_ :: Double
y0_) (Matrix xx'_ :: Double
xx'_ yx'_ :: Double
yx'_ xy'_ :: Double
xy'_ yy'_ :: Double
yy'_ x0'_ :: Double
x0'_ y0'_ :: Double
y0'_) =
Double -> Double -> Double -> Double -> Double -> Double -> Matrix
Matrix (Double -> Double -> Double
f Double
xx_ Double
xx'_) (Double -> Double -> Double
f Double
yx_ Double
yx'_) (Double -> Double -> Double
f Double
xy_ Double
xy'_) (Double -> Double -> Double
f Double
yy_ Double
yy'_) (Double -> Double -> Double
f Double
x0_ Double
x0'_) (Double -> Double -> Double
f Double
y0_ Double
y0'_)
identity :: Matrix
identity :: Matrix
identity = Double -> Double -> Double -> Double -> Double -> Double -> Matrix
Matrix 1 0 0 1 0 0
translate :: Vector -> Matrix -> Matrix
translate :: Vector -> Matrix -> Matrix
translate tv :: Vector
tv m :: Matrix
m = Matrix
m Matrix -> Matrix -> Matrix
forall a. Num a => a -> a -> a
* Double -> Double -> Double -> Double -> Double -> Double -> Matrix
Matrix 1 0 0 1 (Vector -> Double
v_x Vector
tv) (Vector -> Double
v_y Vector
tv)
scale :: Vector -> Matrix -> Matrix
scale :: Vector -> Matrix -> Matrix
scale sv :: Vector
sv m :: Matrix
m = Matrix
m Matrix -> Matrix -> Matrix
forall a. Num a => a -> a -> a
* Double -> Double -> Double -> Double -> Double -> Double -> Matrix
Matrix (Vector -> Double
v_x Vector
sv) 0 0 (Vector -> Double
v_y Vector
sv) 0 0
rotate :: Double -> Matrix -> Matrix
rotate :: Double -> Matrix -> Matrix
rotate r :: Double
r m :: Matrix
m = Matrix
m Matrix -> Matrix -> Matrix
forall a. Num a => a -> a -> a
* Double -> Double -> Double -> Double -> Double -> Double -> Matrix
Matrix Double
c Double
s (-Double
s) Double
c 0 0
where s :: Double
s = Double -> Double
forall a. Floating a => a -> a
sin Double
r
c :: Double
c = Double -> Double
forall a. Floating a => a -> a
cos Double
r
scalarMultiply :: Double -> Matrix -> Matrix
scalarMultiply :: Double -> Matrix -> Matrix
scalarMultiply scalar :: Double
scalar = (Double -> Double) -> Matrix -> Matrix
pointwise (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
scalar)
adjoint :: Matrix -> Matrix
adjoint :: Matrix -> Matrix
adjoint (Matrix a :: Double
a b :: Double
b c :: Double
c d :: Double
d tx :: Double
tx ty :: Double
ty) =
Double -> Double -> Double -> Double -> Double -> Double -> Matrix
Matrix Double
d (-Double
b) (-Double
c) Double
a (Double
cDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
ty Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
dDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
tx) (Double
bDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
tx Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
aDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
ty)
invert :: Matrix -> Matrix
invert :: Matrix -> Matrix
invert m :: Matrix
m@(Matrix xx_ :: Double
xx_ yx_ :: Double
yx_ xy_ :: Double
xy_ yy_ :: Double
yy_ _ _) = Double -> Matrix -> Matrix
scalarMultiply (Double -> Double
forall a. Fractional a => a -> a
recip Double
det) (Matrix -> Matrix) -> Matrix -> Matrix
forall a b. (a -> b) -> a -> b
$ Matrix -> Matrix
adjoint Matrix
m
where det :: Double
det = Double
xx_Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
yy_ Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
yx_Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
xy_