DnaPolygon.hs

--
-- Module      : DnaPolygon
-- Copyright   : (c) Daniel Neun 2008
-- License     : BSD-style
-- Maintainer  : daniel.neun@gmx.de
-- Stability   : experimental
-- Portability : portable

module Hevolisa.Shapes.DnaPolygon (
                   DnaPolygon,

                   -- * Accessors
                   brush,
                   points
                  ) where

import Control.Monad ( replicateM )
import Hevolisa.Settings
import Hevolisa.Tools
import Hevolisa.Shapes.DnaBrush ( DnaBrush )
import Hevolisa.Shapes.DnaPoint ( DnaPoint( DnaPoint ), randomPoint, pointX, pointY )

-- |A polygon has a brush for color and a list of points
data DnaPolygon = DnaPolygon {
      brush  :: DnaBrush, 
      points :: [DnaPoint] 
} deriving (Show,Eq,Read)

-- |Count the points of the polygon
instance Points DnaPolygon where
    pointCount = fromIntegral . length . points

-- |Initialize the polygon with random garbage
instance RandomInit DnaPolygon where
    randomInit = do points <- randomPoints activePointsPerPolygonMin
                    brush <- randomInit
                    return (DnaPolygon brush points)
        where randomPoints :: Integer -> IO [DnaPoint]
              randomPoints n = randomInit >>=
                               replicateM (fromIntegral n) . randomPoint

-- |A polygon has mutable DNA
instance Mutable DnaPolygon where
    mutate = mutatePolygon

-- |Mutate a polygon by adding and removing points and other funny tricks
mutatePolygon :: DnaPolygon -> IO DnaPolygon
mutatePolygon p = maybeAddPoint p >>= 
                  maybeRemovePoint >>= 
                  mutateBrush >>= 
                  mutatePoints
    where
      -- |Add a point if it`s time to do so
      maybeAddPoint :: DnaPolygon -> IO DnaPolygon
      maybeAddPoint p = willMutate activeAddPointMutationRate >>=
                        when (pointCount p < activePointsPerPolygonMax)
                             addPointAtRandomIndex p

      -- |Add a point at a random position between two points
      addPointAtRandomIndex :: DnaPolygon -> IO DnaPolygon
      addPointAtRandomIndex p = do index <- getRandomNumber 1 (pointCount p - 1)
                                   return (p { points = addPoint index (points p) })

      -- |Add a point at the given position
      addPoint :: Int -> [DnaPoint] -> [DnaPoint]
      addPoint index pts = left ++ [DnaPoint newX newY] ++ right
          where left = take index pts
                right = drop index pts
                newX = (pointX prev + pointX next) / 2
                newY = (pointY prev + pointY next) / 2
                prev = last left
                next = head right

      -- |Remove a point if it`s time to do so
      maybeRemovePoint :: DnaPolygon -> IO DnaPolygon
      maybeRemovePoint p = willMutate activeRemovePointMutationRate >>=
                           when (pointCount p > activePointsPerPolygonMin)
                                removePointAtRandomIndex p

      -- |Remove a random point
      removePointAtRandomIndex :: DnaPolygon -> IO DnaPolygon
      removePointAtRandomIndex p@(DnaPolygon b pts) = do 
        index <- getRandomNumber 0 (pointCount p)
        return (DnaPolygon b (removePoint index pts))

      -- |Remove a point from the polygon
      removePoint :: Int -> [DnaPoint] -> [DnaPoint]
      removePoint = removeElem

      -- |Mutate the polygon brush
      mutateBrush :: DnaPolygon -> IO DnaPolygon
      mutateBrush (DnaPolygon brush pts) = mutate brush >>= \b -> return (DnaPolygon b pts)

      -- |Mutate the polygon points
      mutatePoints :: DnaPolygon -> IO DnaPolygon
      mutatePoints p = (mapM mutate . points) p >>= 
                       return . DnaPolygon (brush p)