gameServer/NetRoutines.hs
author smxx
Wed, 10 Feb 2010 00:55:40 +0000
changeset 2786 85f6425a4d74
parent 2403 6c5d504af2ba
child 2867 9be6693c78cb
permissions -rw-r--r--
Engine: * Added LUA scripting support for trainings (and maybe soon) scenarios/missions * Converted Shotgun and Bazooka Training to LUA * New dependency: LUA 5.1 * New Mission Objectives window * Extended default keybinds for non-iPhone builds * NOTE: Script function names etc. might change soon so don't work too hard on your own missions (for now)! This is experimental! Frontend: * Added support for new training maps/LUA scripts

{-# 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