Utility.hs

module Graphics.LambdaCube.Utility where

import Data.List hiding (transpose)

import Graphics.LambdaCube.Types

groupSetBy :: (a -> a -> Ordering) -> [a] -> [[a]]
groupSetBy f = groupBy (\x y -> f x y == EQ) . sortBy f

{-
groupSetBy :: (a -> a -> Bool) -> [a] -> [[a]]
groupSetBy f l = foldl' g [] l
  where
    g el e = case partition ((f e) . head) el of
        { ([],el')      -> [e]:el'
        ; ([gl],el')    -> (e:gl):el'
        ; _ -> error "Invalid case!"
        }
-}

-- | Perspective transformation matrix.
perspective :: FloatType  -- ^ Near plane clipping distance (always positive).
            -> FloatType  -- ^ Far plane clipping distance (always positive).
            -> FloatType  -- ^ Field of view of the y axis, in radians.
            -> FloatType  -- ^ Aspect ratio, i.e. screen's width\/height.
            -> Mat4
perspective n f fovy aspect = transpose $
    Mat4 (Vec4 (2*n/(r-l)) 0 (-(r+l)/(r-l)) 0)
         (Vec4 0 (2*n/(t-b)) ((t+b)/(t-b)) 0)
         (Vec4 0 0 (-(f+n)/(f-n)) (-2*f*n/(f-n)))
         (Vec4 0 0 (-1) 0)
  where
    t = n*tan(fovy/2)
    b = -t
    r = aspect*t
    l = -r

-- | Pure orientation matrix defined by Euler angles.
rotationEuler :: Vec3 -> Proj4
rotationEuler (Vec3 a b c) = orthogonal $ toOrthoUnsafe $ rotMatrixY a .*. rotMatrixX b .*. rotMatrixZ c

-- | Camera transformation matrix.
lookat :: Vec3   -- ^ Camera position.
       -> Vec3   -- ^ Target position.
       -> Vec3   -- ^ Upward direction.
       -> Proj4
lookat pos target up = translateBefore4 (neg pos) (orthogonal $ toOrthoUnsafe r)
  where
    w = normalize $ pos &- target
    u = normalize $ up &^ w
    v = w &^ u
    r = transpose $ Mat3 u v w

foldM' :: Monad m => (a -> b -> m a) -> a -> [b] -> m a
foldM' _ a []     = return a
foldM' f a (x:xs) = f a x >>= \fax -> fax `seq` foldM' f fax xs