diff -r 0b1f44751509 -r 2da1fe033f23 netserver/HWProto.hs --- a/netserver/HWProto.hs Mon Nov 10 15:50:46 2008 +0000 +++ b/netserver/HWProto.hs Mon Nov 10 15:57:59 2008 +0000 @@ -16,7 +16,7 @@ hhsInfo = concatMap (\(HedgehogInfo name hat) -> [name, hat]) $ hedgehogs team makeAnswer :: HandlesSelector -> [String] -> [Answer] -makeAnswer func msg = [(func, msg)]-- [\_ -> (func, msg)] +makeAnswer func msg = [\_ -> (func, msg)] answerClientOnly, answerOthersRoom, answerSameRoom :: [String] -> [Answer] answerClientOnly = makeAnswer clientOnly answerOthersRoom = makeAnswer othersInRoom @@ -72,12 +72,18 @@ (answerClientOnly ["TEAM_COLOR", teamname team, teamcolor team]) ++ (answerClientOnly ["HH_NUM", teamname team, show $ hhnum team]) -answerServerMessage clients = answerClientOnly $ "SERVER_MESSAGE" : [mainbody ++ clientsIn] +answerServerMessage clients = [\serverInfo -> (clientOnly, "SERVER_MESSAGE" : [(mainbody serverInfo) ++ clientsIn])] where - mainbody = serverMessage globalOptions ++ if isDedicated globalOptions then "

Dedicated server

" else "

Private server

" + mainbody serverInfo = serverMessage serverInfo ++ + if isDedicated serverInfo then + "

Dedicated server

" + else + "

Private server

" + clientsIn = "

" ++ (show $ length nicks) ++ " clients in: " ++ clientslist ++ "

" clientslist = if not $ null nicks then foldr1 (\a b -> a ++ ", " ++ b) nicks else "" nicks = filter (not . null) $ map nick clients + answerPing = makeAnswer allClients ["PING"] @@ -157,13 +163,10 @@ sameProtoRooms = filter (\r -> (roomProto r == protocol client) && (not $ isRestrictedJoins r)) rooms handleCmd_noRoom client _ rooms ["CREATE", newRoom, roomPassword] = - if (not $ isDedicated globalOptions) && (not $ null rooms) then - (noChangeClients, noChangeRooms, answerCannotCreateRoom) + if haveSameRoom then + (noChangeClients, noChangeRooms, answerRoomExists) else - if haveSameRoom then - (noChangeClients, noChangeRooms, answerRoomExists) - else - (modifyClient client{room = newRoom, isMaster = True}, addRoom createRoom{name = newRoom, password = roomPassword, roomProto = (protocol client)}, (answerJoined $ nick client) ++ (answerNotReady $ nick client)) + (modifyClient client{room = newRoom, isMaster = True}, addRoom createRoom{name = newRoom, password = roomPassword, roomProto = (protocol client)}, (answerJoined $ nick client) ++ (answerNotReady $ nick client)) where haveSameRoom = isJust $ find (\room -> newRoom == name room) rooms