module Model.Mechanics
 (module System.Random
 ,module Model.Object
 ,tag
 ,mergeCollading
 ,createNew
 ,move
 )
where

import Data.Maybe
import System.Random

import Model.Object


{- findPointed function.

    Extracts an object from an object list which contains a supplied point.

    It is assumed that there might not be two or more objects containing
    supplied point. These objects are colliding and should be eliminated
    before to call this function.
    
    Still, if there are more then one objects in a list containg supplied
    point, then findPointed function returns the first one.

-}
findPointed :: (Floating a, Ord a) =>
    Pnt a -> [Object a] -> (Maybe (Object a), [Object a])
findPointed p objs =
    -- Break list until the object containing a point.
    let (before, after) = break (objectHas p) objs
        in case after of
            -- If the whole list doesn't have it, then return nothing.
            []   -> (Nothing, objs)
            -- Otherwise, the first element in 'after' is that object.
            x:xs -> (Just x,  before ++ xs)


{- findColladingWith.

    Finds first object colliding with supplied one.

    It returns a triple of
    
        * Maybe collading object;
        * Not collading objects;
        * Didn't cheked for being colliding objects.
-}

firstCollidingWith :: (Floating a, Ord a) =>
    Object a -> [Object a] -> (Maybe (Object a), [Object a], [Object a])
firstCollidingWith obj objS = 
    -- Break list until the object containing a supplied one.
    let (before, after) = break (objectCollidingWith obj) objS
        in case after of
            -- If the whole list doesn't have it, then return nothing.
            []   -> (Nothing, objS, [])
            -- Otherwise, the first element in 'after' is that object.
            x:xs -> (Just x,  before, xs)


{- allColladingWith.

    Reduces all objects supplied with the given one.

    It extracts all collading objects with supplied one
    and then merges them into one.

    It returns a tuple of a result of mergin and a list
    of objects without any collading with supplied one.

-}
allColladingWith :: (Floating a, Ord a) =>
    Object a -> [Object a] -> ([Object a], [Object a])
allColladingWith obj =

    -- Collect collading objects into a list.
    collectCollading .
        -- Split collading objects from other ones.
        splitCollading

    where

        {-
            The functions below works with triples of form:
                ([Maybe (Object a)], [Object a], [Object a])

            where
                * first:  collading objects;
                * second: not collading objects;
                * third:  unchecked objects.

            These triples is called normalized if the list of
            unchecked objects is empty.

            Reducing drops elements of unchecked list until first
            collading object.
        -}

        -- Collecting just maps list of maybes to list of objects.
        collectCollading (cs, bf, _) =
            (fromJust $ sequence $ filter isJust cs, bf)

        -- Checks whether triple is normalized: whether there is
        -- nothing left to check.
        normalized (_, _, af) = null af    
   
        -- One step of reducing.
        reduceNext (cs, bf, af) =
            let (c, bf', af') = firstCollidingWith obj af
                in (c:cs, bf ++ bf', af')

        -- Splits supplied list of object on two list of
        -- maybe collading objects and non collading ones.
        splitCollading = until normalized reduceNext . (,,) [] []


{-  mergeCollading.

    Merges all collading objects.

    Returns a list of old non collading objects and new merged ones.

-}
mergeCollading :: (Floating a, Ord a) => [Object a] -> [Object a]
mergeCollading =
    -- Returns list of merged collading objects.
    fst .
        -- While unchecked list isn't null.
        until (\ (_, xs) -> null xs)
            -- Take a first unchecked object.
            (\ (ms, x:xs) ->
                let
                    -- Find all collading object with it.
                    (cs, ys) = allColladingWith x xs
                    -- Merge them into one.
                    m        = foldl mergeObjectWith x cs
                in
                    -- Continue with merged added and the rest unchecked.
                    (m:ms, ys)) . (,) []


{- randomColor.

    Returns a random color.

-}
randomColor :: RandomGen g => g -> (Color, g)
randomColor = idx2clr . randomR (minIdx, maxIdx)
    where

        idx2clr (idx, g) = (toEnum idx, g)

        maxIdx = fromEnum $ (maxBound :: Color)
        minIdx = fromEnum $ (minBound :: Color)


{- randomRadius.

    Returns a random radius.

-}
randomRadius :: (Fractional a, Random a, RandomGen g) => g -> (a, g)
randomRadius = randomR (minRad, maxRad)
    where
        maxRad = 50.0
        minRad = 10.0 


{- createNew.

    Creates a new object with random radius and color.
  
-}
createNew ::
    (Fractional a, Random a, RandomGen g) => g -> Pnt a -> (Object a, g)
createNew g p =
    let
        -- Random color.
        (c, g')  = randomColor g

        -- Random radius.
        (r, g'') = randomRadius g

        -- Initial velocity is null.
        v        = vel 0.0 0.0

        -- Initial acceleration is null.
        a        = acc 0.0 0.0
    in
        (Object p v a r c, g'')


{- tag function.

    Finds an object with supplied point.

    If there is such object, then it makes it bigger.

    Otherwise it creates a new one.
-}
tag ::
    (Floating a, Ord a, Random a, RandomGen g) =>
        g -> Pnt a -> [Object a] -> ([Object a], g)
tag g p objs =
    let (x, xs) = findPointed p objs
        in case x of
            Nothing ->
                let (y, g') = createNew g p in (y:xs, g')
            Just y  ->
                (increaseObject y : xs, g)

{- move.

    Moves objects assuming the movement took supplied time period.

-}
move :: Floating a => a -> [Object a] -> [Object a]
move dt = map (moveObject dt)
