--------------------------------------------------------------------------- -- | -- Module : Main -- Copyright : (c) alpheccar, 2007 -- License : BSD-style -- -- Maintainer : misc@alpheccar.org -- Stability : experimental -- Portability : non-portable (multi-parameter type classes) -- -- Description -- -- Some geometry operations used by the IFS -- ----------------------------------------------------------------------------- module Graphics.IFS.Geometry ( -- * Types -- ** Matrix and Vector M , V(..) -- ** Non linear transformations , NonLinear , NonLinearTransform(..) -- ** Modules , Module(..) -- * Creating linear transformations , linear , rotation , scaling , translation -- * Non linear transformations , v0 , v1 , v2 , v3 , v4 , v5 , v6 , v7 , v8 , v9 , v10 , v11 , v12 -- * Misc , startVector , inv , det ) where -- | Affine transform on 2x2 space newtype M a = M(a,a,a,a,a,a) deriving(Eq,Show) -- | Vector newtype V a = V(a,a) deriving(Eq,Show) -- | A pure non linear transformation type NonLinear a = V a -> V a -- | A non linear transformation with a pure non linear part and an affine one newtype NonLinearTransform a = NL (NonLinear a,M a) -- | Start vector used to initiate the generation of a random trajectory startVector :: V Double startVector = V(0.5,0.5) instance Num a => Num (M a) where (+) (M (a,b,c,d,e,f)) (M (a',b',c',d',e',f')) = M (a+a',b+b',c+c',d+d',e+e',f+f') (-) (M (a,b,c,d,e,f)) (M (a',b',c',d',e',f')) = M (a-a',b-b',c-c',d-d',e-e',f-f') (*) (M (a,b,c,d,e,f)) (M (a',b',c',d',e',f')) = M (a*a' + b*c',a*b' + b*d',c*a' + d*c',c*b' + d*d',a*e' + b*f' + e,c*e' + d*f' + f) abs (M (a,b,c,d,e,f)) = M (abs a,abs b,abs c,abs d,abs e,abs f) -- Just because I need to define it :-( signum (M (a,b,c,d,e,f)) = M (signum a,signum b,signum c,signum d,signum e,signum f) -- Just because I need to define it :-( fromInteger a = M (fromInteger a,0,0,fromInteger a,0,0) instance Num a => Num (V a) where (+) (V (a,b)) (V (a',b')) = V (a+a',b+b') (-) (V (a,b)) (V (a',b')) = V (a-a',b-b') (*) (V (a,b)) (V (a',b')) = V (a*a',b*b') abs (V (a,b)) = V (abs a,abs b) -- Just because I need to define it :-( signum (V (a,b)) = V (signum a,signum b) -- Just because I need to define it :-( fromInteger a = V (fromInteger a,0 )-- arbitrary infixr 5 <*> -- | Elements which can be transformed by an operator class Module a b where (<*>) :: a -> b -> b instance Num a => Module a (V a) where (<*>) a (V (x,y)) = V (a*x,a*y) instance Num a => Module a (M a) where (<*>) x (M (a,b,c,d,e,f)) = M (x*a,b,c,x*d,x*e,x*f) instance Num a => Module (M a) (V a) where (<*>) (M (a,b,c,d,e,f)) (V (x,y)) = V (a*x+b*y + e,c*x+d*y + f) instance Num a => Module (NonLinearTransform a) (V a) where (<*>) (NL(f,m)) v = f (m <*> v) instance Num a => Module (NonLinear a) (NonLinearTransform a) where f <*> (NL(g,m)) = NL (f.g,m) det :: (Num a) => M a -> a det (M (a,b,c,d,_,_)) = a*d - b*c inv :: (Fractional a) => M a -> M a inv m@(M (a,b,c,d,e,f)) = M(d/de,-b/de,-c/de,a/de,0,0) * M(1,0,0,1,-e,-f) where de = det m -- | Create a pure affine transformation -- Linear part: -- a b -- c d -- Affine part: -- e -- f linear :: Num a => a -- ^ a -> a -- ^ b -> a -- ^ c -> a -- ^ d -> a -- ^ e -> a -- ^ f -> M a linear a b c d e f =M(a,b,c,d,e,f) -- | Linear v0 ::NonLinear Double v0 (V(x,y)) = V(x,y) -- | Sinusoidal v1 :: NonLinear Double v1 (V(x,y)) = V(sin x,sin y) -- | Spherical v2 :: NonLinear Double v2 (V(x,y)) = V(x/(r2+1e-6),y/(r2+1e-6)) where r2 = x*x + y*y -- | Swirl v3 :: NonLinear Double v3 (V(x,y)) = V(r*cos(theta+r),r*sin(theta+r)) where theta = atan(x/y) r = sqrt(x*x + y*y) -- | Horseshoe v4 :: NonLinear Double v4 (V(x,y)) = V(r*cos(2*theta),r*sin(2*theta)) where theta = atan(x/y) r = sqrt(x*x + y*y) -- | Polar v5 :: NonLinear Double v5 (V(x,y)) = V(theta/pi,r-1) where theta = atan(x/y) r = sqrt(x*x + y*y) -- | Handkerchief v6 :: NonLinear Double v6 (V(x,y)) = V(r*sin(theta+r),r*cos(theta-r)) where theta = atan(x/y) r = sqrt(x*x + y*y) -- | Heart v7 :: NonLinear Double v7 (V(x,y)) = V(r*sin(theta*r),-r*cos(theta*r)) where theta = atan(x/y) r = sqrt(x*x + y*y) -- | Disc v8 :: NonLinear Double v8 (V(x,y)) = V(theta*sin(pi*r)/pi,theta*cos(pi*r)/pi) where theta = atan(x/y) r = sqrt(x*x + y*y) -- | Spiral v9 :: NonLinear Double v9 (V(x,y)) = V(((cos theta) + (sin r))/r,((sin theta)-(cos r))/r) where theta = atan(x/y) r = sqrt(x*x + y*y) -- | Hyperbolic v10 :: NonLinear Double v10 (V(x,y)) = V(sin(theta)/r,cos(theta)*r) where theta = atan(x/y) r = sqrt(x*x + y*y) -- | Diamond v11 :: NonLinear Double v11 (V(x,y)) = V((sin theta)*(cos r),(cos theta)*(sin r)) where theta = atan(x/y) r = x*x + y*y -- | Ex v12 :: NonLinear Double v12 (V(x,y)) = V(r*(sin(theta+r))^3,r*(cos(theta-r))^3) where theta = atan(x/y) r = sqrt(x*x + y*y) rotation :: Double -> M Double rotation t = M (cos (t*pi/180),sin (t*pi/180),-sin (t*pi/180),cos (t*pi/180),0,0) scaling :: Double -> Double -> M Double scaling sx sy = M(sx,0,0,sy,0,0) translation :: Double -> Double -> M Double translation tx ty = M(1,0,0,1,tx,ty)