gameServer/HandlerUtils.hs
author szczur
Sun, 12 Sep 2010 17:38:14 -0400
changeset 3850 df6ecca1894f
parent 3568 ae89cf0735dc
child 4614 26661bf28dd5
permissions -rw-r--r--
This change allows computers limited to 512 texture size like szczur's card to run Hedgewars, so long as reduce quality is set to eliminate background textures. It makes Ammo menu and Hats multicolumn, 512 high.

module HandlerUtils where

import Control.Monad.Reader
import qualified Data.ByteString.Char8 as B

import RoomsAndClients
import CoreTypes
import Actions

thisClient :: Reader (ClientIndex, IRnC) ClientInfo
thisClient = do
    (ci, rnc) <- ask
    return $ rnc `client` ci

thisRoom :: Reader (ClientIndex, IRnC) RoomInfo
thisRoom = do
    (ci, rnc) <- ask
    let ri = clientRoom rnc ci
    return $ rnc `room` ri

clientNick :: Reader (ClientIndex, IRnC) B.ByteString
clientNick = liftM nick thisClient

roomOthersChans :: Reader (ClientIndex, IRnC) [ClientChan]
roomOthersChans = do
    (ci, rnc) <- ask
    let ri = clientRoom rnc ci
    return $ map (sendChan . client rnc) $ filter (/= ci) (roomClients rnc ri)

roomClientsChans :: Reader (ClientIndex, IRnC) [ClientChan]
roomClientsChans = do
    (ci, rnc) <- ask
    let ri = clientRoom rnc ci
    return $ map (sendChan . client rnc) (roomClients rnc ri)

thisClientChans :: Reader (ClientIndex, IRnC) [ClientChan]
thisClientChans = do
    (ci, rnc) <- ask
    return $ [sendChan (rnc `client` ci)]

answerClient :: [B.ByteString] -> Reader (ClientIndex, IRnC) [Action]
answerClient msg = thisClientChans >>= return . (: []) . flip AnswerClients msg

allRoomInfos :: Reader (a, IRnC) [RoomInfo]
allRoomInfos = liftM ((\irnc -> map (room irnc) $ allRooms irnc) . snd) ask