module Language.Mecha.Solid
  ( Solid (..)
  ) where

import Language.Mecha.Types

-- | A solid is a predicate that is true if the point is inside the solid.
data Solid = Solid (Vector -> Bool)

transform :: Matrix4 -> Solid -> Solid   -- Matrix is from real world back to primitive (inverse transform matrix).
transform m (Solid f) = Solid $ \ a -> f $ m4v3 m a

instance Moveable Solid where
  move (x, y, z) = transform
    ( (1, 0, 0, -x)
    , (0, 1, 0, -y)
    , (0, 0, 1, -z)
    , (0, 0, 0,  1)
    )
  rotate (x', y', z') a' = transform
    ( (xx + cos a * (1 - xx) + sin a *   0 ,    xy + cos a * (0 - xy) + sin a * (-z),    xz + cos a * (0 - xz) + sin a *   y ,    0)
    , (xy + cos a * (0 - xy) + sin a *   z ,    yy + cos a * (1 - yy) + sin a *   0 ,    yz + cos a * (0 - yz) + sin a * (-x),    0)
    , (xz + cos a * (0 - xz) + sin a * (-y),    yz + cos a * (0 - yz) + sin a *   x ,    zz + cos a * (1 - zz) + sin a *   0 ,    0)
    , (0                                   ,    0                                   ,    0                                   ,    1)
    )
    where
    m = sqrt $ x' ** 2 + y' ** 2 + z' ** 2
    x = x' / m
    y = y' / m
    z = z' / m
    xx = x ** 2
    yy = y ** 2
    zz = z ** 2
    xy = x * y
    xz = x * z
    yz = y * z
    a = -a'  -- Reverse direction for inverse matrix.

instance Scaleable Solid where
  scale (x, y, z) = transform
    ( (1/x,   0,   0,   0)
    , (  0, 1/y,   0,   0)
    , (  0,   0, 1/z,   0)
    , (  0,   0,   0,   1)
    )

instance Setable Solid where
  union        (Solid a) (Solid b) = Solid $ \ p -> a p || b p
  intersection (Solid a) (Solid b) = Solid $ \ p -> a p && b p
  difference   (Solid a) (Solid b) = Solid $ \ p -> a p && not (b p)


type Matrix4 = (Vector4, Vector4, Vector4, Vector4)
type Vector4 = (Double, Double, Double, Double)

mv4 :: Matrix4 -> Vector4 -> Vector4
mv4 a b = x
  where
  ((a11, a12, a13, a14), (a21, a22, a23, a24), (a31, a32, a33, a34), (a41, a42, a43, a44)) = a
  (b1, b2, b3, b4) = b
  x1 = a11 * b1 + a12 * b2 + a13 * b3 + a14 * b4
  x2 = a21 * b1 + a22 * b2 + a23 * b3 + a24 * b4
  x3 = a31 * b1 + a32 * b2 + a33 * b3 + a34 * b4
  x4 = a41 * b1 + a42 * b2 + a43 * b3 + a44 * b4
  x = (x1, x2, x3, x4)

to4 :: Vector -> Vector4
to4 (x, y, z) = (x, y, z, 1)

to3 :: Vector4 -> Vector
to3 (x, y, z, w) = (x / w, y / w, z / w)

m4v3 :: Matrix4 -> Vector -> Vector
m4v3 m a = to3 $ mv4 m $ to4 a