Basic client dialogs to login and start a new game
This commit is contained in:
Sasha
parent
a405c3d8ea
commit
2cf5d48419
22 changed files with 709 additions and 389 deletions
|
|
@ -1,5 +1,9 @@
|
|||
# Revision history for hanafudapi
|
||||
|
||||
## 0.1.1.0 -- 2018-05-11
|
||||
|
||||
* Basic client dialogs to login and start a new game
|
||||
|
||||
## 0.1.0.0 -- 2018-03-17
|
||||
|
||||
* First version. Released on an unsuspecting world.
|
||||
|
|
|
|||
|
|
@ -2,8 +2,8 @@
|
|||
-- documentation, see http://haskell.org/cabal/users-guide/
|
||||
|
||||
name: hanafudapi
|
||||
version: 0.1.0.0
|
||||
synopsis: An API for the Haskell hanafuda library
|
||||
version: 0.1.1.0
|
||||
synopsis: A webapp for the Haskell hanafuda library
|
||||
-- description:
|
||||
homepage: https://framagit.org/hanafuda
|
||||
license: BSD3
|
||||
|
|
@ -21,7 +21,8 @@ source-repository head
|
|||
|
||||
executable hanafudapi
|
||||
main-is: Main.hs
|
||||
other-modules: Automaton
|
||||
other-modules: App
|
||||
, Automaton
|
||||
, Config
|
||||
, Message
|
||||
, Game
|
||||
|
|
|
|||
64
src/App.hs
Normal file
64
src/App.hs
Normal file
|
|
@ -0,0 +1,64 @@
|
|||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
module App (
|
||||
T
|
||||
, Context(..)
|
||||
, connection
|
||||
, debug
|
||||
, get
|
||||
, current
|
||||
, server
|
||||
, try
|
||||
, update
|
||||
, update_
|
||||
) where
|
||||
|
||||
import Data.Map ((!))
|
||||
import Control.Concurrent (MVar, modifyMVar, putMVar, readMVar, takeMVar)
|
||||
import Control.Monad.Reader (ReaderT(..), ask, asks, lift)
|
||||
import Network.WebSockets (Connection)
|
||||
import qualified Player (Key)
|
||||
import qualified Session (T(..))
|
||||
import qualified Server (T(..))
|
||||
|
||||
data Context = Context {
|
||||
mServer :: MVar Server.T
|
||||
, key :: Player.Key
|
||||
}
|
||||
|
||||
type T a = ReaderT Context IO a
|
||||
|
||||
server :: T Server.T
|
||||
server = asks mServer >>= lift . readMVar
|
||||
|
||||
get :: Player.Key -> T Session.T
|
||||
get key =
|
||||
(! key) . Server.sessions <$> server
|
||||
|
||||
current :: T Session.T
|
||||
current = do
|
||||
asks key >>= get
|
||||
|
||||
connection :: T Connection
|
||||
connection = Session.connection <$> current
|
||||
|
||||
debug :: String -> T ()
|
||||
debug message =
|
||||
show <$> asks key
|
||||
>>= lift . putStrLn . (++ ' ':message)
|
||||
|
||||
try :: (Server.T -> Either String Server.T) -> T (Maybe String)
|
||||
try f = do
|
||||
Context {mServer} <- ask
|
||||
currentValue <- lift $ takeMVar mServer
|
||||
lift $ case f currentValue of
|
||||
Left message -> putMVar mServer currentValue >> return (Just message)
|
||||
Right updated -> putMVar mServer updated >> return Nothing
|
||||
|
||||
{- Not using the previous to minimize the duration mServer gets locked -}
|
||||
update :: (Server.T -> (Server.T, a)) -> T a
|
||||
update f = do
|
||||
Context {mServer} <- ask
|
||||
lift $ modifyMVar mServer (return . f)
|
||||
|
||||
update_ :: (Server.T -> Server.T) -> T ()
|
||||
update_ f = update $ (\x -> (x, ())) . f
|
||||
|
|
@ -3,66 +3,78 @@ module Automaton (
|
|||
start
|
||||
) where
|
||||
|
||||
import Control.Monad.Reader (asks)
|
||||
import qualified Player (Session(..), Status(..))
|
||||
import qualified Server (logIn, logOut, setStatus)
|
||||
import qualified Session (App, T(..), current, debug, get, server, try, update)
|
||||
import qualified Message (FromClient(..), T(..), broadcast, get, relay, send, sendTo)
|
||||
import Control.Monad.Reader (asks, lift)
|
||||
import qualified Game (export, new)
|
||||
import qualified Session (Status(..), T(..))
|
||||
import qualified Server (get, logIn, logOut, setStatus, register)
|
||||
import qualified App (Context(..), T, current, debug, get, server, try, update, update_)
|
||||
import qualified Message (FromClient(..), T(..), broadcast, get, relay, send, sendTo, update)
|
||||
|
||||
type Vertex = Player.Status
|
||||
type Vertex = Session.Status
|
||||
|
||||
edges :: Vertex -> Message.FromClient -> Session.App Vertex
|
||||
edges :: Vertex -> Message.FromClient -> App.T Vertex
|
||||
|
||||
edges (Player.LoggedIn False) logIn@(Message.LogIn login) =
|
||||
asks Session.key >>= Session.try . (Server.logIn login)
|
||||
edges (Session.LoggedIn False) logIn@(Message.LogIn login) =
|
||||
asks App.key >>= App.try . (Server.logIn login)
|
||||
>>= maybe
|
||||
(Message.relay logIn Message.broadcast >> return (Player.LoggedIn True))
|
||||
(withError $ Player.LoggedIn False)
|
||||
(Message.relay logIn Message.broadcast >> return (Session.LoggedIn True))
|
||||
(withError $ Session.LoggedIn False)
|
||||
|
||||
edges (Player.LoggedIn True) logOut@Message.LogOut = do
|
||||
edges (Session.LoggedIn True) logOut@Message.LogOut = do
|
||||
Message.relay logOut Message.broadcast
|
||||
asks Session.key >>= Session.update . Server.logOut
|
||||
return (Player.LoggedIn False)
|
||||
asks App.key >>= App.update_ . Server.logOut
|
||||
return (Session.LoggedIn False)
|
||||
|
||||
edges (Player.LoggedIn True) invitation@(Message.Invitation {Message.to}) = do
|
||||
session <- Session.get to
|
||||
case Player.status session of
|
||||
Player.LoggedIn True -> do
|
||||
key <- asks Session.key
|
||||
Session.update (Server.setStatus (Player.Answering key) to)
|
||||
(Message.relay invitation $ Message.sendTo (to, session))
|
||||
return (Player.Waiting to)
|
||||
_ -> Player.LoggedIn True `withError` "They just left"
|
||||
edges (Session.LoggedIn True) invitation@(Message.Invitation {Message.to}) = do
|
||||
session <- App.get to
|
||||
case Session.status session of
|
||||
Session.LoggedIn True -> do
|
||||
key <- asks App.key
|
||||
App.update_ (Server.setStatus (Session.Answering key) to)
|
||||
Message.broadcast $ Message.update {Message.paired = [key, to]}
|
||||
(Message.relay invitation $ Message.sendTo [(to, session)])
|
||||
return (Session.Waiting to)
|
||||
_ -> Session.LoggedIn True `withError` "They just left"
|
||||
|
||||
edges (Player.Answering to) message@(Message.Answer {Message.accept}) = do
|
||||
session <- Session.get to
|
||||
key <- asks Session.key
|
||||
case Player.status session of
|
||||
Player.Waiting for | for == key -> do
|
||||
Message.relay message $ Message.sendTo (to, session)
|
||||
if accept
|
||||
then Session.debug "Yeah ! Let's start a game" >> return (Player.LoggedIn True)
|
||||
else Session.debug "Oh, they said no" >> return (Player.LoggedIn True)
|
||||
_ -> (Player.LoggedIn True) `withError` "They're not waiting for your answer"
|
||||
edges (Session.Answering to) message@(Message.Answer {Message.accept}) = do
|
||||
session <- App.get to
|
||||
key <- asks App.key
|
||||
case Session.status session of
|
||||
Session.Waiting for | for == key -> do
|
||||
Message.relay message $ Message.sendTo [(to, session)]
|
||||
newStatus <-
|
||||
if accept
|
||||
then do
|
||||
gameKey <- Server.register <$> (lift $ Game.new for to) >>= App.update
|
||||
game <- Server.get gameKey <$> App.server
|
||||
current <- App.current
|
||||
Message.sendTo [(to, session), (key, current)] $ Message.NewGame $ Game.export game
|
||||
return $ Session.Playing gameKey
|
||||
else do
|
||||
Message.broadcast $ Message.update {Message.alone = [key, to]}
|
||||
return $ Session.LoggedIn True
|
||||
App.update_ $ Server.setStatus newStatus for
|
||||
return newStatus
|
||||
_ -> (Session.LoggedIn True) `withError` "They're not waiting for your answer"
|
||||
|
||||
edges state _ =
|
||||
state `withError` ("Invalid message in state " ++ show state)
|
||||
|
||||
withError :: Vertex -> String -> Session.App Vertex
|
||||
withError :: Vertex -> String -> App.T Vertex
|
||||
withError vertex message =
|
||||
(Message.send $ Message.Error message) >> return vertex
|
||||
|
||||
run :: Session.App ()
|
||||
run :: App.T ()
|
||||
run = do
|
||||
message <- Message.get
|
||||
status <- Player.status <$> Session.current
|
||||
status <- Session.status <$> App.current
|
||||
newStatus <- edges status message
|
||||
Server.setStatus newStatus <$> asks Session.key >>= Session.update
|
||||
Session.debug $ show newStatus
|
||||
asks App.key >>= App.update_ . Server.setStatus newStatus
|
||||
App.debug $ show newStatus
|
||||
run
|
||||
|
||||
start :: Session.App ()
|
||||
start :: App.T ()
|
||||
start = do
|
||||
Session.debug "Initial state"
|
||||
Message.Welcome <$> Session.server <*> asks Session.key >>= Message.send
|
||||
App.debug "Initial state"
|
||||
Message.Welcome <$> App.server <*> asks App.key >>= Message.send
|
||||
run
|
||||
|
|
|
|||
27
src/Data.hs
27
src/Data.hs
|
|
@ -1,9 +1,30 @@
|
|||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
module Data (
|
||||
RW(..)
|
||||
Key(..)
|
||||
, RW(..)
|
||||
) where
|
||||
|
||||
import Data.Aeson (FromJSON(..), ToJSON(..), ToJSONKey(..), genericToEncoding)
|
||||
import Data.Aeson.Types (toJSONKeyText)
|
||||
import Data.Text (pack)
|
||||
import GHC.Generics
|
||||
import qualified JSON (defaultOptions)
|
||||
|
||||
class RW a b where
|
||||
update :: (a -> a) -> b -> b
|
||||
get :: b -> a
|
||||
set :: a -> b -> b
|
||||
set = update . const
|
||||
update :: (a -> a) -> b -> b
|
||||
update f v =
|
||||
set (f (get v)) v
|
||||
|
||||
newtype Key a = Key Int deriving (Eq, Ord, Enum, Read, Show, Generic)
|
||||
|
||||
instance FromJSON (Key a)
|
||||
instance ToJSON (Key a) where
|
||||
toEncoding = genericToEncoding JSON.defaultOptions
|
||||
|
||||
instance ToJSONKey (Key a) where
|
||||
toJSONKey = toJSONKeyText (pack . \(Key n) -> show n)
|
||||
|
|
|
|||
61
src/Game.hs
61
src/Game.hs
|
|
@ -1,19 +1,62 @@
|
|||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
module Game where
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
module Game (
|
||||
Key
|
||||
, State(..)
|
||||
, T(..)
|
||||
, export
|
||||
, new
|
||||
) where
|
||||
|
||||
import Hanafuda (Card(..))
|
||||
import Hanafuda.KoiKoi (Move(..))
|
||||
import Data.Map (Map, (!), fromList, mapKeys)
|
||||
import Data.Aeson (FromJSON(..), ToJSON(..), genericToEncoding)
|
||||
import qualified JSON (singleLCField)
|
||||
import qualified Data (Key)
|
||||
import qualified Player (Key)
|
||||
import qualified Hanafuda (Card(..), cardsOfPack)
|
||||
import qualified Hanafuda.Player (Player(..), Seat(..))
|
||||
import qualified Hanafuda.KoiKoi (Mode(..), Move(..), On(..), new)
|
||||
import GHC.Generics
|
||||
|
||||
deriving instance Generic Card
|
||||
deriving instance Generic Move
|
||||
deriving instance Generic Hanafuda.Card
|
||||
deriving instance Generic Hanafuda.KoiKoi.Move
|
||||
|
||||
instance FromJSON Card
|
||||
instance ToJSON Card
|
||||
instance FromJSON Hanafuda.Card
|
||||
instance ToJSON Hanafuda.Card
|
||||
|
||||
instance FromJSON Move
|
||||
instance ToJSON Move where
|
||||
instance FromJSON Hanafuda.KoiKoi.Move
|
||||
instance ToJSON Hanafuda.KoiKoi.Move where
|
||||
toEncoding = genericToEncoding JSON.singleLCField
|
||||
|
||||
data T = T {
|
||||
seats :: Map Hanafuda.Player.Seat Player.Key
|
||||
, state :: Hanafuda.KoiKoi.On
|
||||
}
|
||||
type Key = Data.Key T
|
||||
|
||||
data State = State {
|
||||
river :: [Hanafuda.Card]
|
||||
, yakus :: Map Player.Key [Hanafuda.Card]
|
||||
} deriving (Generic)
|
||||
|
||||
instance ToJSON State where
|
||||
toEncoding = genericToEncoding JSON.singleLCField
|
||||
|
||||
new :: Player.Key -> Player.Key -> IO T
|
||||
new p1 p2 = do
|
||||
state <- Hanafuda.KoiKoi.new Hanafuda.KoiKoi.WholeYear
|
||||
return $ T {
|
||||
seats = fromList [(Hanafuda.Player.Player1, p1), (Hanafuda.Player.Player2, p2)]
|
||||
, state
|
||||
}
|
||||
|
||||
export :: T -> State
|
||||
export (T {seats, state}) = State {
|
||||
river = Hanafuda.cardsOfPack $ Hanafuda.KoiKoi.river state
|
||||
, yakus = fmap extractYakus players
|
||||
}
|
||||
where
|
||||
extractYakus = Hanafuda.cardsOfPack . Hanafuda.Player.meld
|
||||
players = mapKeys (seats !) $ Hanafuda.KoiKoi.players state
|
||||
|
|
|
|||
23
src/Main.hs
23
src/Main.hs
|
|
@ -11,28 +11,27 @@ import Control.Monad.Reader (ReaderT(..), asks)
|
|||
import Control.Concurrent (newMVar, modifyMVar)
|
||||
import Control.Exception (finally)
|
||||
import qualified Config (listenPort)
|
||||
import qualified Player (openSession)
|
||||
import qualified Server (disconnect, join, new)
|
||||
import qualified Session (App, T(..), update)
|
||||
import qualified Session (open)
|
||||
import qualified Server (disconnect, new, register)
|
||||
import qualified App (Context(..), T, update_)
|
||||
import qualified Message (FromClient(..), broadcast, relay)
|
||||
import qualified Automaton (start)
|
||||
|
||||
exit :: Session.App ()
|
||||
exit :: App.T ()
|
||||
exit = do
|
||||
asks Session.key >>= Session.update . Server.disconnect
|
||||
asks App.key >>= App.update_ . Server.disconnect
|
||||
Message.relay Message.LogOut Message.broadcast
|
||||
|
||||
serverApp :: Session.App () -> Session.App () -> IO ServerApp
|
||||
serverApp :: App.T () -> App.T () -> IO ServerApp
|
||||
serverApp onEnter onExit = do
|
||||
mServer <- newMVar Server.new
|
||||
return $ \pending -> do
|
||||
key <- acceptRequest pending
|
||||
>>= return . Player.openSession
|
||||
>>= modifyMVar mServer . Server.join
|
||||
let session = Session.T {Session.mServer, Session.key}
|
||||
session <- Session.open <$> acceptRequest pending
|
||||
key <- modifyMVar mServer (return . Server.register session)
|
||||
let app = App.Context {App.mServer, App.key}
|
||||
finally
|
||||
(runReaderT onEnter session)
|
||||
(runReaderT onExit session)
|
||||
(runReaderT onEnter app)
|
||||
(runReaderT onExit app)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
|
|
|
|||
|
|
@ -9,25 +9,29 @@ module Message (
|
|||
, relay
|
||||
, send
|
||||
, sendTo
|
||||
, update
|
||||
) where
|
||||
|
||||
import Data.List (intercalate)
|
||||
import Data.Foldable (forM_)
|
||||
import Data.Map (toList)
|
||||
import Data.Aeson (FromJSON(..), ToJSON(..), eitherDecode', encode, genericParseJSON, genericToEncoding, defaultOptions)
|
||||
import Network.WebSockets (receiveData, sendTextData)
|
||||
import Data.ByteString.Lazy.Char8 (unpack)
|
||||
import Control.Monad (mapM_)
|
||||
import Data.Text (Text)
|
||||
import Control.Monad.Reader (asks, lift)
|
||||
import qualified Player (Key, Name, Session(..))
|
||||
import qualified Player (Key)
|
||||
import qualified Game (State)
|
||||
import qualified Session (T(..))
|
||||
import qualified Server (T(..))
|
||||
import qualified Session (App, T(..), connection, current, debug, server)
|
||||
import qualified App (Context(..), T, connection, current, debug, server)
|
||||
import qualified Hanafuda.KoiKoi as KoiKoi (Move(..))
|
||||
import GHC.Generics (Generic)
|
||||
import Game ()
|
||||
|
||||
data FromClient =
|
||||
Answer {accept :: Bool}
|
||||
| Invitation {to :: Player.Key}
|
||||
| LogIn {name :: Player.Name}
|
||||
| LogIn {name :: Text}
|
||||
| LogOut
|
||||
| Game {move :: KoiKoi.Move}
|
||||
| Ping
|
||||
|
|
@ -41,6 +45,8 @@ instance FromJSON FromClient where
|
|||
data T =
|
||||
Relay {from :: Player.Key, message :: FromClient}
|
||||
| Welcome {room :: Server.T, key :: Player.Key}
|
||||
| Update {alone :: [Player.Key], paired :: [Player.Key]}
|
||||
| NewGame Game.State
|
||||
| Pong
|
||||
| Error {error :: String}
|
||||
deriving (Generic)
|
||||
|
|
@ -48,40 +54,45 @@ data T =
|
|||
instance ToJSON T where
|
||||
toEncoding = genericToEncoding defaultOptions
|
||||
|
||||
sendTo :: (Player.Key, Player.Session) -> T -> Session.App ()
|
||||
sendTo (key, session) obj = do
|
||||
Session.debug $ '(' : show key ++ ") <" ++ (unpack encoded)
|
||||
lift $ sendTextData (Player.connection session) $ encoded
|
||||
sendTo :: [(Player.Key, Session.T)] -> T -> App.T ()
|
||||
sendTo sessions obj = do
|
||||
App.debug $ '(' : intercalate ", " recipients ++ ") <" ++ (unpack encoded)
|
||||
lift $ forM_ connections $ flip sendTextData encoded
|
||||
where
|
||||
encoded = encode $ obj
|
||||
(recipients, connections) = unzip [
|
||||
(show key, Session.connection session) | (key, session) <- sessions
|
||||
]
|
||||
|
||||
send :: T -> Session.App ()
|
||||
send :: T -> App.T ()
|
||||
send obj = do
|
||||
key <- asks Session.key
|
||||
session <- Session.current
|
||||
sendTo (key, session) obj
|
||||
key <- asks App.key
|
||||
session <- App.current
|
||||
sendTo [(key, session)] obj
|
||||
|
||||
broadcast :: T -> Session.App ()
|
||||
broadcast :: T -> App.T ()
|
||||
broadcast obj =
|
||||
(toList . Server.sessions) <$> Session.server
|
||||
>>= mapM_ (flip sendTo obj)
|
||||
App.server >>= flip sendTo obj . toList . Server.sessions
|
||||
|
||||
relay :: FromClient -> (T -> Session.App ()) -> Session.App ()
|
||||
relay :: FromClient -> (T -> App.T ()) -> App.T ()
|
||||
relay message f = do
|
||||
Session.debug "Relaying"
|
||||
(\from -> f $ Relay {from, message}) =<< asks Session.key
|
||||
App.debug "Relaying"
|
||||
(\from -> f $ Relay {from, message}) =<< asks App.key
|
||||
|
||||
receive :: Session.App FromClient
|
||||
receive :: App.T FromClient
|
||||
receive = do
|
||||
received <- ((lift . receiveData) =<< Session.connection)
|
||||
Session.debug $ '>':(unpack received)
|
||||
received <- ((lift . receiveData) =<< App.connection)
|
||||
App.debug $ '>':(unpack received)
|
||||
case eitherDecode' received of
|
||||
Left errorMessage -> send (Message.Error errorMessage) >> receive
|
||||
Right clientMessage -> return clientMessage
|
||||
|
||||
get :: Session.App Message.FromClient
|
||||
get :: App.T Message.FromClient
|
||||
get =
|
||||
receive >>= pong
|
||||
where
|
||||
pong Ping = send Pong >> get
|
||||
pong m = return m
|
||||
|
||||
update :: T
|
||||
update = Update {alone = [], paired = []}
|
||||
|
|
|
|||
|
|
@ -1,25 +1,22 @@
|
|||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
module Player (
|
||||
Key(..)
|
||||
, Name
|
||||
, Session(..)
|
||||
, Status(..)
|
||||
, openSession
|
||||
Key
|
||||
, T(..)
|
||||
) where
|
||||
|
||||
import Data.Text (Text, pack)
|
||||
import Data.Aeson (FromJSON(..), ToJSON(..), ToJSONKey(..), genericToEncoding)
|
||||
import Data.Aeson.Types (toJSONKeyText)
|
||||
import qualified JSON (defaultOptions)
|
||||
import qualified Data (RW(..))
|
||||
import Network.WebSockets (Connection)
|
||||
import Data.Text (Text)
|
||||
import qualified Data (Key)
|
||||
import GHC.Generics
|
||||
|
||||
newtype Key = Key Int deriving (Eq, Ord, Read, Show, Generic)
|
||||
newtype Name = Name Text deriving (Eq, Ord, Generic)
|
||||
data T = T {
|
||||
name :: Text
|
||||
} deriving (Eq, Ord, Generic)
|
||||
type Key = Data.Key T
|
||||
|
||||
{-
|
||||
instance FromJSON Key
|
||||
instance ToJSON Key where
|
||||
toEncoding = genericToEncoding JSON.defaultOptions
|
||||
|
|
@ -30,23 +27,4 @@ instance ToJSONKey Key where
|
|||
instance FromJSON Name
|
||||
instance ToJSON Name where
|
||||
toEncoding = genericToEncoding JSON.defaultOptions
|
||||
|
||||
data Status =
|
||||
LoggedIn Bool
|
||||
| Answering Key
|
||||
| Waiting Key
|
||||
deriving (Show, Generic)
|
||||
|
||||
data Session = Session {
|
||||
connection :: Connection
|
||||
, status :: Status
|
||||
}
|
||||
|
||||
instance Data.RW Status Session where
|
||||
update f session@(Session {status}) = session {status = f status}
|
||||
|
||||
openSession :: Connection -> Session
|
||||
openSession connection = Session {
|
||||
connection
|
||||
, status = LoggedIn False
|
||||
}
|
||||
-}
|
||||
|
|
|
|||
105
src/Server.hs
105
src/Server.hs
|
|
@ -1,78 +1,115 @@
|
|||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
module Server (
|
||||
T(..)
|
||||
, disconnect
|
||||
, join
|
||||
, get
|
||||
, logIn
|
||||
, logOut
|
||||
, new
|
||||
, register
|
||||
, setStatus
|
||||
) where
|
||||
|
||||
import Data.Map ((!?), Map, adjust, delete, insert, lookupMax)
|
||||
import Data.Aeson (ToJSON(..), (.=), object, pairs)
|
||||
import Data.Map (Map, (!), (!?), adjust, delete, insert, lookupMax, mapWithKey)
|
||||
import qualified Data.Map as Map (empty)
|
||||
import Data.Aeson (ToJSON(..))
|
||||
import Data.Monoid ((<>))
|
||||
import Data.Set (Set, member)
|
||||
import qualified Data.Set as Set (delete, empty, insert)
|
||||
import Data.Text (Text)
|
||||
import qualified Data (RW(..))
|
||||
import qualified Player (Key(..), Name, Session(..), Status(..))
|
||||
import qualified Game (Key, T(..))
|
||||
import qualified Player (Key, T(..))
|
||||
import qualified Session (Status(..), T(..))
|
||||
|
||||
type Keys = Map Player.Name Player.Key
|
||||
type Names = Map Player.Key Player.Name
|
||||
type Sessions = Map Player.Key Player.Session
|
||||
type Names = Set Text
|
||||
type Players = Map Player.Key Player.T
|
||||
type Sessions = Map Player.Key Session.T
|
||||
type Games = Map Game.Key Game.T
|
||||
data T = T {
|
||||
keys :: Keys
|
||||
, names :: Names
|
||||
names :: Names
|
||||
, players :: Players
|
||||
, sessions :: Sessions
|
||||
, games :: Games
|
||||
}
|
||||
|
||||
instance Data.RW Keys T where
|
||||
update f server@(T {keys}) = server {keys = f keys}
|
||||
|
||||
instance Data.RW Names T where
|
||||
update f server@(T {names}) = server {names = f names}
|
||||
get = names
|
||||
set names server = server {names}
|
||||
|
||||
instance Data.RW Players T where
|
||||
get = players
|
||||
set players server = server {players}
|
||||
|
||||
instance Data.RW Sessions T where
|
||||
update f server@(T {sessions}) = server {sessions = f sessions}
|
||||
get = sessions
|
||||
set sessions server = server {sessions}
|
||||
|
||||
instance Data.RW Games T where
|
||||
get = games
|
||||
set games server = server {games}
|
||||
|
||||
newtype Player = Player (Text, Bool)
|
||||
instance ToJSON Player where
|
||||
toJSON (Player (name, alone)) = object ["name" .= name, "alone" .= alone]
|
||||
toEncoding (Player (name, alone)) = pairs ("name" .= name <> "alone" .= alone)
|
||||
|
||||
export :: Sessions -> Player.Key -> Player.T -> Player
|
||||
export sessions key player = Player (Player.name player, alone)
|
||||
where
|
||||
alone =
|
||||
case Session.status (sessions ! key) of
|
||||
Session.LoggedIn True -> True
|
||||
_ -> False
|
||||
|
||||
instance ToJSON T where
|
||||
toJSON = toJSON . names
|
||||
toEncoding = toEncoding . names
|
||||
toJSON (T {players, sessions}) = toJSON $ mapWithKey (export sessions) players
|
||||
toEncoding (T {players, sessions}) = toEncoding $ mapWithKey (export sessions) players
|
||||
|
||||
new :: T
|
||||
new = T {
|
||||
keys = Map.empty
|
||||
, names = Map.empty
|
||||
names = Set.empty
|
||||
, players = Map.empty
|
||||
, sessions = Map.empty
|
||||
, games = Map.empty
|
||||
}
|
||||
|
||||
join :: Player.Session -> T -> IO (T, Player.Key)
|
||||
join session server@(T {sessions}) =
|
||||
return (Data.update (insert key session) server, key)
|
||||
where
|
||||
key = Player.Key $ maybe 0 (\(Player.Key n, _) -> n+1) $ lookupMax sessions
|
||||
register :: forall a b. (Enum a, Ord a, Data.RW (Map a b) T) => b -> T -> (T, a)
|
||||
register x server =
|
||||
let key = maybe (toEnum 0) (\(n, _) -> succ n) $ lookupMax $ (Data.get server :: Map a b) in
|
||||
(Data.update (insert key x) server, key)
|
||||
|
||||
get :: forall a b. (Ord a, Data.RW (Map a b) T) => a -> T -> b
|
||||
get key server = (Data.get server :: Map a b) ! key
|
||||
|
||||
disconnect :: Player.Key -> T -> T
|
||||
disconnect key =
|
||||
Data.update (delete key :: Sessions -> Sessions) . logOut key
|
||||
|
||||
logIn :: Player.Name -> Player.Key -> T -> Either String T
|
||||
logIn :: Text -> Player.Key -> T -> Either String T
|
||||
logIn name key server =
|
||||
Data.update (insert name key) .
|
||||
Data.update (insert key name) .
|
||||
setStatus (Player.LoggedIn True) key <$>
|
||||
maybe (Right server) (\_-> Left "This name is already registered") (keys server !? name)
|
||||
Data.update (Set.insert name) .
|
||||
Data.update (insert key $ Player.T {Player.name}) .
|
||||
setStatus (Session.LoggedIn True) key <$>
|
||||
if name `member` names server
|
||||
then Left "This name is already registered"
|
||||
else Right server
|
||||
|
||||
logOut :: Player.Key -> T -> T
|
||||
logOut key server =
|
||||
maybe
|
||||
server
|
||||
(\name ->
|
||||
Data.update (delete key :: Names -> Names) $
|
||||
setStatus (Player.LoggedIn False) key $
|
||||
Data.update (delete name :: Keys -> Keys) server)
|
||||
(names server !? key)
|
||||
(\player ->
|
||||
Data.update (delete key :: Players -> Players) $
|
||||
setStatus (Session.LoggedIn False) key $
|
||||
Data.update (Set.delete $ Player.name player :: Names -> Names) server)
|
||||
(players server !? key)
|
||||
|
||||
setStatus :: Player.Status -> Player.Key -> T -> T
|
||||
setStatus :: Session.Status -> Player.Key -> T -> T
|
||||
setStatus status key =
|
||||
Data.update (adjust (Data.set status) key :: Sessions -> Sessions)
|
||||
|
|
|
|||
|
|
@ -1,59 +1,41 @@
|
|||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
module Session (
|
||||
App
|
||||
Status(..)
|
||||
, T(..)
|
||||
, connection
|
||||
, debug
|
||||
, get
|
||||
, current
|
||||
, server
|
||||
, try
|
||||
, update
|
||||
, open
|
||||
) where
|
||||
|
||||
import Data.Map ((!))
|
||||
import Control.Concurrent (MVar, modifyMVar_, putMVar, readMVar, takeMVar)
|
||||
import Control.Monad.Reader (ReaderT(..), ask, asks, lift)
|
||||
import Network.WebSockets (Connection)
|
||||
import qualified Player (Key, Session(..))
|
||||
import qualified Server (T(..))
|
||||
import Data.Aeson (ToJSON(..), genericToEncoding)
|
||||
import GHC.Generics (Generic)
|
||||
import qualified JSON (singleLCField)
|
||||
import qualified Data (RW(..))
|
||||
import qualified Player (Key)
|
||||
import qualified Game (Key)
|
||||
|
||||
data Status =
|
||||
LoggedIn Bool
|
||||
| Answering Player.Key
|
||||
| Waiting Player.Key
|
||||
| Playing Game.Key
|
||||
deriving (Show, Generic)
|
||||
|
||||
instance ToJSON Status where
|
||||
toEncoding = genericToEncoding JSON.singleLCField
|
||||
|
||||
data T = T {
|
||||
mServer :: MVar Server.T
|
||||
, key :: Player.Key
|
||||
connection :: Connection
|
||||
, status :: Status
|
||||
}
|
||||
|
||||
type App a = ReaderT T IO a
|
||||
instance Data.RW Status T where
|
||||
get = status
|
||||
set status session = session {status}
|
||||
|
||||
server :: App Server.T
|
||||
server = asks mServer >>= lift . readMVar
|
||||
|
||||
get :: Player.Key -> App Player.Session
|
||||
get key =
|
||||
(! key) . Server.sessions <$> server
|
||||
|
||||
current :: App Player.Session
|
||||
current = do
|
||||
asks key >>= get
|
||||
|
||||
connection :: App Connection
|
||||
connection = Player.connection <$> current
|
||||
|
||||
debug :: String -> App ()
|
||||
debug message =
|
||||
show <$> asks key
|
||||
>>= lift . putStrLn . (++ ' ':message)
|
||||
|
||||
try :: (Server.T -> Either String Server.T) -> App (Maybe String)
|
||||
try f = do
|
||||
T {mServer} <- ask
|
||||
currentValue <- lift $ takeMVar mServer
|
||||
lift $ case f currentValue of
|
||||
Left message -> putMVar mServer currentValue >> return (Just message)
|
||||
Right updated -> putMVar mServer updated >> return Nothing
|
||||
|
||||
{- Not using the previous to minimize the duration mServer gets locked -}
|
||||
update :: (Server.T -> Server.T) -> App ()
|
||||
update f = do
|
||||
T {mServer} <- ask
|
||||
lift $ modifyMVar_ mServer (return . f)
|
||||
open :: Connection -> T
|
||||
open connection = T {
|
||||
connection
|
||||
, status = LoggedIn False
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,56 +0,0 @@
|
|||
window.addEventListener('load', function() {
|
||||
var ws = new WebSocket('ws://' + window.location.hostname + '/play/');
|
||||
var sessionKey = null;
|
||||
var lib = Lib(ws);
|
||||
var room = Room(document.getElementById('room'), lib);
|
||||
var login = Login(document.getElementById('login'), lib);
|
||||
var debug = document.getElementById('debug');
|
||||
setTimeout(ping, 20000);
|
||||
|
||||
ws.addEventListener('message', function(event) {
|
||||
var o = JSON.parse(event.data);
|
||||
switch(o.tag) {
|
||||
case "Welcome":
|
||||
sessionKey = o.key;
|
||||
room.populate(o.room, sessionKey);
|
||||
break;
|
||||
case "Pong":
|
||||
setTimeout(ping, 10000);
|
||||
break;
|
||||
case "Relay":
|
||||
relayedMessage(o)
|
||||
break;
|
||||
default:
|
||||
debug.textContent = event.data;
|
||||
}
|
||||
});
|
||||
|
||||
function relayedMessage(o) {
|
||||
switch(o.message.tag) {
|
||||
case "LogIn":
|
||||
room.enter(o.from, o.message.name);
|
||||
if(o.from == sessionKey) {
|
||||
login.on(o.from);
|
||||
}
|
||||
break;
|
||||
case "LogOut":
|
||||
room.leave(o.from);
|
||||
if(o.from == sessionKey) {
|
||||
login.off(o.from);
|
||||
}
|
||||
break;
|
||||
case "Invitation":
|
||||
var name = room.name(o.from);
|
||||
var accept = false;
|
||||
// invitations should come only from known players, in doubt say «no»
|
||||
if(name) {
|
||||
accept = confirm(name + " has invited you to a game");
|
||||
}
|
||||
lib.send({tag: "Answer", accept: accept});
|
||||
}
|
||||
}
|
||||
|
||||
function ping() {
|
||||
lib.send({tag: "Ping"});
|
||||
}
|
||||
});
|
||||
11
www/dom.js
Normal file
11
www/dom.js
Normal file
|
|
@ -0,0 +1,11 @@
|
|||
function Dom() {
|
||||
return {
|
||||
clear: clear
|
||||
}
|
||||
|
||||
function clear(elem) {
|
||||
while(elem.firstChild) {
|
||||
elem.removeChild(elem.firstChild);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -2,28 +2,39 @@
|
|||
<html>
|
||||
<head>
|
||||
<title>KoiKoi</title>
|
||||
<script src="lib.js"></script>
|
||||
<script src="dom.js"></script>
|
||||
<script src="sort.js"></script>
|
||||
<script src="session.js"></script>
|
||||
<script src="login.js"></script>
|
||||
<script src="room.js"></script>
|
||||
<script src="connect.js"></script>
|
||||
<script src="screen.js"></script>
|
||||
<script src="messaging.js"></script>
|
||||
<script src="main.js"></script>
|
||||
<link rel="stylesheet" href="skin.css" type="text/css"/>
|
||||
</head>
|
||||
<body>
|
||||
<p>Hanafuda</p>
|
||||
<form id="login">
|
||||
<p id="join">
|
||||
<label for="name">Name</label><input type="text" name="name"/>
|
||||
<input type="submit" name="join" value="Join"/>
|
||||
</p>
|
||||
<p id="leave">
|
||||
<input type="button" name="leave" value="Leave"/>
|
||||
</p>
|
||||
</form>
|
||||
<form id="room" class="off">
|
||||
<ul class="players">
|
||||
</ul>
|
||||
<input type="submit" name="invite" value="Invite to a game" disabled/>
|
||||
</form>
|
||||
<div id="reception" class="on">
|
||||
<h1>Hanafuda</h1>
|
||||
<form id="login">
|
||||
<input type="submit" name="submitButton" hidden disabled/>
|
||||
<p id="join" class="on">
|
||||
<label for="you">Pick a name you like</label><input type="text" name="you"/>
|
||||
<input type="submit" name="join" value="Join" disabled/>
|
||||
</p>
|
||||
<p id="invite">
|
||||
<label for="them">Start a game with</label><input type="text" name="them"/>
|
||||
<input type="submit" name="invite" value="Invite" disabled/>
|
||||
</p>
|
||||
<ul class="players"></ul>
|
||||
<p id="leave">
|
||||
<input type="button" name="leave" value="Leave"/>
|
||||
</p>
|
||||
</form>
|
||||
</div>
|
||||
<div id="game">
|
||||
<ul id="river"></ul>
|
||||
<ul id="hand"></ul>
|
||||
</div>
|
||||
<p id="debug"></p>
|
||||
</body>
|
||||
</html>
|
||||
|
|
|
|||
133
www/login.js
133
www/login.js
|
|
@ -1,23 +1,132 @@
|
|||
function Login(domElem, lib) {
|
||||
domElem.addEventListener('submit', function(e) {
|
||||
function Login(modules) {
|
||||
var root = document.getElementById('login');
|
||||
var players = root.getElementsByClassName('players')[0];
|
||||
var join = document.getElementById("join");
|
||||
var invite = document.getElementById("invite");
|
||||
var submit = root.submitButton;
|
||||
var them = null;
|
||||
|
||||
root.addEventListener('submit', function(e) {
|
||||
e.preventDefault();
|
||||
lib.send({tag: "LogIn", name: domElem.name.value})
|
||||
if(modules.session.loggedIn()) {
|
||||
modules.messaging.send({tag: "Invitation", to: them});
|
||||
} else {
|
||||
modules.messaging.send({tag: "LogIn", name: root.you.value});
|
||||
}
|
||||
});
|
||||
domElem.leave.addEventListener('click', function(e) {
|
||||
|
||||
root.leave.addEventListener('click', function(e) {
|
||||
e.preventDefault();
|
||||
lib.send({tag: "LogOut"})
|
||||
});
|
||||
|
||||
return {
|
||||
on: on,
|
||||
off: off
|
||||
};
|
||||
root.you.addEventListener("input", function() {refreshPlayers(false);});
|
||||
root.them.addEventListener("input", function() {refreshPlayers(true);});
|
||||
|
||||
function on(name) {
|
||||
domElem.className = "on";
|
||||
modules.messaging.addEventListener(["Welcome"], function() {
|
||||
refreshPlayers(modules.session.loggedIn());
|
||||
});
|
||||
|
||||
modules.messaging.addEventListener(["Update"], function(o) {
|
||||
refreshPlayers(modules.session.loggedIn());
|
||||
});
|
||||
|
||||
modules.messaging.addEventListener(["Relay", "LogIn"], function() {
|
||||
playersChanged();
|
||||
});
|
||||
|
||||
modules.messaging.addEventListener(["Relay", "LogOut"], function() {
|
||||
playersChanged();
|
||||
});
|
||||
|
||||
modules.messaging.addEventListener(["Relay", "Invitation"], function(o) {
|
||||
var name = modules.room.name(o.from);
|
||||
var accept = false;
|
||||
// invitations should come only from known players, in doubt say «no»
|
||||
if(name) {
|
||||
accept = confirm(name + " has invited you to a game");
|
||||
if(accept) {
|
||||
modules.screen.select("game");
|
||||
}
|
||||
}
|
||||
modules.messaging.send({tag: "Answer", accept: accept});
|
||||
});
|
||||
|
||||
modules.messaging.addEventListener(["Relay", "Answer"], function(o) {
|
||||
if(o.message.accept) {
|
||||
modules.screen.select("game");
|
||||
}
|
||||
});
|
||||
|
||||
return {};
|
||||
|
||||
function playersChanged() {
|
||||
var loggedIn = modules.session.loggedIn();
|
||||
setMode(loggedIn);
|
||||
refreshPlayers(loggedIn);
|
||||
}
|
||||
|
||||
function off() {
|
||||
domElem.className = "";
|
||||
function refreshPlayers(loggedIn) {
|
||||
modules.dom.clear(players);
|
||||
if(loggedIn) {
|
||||
refreshThem();
|
||||
} else {
|
||||
refreshYou();
|
||||
}
|
||||
}
|
||||
|
||||
function refreshYou() {
|
||||
var nameTaken = false;
|
||||
var name = root.you.value;
|
||||
modules.room.filter(name).forEach(function(player) {
|
||||
players.appendChild(player.dom);
|
||||
nameTaken = nameTaken || name == player.name;
|
||||
});
|
||||
formDisable("join", name.length < 1 || nameTaken);
|
||||
}
|
||||
|
||||
function refreshThem() {
|
||||
them = null;
|
||||
var name = root.them.value;
|
||||
var filtered = modules.room.filter(name);
|
||||
filtered.forEach(function(player) {
|
||||
players.appendChild(player.dom);
|
||||
});
|
||||
var exact = filtered.find(exactMatch(name));
|
||||
players.classList.remove("alone", "notFound");
|
||||
if(exact != undefined) {
|
||||
them = exact.key;
|
||||
} else if(filtered.length == 1) {
|
||||
them = filtered[0].key;
|
||||
} else if(filtered.length == 0) {
|
||||
players.classList.add(name.length > 0 ? "notFound" : "alone");
|
||||
}
|
||||
formDisable("invite", them == undefined);
|
||||
}
|
||||
|
||||
function formDisable(name, disabled) {
|
||||
[submit, root[name]].forEach(function(button) {
|
||||
button.disabled = disabled;
|
||||
});
|
||||
}
|
||||
|
||||
function exactMatch(name) {
|
||||
return function(player) {
|
||||
return player.name === name;
|
||||
};
|
||||
}
|
||||
|
||||
function setMode(loggedIn) {
|
||||
root.join.disabled = loggedIn;
|
||||
root.invite.disabled = !loggedIn;
|
||||
if(loggedIn) {
|
||||
join.className = "";
|
||||
invite.className = "on";
|
||||
root.them.focus();
|
||||
} else {
|
||||
join.className = "on";
|
||||
invite.className = "";
|
||||
root.you.focus();
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
11
www/main.js
Normal file
11
www/main.js
Normal file
|
|
@ -0,0 +1,11 @@
|
|||
window.addEventListener('load', function() {
|
||||
var dom = Dom();
|
||||
var sort = Sort();
|
||||
var screen = Screen();
|
||||
var messaging = Messaging();
|
||||
var session = Session({messaging: messaging});
|
||||
var room = Room({dom: dom, messaging: messaging, session: session, sort: sort});
|
||||
var login = Login({dom: dom, messaging: messaging, room: room, screen: screen, session: session});
|
||||
|
||||
messaging.start();
|
||||
});
|
||||
62
www/messaging.js
Normal file
62
www/messaging.js
Normal file
|
|
@ -0,0 +1,62 @@
|
|||
function Messaging(screen) {
|
||||
var ws = new WebSocket('ws://' + window.location.hostname + '/play/');
|
||||
var keepAlivePeriod = 20000;
|
||||
var routes = {callbacks: [], children: {}};
|
||||
|
||||
return {
|
||||
addEventListener: addEventListener,
|
||||
send: send,
|
||||
start: start
|
||||
}
|
||||
|
||||
function get(obj, path, write) {
|
||||
write = write || false;
|
||||
if(path.length < 1) {
|
||||
return obj;
|
||||
} else {
|
||||
if(obj.children[path[0]] == undefined && write) {
|
||||
obj.children[path[0]] = {callbacks: [], children: {}};
|
||||
}
|
||||
if(obj.children[path[0]] != undefined) {
|
||||
return get(obj.children[path[0]], path.slice(1), write);
|
||||
} else {
|
||||
return null;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
function addEventListener(path, callback) {
|
||||
var route = get(routes, path, true);
|
||||
route.callbacks.push(callback);
|
||||
}
|
||||
|
||||
function messageListener(event) {
|
||||
var o = JSON.parse(event.data);
|
||||
var path = [];
|
||||
var tmp = o;
|
||||
while(tmp != undefined && tmp.tag != undefined) {
|
||||
path.push(tmp.tag);
|
||||
tmp = tmp.message;
|
||||
}
|
||||
var route = get(routes, path);
|
||||
if(route != undefined && route.callbacks != undefined) {
|
||||
route.callbacks.forEach(function(f) {f(o);});
|
||||
} else {
|
||||
debug.textContent = event.data;
|
||||
}
|
||||
};
|
||||
|
||||
function start() {
|
||||
ping();
|
||||
addEventListener(["Pong"], ping);
|
||||
ws.addEventListener('message', messageListener);
|
||||
}
|
||||
|
||||
function send(o) {
|
||||
ws.send(JSON.stringify(o));
|
||||
}
|
||||
|
||||
function ping() {
|
||||
setTimeout(function() {send({tag: "Ping"});}, keepAlivePeriod);
|
||||
}
|
||||
}
|
||||
124
www/room.js
124
www/room.js
|
|
@ -1,4 +1,14 @@
|
|||
function Room(domElem, lib) {
|
||||
function Room(modules) {
|
||||
|
||||
function Player(key, name, alone) {
|
||||
this.key = key;
|
||||
this.name = name;
|
||||
this.alone = alone;
|
||||
this.dom = document.createElement('li');
|
||||
this.dom.textContent = name;
|
||||
this.position = null;
|
||||
}
|
||||
|
||||
var players = {};
|
||||
var sortedKeys = [];
|
||||
var session = {
|
||||
|
|
@ -6,67 +16,61 @@ function Room(domElem, lib) {
|
|||
loggedIn: false,
|
||||
selected: null
|
||||
};
|
||||
var playersList = domElem.getElementsByClassName('players')[0];
|
||||
domElem.addEventListener('submit', function(e) {
|
||||
e.preventDefault();
|
||||
lib.send({tag: "Invitation", to: session.selected})
|
||||
|
||||
modules.messaging.addEventListener(["Welcome"], function(o) {
|
||||
for(var key in o.room) {
|
||||
enter(parseInt(key), o.room[key]);
|
||||
}
|
||||
});
|
||||
var compareKeysByLogin = lib.funMap(function(key) {return players[key].name;}, lib.defaultCompare);
|
||||
|
||||
modules.messaging.addEventListener(["Update"], function(o) {
|
||||
o.alone.forEach(function(key) {players[key].alone = true;});
|
||||
o.paired.forEach(function(key) {players[key].alone = false;});
|
||||
});
|
||||
|
||||
modules.messaging.addEventListener(["Relay", "LogIn"], function(o) {
|
||||
enter(o.from, o.message);
|
||||
});
|
||||
|
||||
modules.messaging.addEventListener(["Relay", "LogOut"], function(o) {
|
||||
leave(o.from);
|
||||
});
|
||||
|
||||
var compareKeysByLogin = modules.sort.map(function(key) {return players[key].name;}, modules.sort.defaultCompare);
|
||||
|
||||
return {
|
||||
populate: populate,
|
||||
filter: filter,
|
||||
enter: enter,
|
||||
leave: leave,
|
||||
name: name
|
||||
};
|
||||
|
||||
function Player(key, name) {
|
||||
var player = {
|
||||
name: name,
|
||||
dom: document.createElement('li'),
|
||||
position: null
|
||||
};
|
||||
player.dom.textContent = name;
|
||||
if(key != session.key) {
|
||||
player.dom.addEventListener('click', function(e) {
|
||||
e.preventDefault();
|
||||
if(session.loggedIn) {
|
||||
select(key);
|
||||
}
|
||||
});
|
||||
function filter(name) {
|
||||
if(modules.session.loggedIn()) {
|
||||
var keep = function(player) {
|
||||
return player.name.match(name) && !modules.session.is(player.key) && player.alone;
|
||||
};
|
||||
} else {
|
||||
on();
|
||||
player.dom.title = "Hey ! That's you !";
|
||||
var keep = function(player) {return player.name.match(name);};
|
||||
}
|
||||
return player;
|
||||
return sortedKeys.reduce(function(accumulator, key) {
|
||||
var player = players[key];
|
||||
return keep(player) ? accumulator.concat(player) : accumulator;
|
||||
}, []);
|
||||
}
|
||||
|
||||
function populate(playersHash, sessionKey) {
|
||||
session.key = sessionKey;
|
||||
lib.clearElement(playersList);
|
||||
for(var key in playersHash) {
|
||||
enter(parseInt(key), playersHash[key] || "anon");
|
||||
}
|
||||
}
|
||||
|
||||
function enter(key, name) {
|
||||
var player = Player(key, name);
|
||||
function enter(key, obj) {
|
||||
var name = obj.name || "anon";
|
||||
var alone = obj.alone != undefined ? obj.alone : true;
|
||||
var player = new Player(key, name, alone);
|
||||
players[key] = player;
|
||||
player.position = lib.insert(key, sortedKeys, compareKeysByLogin);
|
||||
beforePlayer = players[sortedKeys[player.position]];
|
||||
playersList.insertBefore(player.dom, beforePlayer && beforePlayer.dom);
|
||||
player.position = modules.sort.insert(key, sortedKeys, compareKeysByLogin);
|
||||
sortedKeys.splice(player.position, 0, key);
|
||||
}
|
||||
|
||||
function leave(key) {
|
||||
var player = players[key];
|
||||
if(key === session.key) {
|
||||
off();
|
||||
} else if(key === session.selected) {
|
||||
reset();
|
||||
}
|
||||
if(player != undefined) {
|
||||
playersList.removeChild(player.dom);
|
||||
sortedKeys.splice(player.position, 1);
|
||||
delete players[key];
|
||||
}
|
||||
|
|
@ -76,38 +80,4 @@ function Room(domElem, lib) {
|
|||
player = players[key];
|
||||
return player && player.name;
|
||||
}
|
||||
|
||||
function on() {
|
||||
domElem.className = "";
|
||||
session.loggedIn = true;
|
||||
}
|
||||
|
||||
function off() {
|
||||
domElem.className = "off";
|
||||
session.loggedIn = false;
|
||||
reset();
|
||||
}
|
||||
|
||||
function select(key) {
|
||||
if(key === session.selected) {
|
||||
unselect(key);
|
||||
} else {
|
||||
reset();
|
||||
players[key].dom.className = "selected";
|
||||
session.selected = key;
|
||||
domElem.invite.disabled = false;
|
||||
}
|
||||
}
|
||||
|
||||
function reset() {
|
||||
if(session.selected) {
|
||||
unselect(session.selected);
|
||||
}
|
||||
}
|
||||
|
||||
function unselect(key) {
|
||||
players[key].dom.className = "";
|
||||
session.selected = null;
|
||||
domElem.invite.disabled = true;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
13
www/screen.js
Normal file
13
www/screen.js
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
function Screen() {
|
||||
var current = document.querySelector("body > div.on");
|
||||
|
||||
return {
|
||||
select: select
|
||||
};
|
||||
|
||||
function select(name) {
|
||||
current.className = "";
|
||||
current = document.getElementById(name);
|
||||
current.className = "on";
|
||||
}
|
||||
}
|
||||
27
www/session.js
Normal file
27
www/session.js
Normal file
|
|
@ -0,0 +1,27 @@
|
|||
function Session(modules) {
|
||||
var key = null;
|
||||
var name = null;
|
||||
|
||||
modules.messaging.addEventListener(["Welcome"], function(o) {
|
||||
key = o.key;
|
||||
});
|
||||
|
||||
modules.messaging.addEventListener(["Relay", "LogIn"], function(o) {
|
||||
if(is(o.from)) {
|
||||
name = o.message.name;
|
||||
}
|
||||
});
|
||||
|
||||
return {
|
||||
is: is,
|
||||
loggedIn: loggedIn
|
||||
};
|
||||
|
||||
function is(sessionKey) {
|
||||
return key == sessionKey;
|
||||
}
|
||||
|
||||
function loggedIn() {
|
||||
return name != undefined;
|
||||
}
|
||||
}
|
||||
35
www/skin.css
35
www/skin.css
|
|
@ -1,3 +1,19 @@
|
|||
body > div {
|
||||
display: none;
|
||||
}
|
||||
|
||||
body > div.on {
|
||||
display: block;
|
||||
}
|
||||
|
||||
#join, #invite {
|
||||
display: none;
|
||||
}
|
||||
|
||||
#join.on, #invite.on {
|
||||
display: block;
|
||||
}
|
||||
|
||||
#leave {
|
||||
display: none;
|
||||
}
|
||||
|
|
@ -10,19 +26,24 @@
|
|||
display: inline;
|
||||
}
|
||||
|
||||
#room .players {
|
||||
#login .players {
|
||||
min-height: 4em;
|
||||
border: 1px solid #ccc;
|
||||
list-style: none;
|
||||
padding-left: 0;
|
||||
cursor: pointer;
|
||||
}
|
||||
|
||||
#room.off .players li {
|
||||
color: #777;
|
||||
.players:empty::before {
|
||||
display: block;
|
||||
text-align: center;
|
||||
margin: 1em;
|
||||
color: #555;
|
||||
}
|
||||
|
||||
#room .players .selected {
|
||||
background: #92c8f6;
|
||||
color: #fff;
|
||||
.players.alone::before {
|
||||
content: "No one to play with yet ! Wait a little";
|
||||
}
|
||||
|
||||
.players.notFound::before {
|
||||
content: "No one by that name is awaiting an opponent";
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,18 +1,10 @@
|
|||
function Lib(ws) {
|
||||
function Sort() {
|
||||
return {
|
||||
clearElement: clearElement,
|
||||
defaultCompare: defaultCompare,
|
||||
funMap: funMap,
|
||||
map: map,
|
||||
insert: insert,
|
||||
send: send
|
||||
};
|
||||
|
||||
function clearElement(elem) {
|
||||
while(elem.firstChild) {
|
||||
elem.removeChild(elem.firstChild);
|
||||
}
|
||||
}
|
||||
|
||||
function insert(obj, t, compare, min, max) {
|
||||
min = min == undefined ? 0 : min;
|
||||
max = max == undefined ? t.length : max;
|
||||
|
|
@ -38,14 +30,11 @@ function Lib(ws) {
|
|||
}
|
||||
}
|
||||
|
||||
function funMap(projector, f) {
|
||||
function map(projector, f) {
|
||||
return function() {
|
||||
var args = Array.prototype.map.call(arguments, projector);
|
||||
return f.apply(null, args);
|
||||
}
|
||||
}
|
||||
|
||||
function send(o) {
|
||||
ws.send(JSON.stringify(o));
|
||||
}
|
||||
}
|
||||
Loading…
Reference in a new issue