module Model.Object
 (module Model.Movement
 ,Object(..)
 ,Color(..)
 ,moveObject
 ,objectHas
 ,objectCollidingWith
 ,mergeObjectWith
 ,increaseObject
 )
where

import Model.Movement

{- Naming convention for this module.

    * Record field names.
    
        Each name is prefixed by abbreviation of record:
        
            data Record = Record { rcdField :: Int }
            
            where
                
                rcd ~ record
    
    * Record function names.
    
        ** Compute value functions.
        
            Each name is prefixed by record's name in lower case:
            
                data Record = Record { rcdA :: Int, rcdB :: Int }
                
                recordSum :: Record -> Int
                recordSum (Record a b) = a + b
            
        ** Update record functions.
        
            Each name is combined from verd which prefixes a record name:
            
            
                data Record = Record { rcdA :: Int, rcdB :: Int }
                
                scaleRecord :: Int -> Record -> Record
                scaleRecord n (Record a b) = Record (n * a) (n * b)
-}

{- Abbreviations.

    * obj ~ object
    * ccl ~ circle
    * rct ~ rectangle
    * ctr ~ center
    * dst ~ distance

-}

{- Object data type.

    Object is movable item which has a radius and color.

-}
data Object a =
    Object { objCtr    :: Pnt a
           , objVel    :: Vel a
           , objAcc    :: Acc a
           , objRadius :: a
           , objColor  :: Color }


{- Show instance for Object.

    Show instance isn't derived because it would
    make Object unable to read when printed.
    
    Most of the time, Object will be in a container.
    So it is better to make Show instance to look
    good in container.
-}

prettyShow :: Show a => Object a -> String
prettyShow (Object p v a s c) =
    "\n" ++
    "Object {" ++
        "\n  center:       " ++ (show p) ++
        "\n  velocity:     " ++ (show v) ++
        "\n  acceleration: " ++ (show a) ++
        "\n  radius:       " ++ (show s) ++
        "\n  color:        " ++ (show c) ++
    "\n}\n"

instance Show a => Show (Object a) where
    show = indent . prettyShow            
        where
            indent = unlines. map (spc++) . lines
                where
                    spc = "  "
               
                    
{- Note about naming enumerations.

    Enumerated types like
    
        data EnumType = Val1 | Val2 | ... | ValN
        
    could be defined like
    
        data EnumType = EnumTypeVal1
                      | EnumTypeVal2
                      | ...
                      | EnumTypeValN
    
    It makes names a little bit ugly, but more readable.
    I don't think here will be a problem with readability.
    So, names stay nice.    
    
-}

-- Type of color.
data Color
    = Red | Orange | Yellow | Green | Azure | Blue | Purple
        deriving (Bounded, Enum, Show)


{- Object's interface -}

-- Returns new state of object after some period of time.
moveObject :: Floating a => a -> Object a -> Object a
moveObject dt (Object p v a r c) =
    -- Update point using velocity;
    -- update velocity using acceleration;
    -- update accelration using some hidden formula:
    let p' = pntDrv dt v
        v' = velDrv dt a
        a' = updateAcc
        in Object p' v' a' r c
        where
            -- Acceleration changing formula.
            updateAcc =
                -- Acceleration changes depending from radius:
                let accInc = acc 0 $ r / 4
                    in a ^+^ accInc
                    

-- Checks whether object has supplied point.
objectHas :: (Floating a, Ord a) => Pnt a -> Object a -> Bool
objectHas p obj = pntDst p (objCtr obj) < objRadius obj 


{- Checks whether two objects are colliding.

    Two objects are collading if distance between their
    centers is less then the minimal distance from center
    of one of them to it's boarders.    
    
    NOTE:
        
        This criteria holds for circles. For other
        figures it might fail.

-}
objectCollidingWith :: (Floating a, Ord a) => Object a -> Object a -> Bool
objectCollidingWith objA objB =
    let
        -- Distance between centers.
        ctrDst  = objCtr objA `pntDst` objCtr objB
        -- Minimal distance from center of A to it's boarder.
        minDstA = objRadius objA
        -- Minimal distance from center of B to it's boarder.
        minDstB = objRadius objB
    in
        ctrDst < minDstA || ctrDst < minDstB


-- Merges two objects into one.
mergeObjectWith :: (Floating a, Ord a) => Object a -> Object a -> Object a
mergeObjectWith
    (Object pA vA aA rA cA)
    (Object pB vB aB rB cB) =
                
        let
            -- New point is a middle between two.
            p' = pntMid pA pB
            
            -- New velocity is a half of sum of two.
            v' = (vA ^+^ vB) ^/ 2
            
            -- New acceleration is a quoter of sum of two.
            a' = (aA ^+^ aB) ^/ 4
            
            -- New radius is a result of half of sum of two.
            r' = (rA + rB) / 2
            
            -- New color is those whose object's square is bigger.
            sA = pi * rA^2
            sB = pi * rB^2
            c' = if sA > sB
                    then cA
                    else cB
            
        in Object p' v' a' r' c'


-- Increases object's radius.
increaseObject :: Fractional a => Object a -> Object a
increaseObject (Object p v a r c) = Object p v a (r + inc) c
    where
        -- formula of radius increment:
        inc = r / 6


{- Abstract interface of object.

   NOTE: this is scratch.

   Should it wide enough to allow adding
   a new objects into existing world?
-}
class Object' t where

    -- Returns object's state after supplied time value.
    move :: a -> t a -> t a

    {- Returns object's center.
        
        Having a two objects of different types
        it is still possible to find a distance
        between them using coordinates of their
        centers.
    -}    
    center :: t a -> Pnt a

    -- Whether object has a point inside.
    hasPnt :: Pnt a -> t a -> Bool

    {- Square of object.
        Should it be here?
    -}
    square :: t a -> a
    
    

    
