diff options
author | Matthias Schiffer <mschiffer@universe-factory.net> | 2011-06-26 20:55:51 +0200 |
---|---|---|
committer | Matthias Schiffer <mschiffer@universe-factory.net> | 2011-06-26 20:55:51 +0200 |
commit | cc53496bab9ad2bbfc3fb2868cd10fa46f612e69 (patch) | |
tree | f974028160c90e5a373c3ac38d8d7229c419aaa7 /src/Vector.hs | |
parent | 8f1fd98cd69659446b9fdd11c0f3d2b860d779f7 (diff) | |
download | htanks-cc53496bab9ad2bbfc3fb2868cd10fa46f612e69.tar htanks-cc53496bab9ad2bbfc3fb2868cd10fa46f612e69.zip |
Reworked Transform as a type class
Diffstat (limited to 'src/Vector.hs')
-rw-r--r-- | src/Vector.hs | 70 |
1 files changed, 52 insertions, 18 deletions
diff --git a/src/Vector.hs b/src/Vector.hs index 847be58..174afd3 100644 --- a/src/Vector.hs +++ b/src/Vector.hs @@ -1,12 +1,20 @@ {-# LANGUAGE TypeFamilies #-} -module Vector ( Vertex(..) +module Vector ( Coord + , Transformable(..) + , Transform(..) + , ReversibleTransform(..) + , Vertex(..) , Vector(..) + , Rotation + , zeroV + , (^+^) + , negateV + , (><) , toAngle - , translateV - , translateV' - , rotateV - , rotateV' + , fromAngle + , toVector + , fromVector , diffV ) where @@ -18,13 +26,14 @@ import Data.LinearMap data Vertex = Vertex { vertexX :: Coord, vertexY :: Coord } deriving (Show, Eq) instance Transformable Vertex where - t >< (Vertex x y) = Vertex x' y' + transform t (Vertex x y) = Vertex x' y' where (x', y', _) = t >< (x, y, 1) :: Vector3 data Vector = Vector { vectorX :: Coord, vectorY :: Coord } deriving (Show, Eq) + instance Transformable Vector where - t >< (Vector x y) = Vector x' y' + transform t (Vector x y) = Vector x' y' where (x', y', _) = t >< (x, y, 0) :: Vector3 @@ -35,25 +44,50 @@ instance AdditiveGroup Vector where instance VectorSpace Vector where type Scalar Vector = Coord - s *^ Vector x y = Vector (s*x) (s*y) + r *^ Vector x y = Vector (r*x) (r*y) instance InnerSpace Vector where Vector x1 y1 <.> Vector x2 y2 = x1*x2 + y1*y2 -toAngle :: Vector -> Coord -toAngle (Vector x y) = atan2 y x +instance Transform Vector where + toMap (Vector dx dy) = linear $ \(x, y, w) -> (x+w*dx, y+w*dy, w) + +instance ReversibleTransform Vector where + toMap' = toMap . negateV + +data Rotation = Rotation { rotC :: Coord, rotS :: Coord } deriving (Show, Eq) + +instance Transformable Rotation where + transform t (Rotation c s) = Rotation (c'/l) (s'/l) + where + (c', s', _) = t >< (c, s, 0) :: Vector3 + l = sqrt $ c'^2 + s'^2 + +instance AdditiveGroup Rotation where + zeroV = Rotation 1 0 + Rotation c1 s1 ^+^ Rotation c2 s2 = Rotation (c1*c2 - s1*s2) (s1*c2 + c1*s2) + negateV (Rotation c s) = Rotation (-c) s + +instance Transform Rotation where + toMap (Rotation c s) = linear $ \(x, y, w) -> (c*x - s*y, s*x + c*y, w) + +instance ReversibleTransform Rotation where + toMap' = toMap . negateV + -translateV :: Vector -> Transform -translateV (Vector x y) = translate x y +toAngle :: Rotation -> Coord +toAngle (Rotation c s) = atan2 s c -translateV' :: Vector -> Transform -translateV' = translateV . negateV +fromAngle :: Coord -> Rotation +fromAngle a = Rotation (cos a) (sin a) -rotateV :: Vector -> Transform -rotateV (Vector c s) = linear $ \(x, y, w) -> (c*x - s*y, s*x + c*y, w) +toVector :: Rotation -> Vector +toVector (Rotation c s) = Vector c s -rotateV' :: Vector -> Transform -rotateV' (Vector c s) = rotateV $ Vector c (-s) +fromVector :: Vector -> Rotation +fromVector v = Rotation x y + where + Vector x y = normalized v diffV :: Vertex -> Vertex -> Vector diffV (Vertex x1 y1) (Vertex x2 y2) = Vector (x2-x1) (y2-y1) |