module HWProtoInRoomState where

import qualified Data.IntMap as IntMap

import qualified Data.Map as Map

import Data.Sequence(Seq, (|>), (><), fromList, empty)

import Data.List

import Maybe

--------------------------------------

import CoreTypes

import Actions

import Utils

handleCmd_inRoom :: CmdHandler

handleCmd_inRoom clID clients _ ["CHAT_STRING", msg] =

	[AnswerOthersInRoom ["CHAT_STRING", clientNick, msg]]

	where

		clientNick = nick $ clients IntMap.! clID

handleCmd_inRoom clID clients _ ["PART"] =

	if isMaster client then

		[RemoveRoom]

	else

		[RoomRemoveThisClient]

	where

		client = clients IntMap.! clID

handleCmd_inRoom clID clients rooms ("CFG" : paramName : paramStrs) =

	if isMaster client then

		[ModifyRoom (\r -> r{params = Map.insert paramName paramStrs (params r)})

		, AnswerOthersInRoom ("CFG" : paramName : paramStrs)]

	else

		[ProtocolError "Not room master"]

	where

		client = clients IntMap.! clID

handleCmd_inRoom clID clients rooms ("ADD_TEAM" : name : color : grave : fort : voicepack : difStr : hhsInfo)

	| length hhsInfo == 16 =

	if length (teams room) == 6 then

		[Warning "too many teams"]

	else if canAddNumber <= 0 then

		[Warning "too many hedgehogs"]

	else if isJust findTeam then

		[Warning "already have a team with same name"]

	else if gameinprogress room then

		[Warning "round in progress"]

	else if isRestrictedTeams room then

		[Warning "restricted"]

	else

		[ModifyRoom (\r -> r{teams = teams r ++ [newTeam]}),

		AnswerThisClient ["TEAM_ACCEPTED", name],

		AnswerOthersInRoom $ teamToNet newTeam,

		AnswerOthersInRoom ["TEAM_COLOR", name, color]

		]

	where

		client = clients IntMap.! clID

		room = rooms IntMap.! (roomID client)

		canAddNumber = 48 - (sum . map hhnum $ teams room)

		findTeam = find (\t -> name == teamname t) $ teams room

		newTeam = (TeamInfo (nick client) name color grave fort voicepack difficulty newTeamHHNum (hhsList hhsInfo))

		difficulty = fromMaybe 0 (maybeRead difStr :: Maybe Int)

		hhsList [] = []

		hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs

		newTeamHHNum = min 4 canAddNumber

handleCmd_inRoom clID clients rooms ["REMOVE_TEAM", teamName] =

	if noSuchTeam then

		[Warning "REMOVE_TEAM: no such team"]

	else

		if not $ nick client == teamowner team then

			[ProtocolError "Not team owner!"]

		else

			if not $ gameinprogress room then

				[ModifyRoom (\r -> r{teams = filter (\t -> teamName /= teamname t) $ teams r}),

				AnswerOthersInRoom ["REMOVE_TEAM", teamName]]

			else

				[]

{-			else

				(noChangeClients,

				modifyRoom clRoom{

					teams = filter (\t -> teamName /= teamname t) $ teams clRoom,

					leftTeams = teamName : leftTeams clRoom,

					roundMsgs = roundMsgs clRoom |> rmTeamMsg

					},

				answerOthersRoom ["GAMEMSG", rmTeamMsg]) -}

	where

		client = clients IntMap.! clID

		room = rooms IntMap.! (roomID client)

		noSuchTeam = isNothing findTeam

		team = fromJust findTeam

		findTeam = find (\t -> teamName == teamname t) $ teams room

		rmTeamMsg = toEngineMsg $ 'F' : teamName

handleCmd_inRoom clID clients rooms ["HH_NUM", teamName, numberStr] =

	if not $ isMaster client then

		[ProtocolError "Not room master"]

	else

		if hhNumber < 1 || hhNumber > 8 || noSuchTeam || hhNumber > (canAddNumber + (hhnum team)) then

			[]

		else

			[ModifyRoom $ modifyTeam team{hhnum = hhNumber},

			AnswerOthersInRoom ["HH_NUM", teamName, show hhNumber]]

	where

		client = clients IntMap.! clID

		room = rooms IntMap.! (roomID client)

		hhNumber = fromMaybe 0 (maybeRead numberStr :: Maybe Int)

		noSuchTeam = isNothing findTeam

		team = fromJust findTeam

		findTeam = find (\t -> teamName == teamname t) $ teams room

		canAddNumber = 48 - (sum . map hhnum $ teams room)

handleCmd_inRoom clID clients rooms ["TEAM_COLOR", teamName, newColor] =

	if not $ isMaster client then

		[ProtocolError "Not room master"]

	else

		if noSuchTeam then

			[]

		else

			[ModifyRoom $ modifyTeam team{teamcolor = newColor},

			AnswerOthersInRoom ["TEAM_COLOR", teamName, newColor]]

	where

		noSuchTeam = isNothing findTeam

		team = fromJust findTeam

		findTeam = find (\t -> teamName == teamname t) $ teams room

		client = clients IntMap.! clID

		room = rooms IntMap.! (roomID client)

handleCmd_inRoom clID clients rooms ["TOGGLE_READY"] =

	[ModifyClient (\c -> c{isReady = not $ isReady client}),

	ModifyRoom (\r -> r{readyPlayers = readyPlayers r + (if isReady client then -1 else 1)}),

	AnswerThisRoom $ [if isReady client then "NOT_READY" else "READY", nick client]]

	where

		client = clients IntMap.! clID

handleCmd_inRoom clID clients rooms ["START_GAME"] =

	if isMaster client && (playersIn room == readyPlayers room) && (not $ gameinprogress room) then

		if enoughClans then

			AnswerThisRoom ["RUN_GAME"]]

		else

			[Warning "Less than two clans!"]

	else

		[]

	where

		client = clients IntMap.! clID

		room = rooms IntMap.! (roomID client)

		enoughClans = not $ null $ drop 1 $ group $ map teamcolor $ teams room

	[ModifyRoom (\r -> r{roundMsgs = roundMsgs r |> msg}),

	AnswerOthersInRoom ["GAMEMSG", msg]]

handleCmd_inRoom clID _ _ _ = [ProtocolError "Incorrect command (state: in room)"]