netserver/HWProto.hs
changeset 1384 329d3308e2e3
parent 1383 d20e6e8928e3
child 1385 ca72264f921a
equal deleted inserted replaced
1383:d20e6e8928e3 1384:329d3308e2e3
     4 import Data.List
     4 import Data.List
     5 import Data.Word
     5 import Data.Word
     6 import Miscutils
     6 import Miscutils
     7 import Maybe
     7 import Maybe
     8 import qualified Data.Map as Map
     8 import qualified Data.Map as Map
       
     9 import Opts
     9 
    10 
    10 teamToNet team = ["ADD_TEAM", teamname team, teamgrave team, teamfort team, show $ difficulty team] ++ hhsInfo
    11 teamToNet team = ["ADD_TEAM", teamname team, teamgrave team, teamfort team, show $ difficulty team] ++ hhsInfo
    11 	where
    12 	where
    12 		hhsInfo = concatMap (\(HedgehogInfo name hat) -> [name, hat]) $ hedgehogs team
    13 		hhsInfo = concatMap (\(HedgehogInfo name hat) -> [name, hat]) $ hedgehogs team
    13 
    14 
    14 answerServerMessage = [(clientOnly, ["SERVER_MESSAGE", ""])]
    15 answerServerMessage = [(clientOnly, "SERVER_MESSAGE" : [body])]
       
    16 	where
       
    17 		body = serverMessage globalOptions ++ if isDedicated globalOptions then "" else "<p align=center>Private server</p>"
    15 answerBadCmd = [(clientOnly, ["ERROR", "Bad command, state or incorrect parameter"])]
    18 answerBadCmd = [(clientOnly, ["ERROR", "Bad command, state or incorrect parameter"])]
    16 answerNotMaster = [(clientOnly, ["ERROR", "You cannot configure room parameters"])]
    19 answerNotMaster = [(clientOnly, ["ERROR", "You cannot configure room parameters"])]
    17 answerBadParam = [(clientOnly, ["ERROR", "Bad parameter"])]
    20 answerBadParam = [(clientOnly, ["ERROR", "Bad parameter"])]
    18 answerQuit = [(clientOnly, ["BYE"])]
    21 answerQuit = [(clientOnly, ["BYE"])]
    19 answerAbandoned = [(othersInRoom, ["BYE"])]
    22 answerAbandoned = [(othersInRoom, ["BYE"])]
    48 			[(clientOnly, teamToNet team),
    51 			[(clientOnly, teamToNet team),
    49 			(clientOnly, ["TEAM_COLOR", teamname team, teamcolor team]),
    52 			(clientOnly, ["TEAM_COLOR", teamname team, teamcolor team]),
    50 			(clientOnly, ["HH_NUM", teamname team, show $ hhnum team])]
    53 			(clientOnly, ["HH_NUM", teamname team, show $ hhnum team])]
    51 answerMap mapName = [(othersInRoom, ["MAP", mapName])]
    54 answerMap mapName = [(othersInRoom, ["MAP", mapName])]
    52 answerRunGame = [(sameRoom, ["RUN_GAME"])]
    55 answerRunGame = [(sameRoom, ["RUN_GAME"])]
    53 
    56 answerCannotCreateRoom = [(clientOnly, ["WARNING", "Cannot create more rooms"])]
    54 -- Main state-independent cmd handler
    57 -- Main state-independent cmd handler
    55 handleCmd :: CmdHandler
    58 handleCmd :: CmdHandler
    56 handleCmd client _ rooms ("QUIT":xs) =
    59 handleCmd client _ rooms ("QUIT":xs) =
    57 	if null (room client) then
    60 	if null (room client) then
    58 		(noChangeClients, noChangeRooms, answerQuit)
    61 		(noChangeClients, noChangeRooms, answerQuit)
   105 handleCmd_noRoom :: CmdHandler
   108 handleCmd_noRoom :: CmdHandler
   106 handleCmd_noRoom client _ rooms ["LIST"] =
   109 handleCmd_noRoom client _ rooms ["LIST"] =
   107 		(noChangeClients, noChangeRooms, answerServerMessage ++ (answerRoomsList $ map name rooms))
   110 		(noChangeClients, noChangeRooms, answerServerMessage ++ (answerRoomsList $ map name rooms))
   108 
   111 
   109 handleCmd_noRoom client _ rooms ["CREATE", newRoom, roomPassword] =
   112 handleCmd_noRoom client _ rooms ["CREATE", newRoom, roomPassword] =
   110 	if haveSameRoom then
   113 	if (not $ isDedicated globalOptions) && (not $ null rooms) then
   111 		(noChangeClients, noChangeRooms, answerRoomExists)
   114 		(noChangeClients, noChangeRooms, answerCannotCreateRoom)
   112 	else
   115 	else
   113 		(modifyClient client{room = newRoom, isMaster = True}, addRoom createRoom{name = newRoom, password = roomPassword, roomProto = (protocol client)}, answerJoined $ nick client)
   116 		if haveSameRoom then
       
   117 			(noChangeClients, noChangeRooms, answerRoomExists)
       
   118 		else
       
   119 			(modifyClient client{room = newRoom, isMaster = True}, addRoom createRoom{name = newRoom, password = roomPassword, roomProto = (protocol client)}, answerJoined $ nick client)
   114 	where
   120 	where
   115 		haveSameRoom = isJust $ find (\room -> newRoom == name room) rooms
   121 		haveSameRoom = isJust $ find (\room -> newRoom == name room) rooms
   116 
   122 
   117 handleCmd_noRoom client clients rooms ["CREATE", newRoom] =
   123 handleCmd_noRoom client clients rooms ["CREATE", newRoom] =
   118 	handleCmd_noRoom client clients rooms ["CREATE", newRoom, ""]
   124 	handleCmd_noRoom client clients rooms ["CREATE", newRoom, ""]