{-# LANGUAGE PatternGuards, ScopedTypeVariables #-}

module Turns
    (dbPerformPlayerTurn)
    where

import Control.Monad.Maybe
import Control.Monad.Trans
import DB
import FactionData
import SpeciesData
import Plane
import Control.Monad
import Creature
import Data.Ratio
import Facing
import TerrainData
import Data.Maybe
import Behavior
import qualified Perception as P
import Position
import PlayerState
import Logging

dbPerformPlayerTurn :: Behavior -> CreatureRef -> DB ()
dbPerformPlayerTurn beh creature_ref =
    do logDB log_turns INFO $ "Beginning player action: " ++ show beh
       dbBehave beh creature_ref
       logDB log_turns INFO $ "Finishing AI turns."
       dbFinishPendingAITurns

dbFinishPendingAITurns :: DB ()
dbFinishPendingAITurns =
    do m_current_plane <- dbGetCurrentPlane
       case m_current_plane of
           Just p -> dbFinishPlanarAITurns p
           Nothing -> return ()

dbFinishPlanarAITurns :: PlaneRef -> DB ()
dbFinishPlanarAITurns plane_ref =
    do sweepDead plane_ref
       (all_creatures_on_plane :: [CreatureRef]) <- dbGetContents plane_ref
       any_players_left <- liftM (any (== Player)) $ mapM getCreatureFaction all_creatures_on_plane
       next_turn <- dbNextTurn $ map generalizeReference all_creatures_on_plane ++ [generalizeReference plane_ref]
       case next_turn of
           _ | not any_players_left ->
               do setPlayerState GameOver
                  return ()
           ref | ref =:= plane_ref ->
               do dbPerform1PlanarAITurn plane_ref
                  dbFinishPlanarAITurns plane_ref
           ref | Just creature_ref <- coerceReferenceTyped _creature ref ->
               do faction <- getCreatureFaction creature_ref
                  if (faction /= Player)
                      then do dbPerform1CreatureAITurn creature_ref
                              dbFinishPlanarAITurns plane_ref
                      else setPlayerState (PlayerCreatureTurn creature_ref NormalMode)
                  return ()
           _ -> error "dbFinishPlanarAITurns: impossible case"

planar_turn_frequency :: Integer
planar_turn_frequency = 100

monster_spawns :: [(TerrainPatch,Species)]
monster_spawns = [(RecreantFactory,Recreant), (Dirt,DustVortex)]

dbPerform1PlanarAITurn :: PlaneRef -> DB ()
dbPerform1PlanarAITurn plane_ref =
    do creature_locations <- dbGetContents plane_ref
       player_locations <- filterRO (liftM (== Player) . getCreatureFaction . child) creature_locations
       num_npcs <- liftM length $ filterRO (liftM (/= Player) . getCreatureFaction . child) creature_locations
       when (num_npcs < length player_locations * 2) $
           do (terrain_type,species) <- pickM monster_spawns
              _ <- spawnNPC terrain_type species plane_ref $ map parent $ player_locations
              return ()
       dbAdvanceTime plane_ref (1%planar_turn_frequency)

-- |
-- Spawn a non-player creature on the specified terrain type (or fail if not finding that terrain type)
-- and of the specified species, on the specified plane, near one of the specified positions
-- (presumably the list of positions of all player characters).
spawnNPC :: TerrainPatch -> Species -> PlaneRef -> [Position] -> DB Bool
spawnNPC terrain_type species plane_ref player_locations =
    do p <- pickM player_locations
       m_spawn_position <- pickRandomClearSite_withTimeout (Just 2) 7 0 0 p (== terrain_type) plane_ref
       case m_spawn_position of
           Nothing -> return False
           Just spawn_position ->
               do _ <- newCreature Pirates species (Standing plane_ref spawn_position Here)
                  return True

dbPerform1CreatureAITurn :: CreatureRef -> DB ()
dbPerform1CreatureAITurn creature_ref = liftM (const ()) $ atomic (flip dbBehave creature_ref) $
    P.runPerception creature_ref $ liftM (fromMaybe Vanish) $ runMaybeT $
        do player <- MaybeT $ liftM listToMaybe $ filterM (liftM (== Player) . P.getCreatureFaction . child) =<< P.visibleObjects (return . const True)
           (rand_x :: Integer) <- lift $ getRandomR (1,100)
           rand_face <- lift $ pickM [minBound..maxBound]
           (_,my_position) <- lift P.whereAmI
	   let face_to_player = faceAt my_position (parent player)
	   return $ case distanceBetweenChessboard my_position (parent player) of
               _ | rand_x < 5 -> Wait -- if AI gets stuck, this will make sure they waste time so the game doesn't hang
               _ | rand_x < 20 -> Step rand_face
	       1 -> Attack face_to_player
               -- x | x >= 10 -> Jump face_to_player  -- disable this until we can handle non-player teleporting sanely
	       _ -> Step face_to_player