Don't gray out images of disabled ToggleButtons as its a little too hard on the eyes
The disabled state is visible by the button border color.
{-
* Hedgewars, a free turn based strategy game
* Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com>
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; version 2 of the License
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
\-}
{-# LANGUAGE CPP, OverloadedStrings, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
module CoreTypes where
import Control.Concurrent
import Data.Word
import qualified Data.Map as Map
import Data.Time
import Network
import Data.Function
import Data.ByteString.Char8 as B
import Data.Unique
import Control.Exception
import Data.Typeable
import Data.TConfig
import Control.DeepSeq
-----------------------
import RoomsAndClients
#if __GLASGOW_HASKELL__ < 706
instance NFData B.ByteString
#endif
instance NFData (Chan a) where rnf a = a `seq` ()
instance NFData Action where
rnf (AnswerClients chans msg) = chans `deepseq` msg `deepseq` ()
rnf a = a `seq` ()
data Action =
AnswerClients ![ClientChan] ![B.ByteString]
| SendServerMessage
| SendServerVars
| MoveToRoom RoomIndex
| MoveToLobby B.ByteString
| RemoveTeam B.ByteString
| SendTeamRemovalMessage B.ByteString
| RemoveRoom
| FinishGame
| UnreadyRoomClients
| JoinLobby
| ProtocolError B.ByteString
| Warning B.ByteString
| NoticeMessage Notice
| ByeClient B.ByteString
| KickClient ClientIndex
| KickRoomClient ClientIndex
| BanClient NominalDiffTime B.ByteString ClientIndex
| BanIP B.ByteString NominalDiffTime B.ByteString
| BanNick B.ByteString NominalDiffTime B.ByteString
| BanList
| Unban B.ByteString
| ChangeMaster (Maybe ClientIndex)
| RemoveClientTeams
| ModifyClient (ClientInfo -> ClientInfo)
| ModifyClient2 ClientIndex (ClientInfo -> ClientInfo)
| ModifyRoomClients (ClientInfo -> ClientInfo)
| ModifyRoom (RoomInfo -> RoomInfo)
| ModifyServerInfo (ServerInfo -> ServerInfo)
| AddRoom B.ByteString B.ByteString
| SendUpdateOnThisRoom
| CheckRegistered
| ClearAccountsCache
| ProcessAccountInfo AccountInfo
| AddClient ClientInfo
| DeleteClient ClientIndex
| PingAll
| StatsAction
| RestartServer
| AddNick2Bans B.ByteString B.ByteString UTCTime
| AddIP2Bans B.ByteString B.ByteString UTCTime
| CheckBanned Bool
| SaveReplay
| Stats
| CheckRecord
| CheckFailed B.ByteString
| CheckSuccess [B.ByteString]
| Random [ClientChan] [B.ByteString]
| LoadGhost B.ByteString
| QueryReplay B.ByteString
| ShowReplay B.ByteString
| Cleanup
| RegisterEvent Event
| SaveRoom B.ByteString
| LoadRoom B.ByteString
| ReactCmd [B.ByteString]
| CheckVotes
| SetRandomSeed
data Event = LobbyChatMessage
| EngineMessage
| RoomJoin
type EventsInfo = [(Int, UTCTime)]
newEventsInfo :: EventsInfo
newEventsInfo = []
type ClientChan = Chan [B.ByteString]
data CheckInfo =
CheckInfo
{
recordFileName :: String,
recordTeams :: [TeamInfo],
details :: Maybe GameDetails
}
data ClientInfo =
ClientInfo
{
clUID :: !Unique,
sendChan :: !ClientChan,
clientSocket :: !Socket,
host :: !B.ByteString,
connectTime :: !UTCTime,
nick :: !B.ByteString,
webPassword :: !B.ByteString,
serverSalt :: !B.ByteString,
logonPassed :: !Bool,
isVisible :: !Bool,
clientProto :: !Word16,
pingsQueue :: !Word,
isMaster :: !Bool,
isReady :: !Bool,
isInGame :: !Bool,
isAdministrator :: !Bool,
hasSuperPower :: !Bool,
isChecker :: !Bool,
isContributor :: !Bool,
isKickedFromServer :: !Bool,
isJoinedMidGame :: !Bool,
hasAskedList :: !Bool,
clientClan :: !(Maybe B.ByteString),
checkInfo :: !(Maybe CheckInfo),
eiLobbyChat,
eiEM,
eiJoin :: !EventsInfo,
teamsInGame :: !Word,
teamIndexes :: ![Word8],
pendingActions :: ![Action]
}
instance Eq ClientInfo where
(==) = (==) `on` clientSocket
data HedgehogInfo =
HedgehogInfo B.ByteString B.ByteString
deriving (Show, Read)
data TeamInfo =
TeamInfo
{
teamowner :: !B.ByteString,
teamname :: !B.ByteString,
teamcolor :: !B.ByteString,
teamgrave :: !B.ByteString,
teamfort :: !B.ByteString,
teamvoicepack :: !B.ByteString,
teamflag :: !B.ByteString,
isOwnerRegistered :: !Bool,
difficulty :: !Int,
hhnum :: !Int,
hedgehogs :: ![HedgehogInfo]
}
deriving (Show, Read)
instance Eq TeamInfo where
(==) = (==) `on` teamname
data GameInfo =
GameInfo
{
roundMsgs :: [B.ByteString],
lastFilteredTimedMsg :: Maybe B.ByteString,
leftTeams :: [B.ByteString],
rejoinedTeams :: [B.ByteString], -- for 0.9.21 frontend workaround
teamsAtStart :: [TeamInfo],
teamsInGameNumber :: Int,
allPlayersHaveRegisteredAccounts :: !Bool,
giMapParams :: Map.Map B.ByteString B.ByteString,
giParams :: Map.Map B.ByteString [B.ByteString],
isPaused :: Bool
} deriving (Show, Read)
newGameInfo :: [TeamInfo]
-> Int
-> Bool
-> Map.Map ByteString ByteString
-> Map.Map ByteString [ByteString]
-> Bool
-> GameInfo
newGameInfo =
GameInfo
[]
Nothing
[]
[]
data RoomInfo =
RoomInfo
{
masterID :: !(Maybe ClientIndex),
name :: !B.ByteString,
password :: !B.ByteString,
roomProto :: !Word16,
teams :: ![TeamInfo],
gameInfo :: !(Maybe GameInfo),
playersIn :: !Int,
readyPlayers :: !Int,
isRestrictedJoins :: !Bool,
isRestrictedTeams :: !Bool,
isRegisteredOnly :: !Bool,
isSpecial :: !Bool,
defaultHedgehogsNumber :: !Int,
teamsNumberLimit :: !Int,
greeting :: !B.ByteString,
voting :: !(Maybe Voting),
roomBansList :: ![B.ByteString],
mapParams :: !(Map.Map B.ByteString B.ByteString),
params :: !(Map.Map B.ByteString [B.ByteString]),
roomSaves :: !(Map.Map B.ByteString (B.ByteString, Map.Map B.ByteString B.ByteString, Map.Map B.ByteString [B.ByteString]))
}
newRoom :: RoomInfo
newRoom =
RoomInfo
Nothing
""
""
0
[]
Nothing
0
0
False
False
False
False
4
8
""
Nothing
[]
(
Map.fromList $ Prelude.zip
["FEATURE_SIZE", "MAP", "MAPGEN", "MAZE_SIZE", "SEED", "TEMPLATE"]
["12", "+rnd+", "0", "0", "seed", "0"]
)
(
Map.fromList $ Prelude.zip
["AMMO", "SCHEME", "SCRIPT", "THEME"]
[["Default"], ["Default"], ["Normal"], ["avematan"]]
)
Map.empty
data StatisticsInfo =
StatisticsInfo
{
playersNumber :: Int,
roomsNumber :: Int
}
data ServerInfo =
ServerInfo
{
isDedicated :: Bool,
isRegisteredUsersOnly :: Bool,
serverMessage :: B.ByteString,
serverMessageForOldVersions :: B.ByteString,
latestReleaseVersion :: Word16,
earliestCompatibleVersion :: Word16,
listenPort :: PortNumber,
dbHost :: B.ByteString,
dbName :: B.ByteString,
dbLogin :: B.ByteString,
dbPassword :: B.ByteString,
bans :: [BanInfo],
shutdownPending :: Bool,
runArgs :: [String],
coreChan :: Chan CoreMessage,
dbQueries :: Chan DBQuery,
serverSocket :: Maybe Socket,
serverConfig :: Maybe Conf
}
newServerInfo :: Chan CoreMessage -> Chan DBQuery -> Maybe Socket -> Maybe Conf -> ServerInfo
newServerInfo =
ServerInfo
True
False
"<h2><p align=center><a href=\"http://www.hedgewars.org/\">http://www.hedgewars.org/</a></p></h2>"
"<font color=yellow><h3 align=center>Hedgewars 0.9.23 is out! Please update.</h3><p align=center><a href=http://hedgewars.org/download.html>Download page here</a></font>"
53 -- latestReleaseVersion
41 -- earliestCompatibleVersion
46631
""
""
""
""
[]
False
[]
data Voting = Voting {
voteTTL :: Int,
entitledToVote :: [Unique],
votes :: [(Unique, Bool)],
voteType :: VoteType
}
data VoteType = VoteKick B.ByteString
| VoteMap B.ByteString
| VotePause
| VoteNewSeed
| VoteHedgehogsPerTeam Int
newVoting :: VoteType -> Voting
newVoting = Voting 2 [] []
data AccountInfo =
HasAccount B.ByteString Bool Bool
| Guest
| Admin
| ReplayName B.ByteString
deriving (Show, Read)
data DBQuery =
CheckAccount ClientIndex Int B.ByteString B.ByteString
| ClearCache
| SendStats Int Int
| StoreAchievements Word16 B.ByteString [(B.ByteString, B.ByteString)] GameDetails [B.ByteString]
| GetReplayName ClientIndex Int B.ByteString
deriving (Show, Read)
data GameDetails =
GameDetails {
gameScript :: B.ByteString
, infRope
, isVamp
, infAttacks :: Bool
} deriving (Show, Read)
instance NFData GameDetails where
rnf (GameDetails a b c d) = a `deepseq` b `deepseq` c `deepseq` d `deepseq` ()
data CoreMessage =
Accept ClientInfo
| ClientMessage (ClientIndex, [B.ByteString])
| ClientAccountInfo ClientIndex Int AccountInfo
| TimerAction Int
| Remove ClientIndex
type MRnC = MRoomsAndClients RoomInfo ClientInfo
type IRnC = IRoomsAndClients RoomInfo ClientInfo
data Notice =
NickAlreadyInUse
| AdminLeft
| WrongPassword
deriving Enum
data ShutdownException =
ShutdownException
deriving (Show, Typeable)
instance Exception ShutdownException
data ShutdownThreadException = ShutdownThreadException String
deriving Typeable
instance Show ShutdownThreadException where
show (ShutdownThreadException s) = s
instance Exception ShutdownThreadException
data BanInfo =
BanByIP B.ByteString B.ByteString UTCTime
| BanByNick B.ByteString B.ByteString UTCTime
deriving (Show, Read)