{-# 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

dbPerformPlayerTurn :: Behavior -> CreatureRef -> DB ()
dbPerformPlayerTurn beh creature_ref =
    do dbBehave beh creature_ref
       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

dbPerform1PlanarAITurn :: PlaneRef -> DB ()
dbPerform1PlanarAITurn plane_ref = 
    do creature_locations <- dbGetContents plane_ref
       player_locations <- filterRO (liftM (== Player) . getCreatureFaction . entity) creature_locations
       native_locations <- filterRO (liftM (/= Player) . getCreatureFaction . entity) creature_locations
       should_randomly_generate_monster <- liftM (<= 10) $ linearRoll planar_turn_frequency
       when (length native_locations < length player_locations * 2 && should_randomly_generate_monster) $
           do p <- pickM $ map location player_locations
	      m_spawn_position <- pickRandomClearSite_withTimeout (Just 2) 7 0 0 p (== RecreantFactory) plane_ref
	      maybe (return () )
                    (\spawn_position -> newCreature Pirates Recreant (Standing plane_ref spawn_position Here) >> return ()) $ 
                    m_spawn_position
       dbAdvanceTime plane_ref (1%planar_turn_frequency)

dbPerform1CreatureAITurn :: CreatureRef -> DB ()
dbPerform1CreatureAITurn creature_ref = 
    atomic $ liftM (flip dbBehave creature_ref) $ P.runPerception creature_ref $ liftM (fromMaybe Vanish) $ runMaybeT $
        do player <- MaybeT $ liftM listToMaybe $ filterM (liftM (== Player) . P.getCreatureFaction . entity) =<< 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 (location player)
	   return $ case distanceBetweenChessboard my_position (location 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