gameServer/HWProtoNEState.hs
author szczur
Sun, 12 Sep 2010 17:38:14 -0400
changeset 3850 df6ecca1894f
parent 3671 a94d1dc4a8d9
child 4242 5e3c5fe2cb14
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.

{-# LANGUAGE OverloadedStrings #-}
module HWProtoNEState where

import qualified Data.IntMap as IntMap
import Data.Maybe
import Data.List
import Data.Word
import Control.Monad.Reader
import qualified Data.ByteString.Char8 as B
--------------------------------------
import CoreTypes
import Actions
import Utils
import RoomsAndClients

handleCmd_NotEntered :: CmdHandler

handleCmd_NotEntered ["NICK", newNick] = do
    (ci, irnc) <- ask
    let cl = irnc `client` ci
    if not . B.null $ nick cl then return [ProtocolError "Nickname already chosen"]
        else
        if haveSameNick irnc (nick cl) then return [AnswerClients [sendChan cl] ["WARNING", "Nickname already in use"], ByeClient ""]
            else
            if illegalName newNick then return [ByeClient "Illegal nickname"]
                else
                return $
                    ModifyClient (\c -> c{nick = newNick}) :
                    AnswerClients [sendChan cl] ["NICK", newNick] :
                    [CheckRegistered | clientProto cl /= 0]
    where
    haveSameNick irnc clNick = isJust $ find (\cl -> newNick == clNick) $ map (client irnc) $ allClients irnc

handleCmd_NotEntered ["PROTO", protoNum] = do
    (ci, irnc) <- ask
    let cl = irnc `client` ci
    if clientProto cl > 0 then return [ProtocolError "Protocol already known"]
        else
        if parsedProto == 0 then return [ProtocolError "Bad number"]
            else
            return $
                ModifyClient (\c -> c{clientProto = parsedProto}) :
                AnswerClients [sendChan cl] ["PROTO", B.pack $ show parsedProto] :
                [CheckRegistered | not . B.null $ nick cl]
    where
        parsedProto = case B.readInt protoNum of
                           Just (i, t) | B.null t -> fromIntegral i
                           otherwise -> 0


handleCmd_NotEntered ["PASSWORD", passwd] = do
    (ci, irnc) <- ask
    let cl = irnc `client` ci

    if passwd == webPassword cl then
        return $ JoinLobby : [AnswerClients [sendChan cl] ["ADMIN_ACCESS"] | isAdministrator cl]
        else
        return [ByeClient "Authentication failed"]

{-

handleCmd_NotEntered clID clients _ ["DUMP"] =
    if isAdministrator (clients IntMap.! clID) then [Dump] else []
-}

handleCmd_NotEntered _ = return [ProtocolError "Incorrect command (state: not entered)"]