gameServer/Utils.hs
author unc0rr
Wed, 18 Feb 2009 15:04:40 +0000
changeset 1804 4e78ad846fb6
child 1917 c94045b70142
permissions -rw-r--r--
New game server: - Incomplete implementation - More robust, no memory leaks, better architecture for easy features addition - Incompatible with current client
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     1
module Utils where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     2
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     3
import Control.Concurrent
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     4
import Control.Concurrent.STM
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     5
import Data.Char
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
-------------------------------------------------
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    10
import qualified Codec.Binary.Base64 as Base64
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    11
import qualified Codec.Binary.UTF8.String as UTF8
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    12
import CoreTypes
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    14
toEngineMsg :: String -> String
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    15
toEngineMsg msg = Base64.encode (fromIntegral (length msg) : (UTF8.encode msg))
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    16
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    17
--tselect :: [ClientInfo] -> STM ([String], ClientInfo)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    18
--tselect = foldl orElse retry . map (\ci -> (flip (,) ci) `fmap` readTChan (chan ci))
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    19
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    20
maybeRead :: Read a => String -> Maybe a
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    21
maybeRead s = case reads s of
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    22
	[(x, rest)] | all isSpace rest -> Just x
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    23
	_         -> Nothing
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    24
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    25
teamToNet team = [
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    26
		"ADD_TEAM",
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    27
		teamname team,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    28
		teamgrave team,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    29
		teamfort team,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    30
		teamvoicepack team,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    31
		teamowner team,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    32
		show $ difficulty team
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    33
		]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    34
		++ hhsInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    35
	where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    36
		hhsInfo = concatMap (\(HedgehogInfo name hat) -> [name, hat]) $ hedgehogs team
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    37
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    38
modifyTeam :: TeamInfo -> RoomInfo -> RoomInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    39
modifyTeam team room = room{teams = replaceTeam team $ teams room}
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    40
	where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    41
	replaceTeam _ [] = error "modifyTeam: no such team"
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    42
	replaceTeam team (t:teams) =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    43
		if teamname team == teamname t then
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    44
			team : teams
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    45
		else
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    46
			t : replaceTeam team teams
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    47
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    48
protoNumber2ver :: Word16 -> String
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    49
protoNumber2ver 17 = "0.9.7-dev"
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    50
protoNumber2ver 19 = "0.9.7"
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    51
protoNumber2ver 20 = "0.9.8-dev"
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    52
protoNumber2ver 21 = "0.9.8"
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    53
protoNumber2ver 22 = "0.9.9-dev"
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    54
protoNumber2ver 23 = "0.9.9"
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    55
protoNumber2ver 24 = "0.9.10-dev"
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    56
protoNumber2ver 25 = "0.9.10"
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    57
protoNumber2ver _ = "Unknown"
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    58