gameServer/ServerState.hs
author sheepluva
Sun, 19 Jan 2014 13:41:11 +0100
changeset 10016 59a6d65fcb60
parent 9973 7589978c9912
child 10460 8dcea9087d75
permissions -rw-r--r--
(experimental) make the mysterious borders around land/hats/etc that appear on zoom vanish note: not applied to everything yet note: I'll probably merge the two functions that do the same thing (one for 1darray, one for 2darray representation of pixels) into a single function

module ServerState
    (
    module RoomsAndClients,
    module JoinsMonitor,
    clientRoomA,
    ServerState(..),
    client's,
    allClientsS,
    allRoomsS,
    roomClientsS,
    sameProtoClientsS,
    io
    ) where

import Control.Monad.State.Strict
import Data.Set as Set(Set)
import Data.Word
----------------------
import RoomsAndClients
import CoreTypes
import JoinsMonitor

data ServerState = ServerState {
        clientIndex :: !(Maybe ClientIndex),
        serverInfo :: !ServerInfo,
        removedClients :: !(Set.Set ClientIndex),
        roomsClients :: !MRnC,
        joinsMonitor :: !JoinsMonitor
    }


clientRoomA :: StateT ServerState IO RoomIndex
clientRoomA = do
    (Just ci) <- gets clientIndex
    rnc <- gets roomsClients
    io $ clientRoomM rnc ci

client's :: (ClientInfo -> a) -> StateT ServerState IO a
client's f = do
    (Just ci) <- gets clientIndex
    rnc <- gets roomsClients
    io $ client'sM rnc f ci

allClientsS :: StateT ServerState IO [ClientInfo]
allClientsS = gets roomsClients >>= liftIO . clientsM

allRoomsS :: StateT ServerState IO [RoomInfo]
allRoomsS = gets roomsClients >>= liftIO . roomsM

roomClientsS :: RoomIndex -> StateT ServerState IO [ClientInfo]
roomClientsS ri = do
    rnc <- gets roomsClients
    io $ roomClientsM rnc ri

sameProtoClientsS :: Word16 -> StateT ServerState IO [ClientInfo]
sameProtoClientsS p = liftM f allClientsS
    where
        f = filter (\c -> clientProto c == p)

io :: IO a -> StateT ServerState IO a
io = liftIO