{-
Mandulia -- Mandelbrot/Julia explorer
Copyright (C) 2010  Claude Heiland-Allen <claudiusmaximus@goto10.org>

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.
-}

module Vector
  ( R
  , V(..)
  , M(..)
  , (^*)
  , (^/)
  , (^+^)
  , (^-^)
  , (^|-|^)
  , (^^*^)
  , (^^*^^)
  , translate
  , scale
  , rotate
  ) where

type R = Double
data V = V !R !R !R deriving (Show, Read, Eq, Ord)
data M = M !V !V !V deriving (Show, Read, Eq, Ord)

translate :: R -> R -> M
translate x y = M (V 1 0 x) (V 0 1 y) (V 0 0 1)

scale :: R -> R -> M
scale x y = M (V x 0 0) (V 0 y 0) (V 0 0 1)

rotate :: R -> M
rotate a = M (V c s 0) (V (-s) c 0) (V 0 0 1)
  where
    s = sin a
    c = cos a

(^*) :: V -> R -> V
(V a b c)  ^*   x = V (a*x) (b*x) (c*x)

(^/) :: V -> R -> V
(V a b c)  ^/   x = V (a/x) (b/x) (c/x)

(^+^) :: V -> V -> V
(V a b c)  ^+^  (V x y z) = V (a+x) (b+y) (c+z)

(^-^) :: V -> V -> V
(V a b c)  ^-^  (V x y z) = V (a-x) (b-y) (c-z)

{-
dot :: V -> V -> R
(V a b c) `dot` (V x y z) = sumV $ V (a*x) (b*y) (c*z)
-}

dot :: V -> V -> R
(V a b c) `dot` (V x y z) = a*x + b*y + c*z

{-
(^^*^) :: M -> V -> V
(M a b c) ^^*^  v = V (a`dot`v) (b`dot`v) (c`dot`v)
-}

(^^*^) :: M -> V -> V
(M (V a b c) (V d e f) (V g h i)) ^^*^ (V r u x) =
  V (a * r + b * u + c * x)
    (d * r + e * u + f * x)
    (g * r + h * u + i * x)

{-
(^^*^^) :: M -> M -> M
(M a b c) ^^*^^ m = let M x y z = transposeM m
                    in M (V (a`dot`x) (a`dot`y) (a`dot`z))
                         (V (b`dot`x) (b`dot`y) (b`dot`z))
                         (V (c`dot`x) (c`dot`y) (c`dot`z))
-}

(^^*^^) :: M -> M -> M
(M (V a b c) (V d e f) (V g h i)) ^^*^^ (M (V r s t) (V u v w) (V x y z)) =
  M (V (a * r + b * u + c * x) (a * s + b * v + c * y) (a * t + b * w + c * z))
    (V (d * r + e * u + f * x) (d * s + e * v + f * y) (d * t + e * w + f * z))
    (V (g * r + h * u + i * x) (g * s + h * v + i * y) (g * t + h * w + i * z))

(^|-|^) :: V -> V -> R
u ^|-|^ v = let d = u ^-^ v in sqrt $ d `dot` d

{-
import Numeric (showFFloat)

sumV :: V -> R
sumV (V a b c) = a + b + c

identity :: M
identity = M (V 1 0 0) (V 0 1 0) (V 0 0 1)

transposeM :: M -> M
transposeM (M (V a b c) (V d e f) (V g h i)) =
            M (V a d g) (V b e h) (V c f i)

prettyR :: R -> String
prettyR x = (if x < 0 then id else ('+':)) $ showFFloat (Just 6) x ""

prettyV :: V -> String
prettyV (V a b c) = unwords . map prettyR $ [a,b,c]

prettyM :: M -> String
prettyM (M a b c) = unlines . map prettyV $ [a,b,c]
-}