netserver/HWProto.hs
changeset 1569 4456a0dfc647
parent 1568 15a446307993
child 1571 574063b456c0
equal deleted inserted replaced
1568:15a446307993 1569:4456a0dfc647
    80 		toAnswer team =
    80 		toAnswer team =
    81 			(answerClientOnly $ teamToNet team) ++
    81 			(answerClientOnly $ teamToNet team) ++
    82 			(answerClientOnly ["TEAM_COLOR", teamname team, teamcolor team]) ++
    82 			(answerClientOnly ["TEAM_COLOR", teamname team, teamcolor team]) ++
    83 			(answerClientOnly ["HH_NUM", teamname team, show $ hhnum team])
    83 			(answerClientOnly ["HH_NUM", teamname team, show $ hhnum team])
    84 
    84 
    85 answerServerMessage clients = [\serverInfo -> (clientOnly, "SERVER_MESSAGE" :
    85 answerServerMessage client clients = [\serverInfo -> (clientOnly, "SERVER_MESSAGE" :
    86 		[(mainbody serverInfo) ++ clientsIn ++ (lastHour serverInfo)])]
    86 		[(mainbody serverInfo) ++ clientsIn ++ (lastHour serverInfo)])]
    87 	where
    87 	where
    88 		mainbody serverInfo = serverMessage serverInfo ++
    88 		mainbody serverInfo = serverMessage serverInfo ++
    89 			if isDedicated serverInfo then
    89 			if isDedicated serverInfo then
    90 				"<p align=center>Dedicated server</p>"
    90 				"<p align=center>Dedicated server</p>"
    91 				else
    91 				else
    92 				"<p align=center>Private server</p>"
    92 				"<p align=center>Private server</p>"
    93 		
    93 		
    94 		clientsIn = "<p align=left>" ++ (show $ length nicks) ++ " clients in: " ++ clientslist ++ "</p>"
    94 		clientsIn = if protocol client < 20 then "<p align=left>" ++ (show $ length nicks) ++ " clients in: " ++ clientslist ++ "</p>" else []
    95 		clientslist = if not $ null nicks then foldr1 (\a b -> a  ++ ", " ++ b) nicks else ""
    95 		clientslist = if not $ null nicks then foldr1 (\a b -> a  ++ ", " ++ b) nicks else ""
    96 		lastHour serverInfo =
    96 		lastHour serverInfo =
    97 			if isDedicated serverInfo then
    97 			if isDedicated serverInfo then
    98 				"<p align=left>" ++ (show $ length $ lastHourUsers serverInfo) ++ " user logins in last hour</p>"
    98 				"<p align=left>" ++ (show $ length $ lastHourUsers serverInfo) ++ " user logins in last hour</p>"
    99 				else
    99 				else
   173 
   173 
   174 
   174 
   175 -- 'noRoom' clients state command handlers
   175 -- 'noRoom' clients state command handlers
   176 handleCmd_noRoom :: CmdHandler
   176 handleCmd_noRoom :: CmdHandler
   177 handleCmd_noRoom client clients rooms ["LIST"] =
   177 handleCmd_noRoom client clients rooms ["LIST"] =
   178 		(noChangeClients, noChangeRooms, answerServerMessage clients ++ (answerRoomsList $ concatMap roomInfo $ sameProtoRooms))
   178 		(noChangeClients, noChangeRooms, answerServerMessage client clients ++ (answerRoomsList $ concatMap roomInfo $ sameProtoRooms))
   179 		where
   179 		where
   180 			roomInfo room = [
   180 			roomInfo room = [
   181 					name room,
   181 					name room,
   182 					(show $ playersIn room) ++ "(" ++ (show $ length $ teams room) ++ ")",
   182 					(show $ playersIn room) ++ "(" ++ (show $ length $ teams room) ++ ")",
   183 					show $ gameinprogress room
   183 					show $ gameinprogress room