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