---------------------------------------------------------------------------
-- |
-- 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)