module Wumpus.Core.AffineTrans
(
Transform(..)
, Rotate(..)
, RotateAbout(..)
, Scale(..)
, Translate(..)
, rotate30
, rotate30About
, rotate45
, rotate45About
, rotate60
, rotate60About
, rotate90
, rotate90About
, rotate120
, rotate120About
, uniformScale
, reflectX
, reflectY
, translateBy
, reflectXPlane
, reflectYPlane
) where
import Wumpus.Core.Geometry
class Transform t where
transform :: u ~ DUnit t => Matrix3'3 u -> t -> t
instance Transform (UNil u) where
transform _ = id
instance Num u => Transform (Point2 u) where
transform ctm = (ctm *#)
instance Num u => Transform (Vec2 u) where
transform ctm = (ctm *#)
class Rotate t where
rotate :: Radian -> t -> t
instance Rotate (UNil u) where
rotate _ = id
instance Rotate a => Rotate (Maybe a) where
rotate = fmap . rotate
instance (Rotate a, Rotate b, u ~ DUnit a, u ~ DUnit b) => Rotate (a,b) where
rotate ang (a,b) = (rotate ang a, rotate ang b)
instance (Floating u, Real u) => Rotate (Point2 u) where
rotate ang = ((rotationMatrix ang) *#)
instance (Floating u, Real u) => Rotate (Vec2 u) where
rotate ang = ((rotationMatrix ang) *#)
class RotateAbout t where
rotateAbout :: u ~ DUnit t => Radian -> Point2 u -> t -> t
instance RotateAbout (UNil u) where
rotateAbout _ _ = id
instance RotateAbout a => RotateAbout (Maybe a) where
rotateAbout ang pt = fmap (rotateAbout ang pt)
instance (RotateAbout a, RotateAbout b, u ~ DUnit a, u ~ DUnit b) =>
RotateAbout (a,b) where
rotateAbout ang pt (a,b) = (rotateAbout ang pt a, rotateAbout ang pt b)
instance (Floating u, Real u) => RotateAbout (Point2 u) where
rotateAbout ang pt = ((originatedRotationMatrix ang pt) *#)
instance (Floating u, Real u) => RotateAbout (Vec2 u) where
rotateAbout ang pt = ((originatedRotationMatrix ang pt) *#)
class Scale t where
scale :: u ~ DUnit t => u -> u -> t -> t
instance Scale (UNil u) where
scale _ _ = id
instance Scale a => Scale (Maybe a) where
scale sx sy = fmap (scale sx sy)
instance (Scale a, Scale b, u ~ DUnit a, u ~ DUnit b) => Scale (a,b) where
scale sx sy (a,b) = (scale sx sy a, scale sx sy b)
instance Num u => Scale (Point2 u) where
scale sx sy = ((scalingMatrix sx sy) *#)
instance Num u => Scale (Vec2 u) where
scale sx sy = ((scalingMatrix sx sy) *#)
class Translate t where
translate :: u ~ DUnit t => u -> u -> t -> t
instance Translate (UNil u) where
translate _ _ = id
instance (Translate a, Translate b, u ~ DUnit a, u ~ DUnit b) =>
Translate (a,b) where
translate dx dy (a,b) = (translate dx dy a, translate dx dy b)
instance Translate a => Translate (Maybe a) where
translate dx dy = fmap (translate dx dy)
instance Num u => Translate (Point2 u) where
translate dx dy (P2 x y) = P2 (x+dx) (y+dy)
instance Num u => Translate (Vec2 u) where
translate dx dy (V2 x y) = V2 (x+dx) (y+dy)
rotate30 :: Rotate t => t -> t
rotate30 = rotate (pi/6)
rotate30About :: (RotateAbout t, DUnit t ~ u) => Point2 u -> t -> t
rotate30About = rotateAbout (pi/6)
rotate45 :: Rotate t => t -> t
rotate45 = rotate (pi/4)
rotate45About :: (RotateAbout t, DUnit t ~ u) => Point2 u -> t -> t
rotate45About = rotateAbout (pi/4)
rotate60 :: Rotate t => t -> t
rotate60 = rotate (2*pi/3)
rotate60About :: (RotateAbout t, DUnit t ~ u) => Point2 u -> t -> t
rotate60About = rotateAbout (2*pi/3)
rotate90 :: Rotate t => t -> t
rotate90 = rotate (pi/2)
rotate90About :: (RotateAbout t, DUnit t ~ u) => Point2 u -> t -> t
rotate90About = rotateAbout (pi/2)
rotate120 :: Rotate t => t -> t
rotate120 = rotate (4*pi/3)
rotate120About :: (RotateAbout t, DUnit t ~ u) => Point2 u -> t -> t
rotate120About = rotateAbout (4*pi/3)
uniformScale :: (Scale t, DUnit t ~ u) => u -> t -> t
uniformScale a = scale a a
reflectX :: (Num u, Scale t, DUnit t ~ u) => t -> t
reflectX = scale (1) 1
reflectY :: (Num u, Scale t, DUnit t ~ u) => t -> t
reflectY = scale 1 (1)
translateBy :: (Translate t, DUnit t ~ u) => Vec2 u -> t -> t
translateBy (V2 x y) = translate x y
reflectXPlane :: (Num u, Scale t, Translate t, u ~ DUnit t)
=> Point2 u -> t -> t
reflectXPlane (P2 x y) = translate x y . scale (1) 1 . translate (x) (y)
reflectYPlane :: (Num u, Scale t, Translate t, u ~ DUnit t)
=> Point2 u -> t -> t
reflectYPlane (P2 x y) = translate x y . scale 1 (1) . translate (x) (y)