Reworked Transform as a type class

src/Transformable.hs

@@ -2,11 +2,12 @@
 
 module Transformable ( Coord
                      , Vector3
-                     , Transform
+                     , TransformMap
+                     , Transform(..)
+                     , ReversibleTransform(..)
                      , Transformable(..)
-                     , translate
-                     , rotate
-                     , scale
+                     , (><)
+                     , (>:<)
                      ) where
 
 import Data.LinearMap
@@ -14,24 +15,29 @@ import Data.LinearMap
 type Coord = Double
 
 type Vector3 = (Coord, Coord, Coord)
-type Transform = Vector3 :-* Vector3
+type TransformMap = Vector3 :-* Vector3
 
 class Transformable a where
-  (><) :: Transform -> a -> a
+  transform :: TransformMap -> a -> a
 
-instance Transformable Transform where
-  t1 >< t2 = t1 *.* t2
+class Transform a where
+  toMap :: a -> TransformMap
+
+class Transform a => ReversibleTransform a where
+  toMap' :: a -> TransformMap
 
 instance Transformable Vector3 where
-  t >< v = t `lapply` v
+  transform = lapply
 
-translate :: Coord -> Coord -> Transform
-translate dx dy = linear $ \(x, y, w) -> (x + w*dx, y + w*dy, w)
+instance Transform TransformMap where
+  toMap = id
 
-rotate :: Coord -> Transform
-rotate a = linear $ \(x, y, w) -> (c*x - s*y, s*x + c*y, w) where
-  c = cos a
-  s = sin a
+instance Transformable TransformMap where
+  transform = (*.*)
+
+(><) :: (Transform t, Transformable a) => t -> a -> a
+t >< a = transform (toMap t) a
+
+(>:<) :: (ReversibleTransform t, Transformable a) => t -> a -> a
+t >:< a = transform (toMap' t) a
 
-scale :: Coord -> Transform
-scale s = linear $ \(x, y, w) -> (s*y, s*y, w)