gameServer/NetRoutines.hs
author sheepluva
Fri, 14 Jan 2011 17:01:29 +0100
changeset 4840 d607e8c5a743
parent 4568 f85243bf890e
child 4905 7842d085acf4
permissions -rw-r--r--
also convert/pngcrush png pictures with 16bit/channel (resulting in 8bit/channel) and repage their layers (as I found out that some of the pics had their layer offset the actual visual area, which makes the picture look blank in gimp)

{-# LANGUAGE ScopedTypeVariables #-}
module NetRoutines where

import Network
import Network.Socket
import System.IO
import Control.Concurrent
import Control.Concurrent.Chan
import Control.Concurrent.STM
import qualified Control.Exception as Exception
import Data.Time
-----------------------------
import CoreTypes
import ClientIO
import Utils

acceptLoop :: Socket -> Chan CoreMessage -> Int -> IO ()
acceptLoop servSock coreChan clientCounter = do
    Exception.handle
        (\(_ :: Exception.IOException) -> putStrLn "exception on connect") $
        do
        (socket, sockAddr) <- Network.Socket.accept servSock

        cHandle <- socketToHandle socket ReadWriteMode
        hSetBuffering cHandle LineBuffering
        clientHost <- sockAddr2String sockAddr

        currentTime <- getCurrentTime
        
        sendChan <- newChan

        let newClient =
                (ClientInfo
                    nextID
                    sendChan
                    cHandle
                    clientHost
                    currentTime
                    ""
                    ""
                    False
                    0
                    0
                    0
                    False
                    False
                    False
                    undefined
                    undefined
                    )

        writeChan coreChan $ Accept newClient

        forkIO $ clientRecvLoop cHandle coreChan nextID
        forkIO $ clientSendLoop cHandle coreChan sendChan nextID
        return ()

    acceptLoop servSock coreChan nextID
    where
        nextID = clientCounter + 1