{-# LANGUAGE
	GADTs
      , MultiParamTypeClasses
      , TemplateHaskell
      , ViewPatterns
  #-}

module Satter.Types
       (
         -- * Geometry
         simulationScale
       , Geometrics (..)
       , position
       , direction
       , velocity
       , geometricsDefault
       , playersAt
       , randomizePosition
       , randomizeDirection
       , beyond
       , isBehind
       , currentEnemyOffside
       , currentOurOffside
       , keepInRange
       , onEdge
         -- * Player Index and Roll
       , PlayerIndex
       , PlayerRoll (..)
       , Team (..)
         -- * Action Target
       , ActionTarget (..)
         -- * Ball
       , Ball (..)
       , geometrics_b
       , holdBy
       , ballDefault
       , ballSize
         -- * Director Intention
       , DirectorIntention (..)
         -- * Player Property and Intention
       , PlayerProperty (..)
       , roll
       , team
       , number
       , idNumber
       , defaultPosition
         -- * Team Context
       , TeamContext (..)
       , positions
       , directorIntention
       , goalPosition
       , getTeammatePositions
       , getEnemies
       , getEnemyPositions
         -- * Player
       , Player (..)
       , geometrics_p
       , property
       , intention
       , Intention (..)
       , playerPropertyDefault
       , playerSize
         -- * Game Context
       , GameContext (..)
       , time
       , ball
       , players
       , runMode
       , team1
       , team2
       , score
       , debug
       , nthPlayer
       , suspendByGoal
       , solverIteration
       , satAssignments
       , numberOfRun
       , usedSeeds
       , defaultGameContext
       , getTeamContext
       , getPositions
       , inOurPenaltyArea
       , isInOurPenaltyArea
       , inEnemyPenaltyArea
       , isInEnemyPenaltyArea
       , inOurArea
       , isInOurArea
       , inEnemyArea
       , isInEnemyArea
         -- * SObject
       , SObject (..)
       )
       where

import Control.Applicative
import Control.Lens
import Control.Monad
import Data.IORef
import qualified Data.Vector as V
import Satter.TwoD
import Satter.Field

simulationScale :: Double
simulationScale = 1.7

-------------------------------------------------------------------------------- Geometry

data Geometrics = Geometrics
                  {
                    _position :: TwoD
                  , _direction :: TwoD
                  , _velocity :: Double
                  }
                  deriving (Eq, Ord, Read, Show)

makeLenses ''Geometrics

instance Num Geometrics where
  (Geometrics (x1, y1) (dx1, dy1) v1) + (Geometrics (x2, y2) (dx2, dy2) v2) =
    Geometrics ((x1 + x2) / 2, (y1 + y2) / 2) ((dx1 + dx2) / 2, (dy1 + dy2) / 2) ((v1 + v2) / 2)
  (*) = undefined
  (-) = undefined
  negate (Geometrics (x, y) (dx, dy) v) = Geometrics (negate x, negate y) (negate dx, negate dy) v
  abs = undefined
  signum = undefined
  fromInteger = undefined

geometricsDefault :: Geometrics
geometricsDefault = Geometrics (0, 0) (0, 0) 0

newPosition :: Geometrics -> Double -> TwoD
newPosition (Geometrics (x, y) (dx, dy) v) k =(x + k' * dx * (v + k) * simulationScale, y + k' * dy * (v + k) * simulationScale)
  where k' = max 0.5 $ min 1 k

-------------------------------------------------------------------------------- PlayerIndex and Roll

type PlayerIndex = Int

data PlayerRoll
  =
    PlayerForward
  | PlayerKeeper
  | PlayerDefence
  | PlayerSAT
  deriving (Eq, Ord, Read, Show)

data Team = Team1 | Team2
          deriving (Eq, Ord, Read, Show)

instance Enum Team where
  fromEnum Team1 = 1
  fromEnum Team2 = 2
  toEnum 1 = Team1
  toEnum 2 = Team2

-------------------------------------------------------------------------------- Action Target

-- | total 18 kinds
data ActionTarget where
  -- + [0 .. 5]
  TargetBall :: ActionTarget
  TargetMate :: ActionTarget
  TargetDefaultPosition :: ActionTarget
  TargetOffsideLine :: ActionTarget
  TargetGoal :: ActionTarget
  DefenceLine :: ActionTarget
  -- + this is a synonym of TargetGrid
  -- + [6 .. 17]
  TargetZone :: Int -> ActionTarget
  TargetGrid :: (Int, Int) -> Int -> ActionTarget
  deriving (Eq, Ord, Read, Show)

instance Bounded ActionTarget where
  minBound = TargetBall
  maxBound = DefenceLine

instance Enum ActionTarget where
  succ = toEnum . (1 +) . fromEnum
  pred = toEnum . (1 -) . fromEnum
  fromEnum TargetBall = 0
  fromEnum TargetMate = 1
  fromEnum TargetDefaultPosition = 2
  fromEnum TargetOffsideLine = 3
  fromEnum TargetGoal = 4
  fromEnum DefenceLine = 5
  fromEnum (TargetZone n) = 5 + n
  fromEnum (TargetGrid _ n) = 5 + n
  toEnum 0 = TargetBall
  toEnum 1 = TargetMate
  toEnum 2 = TargetDefaultPosition
  toEnum 3 = TargetOffsideLine
  toEnum 4 = TargetGoal
  toEnum 5 = DefenceLine
  -- we can't convert Int into TargetGrid, so we use TargetZone here
  -- and this means we can check the upper bound here
  toEnum n = if 6 <= n then TargetZone (n - 5) else error "out of index for ActionTarget"

-------------------------------------------------------------------------------- Ball

data Ball = Ball
            {
              _geometrics_b :: Geometrics
            , _holdBy :: Maybe PlayerIndex
              }
            deriving (Eq, Ord, Read, Show)

makeLenses ''Ball

ballDefault :: Ball
ballDefault = Ball (Geometrics (fwidth / 2, fvmargin + fheight / 2) (0,0) 2.2) Nothing

ballSize :: Double
ballSize = 2

-------------------------------------------------------------------------------- DirectorIntention

data DirectorIntention where
  NoStrategy :: DirectorIntention
  BoringAttack :: DirectorIntention
  AggressiveAttack :: DirectorIntention
  OpenToLeft :: DirectorIntention
  OpenToRight :: DirectorIntention
  deriving (Eq, Ord, Read, Show)

-------------------------------------------------------------------------------- Player Property and Intention

data PlayerProperty = PlayerProperty
                      {
                        _roll :: PlayerRoll
                      , _team :: Team
                      , _number :: Int
                      , _idNumber :: Int
                      , _defaultPosition :: TwoD
                      }
  deriving (Eq, Ord, Read, Show)

makeLenses ''PlayerProperty

playerPropertyDefault :: PlayerProperty
playerPropertyDefault = PlayerProperty PlayerForward Team1 0 0 (0, 0)

data Intention where
  Lost :: Double -> Intention
  NoPlan :: Intention
  Keep :: Double -> Intention
  GoFor :: Double -> ActionTarget -> Intention
  KickTo :: Double -> ActionTarget -> Intention
  DribblingTo :: Double -> ActionTarget -> Intention
  deriving (Eq, Ord, Read, Show)

playerIntentionDefault = NoPlan

-------------------------------------------------------------------------------- Team

data TeamContext = TeamContext
                   {
                     _teammates :: [PlayerIndex]
                   , _positions :: ([(Int, TwoD)], [(Int, TwoD)])
                   , _directorIntention :: DirectorIntention
                   , _goalPosition :: TwoD
                   , _baseDirection :: Double
                   }
                   deriving (Eq, Ord, Read, Show)

makeLenses ''TeamContext

-------------------------------------------------------------------------------- Player

playerSize :: Double
playerSize = 8

data Player = Player
              {
                _geometrics_p :: Geometrics
              , _property :: PlayerProperty
              , _intention :: Intention
              }
            deriving (Eq, Ord, Read, Show)

makeLenses ''Player

belongsToTeam :: Int -> Player -> Bool
belongsToTeam t' (_property -> _team -> t) = t' == fromEnum t'

getTeamContext :: GameContext -> Player -> TeamContext
getTeamContext game (_property -> _team -> Team1) = _team1 game
getTeamContext game (_property -> _team -> Team2) = _team2 game

-- | return [(PlayerProperty, TwoD)].
-- If the 3rd arg is True, delete himself
getTeammatePositions :: GameContext -> Player -> Bool -> [(PlayerProperty, TwoD)]
getTeammatePositions (_players -> ps) p@(_property -> _team -> tid) deleteMe
  | deleteMe = map getValue . filter ((i /=) . getID) . filter ((tid ==) . getTeam) $ V.toList ps
  | otherwise = map getValue . filter ((tid ==) . getTeam) $ V.toList ps
  where
    i = p ^. property . idNumber
    getID = _idNumber . _property
    getTeam = _team . _property
    getValue (Player pg pp _) = (pp, _position pg)

getEnemies :: GameContext -> Player -> [Player]
getEnemies (_players -> ps) (_property -> _team -> tid) = filter ((tid /=) . getTeam) $ V.toList ps
  where
    getTeam = _team . _property

getEnemyPositions :: GameContext -> Player -> [(PlayerProperty, TwoD)]
getEnemyPositions p l = map getValue $ getEnemies p l
  where
    getValue (Player pg pp _) = (pp, _position pg)


-------------------------------------------------------------------------------- Game Context

data GameContext = GameContext
                   {
                     _time :: Int
                   , _ball :: Ball
                   , _players :: V.Vector Player
                   , _runMode :: Bool
                   , _team1 :: TeamContext
                   , _team2 :: TeamContext
                   , _score :: (Int, Int)
                   , _debug :: Bool
                   , _suspendByGoal :: Int
                   , _solverIteration :: Int
                   , _satAssignments :: IORef [Bool]
                   , _numberOfRun :: Int
                   , _usedSeeds :: [(Double, Double)]
    }
--                   deriving (Eq, Read, Show)

defaultGameContext =
  GameContext
      (-1)                 -- time
      undefined            -- ball
      undefined            -- player
      undefined            -- runMode
      undefined            -- team1
      undefined            -- team2
      (0, 0)               -- score
      undefined            -- debug
      0                    -- suspendByGoal
      0                    -- solverIteration
      undefined            -- satAssignments
      0                    -- numberOfRun
      []                   -- usedSeeds

makeLenses ''GameContext

nthPlayer :: GameContext -> Int -> Player
nthPlayer g i = (g ^. players) V.! (i -1)

getPositions :: GameContext -> ([(PlayerProperty, TwoD)], [(PlayerProperty, TwoD)])
getPositions (_players -> players) =
  (map getValue $ filter ((Team1 ==) . getTeam) l, map getValue $ filter ((Team2 ==) . getTeam) l)
  where
    l = V.toList players
    getTeam (Player _ pp _) = _team pp
    getValue (Player pg pp _) = (pp, _position pg)

-------------------------------------------------------------------------------- SObject

class SObject a where
  geometricsOf :: a -> Geometrics
  positionOf :: a -> TwoD
  positionOf = _position . geometricsOf
  directionOf :: a -> TwoD
  directionOf = _direction . geometricsOf
  velocityOf :: a -> Double
  velocityOf = _velocity . geometricsOf
  sizeOf :: a -> Double
  -- * return /a/ with a new position after /second/
  (<!!) :: a -> Double -> a
  (<!!) = undefined
  updateIntention :: GameContext -> a -> IO a
  updateIntention _ _ = error "no default method of updateIntention"
  updatePhysics :: GameContext -> a -> IO (Either (a, Ball) a)
  updatePhysics _ _ = error "no default method of updatePhysics"

-------------------------------------------------------------------------------- misc functions

playersAt :: GameContext -> TwoD -> Double -> IO [Player]
playersAt game pos range = do
  let players = _players game
  let l = V.toList players
  return $ filter (\(_geometrics_p -> _position -> pos') -> near2 range pos' pos) l

randomizePosition :: GameContext -> TwoD -> Double -> Int -> TwoD
randomizePosition game (x, y) d k = (x + fromIntegral ox, y + fromIntegral oy)
  where
    t' = _time game
    d' = ceiling d
    ox = mod (t' * k) (2 * d') - d'
    oy = mod (t' * (k +1)) (2 * d') - d'

randomizeDirection :: GameContext -> TwoD -> Double -> Int -> TwoD
randomizeDirection game (x, y) d k = randomizeDirectionWithSeed (_time game) (x, y) d k

randomizeDirectionWithSeed :: Int -> TwoD -> Double -> Int -> TwoD
randomizeDirectionWithSeed t' (x, y) d k
  | 0 == x && 0 == y = (0, 0)
  | 0 <= x && 0 <= y = (cos rad, sin rad)
  | x <= 0 && 0 <= y = (-cos rad, -sin rad)
  | 0 <= x && y <= 0 = (cos rad, sin rad)
  | x <= 0 && y <= 0 = (-cos rad, -sin rad)
  | otherwise = (0.5, 0.5)
  where
    d' = ceiling d
    ox = if d == 0 then 0 else pi / 180 * (fromIntegral $ mod (div (t' * k) d') (2 * d') - d')
    rad = atan (y/x) + ox

-- | 第2引数が第3引数を超えていたらTrue
beyond :: GameContext -> Player -> ActionTarget -> Bool
beyond game player@(Player (_position -> (_,y)) (_team -> t) _) TargetOffsideLine =
  case t of
    Team1 -> y < y'
    Team2 -> y' < y
  where y' = currentOurOffside game player

beyond game player@(Player (_position -> (_,y)) (_team -> t) _) TargetBall =
  case t of
    Team1 -> y < y'
    Team2 -> y' < y
  where (Ball (Geometrics (_, y') _ _) _) = _ball game

isBehind :: Player -> Player -> Bool
isBehind p1@(_geometrics_p -> _position -> (_, y1)) p2@(_geometrics_p -> _position -> (_, y2)) 
  | p1 ^. property . team == Team1 = y2 < y1
  | otherwise = y1 < y2

currentEnemyOffside :: GameContext -> Player -> Double
currentEnemyOffside game player@(Player _ (_team -> t) _) =
  case t of
    Team1 -> (maximum . map (snd . snd) . filter ((PlayerKeeper /=) . _roll . fst) . fst) $ getPositions game
    Team2 -> (minimum . map (snd . snd) . filter ((PlayerKeeper /=) . _roll . fst) . snd) $ getPositions game

currentOurOffside :: GameContext -> Player -> Double
currentOurOffside game player@(Player _ (_team -> t) _) =
  case t of
    Team1 -> (minimum . map (snd . snd) . filter ((PlayerKeeper /=) . _roll . fst) . snd) $ getPositions game
    Team2 -> (maximum . map (snd . snd) . filter ((PlayerKeeper /=) . _roll . fst) . fst) $ getPositions game

inOurPenaltyArea :: GameContext -> Player -> Bool
inOurPenaltyArea game player@(Player (_position -> (x, y)) (_team -> t) _) = do
  case t of
    Team1 -> fvmargin + 3 * fheight / 4 < y
    Team2 -> y < fvmargin + fheight / 4

isInOurPenaltyArea :: GameContext -> Player -> TwoD -> Bool
isInOurPenaltyArea game (_property -> _team -> t) (x, y) = do
  case t of
    Team1 -> fvmargin + 3 * fheight / 4 < y
    Team2 -> y < fvmargin + fheight / 4

inEnemyPenaltyArea :: GameContext -> Player -> Bool
inEnemyPenaltyArea game player@(Player (_position -> (x, y)) (_team -> t) _) = do
  case t of
    Team1 -> y < fvmargin + fheight / 4
    Team2 -> fvmargin + 3 * fheight / 4 < y

isInEnemyPenaltyArea :: GameContext -> Player -> TwoD -> Bool
isInEnemyPenaltyArea game (_property -> _team -> t) (x, y) = do
  case t of
    Team1 -> y < fvmargin + fheight / 4
    Team2 -> fvmargin + 3 * fheight / 4 < y

inOurArea :: GameContext -> Player -> Bool
inOurArea game player@(Player (_position -> (x, y)) (_team -> t) _) = do
  case t of
    Team1 -> fvmargin + fheight / 2 < y
    Team2 -> y < fvmargin + fheight / 2

isInOurArea :: GameContext -> Player -> TwoD -> Bool
isInOurArea game (_property -> _team -> t) (x, y) = do
  case t of
    Team1 -> fvmargin + fheight / 2 < y
    Team2 -> y < fvmargin + fheight / 2

inEnemyArea :: GameContext -> Player -> Bool
inEnemyArea game player@(Player (_position -> (x, y)) (_team -> t) _) = do
  case t of
    Team1 -> y < fvmargin + fheight / 2
    Team2 -> fvmargin + fheight / 2 < y

isInEnemyArea :: GameContext -> Player -> TwoD -> Bool
isInEnemyArea game (_property -> _team -> t) (x, y) = do
  case t of
    Team1 -> y < fvmargin + fheight / 2
    Team2 -> fvmargin + fheight / 2 < y

keepInRange :: TwoD -> TwoD
keepInRange (x, y) = (inRange x left right, inRange y top bottom)
  where
    left = fhmargin
    right = fwidth + fhmargin - playerSize
    top = fvmargin
    bottom = fheight + fvmargin - playerSize
    inRange a l u = case () of { _ | a < l -> l; _ | u < a -> u; _ -> a }

onEdge :: TwoD -> Bool
onEdge (x, y) = elem x [left, right] || elem y [top, bottom]
  where
    left = fhmargin
    right = fwidth + fhmargin - playerSize
    top = fvmargin
    bottom = fheight + fvmargin - playerSize
