gameServer/CoreTypes.hs
author unc0rr
Wed, 13 May 2009 19:53:45 +0000
changeset 2051 949fe7df09b6
parent 2004 f7944d5adc5f
child 2104 b2c50a7480ea
permissions -rw-r--r--
Fix engine crash due to screwing up visual gears list in speechbubbles handler

module CoreTypes where

import System.IO
import Control.Concurrent.Chan
import Control.Concurrent.STM
import Data.Word
import qualified Data.Map as Map
import qualified Data.IntMap as IntMap
import qualified Data.IntSet as IntSet
import Data.Sequence(Seq, empty)
import Data.Time
import Network


data ClientInfo =
 ClientInfo
	{
		clientUID :: !Int,
		sendChan :: Chan [String],
		clientHandle :: Handle,
		host :: String,
		connectTime :: UTCTime,
		nick :: String,
		webPassword :: String,
		logonPassed :: Bool,
		clientProto :: !Word16,
		roomID :: !Int,
		pingsQueue :: !Word,
		isMaster :: Bool,
		isReady :: Bool,
		isAdministrator :: Bool
	}

instance Show ClientInfo where
	show ci = (show $ clientUID ci)
			++ " nick: " ++ (nick ci)
			++ " host: " ++ (host ci)

instance Eq ClientInfo where
	a1 == a2 = clientHandle a1 == clientHandle a2

data HedgehogInfo =
	HedgehogInfo String String

data TeamInfo =
	TeamInfo
	{
		teamowner :: String,
		teamname :: String,
		teamcolor :: String,
		teamgrave :: String,
		teamfort :: String,
		teamvoicepack :: String,
		difficulty :: Int,
		hhnum :: Int,
		hedgehogs :: [HedgehogInfo]
	}

data RoomInfo =
	RoomInfo
	{
		roomUID :: !Int,
		name :: String,
		password :: String,
		roomProto :: Word16,
		teams :: [TeamInfo],
		gameinprogress :: Bool,
		playersIn :: !Int,
		readyPlayers :: !Int,
		playersIDs :: IntSet.IntSet,
		isRestrictedJoins :: Bool,
		isRestrictedTeams :: Bool,
		roundMsgs :: Seq String,
		leftTeams :: [String],
		teamsAtStart :: [TeamInfo],
		params :: Map.Map String [String]
	}

instance Show RoomInfo where
	show ri = (show $ roomUID ri)
			++ ", players ids: " ++ (show $ IntSet.size $ playersIDs ri)
			++ ", players: " ++ (show $ playersIn ri)
			++ ", ready: " ++ (show $ readyPlayers ri)

instance Eq RoomInfo where
	a1 == a2 = roomUID a1 == roomUID a2

newRoom = (
	RoomInfo
		0
		""
		""
		0
		[]
		False
		0
		0
		IntSet.empty
		False
		False
		Data.Sequence.empty
		[]
		[]
		(Map.singleton "MAP" ["+rnd+"])
	)

data StatisticsInfo =
	StatisticsInfo
	{
		playersNumber :: Int,
		roomsNumber :: Int
	}

data ServerInfo =
	ServerInfo
	{
		isDedicated :: Bool,
		serverMessage :: String,
		serverMessageForOldVersions :: String,
		listenPort :: PortNumber,
		nextRoomID :: Int,
		dbHost :: String,
		dbLogin :: String,
		dbPassword :: String,
		lastLogins :: [(String, UTCTime)],
		stats :: TMVar StatisticsInfo,
		coreChan :: Chan CoreMessage,
		dbQueries :: Chan DBQuery
	}

instance Show ServerInfo where
	show si = "Server Info"

newServerInfo = (
	ServerInfo
		True
		"<h2><p align=center><a href=\"http://www.hedgewars.org/\">http://www.hedgewars.org/</a></p></h2>"
		"<font color=yellow><h3>Hedgewars 0.9.10 is out! Please, update. Support for previous versions IS DROPPED</h3><p align=center><a href=http://hedgewars.org/download.html>Download page here</a></p><h4>New features are:</h4><ul><li>Large maps</li><li>New game options</li><li>Utilities</li><li>...</li></ul></font>"
		46631
		0
		""
		""
		""
		[]
	)

data AccountInfo =
	HasAccount String Bool
	| Guest
	| Admin

data CoreMessage =
	Accept ClientInfo
	| ClientMessage (Int, [String])
	| ClientAccountInfo Int AccountInfo
	| TimerAction

data DBQuery =
	CheckAccount ClientInfo


type Clients = IntMap.IntMap ClientInfo
type Rooms = IntMap.IntMap RoomInfo

--type ClientsTransform = [ClientInfo] -> [ClientInfo]
--type RoomsTransform = [RoomInfo] -> [RoomInfo]
--type HandlesSelector = ClientInfo -> [ClientInfo] -> [RoomInfo] -> [ClientInfo]
--type Answer = ServerInfo -> (HandlesSelector, [String])

type ClientsSelector = Clients -> Rooms -> [Int]