gameServer/NetRoutines.hs
author sheepluva
Fri, 06 Dec 2013 23:53:35 +0100
changeset 9760 395ca7fe6362
parent 9528 9351e96990ae
child 10076 b235e520ea21
permissions -rw-r--r--
It seems that at the current state it is necessary to protect sending stats/ending game from multiple execution, as that can happen if you e.g. fail a mission more than once in the same tick (e.g. destroying two essential crates at the same time) Otherwise you can get a blank / stuck frontend (e.g. when using deagle to shoot the two last crates at the same time)! the best approach might be to never call the function that sends stats and ends game from any event handler directly, but instead have a flag 'isFailed' that is set to true when any of the possible fails happen and to check that flag every tick to send stats and end game if true

{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-}
module NetRoutines where

import Network.Socket
import Control.Concurrent.Chan
import Data.Time
import Control.Monad
import Data.Unique
-----------------------------
import CoreTypes
import Utils
import RoomsAndClients

acceptLoop :: Socket -> Chan CoreMessage -> IO ()
acceptLoop servSock chan = forever $
        do
        (sock, sockAddr) <- Network.Socket.accept servSock

        clientHost <- sockAddr2String sockAddr

        currentTime <- getCurrentTime

        sendChan' <- newChan

        uid <- newUnique

        let newClient =
                (ClientInfo
                    uid
                    sendChan'
                    sock
                    clientHost
                    currentTime
                    ""
                    ""
                    False
                    False
                    0
                    0
                    False
                    False
                    False
                    False
                    False
                    False
                    False
                    False
                    Nothing
                    Nothing
                    0
                    )

        writeChan chan $ Accept newClient
        return ()