{-# LANGUAGE RecursiveDo #-}

module Game where

import Control.Applicative
import Control.Monad
import Control.Monad.Fix
import Data.Array
import Data.List
import Data.Maybe
import FRP.Elerea.Experimental.Simple

import Actor
import HighScore
import Level
import Sprites
import Utils
import Vector

numberOfLives = 5

data LevelState = LevelState
                  { level :: Level
                  , actors :: [Actor]
                  , bullets :: [(ActorType,Vec)]
                  , shooters :: [ActorType]
                  }

keySet1 = fst
keySet2 = snd

keyDir (True,_,_,_,_) = Just North
keyDir (_,True,_,_,_) = Just South
keyDir (_,_,True,_,_) = Just West
keyDir (_,_,_,True,_) = Just East
keyDir _              = Nothing

keyShoot (_,_,_,_,s) = s

keyAny k = keyShoot k || isJust (keyDir k)

game highScore storeScore (renderGame,renderMenu) closeAction newActor levels keyPress = do
  let firstTrue s = do
        mask <- delay False =<< transfer False (||) s
        return (liftA2 (&&) (not <$> mask) s)

      mkGame 0 = playGame storeScore renderGame newActor levels keyPress 1
      mkGame 1 = playGame storeScore renderGame newActor levels keyPress 2
      mkGame _ = return (pure closeAction,pure True)

  keys <- memo (keySet1 <$> keyPress)
  (output,_) <- switcher . flip fmap highScore $ \score -> do
    (menu,pick) <- displayMenu (renderMenu score) ["ONE PLAYER GAME","TWO PLAYER GAME","QUIT"] keys
    picked <- firstTrue (keyShoot <$> keys)
    gameSource <- generator (toMaybe <$> picked <*> (mkGame <$> pick))
    fullOutput <- menu --> gameSource
    return (fst =<< fullOutput,snd =<< fullOutput)

  return output

displayMenu renderMenu items keys = do
  let val False = 0
      val True  = 1

  up <- edge ((==Just North) . keyDir <$> keys)
  down <- edge ((==Just South) . keyDir <$> keys)
  item <- transfer2 0 (\u d i -> (i + val d - val u) `mod` length items) up down

  return ((renderMenu items <$> item,pure False),item)

playGame storeScore renderFun newActor levels keyPress numPlayers = mdo
  let startLevel level enemyCount = playLevel newActor keyPress level numPlayers lives' enemyCount
      players = take numPlayers [YellowWorrior,BlueWorrior]

      pickLevel cnt rnd = case () of
        _ | cnt == 4         -> findLevel (=="arena")
        _ | cnt < 8          -> findLevel ((=='b').head)
        _ | cnt `mod` 6 == 1 -> findLevel (=="pit")
        otherwise            -> findLevel ((=='w').head)
        where findLevel p = pickOne (filter (p.levelName) levels)
              pickOne xs = xs !! (rnd `mod` length xs)

      accumScore player state prev = max 0 $ prev +
                                     (sum . map killScore . actors) state -
                                     10 * (length . filter (==player) . shooters) state
        where killScore a = if justDied a && action a == KilledBy player then actorValue a else 0

      accumLives player state prev = max 0 $ prev + (sum . map lifeLost . actors) state
        where lifeLost a = if justDied a && actorType a == player then -1 else 0

  levelNoise <- noise
  (state,trigLevel) <- switcher (startLevel <$> (pickLevel <$> levelCount <*> levelNoise) <*> levelCount)
  trigLevel' <- delay False trigLevel
  levelCount <- transfer 1 (\win cnt -> if win then cnt+1 else cnt) trigLevel'
  scores <- memo =<< (sequence <$> forM players (\t -> transfer 0 (accumScore t) state))
  lives <- memo =<< (sequence <$> forM players (\t -> transfer numberOfLives (accumLives t) state))
  lives' <- delay (replicate numPlayers numberOfLives) lives

  gameOver <- memo (all (==0) <$> lives)

  return (liftA2 (>>)
          ((\c s -> when c (storeScore s)) <$> gameOver <*> scores)
          (renderFun <$> state <*> levelCount <*> scores <*> lives)
         ,gameOver
         )

playLevel newActor keyPress level numPlayers lives enemyCount = mdo
  let mkEnemy etype = enemy (newActor etype) (if etype == Worluk then 2 else 1) level bullets

      mkShot c plr = if c && canShoot
                     then (:[]) <$> bullet (actorType plr) (position plr) (facing plr)
                     else return []
        where canShoot = case action plr of
                Walking  -> True
                Shooting -> True
                _        -> False

      spawnEnemies oldEnemies = concatMap (spawnEnemy (length oldEnemies == 1)) oldEnemies
      spawnEnemy isLast enemy = if justDied enemy then
                                    case actorType enemy of
                                      Burwor  -> [mkEnemy Garwor <$> (position <$> head players)]
                                      Garwor  -> [mkEnemy Thorwor <$> (position <$> head players)]
                                      Thorwor -> if isLast then [mkEnemy Worluk <$> (position <$> head players)] else []
                                      _       -> []
                                else []

      (lw,lh) = levelSize level
      playerInit = take numPlayers [(YellowWorrior,keySet1,1),(BlueWorrior,keySet2,0)]

  (players,bulletSources) <- fmap unzip $ forM (zip playerInit [0..]) $ \((worType,keySet,pix),lix) -> do
    shoot <- edge (keyShoot . keySet <$> keyPress)

    (player,_respawn) <- switcher . flip fmap lives $ \ls -> do
      let (pedir,py,px) = entrances level !! pix
          playerInit = (newActor worType (V (px*fieldSize) ((lh-py-1)*fieldSize)))
                         { action = Entering pedir False
                         , facing = [East,West] !! pix
                         }
          respawn plr = ls !! lix > 1 && null (animation plr)

      if ls !! lix == 0
        then return (pure (playerInit { animation = [] }),pure False)
        else do plr <- transfer3 playerInit (movePlayer level) (keyDir . keySet <$> keyPress) shoot enemies'
                return (plr, respawn <$> plr)

    bulletSource <- generator (mkShot <$> shoot <*> player)
    return (player,bulletSource)

  newBullets <- memo (concat <$> sequence bulletSources)
  bullets <- collection newBullets (notHitAnything level <$> enemies')
  let shooters = fmap (map fst) . sequence =<< newBullets

  initialEnemies <- replicateM enemyCount (mkEnemy Burwor (V (-3*fieldSize) (-3*fieldSize)))
  spawnedEnemies <- generator (sequence <$> (sequence . spawnEnemies =<< enemies'))
  enemySource <- delay initialEnemies spawnedEnemies
  enemies <- collection enemySource (pure (not . null . animation))
  enemies' <- delay [] enemies

  return (LevelState level <$> (liftA2 (++) (sequence players) enemies) <*> bullets <*> shooters
         ,null <$> enemies
         )

bullet src pos dir = fmap ((,) src) <$> stateful pos (+3*dirVec dir)

enemy newActor moveSpeed level bullets (V playerX playerY) = mdo
  let actorInit = (newActor (fromIntegral fieldSize*startPos)) { speed = moveSpeed, animSpeed = 4 }
      startPos = if abs (startX-playerX `div` fieldSize) < 3 && abs (startY-playerY `div` fieldSize) < 3
                 then V ((startX + lw `div` 2) `mod` lw) ((startY + lh `div` 2) `mod` lh)
                 else V startX startY
      (lw,lh) = levelSize level

  startX <- (`mod` lw) <$> getRandom
  startY <- (`mod` lh) <$> getRandom
  startDir <- toEnum . (`mod` 4) <$> getRandom
  dirNoise <- noise

  actorInput <- startDir --> newDir level <$> dirNoise <*> actor'
  actor <- transfer2 actorInit (moveEnemy level) actorInput bullets
  actor' <- delay actorInit actor
  return actor

notHitAnything lev es (_,pos@(V px py)) =
  (sy <  fieldMid-bs || North `elem` legals) &&
  (sx <  fieldMid-bs || East  `elem` legals) &&
  (sy > -fieldMid+bs || South `elem` legals) &&
  (sx > -fieldMid+bs || West  `elem` legals) &&
  not hitExplosion
  where legals = legalMovesAt lev (fieldPos pos)
        (sx,sy) = fieldSub pos
        bs = 3

        hitExplosion = any hitBy es
        hitBy e = isDead e && abs (ex-px) < fieldMid && abs (ey-py) < fieldMid
          where V ex ey = position e

newDir lev rnd act = if not (canMove lev act) then Just pickedLegalDir
                     else if rnd `mod` 1000 < 992 then Nothing
                          else Just (toEnum (rnd `mod` 4))
  where legal = legalMovesAt lev (fieldPos (position act))
        pickedLegalDir = legal !! (rnd `mod` length legal)

movePlayer level mov shoot enemies plr = case action plr of
  Entering dir False -> let startMoving = isJust mov
                        in plr { action = Entering dir startMoving
                               , position = position plr + if startMoving then dirVec dir else 0
                               }
  Entering dir True -> if fieldSub (position plr) == (0,0)
                       then plr { action = Walking }
                       else plr { position = position plr + dirVec dir }
  _ -> case mov of
    Nothing  -> if action plr' /= Walking then animate plr' else plr'
    Just dir -> animate (if isAlive plr then move level dir plr' else plr')
  where plr' = case killed of
          _ | isDead plr -> plr
          Just enemy     -> plr { animation = deathAnimation (skin plr)
                                , action = KilledBy (actorType enemy)
                                , animSpeed = 6
                                }
          _ | shoot      -> plr { animation = shootAnimation (skin plr)
                                , action = Shooting
                                }
          otherwise      -> plr
        killed = find ((==getXY plr).getXY) [enemy | enemy <- enemies, isAlive enemy]
        getXY = fieldPos.position

moveEnemy level dir bs act = animate (mv act')
  where act' = case hit of
          Just (killer,_) -> act { animation = deathAnimation (skin act)
                                 , action = KilledBy killer
                                 }
          Nothing -> act
        mv = if isAlive act' then move level dir else id
        hit = find hitBy bs
        V px py = position act
        hitBy (_,(V bx by)) = abs (bx-px) < fieldMid && abs (by-py) < fieldMid

move :: Level -> Direction -> Actor -> Actor
move lev dir ent = mv ent $ fmap snd . find fst $
                   [(halfway dir || atFieldMid && dirIsLegal, dir)
                   ,(not atFieldMid && dirIsLegal, dir')
                   ,(halfway entDir || legalMove entDir, entDir)
                   ]
  where mv e Nothing  = e
        mv e (Just d) = e { position = position e + fromIntegral (speed e) * dirVec d
                          , facing = d
                          }

        dirIsLegal = legalMove dir
        legalMove d = d `elem` legalMovesAt lev (fieldPos (position ent))

        (sx,sy) = fieldSub (position ent)
        atFieldMid = 0 == if isVertical dir then sx else sy
        halfway d = 0 /= if isVertical d then sy else sx

        entDir = facing ent
        dir' = case entDir of
          North | sy > 0 -> South
          East  | sx > 0 -> West
          South | sy < 0 -> North
          West  | sx < 0 -> East
          otherwise      -> entDir

canMove :: Level -> Actor -> Bool
canMove lev ent = halfway || facing ent `elem` legalMovesAt lev (fieldPos (position ent))
  where (sx,sy) = fieldSub (position ent)
        halfway = sx /= 0 || sy /= 0

legalMovesAt lev pos = legalMoves lev ! ix pos
  where ix (x,y) = (snd (levelSize lev)-1-y,x)

animate :: Actor -> Actor
animate ent = let ent' = ent { tick = (tick ent+1) `mod` animSpeed ent }
                  adv = if tick ent' == 0 then 1 else 0
                  animation' = drop adv (animation ent') in
  case action ent' of
    Entering _ _ -> ent'
    Walking -> ent' { animation = animation' }
    Shooting -> if null animation'
                then ent' { animation = walkAnimation (skin ent')
                          , action = Walking
                          }
                else ent' { animation = animation' }
    KilledBy _ -> ent' { animation = animation' }

dirVec North = V 0 1
dirVec East  = V 1 0
dirVec South = V 0 (-1)
dirVec West  = V (-1) 0