From cc53496bab9ad2bbfc3fb2868cd10fa46f612e69 Mon Sep 17 00:00:00 2001
From: Matthias Schiffer <mschiffer@universe-factory.net>
Date: Sun, 26 Jun 2011 20:55:51 +0200
Subject: Reworked Transform as a type class

---
 src/Transformable.hs | 40 +++++++++++++++++++++++-----------------
 1 file changed, 23 insertions(+), 17 deletions(-)

(limited to 'src/Transformable.hs')

diff --git a/src/Transformable.hs b/src/Transformable.hs
index 2fd64fe..335b477 100644
--- a/src/Transformable.hs
+++ b/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
+
+instance Transform TransformMap where
+  toMap = id
+
+instance Transformable TransformMap where
+  transform = (*.*)
 
-translate :: Coord -> Coord -> Transform
-translate dx dy = linear $ \(x, y, w) -> (x + w*dx, y + w*dy, w)
+(><) :: (Transform t, Transformable a) => t -> a -> a
+t >< a = transform (toMap t) a
 
-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
+(>:<) :: (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)
-- 
cgit v1.2.3