gameServer/CoreTypes.hs
author unc0rr
Mon, 23 Feb 2009 20:15:02 +0000
changeset 1832 1fb61a53a2c2
parent 1824 fbe1fa777d68
child 1833 e901ec5644b4
permissions -rw-r--r--
Add options for database access
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     1
module CoreTypes where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     2
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     3
import System.IO
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     4
import Control.Concurrent.Chan
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     5
import Control.Concurrent.STM
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     6
import Data.Word
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     7
import qualified Data.Map as Map
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     8
import qualified Data.IntMap as IntMap
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     9
import qualified Data.IntSet as IntSet
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    10
import Data.Sequence(Seq, empty)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    11
import Network
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    12
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
data ClientInfo =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    14
 ClientInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    15
	{
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    16
		clientUID :: Int,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    17
		sendChan :: Chan [String],
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    18
		clientHandle :: Handle,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    19
		host :: String,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    20
		nick :: String,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    21
		clientProto :: Word16,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    22
		roomID :: Int,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    23
		isMaster :: Bool,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    24
		isReady :: Bool,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    25
		forceQuit :: Bool,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    26
		partRoom :: Bool
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    27
	}
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    28
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    29
instance Show ClientInfo where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    30
	show ci = show $ clientUID ci
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    31
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    32
instance Eq ClientInfo where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    33
	a1 == a2 = clientHandle a1 == clientHandle a2
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    34
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    35
data HedgehogInfo =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    36
	HedgehogInfo String String
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    37
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    38
data TeamInfo =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    39
	TeamInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    40
	{
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    41
		teamowner :: String,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    42
		teamname :: String,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    43
		teamcolor :: String,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    44
		teamgrave :: String,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    45
		teamfort :: String,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    46
		teamvoicepack :: String,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    47
		difficulty :: Int,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    48
		hhnum :: Int,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    49
		hedgehogs :: [HedgehogInfo]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    50
	}
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    51
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    52
data RoomInfo =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    53
	RoomInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    54
	{
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    55
		roomUID :: Int,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    56
		name :: String,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    57
		password :: String,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    58
		roomProto :: Word16,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    59
		teams :: [TeamInfo],
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    60
		gameinprogress :: Bool,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    61
		playersIn :: !Int,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    62
		readyPlayers :: Int,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    63
		playersIDs :: IntSet.IntSet,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    64
		isRestrictedJoins :: Bool,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    65
		isRestrictedTeams :: Bool,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    66
		roundMsgs :: Seq String,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    67
		leftTeams :: [String],
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    68
		teamsAtStart :: [TeamInfo],
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    69
		params :: Map.Map String [String]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    70
	}
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    71
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    72
instance Show RoomInfo where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    73
	show ri = (show $ roomUID ri)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    74
			++ ", players ids: " ++ (show $ IntSet.size $ playersIDs ri)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    75
			++ ", players: " ++ (show $ playersIn ri)
1824
fbe1fa777d68 More verbose dump
unc0rr
parents: 1804
diff changeset
    76
			++ ", ready: " ++ (show $ readyPlayers ri)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    77
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    78
instance Eq RoomInfo where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    79
	a1 == a2 = roomUID a1 == roomUID a2
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    80
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    81
newRoom = (
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    82
	RoomInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    83
		0
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    84
		""
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    85
		""
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    86
		0
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    87
		[]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    88
		False
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    89
		0
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    90
		0
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    91
		IntSet.empty
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    92
		False
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    93
		False
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    94
		Data.Sequence.empty
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    95
		[]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    96
		[]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    97
		(Map.singleton "MAP" ["+rnd+"])
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    98
	)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    99
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   100
data StatisticsInfo =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   101
	StatisticsInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   102
	{
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   103
		playersNumber :: Int,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   104
		roomsNumber :: Int
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   105
	}
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   106
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   107
data DBQuery =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   108
	HasRegistered String
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   109
	| CheckPassword String
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   110
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   111
data ServerInfo =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   112
	ServerInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   113
	{
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   114
		isDedicated :: Bool,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   115
		serverMessage :: String,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   116
		listenPort :: PortNumber,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   117
		loginsNumber :: Int,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   118
		nextRoomID :: Int,
1832
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1824
diff changeset
   119
		dbHost :: String,
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1824
diff changeset
   120
		dbLogin :: String,
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1824
diff changeset
   121
		dbPassword :: String,
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   122
		stats :: TMVar StatisticsInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   123
		--dbQueries :: TChan DBQuery
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   124
	}
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   125
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   126
instance Show ServerInfo where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   127
	show si = "Logins: " ++ (show $ loginsNumber si)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   128
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   129
newServerInfo = (
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   130
	ServerInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   131
		True
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   132
		"<h2><p align=center><a href=\"http://www.hedgewars.org/\">http://www.hedgewars.org/</a></p></h2>"
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   133
		46631
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   134
		0
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   135
		0
1832
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1824
diff changeset
   136
		""
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1824
diff changeset
   137
		""
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1824
diff changeset
   138
		""
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   139
	)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   140
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   141
data CoreMessage =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   142
	Accept ClientInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   143
	| ClientMessage (Int, [String])
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   144
	-- | CoreMessage String
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   145
	-- | TimerTick
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   146
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   147
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   148
type Clients = IntMap.IntMap ClientInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   149
type Rooms = IntMap.IntMap RoomInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   150
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   151
--type ClientsTransform = [ClientInfo] -> [ClientInfo]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   152
--type RoomsTransform = [RoomInfo] -> [RoomInfo]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   153
--type HandlesSelector = ClientInfo -> [ClientInfo] -> [RoomInfo] -> [ClientInfo]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   154
--type Answer = ServerInfo -> (HandlesSelector, [String])
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   155
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   156
type ClientsSelector = Clients -> Rooms -> [Int]