module Plane
    (dbNewPlane,
     dbGetCurrentPlane,
     dbDistanceBetweenSquared,
     pickRandomClearSite,
     getPlanarLocation)
    where

import Grids
import Dice
import DB
import DBData
import TerrainData
import PlaneData
import Control.Monad
import Data.Maybe
import Data.List
import Position

dbNewPlane :: TerrainGenerationData -> DB PlaneRef
dbNewPlane tg_data = 
    do rns <- dbNextRandomIntegerStream
       dbAddPlane (Plane { plane_terrain = generateTerrain tg_data rns }) ()

-- |
-- If this object is anywhere on a plane (such as carried by a creature who is on the plane),
-- returns the position of this object on that plane.
--
getPlanarLocation :: (DBReadable db,ReferenceType a) => Reference a -> db (Maybe (Location S (Reference ()) (PlaneRef,Position)))
getPlanarLocation ref =
    liftM (listToMaybe . mapMaybe coerceLocationRecord) $ dbGetAncestors ref

-- |
-- Distance between two entities.
--
dbDistanceBetweenSquared :: (DBReadable db,ReferenceType a,ReferenceType b) => Reference a -> Reference b -> db (Maybe Integer)
dbDistanceBetweenSquared a_ref b_ref =
    do m_a <- liftM (fmap location) $ getPlanarLocation a_ref
       m_b <- liftM (fmap location) $ getPlanarLocation b_ref
       return $
           do (p_a,a) <- m_a
	      (p_b,b) <- m_b
	      guard $ p_a == p_b
	      return $ distanceBetweenSquared a b

-- |
-- Gets the current plane of interest based on whose turn it is.
--
dbGetCurrentPlane :: (DBReadable db) => db (Maybe PlaneRef)
dbGetCurrentPlane = 
    do state <- playerState
       case state of
		  PlayerCreatureTurn creature_ref _ -> 
                      liftM (fmap $ fst . location) $ getPlanarLocation creature_ref
		  SnapshotEvent (AttackEvent { attack_event_source_creature = attacker_ref }) ->
		      liftM (fmap $ fst . location) $ getPlanarLocation attacker_ref
		  SnapshotEvent (MissEvent { miss_event_creature = attacker_ref }) ->
		      liftM (fmap $ fst . location) $ getPlanarLocation attacker_ref
		  SnapshotEvent (KilledEvent killed_ref) ->
		      liftM (fmap $ fst . location) $ getPlanarLocation killed_ref
		  _ -> return Nothing

-- |
-- Selects sites at random until one seems reasonably clear.  It begins at
-- the specified Position on the map, and then picks more sites further and further away from the center
-- until it one seems clear -- this tends to concentrate sites near the center.
--
-- A site is considered clear if there are no objects at all within object_clear squares, and
-- only appropriate terrain (as defined by a predicate) within terrain_clear squares.
--
-- This function will return an unsuitable site if it can't find a suitable one.
-- Such a site may have unsuitable terrain around it or it may be outside of
-- the search_radius (it is never impossible to find an area free of objects, since
-- terrain is infinite and objects are not).
--
pickRandomClearSite :: Integer -> Integer -> Integer -> Position -> (TerrainPatch -> Bool) -> PlaneRef -> DB Position
pickRandomClearSite search_radius object_clear terrain_clear (Position (start_x,start_y)) terrainPredicate plane_ref =
    do xys <- liftM2 (\a b -> map Position $ zip a b)
           (mapM (\x -> liftM (+start_x) $ roll [-x..x]) [1..search_radius])
           (mapM (\x -> liftM (+start_y) $ roll [-x..x]) [1..search_radius])
       terrain <- liftM plane_terrain $ dbGetPlane plane_ref
       clutter_locations <- locationsOf $ dbGetContents plane_ref
       let terrainIsClear (Position (x,y)) = 
               all terrainPredicate $
                   concat [[gridAt terrain (x',y') | 
                            x' <- [x-terrain_clear..x+terrain_clear]] |
			    y' <- [y-terrain_clear..y+terrain_clear]]
       let clutterIsClear (Position (x,y)) = not $ any (\(Position (x',y')) -> abs (x' - x) <= object_clear && y' - y <= object_clear) clutter_locations
       maybe (pickRandomClearSite (search_radius + 1) 
                                  object_clear 
                                  (max 0 $ terrain_clear - 1) 
                                  (Position (start_x,start_y))
				  terrainPredicate
				  plane_ref) 
             return $
             find (\p -> terrainIsClear p && clutterIsClear p) xys