module Server(start,oneGame,singleGames,contGame) where

import Concurrent
import System(getEnv,system)
import Time
import IO
import Maybe(catMaybes)
import Monad(unless,when)
import Network hiding (accept)
import SocketPrim(accept,socketToHandle)
import Prelude hiding (log)
import Utils
import Ix
import Array

import qualified Board
import qualified Event
import qualified Game
import qualified Observer
import qualified Opts
import qualified Pack
import qualified Robo



--------------------------------------------------------------------------------
-- the server
--------------------------------------------------------------------------------

-- some ugly hackery happens here
start optsO = 
  do  chan <- newChan

      -- argh
      let (uids,opts) = case Opts.gameType optsO of
                          Opts.OneGamePlayers ps -> 
                            let (uids1,initPs,_) = unzip3 ps
                            in (uids1, optsO { Opts.initPoses = initPs })
                          _ -> ([1..], optsO)

      mOpts <- newEmptyMVar 
      forkIO $ do sock <- listenOn (Opts.portNum opts)
                  putMVar mOpts opts
                  mapM_ (getClient sock mOpts chan) uids

      -- wait for the server to start
      readMVar mOpts

      case Opts.gameType opts of
        Opts.Continuous -> contGame chan opts
        Opts.ManyGames n -> singleGames n chan opts
        Opts.OneGame n   -> oneGame n chan opts
        Opts.OneGamePlayers ps -> do
          let (_,_,cmds) = unzip3 ps
          chan1 <- newChan
          forkIO $ startSomePlayers cmds chan chan1 
          oneGame (length cmds) chan1 opts


  where
  close h = hClose h `catch` \e -> return ()

  getClient sock mOpts chan n = do
    h <- flip socketToHandle ReadWriteMode . fst =<< accept sock
    forkIO $ mkPlayer h mOpts chan n `catch` const (close h) 
     
  mkPlayer h mOpts chan uid = 
    do  b <- h `hWaitForInput` (2 * 1000)
        if b
          then do 
            ln <- hGetLine h 
            case parse ln of
              Just (Game.StartAt x y) 
                | inRange (bounds (Opts.mapFile optsO)) (x,y) -> 
                  do r <- Robo.create (optsO {Opts.initPos = (x,y)}) uid h
                     writeChan chan (Game.Robo r)
                | otherwise -> close h 
              Just Game.Player -> 
                do o <- takeMVar mOpts 
                   o' <- do
                    if null (Opts.initPoses o) 
                      then putMVar mOpts o >> return o
                      else do 
                        let p:ps = Opts.initPoses o
                        putMVar mOpts (o { Opts.initPoses = ps })
                        return (o { Opts.initPos = p }) 
                   r <- Robo.create o' uid h 
                   writeChan chan (Game.Robo r)

              Just Game.Observer -> 
                do  o <- Observer.create h
                    writeChan chan (Game.Obs o) 
              _ -> close h
          else close h

      
startSomePlayers cmds from to = mapM_ startOne cmds
  where
  startOne cmd = do forkIO (system cmd >> return ())
                    writeChan to =<< readChan from



--------------------------------------------------------------------------------
-- games that end
--------------------------------------------------------------------------------

-- initialization
newGame n chan h opts = 
  do players <- sequence $ replicate n $ waitForPlayer (hPutStrLn h) chan
     g <- Game.create opts players h 
     mapM_ (initPlayer g (Opts.packFile opts)) players
     return g


waitForPlayer log chan = 
  do p <- readChan chan 
     case p of 
       Game.Robo r -> 
         comment log ("a player joined. uid = " ++ show (Robo.uid r))
       Game.Obs o -> comment log "an observer joined."
     return p



-- start many games in a single server 
singleGames n chan opts = 
  mapM_ (oneGameOfMany n chan opts) [1..]

oneGameOfMany n chan opts gameId = 
  do comment putStr $ 
        "ready for game " ++ show gameId ++ " (" ++ show n ++ " players)"
     time <- calendarTimeToString # (toCalendarTime =<< getClockTime)
     let logFileName = spacesTo_ $ "game_" ++ time ++ "_" ++ show port 
                                           ++ "_" ++ show gameId ++ ".log"
     logFile <- openFile logFileName WriteMode
     logFile `hSetBuffering` LineBuffering
     forkIO . playSingleGame chan =<< newGame n chan logFile opts
  where
  PortNumber port = Opts.portNum opts
    
 
-- start just a single finishing game - no forking, log to stdout
oneGame n chan opts = 
  do comment putStrLn $ "ready for game (" ++ show n ++ " players)"
     stdout `hSetBuffering` LineBuffering
     playSingleGame chan =<< newGame n chan stdout opts

playSingleGame chan g = 
  do Game.oneTurn g `untilM` Game.noRobots g
     Game.over g


--------------------------------------------------------------------------------
-- a continuous game
--------------------------------------------------------------------------------

contGame chan opts = 
  do comment putStrLn "ready for a continuous game"
     hSetBuffering stdout LineBuffering
     g <- Game.create opts [] stdout 
     playContGame chan g (Opts.packFile opts)
     

playContGame chan g packs
  = do whenM (Game.noRobots g) (newPlayers True 1)
       newPlayers False maxConns
       Game.oneTurn g
       whenM (Game.noPacksOnGround g) addMorePacks
       playContGame chan g packs
  where
  -- max players that can join each turn
  maxConns = 5

  -- check for new players
  newPlayers wait n = do
    newRs <- takeC chan wait n
    (g `upd` Game.players) (newRs ++)
    mapM_ (initPlayer g packs) newRs
    let num = length newRs
    when (num /= 0) $ 
      do comment putStrLn (show num ++  " new players joined the game." )
         addMorePacks

  addMorePacks = 
    do mx <- g `get` Game.nextPackID
       let incID p = p { Pack.uid = Pack.uid p + mx }
           addGr gr@(loc,newPs) = 
              do ps <- g `Game.getPacksAt` loc
                 return $ if null ps then Just (loc, map incID newPs)
                                     else Nothing

       newpacks <- catMaybes # mapM addGr packs
       unless (null newpacks) $
          do (g `set` Game.nextPackID) (Game.maxPackID newpacks + 1)
             g `Game.addPackages` newpacks




--------------------------------------------------------------------------------
-- init players when they first connect
--------------------------------------------------------------------------------    
initPlayer g _ (Game.Robo r) =
  do  r `Robo.sendStrLn` Board.toString (Game.board g)
      m <- r `get` Robo.money 
      r `Robo.sendStrLn` unwords [show (Robo.uid r),
                                  show (Robo.capacity r),
                                  show m]
      infos <- mapM getInfo =<< Game.getRobots g
      r `Robo.sendStrLn` Game.mkRsp infos
      
      hFlush (Robo.talkTo r)
  `catch` const (Robo.kill "<connection was closed>" r)

  where
  getInfo s = do pos <- s `get` Robo.pos
                 return (Robo.uid s, [Event.Spawned pos])

initPlayer g packs (Game.Obs o) = 
  do o `Observer.sendStrLn` Board.toString (Game.board g)
     o `Observer.sendStrLn` show (Game.packDests packs)