alois/CoqDecks
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Elm format run to standardise formatting.

Browse Source
This commit is contained in:
Gareth Latty
2017-03-11 05:08:38 +00:00
parent 71307902a7
commit 05583b9f34
50 changed files with 3486 additions and 2556 deletions
Download Patch File Download Diff File Expand all files Collapse all files
client/src/MassiveDecks.elm
+11 -9
View File
@@ -1,7 +1,6 @@
module MassiveDecks exposing (main)
import Navigation
import MassiveDecks.Models exposing (Init, Path, pathFromLocation)
import MassiveDecks.Scenes.Start as Start
import MassiveDecks.Scenes.Start.Messages as Start
@@ -11,13 +10,16 @@ import MassiveDecks.Scenes.Start.Models as Start
{-| The main application loop setup.
-}
main : Program Init Start.Model Start.Message
main = Navigation.programWithFlags
locationToMessage
{ init = Start.init
, update = Start.update
, subscriptions = Start.subscriptions
, view = Start.view
}
main =
Navigation.programWithFlags
locationToMessage
{ init = Start.init
, update = Start.update
, subscriptions = Start.subscriptions
, view = Start.view
}
locationToMessage : Navigation.Location -> Start.Message
locationToMessage location = pathFromLocation location |> Start.PathChange
locationToMessage location =
pathFromLocation location |> Start.PathChange
client/src/MassiveDecks/API.elm
+121 -112
View File
@@ -2,7 +2,6 @@ module MassiveDecks.API exposing (..)
import Json.Decode as Decode
import Json.Encode as Encode
import MassiveDecks.API.Request exposing (..)
import MassiveDecks.Scenes.Playing.HouseRule.Id as HouseRule
import MassiveDecks.Models.Game as Game
@@ -16,7 +15,8 @@ import MassiveDecks.Models.JSON.Encode exposing (..)
{-| Makes a request to create a new game lobby to the server. On success, returns that lobby.
-}
createLobby : String -> Request Never Game.GameCodeAndSecret
createLobby name = request "POST" "/api/lobbies" (Just (encodeName name)) [] gameCodeAndSecretDecoder
createLobby name =
request "POST" "/api/lobbies" (Just (encodeName name)) [] gameCodeAndSecretDecoder
{-| Errors specific to new player requests.
@@ -24,65 +24,67 @@ createLobby name = request "POST" "/api/lobbies" (Just (encodeName name)) [] gam
* `LobbyNotFound` - The given lobby does not exist.
-}
type NewPlayerError
= NameInUse
| NewPlayerLobbyNotFound
= NameInUse
| NewPlayerLobbyNotFound
{-| Makes a request to add a new player to the given lobby. On success, returns a `Secret` for that player.
-}
newPlayer : String -> String -> Request NewPlayerError Player.Secret
newPlayer gameCode name =
request
"POST"
("/api/lobbies/" ++ gameCode ++ "/players")
(Just (encodeName name))
[ ((400, "name-in-use"), Decode.succeed NameInUse)
, ((404, "lobby-not-found"), Decode.succeed NewPlayerLobbyNotFound)
]
playerSecretDecoder
request
"POST"
("/api/lobbies/" ++ gameCode ++ "/players")
(Just (encodeName name))
[ ( ( 400, "name-in-use" ), Decode.succeed NameInUse )
, ( ( 404, "lobby-not-found" ), Decode.succeed NewPlayerLobbyNotFound )
]
playerSecretDecoder
{-| Errors specific to getting the lobby and hand.
* `LobbyNotFound` - The given lobby does not exist.
-}
type GetLobbyAndHandError
= LobbyNotFound
| SecretWrongOrNotAPlayer
= LobbyNotFound
| SecretWrongOrNotAPlayer
{-| Get the lobby and the hand for the player with the given secret (using it to authenticate).
-}
getLobbyAndHand : String -> Player.Secret -> Request GetLobbyAndHandError Game.LobbyAndHand
getLobbyAndHand = commandRequest
"getLobbyAndHand"
[]
[ ((404, "lobby-not-found"), Decode.succeed LobbyNotFound)
, ((403, "secret-wrong-or-not-a-player"), Decode.succeed SecretWrongOrNotAPlayer)
]
lobbyAndHandDecoder
getLobbyAndHand =
commandRequest
"getLobbyAndHand"
[]
[ ( ( 404, "lobby-not-found" ), Decode.succeed LobbyNotFound )
, ( ( 403, "secret-wrong-or-not-a-player" ), Decode.succeed SecretWrongOrNotAPlayer )
]
lobbyAndHandDecoder
{-| Get the hand of the player with the given secret (using it to authenticate).
-}
getHand : String -> Player.Secret -> Request Never Card.Hand
getHand gameCode secret =
request
"POST"
("/api/lobbies/" ++ gameCode ++ "/players/" ++ (toString secret.id))
(Just (encodePlayerSecret secret))
[]
handDecoder
request
"POST"
("/api/lobbies/" ++ gameCode ++ "/players/" ++ (toString secret.id))
(Just (encodePlayerSecret secret))
[]
handDecoder
{-| Get the history of the given game.
-}
getHistory : String -> Request Never (List Round.FinishedRound)
getHistory gameCode =
request
"GET"
("/api/lobbies/" ++ gameCode ++ "/history")
Nothing
[]
(Decode.list finishedRoundDecoder)
request
"GET"
("/api/lobbies/" ++ gameCode ++ "/history")
Nothing
[]
(Decode.list finishedRoundDecoder)
{-| Errors specific to add deck requests.
@@ -90,35 +92,36 @@ getHistory gameCode =
* `DeckNotFound` - The given play code does not resolve to a Cardcast deck.
-}
type AddDeckError
= CardcastTimeout
| DeckNotFound
= CardcastTimeout
| DeckNotFound
{-| Makes a request to add the deck for the given play code to the game configuration, using the given secret to
authenticate.
-}
addDeck : String -> Player.Secret -> String -> Request AddDeckError ()
addDeck gameCode secret playCode =
commandRequest
"addDeck"
[ ("playCode", Encode.string playCode) ]
[ ((502, "cardcast-timeout"), Decode.succeed CardcastTimeout)
, ((400, "deck-not-found"), Decode.succeed DeckNotFound)
]
(Decode.succeed ())
gameCode
secret
commandRequest
"addDeck"
[ ( "playCode", Encode.string playCode ) ]
[ ( ( 502, "cardcast-timeout" ), Decode.succeed CardcastTimeout )
, ( ( 400, "deck-not-found" ), Decode.succeed DeckNotFound )
]
(Decode.succeed ())
gameCode
secret
{-| Makes a request to the server to add a new AI player to the game.
-}
newAi : String -> Player.Secret -> Request Never ()
newAi gameCode secret =
request
"POST"
("/api/lobbies/" ++ gameCode ++ "/players/newAi")
(Just (encodePlayerSecret secret))
[]
(Decode.succeed ())
request
"POST"
("/api/lobbies/" ++ gameCode ++ "/players/newAi")
(Just (encodePlayerSecret secret))
[]
(Decode.succeed ())
{-| Errors specific to starting a new game.
@@ -126,43 +129,44 @@ newAi gameCode secret =
* `GameInProgress` - There is already a game in progress.
-}
type NewGameError
= NotEnoughPlayers Int
| GameInProgress
= NotEnoughPlayers Int
| GameInProgress
{-| Makes a request to the server to start a new game in the given lobby, using the given secret to authenticate.
-}
newGame : String -> Player.Secret -> Request NewGameError Card.Hand
newGame gameCode secret =
commandRequest
"newGame"
[]
[ ((400, "game-in-progress"), Decode.succeed GameInProgress)
, ((400, "not-enough-players"), Decode.map NotEnoughPlayers (Decode.field "required" Decode.int))
]
handDecoder
gameCode
secret
commandRequest
"newGame"
[]
[ ( ( 400, "game-in-progress" ), Decode.succeed GameInProgress )
, ( ( 400, "not-enough-players" ), Decode.map NotEnoughPlayers (Decode.field "required" Decode.int) )
]
handDecoder
gameCode
secret
{-| Errors specific to choosing a winner for the round.
* `NotCzar` - The player is not the card czar.
-}
type ChooseError
= NotCzar
= NotCzar
{-| Make a request to choose the given (by index) winning response for round for the given lobby, using the given secret
to authenticate.
-}
choose : String -> Player.Secret -> Int -> Request ChooseError ()
choose gameCode secret winner =
commandRequest
"choose"
[ ("winner", Encode.int winner) ]
[ ((400, "not-czar"), Decode.succeed NotCzar) ]
(Decode.succeed ())
gameCode
secret
commandRequest
"choose"
[ ( "winner", Encode.int winner ) ]
[ ( ( 400, "not-czar" ), Decode.succeed NotCzar ) ]
(Decode.succeed ())
gameCode
secret
{-| Errors specific to playing responses into the round.
@@ -173,27 +177,28 @@ choose gameCode secret winner =
* `WrongNumberOfCards` - The wrong number of cards were played, with the number got, and the number expected.
-}
type PlayError
= NotInRound
| AlreadyPlayed
| AlreadyJudging
| WrongNumberOfCards Int Int
= NotInRound
| AlreadyPlayed
| AlreadyJudging
| WrongNumberOfCards Int Int
{-| Make a request to play the given (by index) cards from the player's hand into the round for the given lobby, using
the given secret to authenticate.
-}
play : String -> Player.Secret -> List String -> Request PlayError Card.Hand
play gameCode secret ids =
commandRequest
"play"
[ ("ids", Encode.list (List.map Encode.string ids)) ]
[ ((400, "not-in-round"), Decode.succeed NotInRound)
, ((400, "already-played"), Decode.succeed AlreadyPlayed)
, ((400, "already-judging"), Decode.succeed AlreadyJudging)
, ((400, "wrong-number-of-cards-played"), Decode.map2 WrongNumberOfCards (Decode.field "got" Decode.int) (Decode.field "expected" Decode.int))
]
handDecoder
gameCode
secret
commandRequest
"play"
[ ( "ids", Encode.list (List.map Encode.string ids) ) ]
[ ( ( 400, "not-in-round" ), Decode.succeed NotInRound )
, ( ( 400, "already-played" ), Decode.succeed AlreadyPlayed )
, ( ( 400, "already-judging" ), Decode.succeed AlreadyJudging )
, ( ( 400, "wrong-number-of-cards-played" ), Decode.map2 WrongNumberOfCards (Decode.field "got" Decode.int) (Decode.field "expected" Decode.int) )
]
handDecoder
gameCode
secret
{-| Errors specific to skipping a player in the lobby.
@@ -203,72 +208,76 @@ play gameCode secret ids =
* disconnected or timed out).
-}
type SkipError
= NotEnoughPlayersToSkip Int
| PlayersNotSkippable
= NotEnoughPlayersToSkip Int
| PlayersNotSkippable
{-| Make a request to skip the given players in the given lobby using the given secret to authenticate.
-}
skip : String -> Player.Secret -> List Player.Id -> Request SkipError ()
skip gameCode secret players =
commandRequest
"skip"
[ ("players", Encode.list (List.map Encode.int players)) ]
[ ((400, "not-enough-players"), Decode.map NotEnoughPlayersToSkip (Decode.field "required" Decode.int))
, ((400, "players-must-be-skippable"), Decode.succeed PlayersNotSkippable)
]
(Decode.succeed ())
gameCode
secret
commandRequest
"skip"
[ ( "players", Encode.list (List.map Encode.int players) ) ]
[ ( ( 400, "not-enough-players" ), Decode.map NotEnoughPlayersToSkip (Decode.field "required" Decode.int) )
, ( ( 400, "players-must-be-skippable" ), Decode.succeed PlayersNotSkippable )
]
(Decode.succeed ())
gameCode
secret
{-| Make a request to stop being skipped.
-}
back : String -> Player.Secret -> Request Never ()
back = commandRequest "back" [] [] (Decode.succeed ())
back =
commandRequest "back" [] [] (Decode.succeed ())
{-| Make a request to leave the game.
-}
leave : String -> Player.Secret -> Request Never ()
leave gameCode secret =
request
"POST"
("/api/lobbies/" ++ gameCode ++ "/players/" ++ (toString secret.id) ++ "/leave")
(Just (encodePlayerSecret secret))
[]
(Decode.succeed ())
request
"POST"
("/api/lobbies/" ++ gameCode ++ "/players/" ++ (toString secret.id) ++ "/leave")
(Just (encodePlayerSecret secret))
[]
(Decode.succeed ())
{-| Errors specific to redrawing.
* `NotEnoughPoints` - The player does not have enough points to redraw.
-}
type RedrawError
= NotEnoughPoints
= NotEnoughPoints
{-| Make a request to redraw the players hand, losing a point.
-}
redraw : String -> Player.Secret -> Request RedrawError Card.Hand
redraw =
commandRequest
"redraw"
[]
[ ((400, "not-enough-points"), Decode.succeed NotEnoughPoints)
]
handDecoder
commandRequest
"redraw"
[]
[ ( ( 400, "not-enough-points" ), Decode.succeed NotEnoughPoints )
]
handDecoder
{-| Make a request to enable a house rule.
-}
enableRule : HouseRule.Id -> String -> Player.Secret -> Request Never ()
enableRule rule gameCode secret =
commandRequest "enableRule" [ ("rule", rule |> HouseRule.toString |> Encode.string) ] [] (Decode.succeed ()) gameCode secret
commandRequest "enableRule" [ ( "rule", rule |> HouseRule.toString |> Encode.string ) ] [] (Decode.succeed ()) gameCode secret
{-| Make a request to disable a house rule.
-}
disableRule : HouseRule.Id -> String -> Player.Secret -> Request Never ()
disableRule rule gameCode secret =
commandRequest "disableRule" [ ("rule", rule |> HouseRule.toString |> Encode.string) ] [] (Decode.succeed ()) gameCode secret
commandRequest "disableRule" [ ( "rule", rule |> HouseRule.toString |> Encode.string ) ] [] (Decode.succeed ()) gameCode secret
{- Private -}
@@ -278,4 +287,4 @@ disableRule rule gameCode secret =
-}
commandRequest : String -> List ( String, Encode.Value ) -> List (KnownError a) -> Decode.Decoder b -> String -> Player.Secret -> Request a b
commandRequest name args errors decoder gameCode secret =
request "POST" ("/api/lobbies/" ++ gameCode) (Just (encodeCommand name secret args)) errors decoder
request "POST" ("/api/lobbies/" ++ gameCode) (Just (encodeCommand name secret args)) errors decoder
client/src/MassiveDecks/API/Request.elm
+118 -74
View File
@@ -2,9 +2,7 @@ module MassiveDecks.API.Request exposing (send, send_, request, Request, KnownEr
import Json.Decode as Json
import Dict exposing (Dict)
import Http
import MassiveDecks.Components.Errors as Errors
import MassiveDecks.Util as Util
@@ -20,90 +18,125 @@ If the request has no specific errors, use `send_` instead.
-}
send : Request specificError result -> (specificError -> message) -> (Errors.Message -> message) -> (result -> message) -> Cmd message
send request onSpecificError onGeneralError onSuccess =
let
req = Http.request
{ method = request.method
, headers = []
, url = request.url
, body = case request.body of
Just json -> Http.jsonBody json
Nothing -> Http.emptyBody
, expect = Http.expectStringResponse (handleResponse request.resultDecoder request.errors)
, timeout = Nothing
, withCredentials = False
}
in
Http.send (\result ->
case result of
Result.Ok errorOrResult -> case errorOrResult of
Error error -> handleErrors onSpecificError onGeneralError error
Result result -> onSuccess result
Result.Err error -> (case error of
Http.BadStatus response ->
(Json.decodeString (Json.maybe errorKeyDecoder |> Json.andThen (\n ->
case n of
Just errorName -> errorDecoder response errorName request.errors
Nothing -> Json.succeed (General error))) response.body) |> Result.withDefault (General error)
_ ->
General error) |> handleErrors onSpecificError onGeneralError
) req
let
req =
Http.request
{ method = request.method
, headers = []
, url = request.url
, body =
case request.body of
Just json ->
Http.jsonBody json
Nothing ->
Http.emptyBody
, expect = Http.expectStringResponse (handleResponse request.resultDecoder request.errors)
, timeout = Nothing
, withCredentials = False
}
in
Http.send
(\result ->
case result of
Result.Ok errorOrResult ->
case errorOrResult of
Error error ->
handleErrors onSpecificError onGeneralError error
Result result ->
onSuccess result
Result.Err error ->
(case error of
Http.BadStatus response ->
(Json.decodeString
(Json.maybe errorKeyDecoder
|> Json.andThen
(\n ->
case n of
Just errorName ->
errorDecoder response errorName request.errors
Nothing ->
Json.succeed (General error)
)
)
response.body
)
|> Result.withDefault (General error)
_ ->
General error
)
|> handleErrors onSpecificError onGeneralError
)
req
handleErrors : (specificError -> message) -> (Errors.Message -> message) -> Error specificError -> message
handleErrors onSpecificError onGeneralError error =
case error of
Known specificError -> onSpecificError specificError
_ -> onGeneralError (genericErrorHandler error)
case error of
Known specificError ->
onSpecificError specificError
_ ->
onGeneralError (genericErrorHandler error)
handleResponse : Json.Decoder result -> KnownErrors specificError -> Http.Response String -> Result String (ErrorOrResult specificError result)
handleResponse resultDecoder knownErrors response =
Json.decodeString (resultOrErrorDecoder response resultDecoder knownErrors) response.body
Json.decodeString (resultOrErrorDecoder response resultDecoder knownErrors) response.body
{-| Same as 'send', but for requests with no known errors.
-}
send_ : Request Never result -> (Errors.Message -> message) -> (result -> message) -> Cmd message
send_ request onGeneralError onSuccess = send request Util.impossible onGeneralError onSuccess
send_ request onGeneralError onSuccess =
send request Util.impossible onGeneralError onSuccess
{-| A request to the API.
-}
type alias Request specificError result =
{ method : String
, url : String
, body : Maybe Json.Value
, errors : KnownErrors specificError
, resultDecoder : Json.Decoder result
}
{ method : String
, url : String
, body : Maybe Json.Value
, errors : KnownErrors specificError
, resultDecoder : Json.Decoder result
}
{-| A convinience method to make the errors dictionary from a list.
-}
request : String -> String -> Maybe Json.Value -> List (KnownError specificError) -> Json.Decoder result -> Request specificError result
request verb url body errors resultDecoder = Request verb url body (Dict.fromList errors) resultDecoder
request verb url body errors resultDecoder =
Request verb url body (Dict.fromList errors) resultDecoder
{-| Specifies an error the client understands and can present to the user nicely.
-}
type alias KnownError specificError = ((Int, String), Json.Decoder specificError)
type alias KnownError specificError =
( ( Int, String ), Json.Decoder specificError )
{-| The dictionary of KnownErrors.
-}
type alias KnownErrors specificError = Dict (Int, String) (Json.Decoder specificError)
type alias KnownErrors specificError =
Dict ( Int, String ) (Json.Decoder specificError)
{-| The top level of potential errors from an API request.
-}
type Error specificError
= General Http.Error
| Known specificError
| Unknown (Http.Response String)
= General Http.Error
| Known specificError
| Unknown (Http.Response String)
type ErrorOrResult specificError result
= Error (Error specificError)
| Result result
= Error (Error specificError)
| Result result
{-| Convert errors to generic error messages for display in the errors component. Generally you want to use this as a
@@ -111,48 +144,59 @@ fallback after handling all known errors.
-}
genericErrorHandler : Error a -> Errors.Message
genericErrorHandler error =
case error of
Known specificError ->
Errors.New ("An error was not correctly handled: " ++ (toString specificError)) True
case error of
Known specificError ->
Errors.New ("An error was not correctly handled: " ++ (toString specificError)) True
Unknown response ->
Errors.New("An error was not not recognised (status " ++ (toString response.status.code) ++ "): " ++ response.body) True
Unknown response ->
Errors.New ("An error was not not recognised (status " ++ (toString response.status.code) ++ "): " ++ response.body) True
General Http.Timeout ->
Errors.New "Timed out trying to connect to the server." False
General (Http.Timeout) ->
Errors.New "Timed out trying to connect to the server." False
General Http.NetworkError ->
Errors.New "There was a network error trying to connect to the server." False
General (Http.NetworkError) ->
Errors.New "There was a network error trying to connect to the server." False
General (Http.BadUrl url) ->
Errors.New ("The URL '" ++ url ++ "' was invalid.") True
General (Http.BadUrl url) ->
Errors.New ("The URL '" ++ url ++ "' was invalid.") True
General (Http.BadStatus response) ->
Errors.New ("Recieved an unexpected response (" ++ (toString response.status.code) ++ ") from the server: " ++ response.status.message) True
General (Http.BadStatus response) ->
Errors.New ("Recieved an unexpected response (" ++ (toString response.status.code) ++ ") from the server: " ++ response.status.message) True
General (Http.BadPayload explanation response) ->
Errors.New ("The response recieved from the server wasn't what we expected: " ++ explanation) True
General (Http.BadPayload explanation response) ->
Errors.New ("The response recieved from the server wasn't what we expected: " ++ explanation) True
{-| Decode the error key from
-}
errorKeyDecoder : Json.Decoder String
errorKeyDecoder = Json.at [ "error" ] Json.string
errorKeyDecoder =
Json.at [ "error" ] Json.string
errorDecoder : Http.Response String -> String -> KnownErrors specificError -> Json.Decoder (Error specificError)
errorDecoder response errorName knownErrors =
let
decoder = Dict.get (response.status.code, errorName) knownErrors
in
case decoder of
Just decoder -> Json.map Known decoder
Nothing -> Json.succeed (Unknown response)
let
decoder =
Dict.get ( response.status.code, errorName ) knownErrors
in
case decoder of
Just decoder ->
Json.map Known decoder
Nothing ->
Json.succeed (Unknown response)
resultOrErrorDecoder : Http.Response String -> Json.Decoder result -> KnownErrors specificError -> Json.Decoder (ErrorOrResult specificError result)
resultOrErrorDecoder response resultDecoder knownErrors =
Json.maybe errorKeyDecoder |> Json.andThen (\error ->
case error of
Just errorName -> Json.map (Error) (errorDecoder response errorName knownErrors)
Nothing -> Json.map Result resultDecoder)
Json.maybe errorKeyDecoder
|> Json.andThen
(\error ->
case error of
Just errorName ->
Json.map (Error) (errorDecoder response errorName knownErrors)
Nothing ->
Json.map Result resultDecoder
)
client/src/MassiveDecks/Components/About.elm
+64 -46
View File
@@ -1,65 +1,83 @@
module MassiveDecks.Components.About exposing (show)
import String
import Html exposing (..)
import Html.Attributes exposing (..)
import MassiveDecks.Components.Overlay as Overlay exposing (Overlay)
show : String -> Overlay.Message a
show version = Overlay.Show (Overlay icon title (contents version))
show version =
Overlay.Show (Overlay icon title (contents version))
icon : String
icon = "info-circle"
icon =
"info-circle"
title : String
title = "About"
title =
"About"
contents : String -> List (Html a)
contents version =
([ p [] [ text "Massive Decks is a web game based on the excellent "
, a [ href "https://cardsagainsthumanity.com/", target "_blank", rel "noopener" ] [ text "Cards against Humanity" ]
, text " - a party game where you play white cards to try and produce the most amusing outcome when "
, text "combined with the given black card."
]
, p [] [ text "Massive Decks is also inspired by: "
, ul [] [ li [] [ a [ href "https://www.cardcastgame.com/", target "_blank", rel "noopener" ] [ text "Cardcast" ]
, text " - an app that allows you to play on a ChromeCast."
]
, li [] [ a [ href "http://pretendyoure.xyz/zy/", target "_blank", rel "noopener" ] [ text "Pretend You're Xyzzy" ]
, text " - a web game where you can jump in with people you don't know."
]
]
]
, p [] [ text "This is an open source game developed in "
, a [ href "http://elm-lang.org/", target "_blank", rel "noopener" ] [ text "Elm" ]
, text " for the client and "
, a [ href "http://www.scala-lang.org/", target "_blank", rel "noopener" ] [ text "Scala" ]
, text " for the server."
]
, p [] [ text "We also use: "
, ul [] [ li [] [ a [ href "https://www.cardcastgame.com/", target "_blank", rel "noopener" ] [ text "Cardcast" ]
, text "'s APIs for getting decks of cards (you can go there to make your own!)."
]
, li [] [ text "The "
, a [ href "https://www.playframework.com/", target "_blank", rel "noopener" ] [ text "Play framework" ]
]
, li [] [ a [ href "http://lesscss.org/", target "_blank", rel "noopener" ] [ text "Less" ] ]
, li [] [ a [ href "https://fortawesome.github.io/Font-Awesome/", target "_blank", rel "noopener" ] [ text "Font Awesome" ] ]
, li [] [ a [ href "https://www.muicss.com", target "_blank", rel "noopener" ] [ text "MUI" ] ]
]
]
, p [] [ text "Bug reports and contributions are welcome on the "
, a [ href "https://github.com/Lattyware/massivedecks", target "_blank", rel "noopener" ] [ text "GitHub repository" ]
, text ", where you can find the complete source to the game, under the GPLv3 license. The game concept "
, text "'Cards against Humanity' is used under a "
, a [ href "https://creativecommons.org/licenses/by-nc-sa/2.0/", target "_blank", rel "noopener" ] [ text "Creative Commons BY-NC-SA 2.0 license" ]
, text " granted by "
, a [ href "https://cardsagainsthumanity.com/", target "_blank", rel "noopener" ] [ text "Cards against Humanity" ]
]
]) ++ (if String.isEmpty version then [] else [ p [] [ text ("This server is running version " ++ version ++ ".") ] ])
([ p []
[ text "Massive Decks is a web game based on the excellent "
, a [ href "https://cardsagainsthumanity.com/", target "_blank", rel "noopener" ] [ text "Cards against Humanity" ]
, text " - a party game where you play white cards to try and produce the most amusing outcome when "
, text "combined with the given black card."
]
, p []
[ text "Massive Decks is also inspired by: "
, ul []
[ li []
[ a [ href "https://www.cardcastgame.com/", target "_blank", rel "noopener" ] [ text "Cardcast" ]
, text " - an app that allows you to play on a ChromeCast."
]
, li []
[ a [ href "http://pretendyoure.xyz/zy/", target "_blank", rel "noopener" ] [ text "Pretend You're Xyzzy" ]
, text " - a web game where you can jump in with people you don't know."
]
]
]
, p []
[ text "This is an open source game developed in "
, a [ href "http://elm-lang.org/", target "_blank", rel "noopener" ] [ text "Elm" ]
, text " for the client and "
, a [ href "http://www.scala-lang.org/", target "_blank", rel "noopener" ] [ text "Scala" ]
, text " for the server."
]
, p []
[ text "We also use: "
, ul []
[ li []
[ a [ href "https://www.cardcastgame.com/", target "_blank", rel "noopener" ] [ text "Cardcast" ]
, text "'s APIs for getting decks of cards (you can go there to make your own!)."
]
, li []
[ text "The "
, a [ href "https://www.playframework.com/", target "_blank", rel "noopener" ] [ text "Play framework" ]
]
, li [] [ a [ href "http://lesscss.org/", target "_blank", rel "noopener" ] [ text "Less" ] ]
, li [] [ a [ href "https://fortawesome.github.io/Font-Awesome/", target "_blank", rel "noopener" ] [ text "Font Awesome" ] ]
, li [] [ a [ href "https://www.muicss.com", target "_blank", rel "noopener" ] [ text "MUI" ] ]
]
]
, p []
[ text "Bug reports and contributions are welcome on the "
, a [ href "https://github.com/Lattyware/massivedecks", target "_blank", rel "noopener" ] [ text "GitHub repository" ]
, text ", where you can find the complete source to the game, under the GPLv3 license. The game concept "
, text "'Cards against Humanity' is used under a "
, a [ href "https://creativecommons.org/licenses/by-nc-sa/2.0/", target "_blank", rel "noopener" ] [ text "Creative Commons BY-NC-SA 2.0 license" ]
, text " granted by "
, a [ href "https://cardsagainsthumanity.com/", target "_blank", rel "noopener" ] [ text "Cards against Humanity" ]
]
]
)
++ (if String.isEmpty version then
[]
else
[ p [] [ text ("This server is running version " ++ version ++ ".") ] ]
)
client/src/MassiveDecks/Components/BrowserNotifications.elm
+67 -52
View File
@@ -1,102 +1,117 @@
port module MassiveDecks.Components.BrowserNotifications exposing (Model, Message, ConsumerMessage(..), Permission(..), init, update, subscriptions, notify, enable, disable)
import Maybe
import MassiveDecks.Util as Util
init : Bool -> Bool -> Model
init supported enabled =
{ supported = supported
, enabled = enabled
, permission = Nothing
}
{ supported = supported
, enabled = enabled
, permission = Nothing
}
type alias Model =
{ supported : Bool
, enabled : Bool
, permission : Maybe Permission
}
{ supported : Bool
, enabled : Bool
, permission : Maybe Permission
}
type alias Notification =
{ title : String
, icon : Maybe String
}
{ title : String
, icon : Maybe String
}
type Permission
= Granted
| Denied
| Default
= Granted
| Denied
| Default
update : Message -> Model -> (Model, Cmd Message, Cmd ConsumerMessage)
update : Message -> Model -> ( Model, Cmd Message, Cmd ConsumerMessage )
update message model =
case message of
PermissionGiven permission ->
({ model | permission = Just permission }, Cmd.none, Util.cmd (PermissionChanged permission))
case message of
PermissionGiven permission ->
( { model | permission = Just permission }, Cmd.none, Util.cmd (PermissionChanged permission) )
SendNotification notification ->
if model.supported && model.enabled then
(model, notifications notification, Cmd.none)
else
(model, Cmd.none, Cmd.none)
SendNotification notification ->
if model.supported && model.enabled then
( model, notifications notification, Cmd.none )
else
( model, Cmd.none, Cmd.none )
EnableNotifications ->
({ model | enabled = True }, requestPermission (), Cmd.none)
EnableNotifications ->
( { model | enabled = True }, requestPermission (), Cmd.none )
DisableNotifications ->
({ model | enabled = False }, Cmd.none, Cmd.none)
DisableNotifications ->
( { model | enabled = False }, Cmd.none, Cmd.none )
type ConsumerMessage
= PermissionChanged Permission
= PermissionChanged Permission
type Message
= PermissionGiven Permission
| SendNotification Notification
| EnableNotifications
| DisableNotifications
= PermissionGiven Permission
| SendNotification Notification
| EnableNotifications
| DisableNotifications
subscriptions : Model -> Sub Message
subscriptions model =
if model.supported && model.enabled && model.permission == Nothing then
permissions permission
else
Sub.none
if model.supported && model.enabled && model.permission == Nothing then
permissions permission
else
Sub.none
port permissions : (String -> msg) -> Sub msg
permission : String -> Message
permission name =
let
permission = case name of
"granted" -> Granted
"denied" -> Denied
"default" -> Default
_ ->
let
_ = Debug.log "Unexpected permission for browser notifications, assuming denied" name
in
Denied
in
PermissionGiven permission
let
permission =
case name of
"granted" ->
Granted
"denied" ->
Denied
"default" ->
Default
_ ->
let
_ =
Debug.log "Unexpected permission for browser notifications, assuming denied" name
in
Denied
in
PermissionGiven permission
notify : Notification -> Message
notify notification = SendNotification notification
notify notification =
SendNotification notification
port notifications : Notification -> Cmd msg
enable : Message
enable = EnableNotifications
enable =
EnableNotifications
disable : Message
disable = DisableNotifications
disable =
DisableNotifications
port requestPermission : () -> Cmd msg
client/src/MassiveDecks/Components/Errors.elm
+74 -60
View File
@@ -1,107 +1,121 @@
module MassiveDecks.Components.Errors exposing (Message(..), Model, ApplicationInfo, view, update, init, reportUrl)
import String
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import MassiveDecks.Components.Icon as Icon
import MassiveDecks.Util as Util
type Message
= New String Bool
| Remove Int
= New String Bool
| Remove Int
type alias Model =
{ currentId : Int
, errors : List Error
}
{ currentId : Int
, errors : List Error
}
type alias ApplicationInfo =
{ url : String
, version : String
}
{ url : String
, version : String
}
{-| A generic error message to be displayed when something goes wrong. Should only be used where there isn't a good way
to avoid the error altogether or display the error closer to it's source.
-}
type alias Error =
{ id : Int
, message : String
, bugReport : Bool
}
{ id : Int
, message : String
, bugReport : Bool
}
init : Model
init =
{ currentId = 0
, errors = []
}
{ currentId = 0
, errors = []
}
view : ApplicationInfo -> Model -> Html Message
view applicationInfo model = ol [ id "error-panel"] (List.map (errorMessage applicationInfo) model.errors)
view applicationInfo model =
ol [ id "error-panel" ] (List.map (errorMessage applicationInfo) model.errors)
update : Message -> Model -> (Model, Cmd Message)
update : Message -> Model -> ( Model, Cmd Message )
update message model =
case message of
New message bugReport ->
let
new = { id = model.currentId, message = message, bugReport = bugReport }
in
( { model | errors = model.errors ++ [ new ]
, currentId = model.currentId + 1
case message of
New message bugReport ->
let
new =
{ id = model.currentId, message = message, bugReport = bugReport }
in
( { model
| errors = model.errors ++ [ new ]
, currentId = model.currentId + 1
}
, Cmd.none
)
, Cmd.none
)
Remove id ->
({ model | errors = List.filter (\error -> error.id /= id) model.errors}, Cmd.none)
Remove id ->
( { model | errors = List.filter (\error -> error.id /= id) model.errors }, Cmd.none )
reportText : String -> String
reportText message =
("I was [a short explanation of what you were doing] when I got the following error: \n\n" ++ message)
("I was [a short explanation of what you were doing] when I got the following error: \n\n" ++ message)
reportUrl : ApplicationInfo -> String -> String
reportUrl applicationInfo message =
let
version = if String.isEmpty applicationInfo.version then "Not Specified" else applicationInfo.version
full = message ++ "\n\nApplication Info:\n\tVersion: " ++ version ++ "\n\tURL: " ++ applicationInfo.url
in
"https://github.com/Lattyware/massivedecks/issues/new?body=" ++ full
let
version =
if String.isEmpty applicationInfo.version then
"Not Specified"
else
applicationInfo.version
full =
message ++ "\n\nApplication Info:\n\tVersion: " ++ version ++ "\n\tURL: " ++ applicationInfo.url
in
"https://github.com/Lattyware/massivedecks/issues/new?body=" ++ full
errorMessage : ApplicationInfo -> Error -> Html Message
errorMessage applicationInfo error =
let
url = reportUrl applicationInfo (reportText error.message)
bugReportLink =
if error.bugReport then
Just (p [] [ a [ href url, target "_blank", rel "noopener" ] [ Icon.icon "bug", text " Report this as a bug." ] ])
else
Nothing
in
li
[ class "error" ]
[ div
[]
([ a [ class "link"
, attribute "tabindex" "0"
, attribute "role" "button"
, onClick (Remove error.id)
] [ Icon.icon "times" ]
, h5 [] [ Icon.icon "exclamation-triangle"
, text " Error"
]
, div [ class "mui-divider" ] []
, p [] [ text error.message ]
] |> Util.andMaybe bugReportLink)
]
let
url =
reportUrl applicationInfo (reportText error.message)
bugReportLink =
if error.bugReport then
Just (p [] [ a [ href url, target "_blank", rel "noopener" ] [ Icon.icon "bug", text " Report this as a bug." ] ])
else
Nothing
in
li
[ class "error" ]
[ div
[]
([ a
[ class "link"
, attribute "tabindex" "0"
, attribute "role" "button"
, onClick (Remove error.id)
]
[ Icon.icon "times" ]
, h5 []
[ Icon.icon "exclamation-triangle"
, text " Error"
]
, div [ class "mui-divider" ] []
, p [] [ text error.message ]
]
|> Util.andMaybe bugReportLink
)
]
client/src/MassiveDecks/Components/Icon.elm
+6 -3
View File
@@ -7,16 +7,19 @@ import Html.Attributes exposing (..)
{-| A FointAwesome icon by name.
-}
icon : String -> Html a
icon name = i [ class ("fa fa-" ++ name) ] []
icon name =
i [ class ("fa fa-" ++ name) ] []
{-| A full width FointAwesome icon by name.
-}
fwIcon : String -> Html a
fwIcon name = i [ class ("fa fa-fw fa-" ++ name) ] []
fwIcon name =
i [ class ("fa fa-fw fa-" ++ name) ] []
{-| A loading spinner.
-}
spinner : Html a
spinner = i [ class "fa fa-circle-o-notch fa-spin" ] []
spinner =
i [ class "fa fa-circle-o-notch fa-spin" ] []
client/src/MassiveDecks/Components/Input.elm
+79 -60
View File
@@ -1,45 +1,44 @@
module MassiveDecks.Components.Input exposing (Message, Model, Change(..), init, initWithExtra, subscriptions, view, update)
import Json.Decode as Json
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import MassiveDecks.Util as Util
import MassiveDecks.Components.Icon as Icon
{-| Messages for changes to the input.
-}
type alias Message id = (id, Change)
type alias Message id =
( id, Change )
{-| Changes to the input.
-}
type Change
= Changed String
| Error (Maybe String)
| Submit
| SetEnabled Bool
| SetDefaultValue String
| NoOp
= Changed String
| Error (Maybe String)
| Submit
| SetEnabled Bool
| SetDefaultValue String
| NoOp
{-| The state of the input.
-}
type alias Model id msg =
{ identity : id
, class : String
, label : List (Html msg)
, placeholder : String
, value : String
, error : Maybe String
, extra : (String -> List (Html msg))
, embedMethod : Message id -> msg
, submit : Cmd msg
, enabled : Bool
}
{ identity : id
, class : String
, label : List (Html msg)
, placeholder : String
, value : String
, error : Maybe String
, extra : String -> List (Html msg)
, embedMethod : Message id -> msg
, submit : Cmd msg
, enabled : Bool
}
{-| Create the initial model.
@@ -57,7 +56,7 @@ The embedMethod is how to wrap the input message for the surrounding message typ
-}
init : id -> String -> List (Html msg) -> String -> String -> Cmd msg -> (Message id -> msg) -> Model id msg
init identity class label value placeholder submit embedMethod =
initWithExtra identity class label value placeholder (\_ -> []) submit embedMethod
initWithExtra identity class label value placeholder (\_ -> []) submit embedMethod
{-| Create the initial model with some extra content. See init for most of how this works.
@@ -67,63 +66,83 @@ current value.
-}
initWithExtra : id -> String -> List (Html msg) -> String -> String -> (String -> List (Html msg)) -> Cmd msg -> (Message id -> msg) -> Model id msg
initWithExtra identity class label value placeholder extra submit embedMethod =
{ identity = identity
, class = class
, label = label
, value = value
, placeholder = placeholder
, error = Nothing
, extra = extra
, embedMethod = embedMethod
, submit = submit
, enabled = True
}
{ identity = identity
, class = class
, label = label
, value = value
, placeholder = placeholder
, error = Nothing
, extra = extra
, embedMethod = embedMethod
, submit = submit
, enabled = True
}
{-| Subscriptions for the input.
-}
subscriptions : Model id msg -> Sub (Message id)
subscriptions model = Sub.none
subscriptions model =
Sub.none
{-| Render the input.
-}
view : Model id msg -> Html msg
view model =
div [ class model.class ]
([ div [ class "mui-textfield" ]
([ input [ type_ "text"
, defaultValue model.value
, placeholder model.placeholder
, disabled (not model.enabled)
, on "input" (Json.map (\value -> (model.embedMethod (model.identity, Changed value))) targetValue)
, Util.onKeyDown "Enter" (model.embedMethod (model.identity, Submit)) (model.embedMethod (model.identity, NoOp))
] []
, label [] (List.append [ Icon.icon "info-circle", text " " ] model.label)
] |> Util.andMaybe (error model.error))
] ++ model.extra model.value)
div [ class model.class ]
([ div [ class "mui-textfield" ]
([ input
[ type_ "text"
, defaultValue model.value
, placeholder model.placeholder
, disabled (not model.enabled)
, on "input" (Json.map (\value -> (model.embedMethod ( model.identity, Changed value ))) targetValue)
, Util.onKeyDown "Enter" (model.embedMethod ( model.identity, Submit )) (model.embedMethod ( model.identity, NoOp ))
]
[]
, label [] (List.append [ Icon.icon "info-circle", text " " ] model.label)
]
|> Util.andMaybe (error model.error)
)
]
++ model.extra model.value
)
{-| Render an error message for the input.
-}
error : Maybe String -> Maybe (Html msg)
error message = Maybe.map (\error -> span [ class "input-error" ] [ Icon.icon "exclamation", text " ", text error ]) message
error message =
Maybe.map (\error -> span [ class "input-error" ] [ Icon.icon "exclamation", text " ", text error ]) message
{-| Handles messages and alters the model as appropriate.
-}
update : Message id -> Model id msg -> (Model id msg, Cmd msg)
update : Message id -> Model id msg -> ( Model id msg, Cmd msg )
update message model =
let
(identity, change) = message
in
if (identity == model.identity) then
case change of
Changed value -> ({ model | value = value }, Cmd.none)
Error error -> ({ model | error = error }, Cmd.none)
Submit -> (model, model.submit)
SetEnabled enabled -> ({ model | enabled = enabled}, Cmd.none)
SetDefaultValue value -> ({ model | value = value}, Cmd.none)
NoOp -> (model, Cmd.none)
else
(model, Cmd.none)
let
( identity, change ) =
message
in
if (identity == model.identity) then
case change of
Changed value ->
( { model | value = value }, Cmd.none )
Error error ->
( { model | error = error }, Cmd.none )
Submit ->
( model, model.submit )
SetEnabled enabled ->
( { model | enabled = enabled }, Cmd.none )
SetDefaultValue value ->
( { model | value = value }, Cmd.none )
NoOp ->
( model, Cmd.none )
else
( model, Cmd.none )
client/src/MassiveDecks/Components/Overlay.elm
+54 -51
View File
@@ -1,88 +1,91 @@
port module MassiveDecks.Components.Overlay exposing (Overlay, Model, Message(..), init, view, update, map)
import Json.Decode as Json
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import MassiveDecks.Components.Icon as Icon
import MassiveDecks.Util as Util
type alias Model a =
{ overlay : Maybe (Overlay a)
, wrap : (Message a) -> a
}
{ overlay : Maybe (Overlay a)
, wrap : Message a -> a
}
type alias Overlay a =
{ icon : String
, title : String
, contents : List (Html a)
}
{ icon : String
, title : String
, contents : List (Html a)
}
type Message a
= Show (Overlay a)
| Hide
| NoOp
= Show (Overlay a)
| Hide
| NoOp
init : ((Message a) -> a) -> Model a
init : (Message a -> a) -> Model a
init wrap =
{ overlay = Nothing
, wrap = wrap
}
{ overlay = Nothing
, wrap = wrap
}
map : (a -> b) -> Message a -> Message b
map mapper message =
case message of
Show overlay ->
Show (Overlay overlay.icon overlay.title (List.map (Html.map mapper) overlay.contents))
case message of
Show overlay ->
Show (Overlay overlay.icon overlay.title (List.map (Html.map mapper) overlay.contents))
Hide ->
Hide
Hide ->
Hide
NoOp ->
NoOp
NoOp ->
NoOp
update : Message a -> Model a -> Model a
update message model =
case message of
Show overlay ->
{ model | overlay = Just overlay }
case message of
Show overlay ->
{ model | overlay = Just overlay }
Hide ->
{ model | overlay = Nothing }
Hide ->
{ model | overlay = Nothing }
NoOp ->
model
NoOp ->
model
view : Model a -> List (Html a)
view model =
case model.overlay of
Just overlay ->
[ div [ id "mui-overlay"
, Util.onClickIfId "mui-overlay" (model.wrap Hide) (model.wrap NoOp)
, Util.onKeyDown "Escape" (model.wrap Hide) (model.wrap NoOp)
, tabindex 0
case model.overlay of
Just overlay ->
[ div
[ id "mui-overlay"
, Util.onClickIfId "mui-overlay" (model.wrap Hide) (model.wrap NoOp)
, Util.onKeyDown "Escape" (model.wrap Hide) (model.wrap NoOp)
, tabindex 0
]
[ div [ class "overlay mui-panel" ]
([ h1 [] [ Icon.icon overlay.icon, text " ", text overlay.title ] ]
++ overlay.contents
++ [ p [ class "close-link" ]
[ a
[ class "link"
, attribute "tabindex" "0"
, attribute "role" "button"
, onClick (model.wrap Hide)
]
[ Icon.icon "times", text " Close" ]
]
]
)
]
]
[ div [ class "overlay mui-panel" ]
([ h1 [] [ Icon.icon overlay.icon, text " ", text overlay.title ] ] ++
overlay.contents ++
[ p [ class "close-link"]
[ a [ class "link"
, attribute "tabindex" "0"
, attribute "role" "button"
, onClick (model.wrap Hide)
] [ Icon.icon "times", text " Close" ]
]
])
]
]
Nothing ->
[]
Nothing ->
[]
client/src/MassiveDecks/Components/QR.elm
+5 -3
View File
@@ -4,12 +4,14 @@ import Html exposing (Html)
import Html.Attributes as Html
port qr : { id: String, value: String } -> Cmd msg
port qr : { id : String, value : String } -> Cmd msg
view : String -> Html msg
view containerId = Html.div [ Html.id containerId ] []
view containerId =
Html.div [ Html.id containerId ] []
encodeAndRender : String -> String -> Cmd msg
encodeAndRender containerId value = qr { id = containerId, value = value }
encodeAndRender containerId value =
qr { id = containerId, value = value }
client/src/MassiveDecks/Components/Storage.elm
+14 -12
View File
@@ -3,36 +3,38 @@ port module MassiveDecks.Components.Storage exposing (Model, Message(..), update
import MassiveDecks.Models.Game as Game
type alias Model = List Game.GameCodeAndSecret
type alias Model =
List Game.GameCodeAndSecret
type Message
= Store
| Clear
= Store
| Clear
port store : Model -> Cmd msg
update : Message -> Model -> (Model, Cmd Message)
update : Message -> Model -> ( Model, Cmd Message )
update message model =
case message of
Store ->
(model, store model)
case message of
Store ->
( model, store model )
Clear ->
([], store [])
Clear ->
( [], store [] )
join : Game.GameCodeAndSecret -> Model -> Model
join gameCodeAndSecret model =
gameCodeAndSecret :: List.filter (different gameCodeAndSecret) model
gameCodeAndSecret :: List.filter (different gameCodeAndSecret) model
leave : Game.GameCodeAndSecret -> Model -> Model
leave gameCodeAndSecret =
List.filter (different gameCodeAndSecret)
List.filter (different gameCodeAndSecret)
different : Game.GameCodeAndSecret -> Game.GameCodeAndSecret -> Bool
different check existing = check.gameCode /= existing.gameCode
different check existing =
check.gameCode /= existing.gameCode
client/src/MassiveDecks/Components/TTS.elm
+22 -11
View File
@@ -4,27 +4,38 @@ import MassiveDecks.Util as Util
type alias Model =
{ enabled : Bool
}
{ enabled : Bool
}
type Message
= Say String
| Enabled Bool
= Say String
| Enabled Bool
init : Model
init = { enabled = False }
init =
{ enabled = False }
update : Message -> Model -> (Model, Cmd Message)
update : Message -> Model -> ( Model, Cmd Message )
update message model =
case message of
Say text ->
(model, if model.enabled then say text else Cmd.none)
case message of
Say text ->
( model
, if model.enabled then
say text
else
Cmd.none
)
Enabled enabled ->
({ model | enabled = enabled }, if enabled then Cmd.none else Say "" |> Util.cmd)
Enabled enabled ->
( { model | enabled = enabled }
, if enabled then
Cmd.none
else
Say "" |> Util.cmd
)
port say : String -> Cmd msg
client/src/MassiveDecks/Components/Tabs.elm
+23 -19
View File
@@ -8,39 +8,40 @@ import Html.Events exposing (..)
{-| Messages for the tab system.
-}
type Message tabId
= SetTab tabId
= SetTab tabId
{-| The model for the tabs.
-}
type alias Model tabId msg =
{ tabs : List (Tab tabId msg)
, current : tabId
, tagger : Message tabId -> msg
}
{ tabs : List (Tab tabId msg)
, current : tabId
, tagger : Message tabId -> msg
}
{-| An individual tab.
-}
type alias Tab tabId msg =
{ id : tabId
, title : List (Html msg)
}
{ id : tabId
, title : List (Html msg)
}
{-| Initialise the model.
-}
init : List (Tab tabId msg) -> tabId -> (Message tabId -> msg) -> Model tabId msg
init = Model
init =
Model
{-| Given a message, update the model to fit.
-}
update : Message tabId -> Model tabId msg -> Model tabId msg
update message model =
case message of
SetTab tabId ->
{ model | current = tabId }
case message of
SetTab tabId ->
{ model | current = tabId }
{-| Given a model, render it.
@@ -50,18 +51,21 @@ content easily.
-}
view : (tabId -> List (Html msg)) -> Model tabId msg -> List (Html msg)
view renderer model =
[ ul [ class "mui-tabs__bar mui-tabs__bar--justified" ] (List.map (viewTab model.tagger model.current) model.tabs)
] ++ (List.map (viewPane model.current renderer) model.tabs)
[ ul [ class "mui-tabs__bar mui-tabs__bar--justified" ] (List.map (viewTab model.tagger model.current) model.tabs)
]
++ (List.map (viewPane model.current renderer) model.tabs)
viewTab : (Message tabId -> msg) -> tabId -> Tab tabId msg -> Html msg
viewTab tagger current model =
li [ classList [ ("mui--is-active", current == model.id) ] ]
[ a [ onClick (tagger <| SetTab model.id)
] model.title
]
li [ classList [ ( "mui--is-active", current == model.id ) ] ]
[ a
[ onClick (tagger <| SetTab model.id)
]
model.title
]
viewPane : tabId -> (tabId -> List (Html msg)) -> Tab tabId msg -> Html msg
viewPane current renderer model =
div [ classList [ ("mui-tabs__pane", True), ("mui--is-active", current == model.id) ] ] (renderer model.id)
div [ classList [ ( "mui-tabs__pane", True ), ( "mui--is-active", current == model.id ) ] ] (renderer model.id)
client/src/MassiveDecks/Components/Title.elm
+4 -1
View File
@@ -1,6 +1,9 @@
port module MassiveDecks.Components.Title exposing (set)
port title : String -> Cmd msg
set : String -> Cmd msg
set = title
set =
title
client/src/MassiveDecks/Models.elm
+10 -11
View File
@@ -1,29 +1,28 @@
module MassiveDecks.Models exposing (..)
import Navigation
import MassiveDecks.Models.Game exposing (GameCodeAndSecret)
{-| Data required to create the initial application state.
-}
type alias Init =
{ version : String
, url : String
, existingGames : List GameCodeAndSecret
, seed : String
, browserNotificationsSupported : Bool
}
{ version : String
, url : String
, existingGames : List GameCodeAndSecret
, seed : String
, browserNotificationsSupported : Bool
}
{-| A path to a part of the application.
-}
type alias Path =
{ gameCode : Maybe String
}
{ gameCode : Maybe String
}
pathFromLocation : Navigation.Location -> Path
pathFromLocation location =
{ gameCode = Maybe.map Tuple.second (String.uncons location.hash)
}
{ gameCode = Maybe.map Tuple.second (String.uncons location.hash)
}
client/src/MassiveDecks/Models/Card.elm
+24 -18
View File
@@ -2,7 +2,6 @@ module MassiveDecks.Models.Card exposing (..)
import String
import Dict exposing (Dict)
import MassiveDecks.Models.Player as Player
import MassiveDecks.Util as Util
@@ -11,55 +10,62 @@ import MassiveDecks.Util as Util
a response implicitly existing inbetween each string.
-}
type alias Call =
{ id: String
, parts: List String
}
{ id : String
, parts : List String
}
{-| A response (white card).
-}
type alias Response =
{ id: String
, text: String
}
{ id : String
, text : String
}
{-| A hand of a player.
-}
type alias Hand =
{ hand : List Response
}
{ hand : List Response
}
{-| Cards that have been played into a round for a call.
-}
type alias PlayedCards = List Response
type alias PlayedCards =
List Response
{-| The number of slots on a given call.
-}
slots : Call -> Int
slots call = (List.length call.parts) - 1
slots call =
(List.length call.parts) - 1
{-| Produce a string of the given call with the given played cards injected into it.
-}
filled : Call -> PlayedCards -> String
filled call playedCards = String.concat (Util.interleave (List.map .text playedCards) call.parts)
filled call playedCards =
String.concat (Util.interleave (List.map .text playedCards) call.parts)
{-| Join the player ids to the cards played into a round.
-}
playedCardsByPlayer : List Player.Id -> List PlayedCards -> Dict Player.Id PlayedCards
playedCardsByPlayer players cards = List.map2 (,) players cards |> Dict.fromList
playedCardsByPlayer players cards =
List.map2 (,) players cards |> Dict.fromList
{-| The cards played by the winner of the game.
-}
winningCards : List PlayedCards -> Player.PlayedByAndWinner -> Maybe PlayedCards
winningCards cards playedByAndWinner =
let
cardsByPlayer = playedCardsByPlayer playedByAndWinner.playedBy cards
winner = playedByAndWinner.winner
in
Dict.get winner cardsByPlayer
let
cardsByPlayer =
playedCardsByPlayer playedByAndWinner.playedBy cards
winner =
playedByAndWinner.winner
in
Dict.get winner cardsByPlayer
client/src/MassiveDecks/Models/Event.elm
+64 -44
View File
@@ -1,7 +1,6 @@
module MassiveDecks.Models.Event exposing (Event(..), fromJson)
import Json.Decode as Json
import MassiveDecks.Models.JSON.Decode exposing (..)
import MassiveDecks.Models.Game as Game
import MassiveDecks.Models.Game.Round as Round
@@ -12,63 +11,84 @@ import MassiveDecks.Models.Card as Card
{-| An event represents a change in the game state from the server. These are recieved by websocket.
-}
type Event
= Sync Game.LobbyAndHand
| PlayerJoin Player
| PlayerStatus Player.Id Player.Status
| PlayerLeft Player.Id
| PlayerDisconnect Player.Id
| PlayerReconnect Player.Id
| PlayerScoreChange Player.Id Int
| HandChange Card.Hand
| RoundStart Player.Id Card.Call
| RoundPlayed Int
| RoundJudging (List Card.PlayedCards)
| RoundEnd Round.FinishedRound
| GameStart Player.Id Card.Call
| GameEnd
| ConfigChange Game.Config
| RoundTimeLimitHit
= Sync Game.LobbyAndHand
| PlayerJoin Player
| PlayerStatus Player.Id Player.Status
| PlayerLeft Player.Id
| PlayerDisconnect Player.Id
| PlayerReconnect Player.Id
| PlayerScoreChange Player.Id Int
| HandChange Card.Hand
| RoundStart Player.Id Card.Call
| RoundPlayed Int
| RoundJudging (List Card.PlayedCards)
| RoundEnd Round.FinishedRound
| GameStart Player.Id Card.Call
| GameEnd
| ConfigChange Game.Config
| RoundTimeLimitHit
fromJson : String -> Result String Event
fromJson json = Json.decodeString eventDecoder json
fromJson json =
Json.decodeString eventDecoder json
eventDecoder : Json.Decoder Event
eventDecoder =
(Json.field "event" Json.string) |> Json.andThen specificEventDecoder
(Json.field "event" Json.string) |> Json.andThen specificEventDecoder
specificEventDecoder : String -> Json.Decoder Event
specificEventDecoder : String -> Json.Decoder Event
specificEventDecoder name =
case name of
"Sync" -> Json.map Sync (Json.field "lobbyAndHand" lobbyAndHandDecoder)
case name of
"Sync" ->
Json.map Sync (Json.field "lobbyAndHand" lobbyAndHandDecoder)
"PlayerJoin" -> Json.map PlayerJoin (Json.field "player" playerDecoder)
"PlayerStatus" -> Json.map2 PlayerStatus (Json.field "player" playerIdDecoder) (Json.field "status" playerStatusDecoder)
"PlayerLeft" -> Json.map PlayerLeft (Json.field "player" playerIdDecoder)
"PlayerDisconnect" -> Json.map PlayerDisconnect (Json.field "player" playerIdDecoder)
"PlayerReconnect" -> Json.map PlayerReconnect (Json.field "player" playerIdDecoder)
"PlayerScoreChange" -> Json.map2 PlayerScoreChange (Json.field "player" playerIdDecoder) (Json.field "score" Json.int)
"PlayerJoin" ->
Json.map PlayerJoin (Json.field "player" playerDecoder)
"HandChange" -> Json.map HandChange (Json.field "hand" handDecoder)
"PlayerStatus" ->
Json.map2 PlayerStatus (Json.field "player" playerIdDecoder) (Json.field "status" playerStatusDecoder)
"RoundStart" -> Json.map2 RoundStart (Json.field "czar" playerIdDecoder) (Json.field "call" callDecoder)
"RoundPlayed" -> Json.map RoundPlayed (Json.field "playedCards" Json.int)
"RoundJudging" -> Json.map RoundJudging (Json.field "playedCards" (Json.list (Json.list responseDecoder)))
"RoundEnd" -> Json.map RoundEnd (Json.field "finishedRound" finishedRoundDecoder)
"PlayerLeft" ->
Json.map PlayerLeft (Json.field "player" playerIdDecoder)
"GameStart" -> Json.map2 GameStart (Json.field "czar" playerIdDecoder) (Json.field "call" callDecoder)
"GameEnd" -> Json.succeed GameEnd
"PlayerDisconnect" ->
Json.map PlayerDisconnect (Json.field "player" playerIdDecoder)
"ConfigChange" -> Json.map ConfigChange (Json.field "config" configDecoder)
"PlayerReconnect" ->
Json.map PlayerReconnect (Json.field "player" playerIdDecoder)
"RoundTimeLimitHit" -> Json.succeed RoundTimeLimitHit
"PlayerScoreChange" ->
Json.map2 PlayerScoreChange (Json.field "player" playerIdDecoder) (Json.field "score" Json.int)
unknown -> Json.fail (unknown ++ " is not a recognised event.")
"HandChange" ->
Json.map HandChange (Json.field "hand" handDecoder)
"RoundStart" ->
Json.map2 RoundStart (Json.field "czar" playerIdDecoder) (Json.field "call" callDecoder)
"RoundPlayed" ->
Json.map RoundPlayed (Json.field "playedCards" Json.int)
"RoundJudging" ->
Json.map RoundJudging (Json.field "playedCards" (Json.list (Json.list responseDecoder)))
"RoundEnd" ->
Json.map RoundEnd (Json.field "finishedRound" finishedRoundDecoder)
"GameStart" ->
Json.map2 GameStart (Json.field "czar" playerIdDecoder) (Json.field "call" callDecoder)
"GameEnd" ->
Json.succeed GameEnd
"ConfigChange" ->
Json.map ConfigChange (Json.field "config" configDecoder)
"RoundTimeLimitHit" ->
Json.succeed RoundTimeLimitHit
unknown ->
Json.fail (unknown ++ " is not a recognised event.")
client/src/MassiveDecks/Models/Game.elm
+26 -25
View File
@@ -9,55 +9,56 @@ import MassiveDecks.Scenes.Playing.HouseRule.Id as HouseRule
{-| The required information to rejoin a lobby - the ID and the secret.
-}
type alias GameCodeAndSecret =
{ gameCode : GameCode
, secret : Player.Secret
}
{ gameCode : GameCode
, secret : Player.Secret
}
{-| A lobby ID is a string used to identify a given lobby.
-}
type alias GameCode = String
type alias GameCode =
String
{-| Configuration for a game.
-}
type alias Config =
{ decks : List DeckInfo
, houseRules : List HouseRule.Id
, pasword : Maybe String
}
{ decks : List DeckInfo
, houseRules : List HouseRule.Id
, pasword : Maybe String
}
{-| Information about a deck of cards.
-}
type alias DeckInfo =
{ id : String
, name : String
, calls : Int
, responses : Int
}
{ id : String
, name : String
, calls : Int
, responses : Int
}
type State
= Configuring
| Playing Round
| Finished
= Configuring
| Playing Round
| Finished
{-| A lobby.
-}
type alias Lobby =
{ gameCode : String
, owner : Player.Id
, config : Config
, players : List Player
, game : State
}
{ gameCode : String
, owner : Player.Id
, config : Config
, players : List Player
, game : State
}
{-| A lobby and a player's hand.
-}
type alias LobbyAndHand =
{ lobby : Lobby
, hand: Card.Hand
}
{ lobby : Lobby
, hand : Card.Hand
}
client/src/MassiveDecks/Models/Game/Round.elm
+49 -31
View File
@@ -5,71 +5,89 @@ import MassiveDecks.Models.Player as Player
type alias Round =
{ czar : Player.Id
, call : Card.Call
, state : State
}
{ czar : Player.Id
, call : Card.Call
, state : State
}
{-| The possible states of the round.
-}
type State
= P Playing
| J Judging
| F Finished
= P Playing
| J Judging
| F Finished
playing : Int -> Bool -> State
playing numberPlayed afterTimeLimit = P (Playing numberPlayed afterTimeLimit)
playing numberPlayed afterTimeLimit =
P (Playing numberPlayed afterTimeLimit)
{-| A round that is being played into.
-}
type alias Playing =
{ numberPlayed : Int
, afterTimeLimit : Bool
}
{ numberPlayed : Int
, afterTimeLimit : Bool
}
judging : List Card.PlayedCards -> Bool -> State
judging responses afterTimeLimit = J (Judging responses afterTimeLimit)
judging responses afterTimeLimit =
J (Judging responses afterTimeLimit)
{-| A round that is being judged.
-}
type alias Judging =
{ responses : (List Card.PlayedCards)
, afterTimeLimit : Bool
}
{ responses : List Card.PlayedCards
, afterTimeLimit : Bool
}
finished : List Card.PlayedCards -> Player.PlayedByAndWinner -> State
finished responses playedByAndWinner = F (Finished responses playedByAndWinner)
finished responses playedByAndWinner =
F (Finished responses playedByAndWinner)
{-| A round that has been completed.
-}
type alias Finished =
{ responses : (List Card.PlayedCards)
, playedByAndWinner : Player.PlayedByAndWinner
}
{ responses : List Card.PlayedCards
, playedByAndWinner : Player.PlayedByAndWinner
}
{-| A historical round that has been completed.
-}
type alias FinishedRound =
{ czar : Player.Id
, call : Card.Call
, state : Finished
}
{ czar : Player.Id
, call : Card.Call
, state : Finished
}
afterTimeLimit : State -> Bool
afterTimeLimit state = case state of
P playing -> playing.afterTimeLimit
J judging -> judging.afterTimeLimit
F finished -> False
afterTimeLimit state =
case state of
P playing ->
playing.afterTimeLimit
J judging ->
judging.afterTimeLimit
F finished ->
False
setAfterTimeLimit : Round -> Bool -> Round
setAfterTimeLimit round afterTimeLimit = case round.state of
P playing -> { round | state = P { playing | afterTimeLimit = afterTimeLimit } }
J judging -> { round | state = J { judging | afterTimeLimit = afterTimeLimit } }
F finished -> round
setAfterTimeLimit round afterTimeLimit =
case round.state of
P playing ->
{ round | state = P { playing | afterTimeLimit = afterTimeLimit } }
J judging ->
{ round | state = J { judging | afterTimeLimit = afterTimeLimit } }
F finished ->
round
client/src/MassiveDecks/Models/JSON/Decode.elm
+122 -89
View File
@@ -1,7 +1,6 @@
module MassiveDecks.Models.JSON.Decode exposing (..)
import Json.Decode exposing (..)
import MassiveDecks.Models.Game as Game
import MassiveDecks.Models.Game.Round as Round exposing (Round)
import MassiveDecks.Models.Player as Player exposing (Player)
@@ -10,160 +9,194 @@ import MassiveDecks.Scenes.Playing.HouseRule.Id as HouseRule
lobbyAndHandDecoder : Decoder Game.LobbyAndHand
lobbyAndHandDecoder = map2 Game.LobbyAndHand
(field "lobby" lobbyDecoder)
(field "hand" handDecoder)
lobbyAndHandDecoder =
map2 Game.LobbyAndHand
(field "lobby" lobbyDecoder)
(field "hand" handDecoder)
lobbyDecoder : Decoder Game.Lobby
lobbyDecoder = map5 Game.Lobby
(field "gameCode" string)
(field "owner" playerIdDecoder)
(field "config" configDecoder)
(field "players" (list playerDecoder))
(field "state" gameStateDecoder)
lobbyDecoder =
map5 Game.Lobby
(field "gameCode" string)
(field "owner" playerIdDecoder)
(field "config" configDecoder)
(field "players" (list playerDecoder))
(field "state" gameStateDecoder)
gameCodeAndSecretDecoder : Decoder Game.GameCodeAndSecret
gameCodeAndSecretDecoder = map2 Game.GameCodeAndSecret
(field "gameCode" string)
(field "secret" playerSecretDecoder)
gameCodeAndSecretDecoder =
map2 Game.GameCodeAndSecret
(field "gameCode" string)
(field "secret" playerSecretDecoder)
deckInfoDecoder : Decoder Game.DeckInfo
deckInfoDecoder = map4 Game.DeckInfo
(field "id" string)
(field "name" string)
(field "calls" int)
(field "responses" int)
deckInfoDecoder =
map4 Game.DeckInfo
(field "id" string)
(field "name" string)
(field "calls" int)
(field "responses" int)
configDecoder : Decoder Game.Config
configDecoder = map3 Game.Config
(field "decks" (list deckInfoDecoder))
(field "houseRules" (list houseRuleDecoder))
(maybe (field "password" string))
configDecoder =
map3 Game.Config
(field "decks" (list deckInfoDecoder))
(field "houseRules" (list houseRuleDecoder))
(maybe (field "password" string))
handDecoder : Decoder Card.Hand
handDecoder = map Card.Hand
(field "hand" (list responseDecoder))
handDecoder =
map Card.Hand
(field "hand" (list responseDecoder))
playerDecoder : Decoder Player
playerDecoder = map6 Player
(field "id" playerIdDecoder)
(field "name" string)
(field "status" playerStatusDecoder)
(field "score" int)
(field "disconnected" bool)
(field "left" bool)
playerDecoder =
map6 Player
(field "id" playerIdDecoder)
(field "name" string)
(field "status" playerStatusDecoder)
(field "score" int)
(field "disconnected" bool)
(field "left" bool)
playerStatusDecoder : Decoder Player.Status
playerStatusDecoder = customDecoder (string) (\name -> Player.nameToStatus name |> Result.fromMaybe ("Unknown player status '" ++ name ++ "'."))
playerStatusDecoder =
customDecoder (string) (\name -> Player.nameToStatus name |> Result.fromMaybe ("Unknown player status '" ++ name ++ "'."))
gameStateDecoder : Decoder Game.State
gameStateDecoder =
(field "gameState" string |> andThen (\gameState ->
case gameState of
"configuring" ->
succeed Game.Configuring
(field "gameState" string
|> andThen
(\gameState ->
case gameState of
"configuring" ->
succeed Game.Configuring
"playing" ->
map Game.Playing (field "round" roundDecoder)
"playing" ->
map Game.Playing (field "round" roundDecoder)
"finished" ->
succeed Game.Finished
"finished" ->
succeed Game.Finished
_ ->
fail ("Unknown game state '" ++ gameState ++ "'.")))
_ ->
fail ("Unknown game state '" ++ gameState ++ "'.")
)
)
roundDecoder : Decoder Round
roundDecoder = map3 Round
(field "czar" playerIdDecoder)
(field "call" callDecoder)
(field "state" roundStateDecoder)
roundDecoder =
map3 Round
(field "czar" playerIdDecoder)
(field "call" callDecoder)
(field "state" roundStateDecoder)
roundStateDecoder : Decoder Round.State
roundStateDecoder =
(field "roundState" string |> andThen (\roundState ->
case roundState of
"playing" ->
map2 Round.playing
(field "numberPlayed" int)
(field "afterTimeLimit" bool)
(field "roundState" string
|> andThen
(\roundState ->
case roundState of
"playing" ->
map2 Round.playing
(field "numberPlayed" int)
(field "afterTimeLimit" bool)
"judging" ->
map2 Round.judging
(field "cards" (list (list responseDecoder)))
(field "afterTimeLimit" bool)
"judging" ->
map2 Round.judging
(field "cards" (list (list responseDecoder)))
(field "afterTimeLimit" bool)
"finished" ->
map Round.F finishedStateDecoder
"finished" ->
map Round.F finishedStateDecoder
_ ->
fail ("Unknown round state '" ++ roundState ++ "'.")
)
)
_ ->
fail ("Unknown round state '" ++ roundState ++ "'.")))
finishedStateDecoder : Decoder Round.Finished
finishedStateDecoder = map2 Round.Finished
(field "cards" (list (list responseDecoder)))
(field "playedByAndWinner" playedByAndWinnerDecoder)
finishedStateDecoder =
map2 Round.Finished
(field "cards" (list (list responseDecoder)))
(field "playedByAndWinner" playedByAndWinnerDecoder)
finishedRoundDecoder : Decoder Round.FinishedRound
finishedRoundDecoder = map3 Round.FinishedRound
(field "czar" playerIdDecoder)
(field "call" callDecoder)
(field "state" finishedStateDecoder)
finishedRoundDecoder =
map3 Round.FinishedRound
(field "czar" playerIdDecoder)
(field "call" callDecoder)
(field "state" finishedStateDecoder)
playedByAndWinnerDecoder : Decoder Player.PlayedByAndWinner
playedByAndWinnerDecoder = map2 Player.PlayedByAndWinner
(field "playedBy" (list (playerIdDecoder)))
(field "winner" playerIdDecoder)
playedByAndWinnerDecoder =
map2 Player.PlayedByAndWinner
(field "playedBy" (list (playerIdDecoder)))
(field "winner" playerIdDecoder)
callDecoder : Decoder Card.Call
callDecoder = map2 Card.Call
(field "id" string)
(field "parts" (list string))
callDecoder =
map2 Card.Call
(field "id" string)
(field "parts" (list string))
responseDecoder : Decoder Card.Response
responseDecoder = map2 Card.Response
(field "id" string)
(field "text" string)
responseDecoder =
map2 Card.Response
(field "id" string)
(field "text" string)
playerIdDecoder : Decoder Player.Id
playerIdDecoder = int
playerIdDecoder =
int
playerSecretDecoder : Decoder Player.Secret
playerSecretDecoder = map2 Player.Secret
(field "id" playerIdDecoder)
(field "secret" string)
playerSecretDecoder =
map2 Player.Secret
(field "id" playerIdDecoder)
(field "secret" string)
houseRuleDecoder : Decoder HouseRule.Id
houseRuleDecoder = customDecoder (string) (\name -> ruleNameToId name |> Result.fromMaybe ("Unknown house rule '" ++ name ++ "'."))
houseRuleDecoder =
customDecoder (string) (\name -> ruleNameToId name |> Result.fromMaybe ("Unknown house rule '" ++ name ++ "'."))
ruleNameToId : String -> Maybe HouseRule.Id
ruleNameToId name =
case name of
"reboot" -> Just HouseRule.Reboot
_ -> Nothing
case name of
"reboot" ->
Just HouseRule.Reboot
_ ->
Nothing
customDecoder : Decoder b -> (b -> Result String a) -> Decoder a
customDecoder decoder toResult =
andThen (\a ->
case toResult a of
Ok b -> succeed b
Err err -> fail err
) decoder
andThen
(\a ->
case toResult a of
Ok b ->
succeed b
Err err ->
fail err
)
decoder
client/src/MassiveDecks/Models/JSON/Encode.elm
+20 -14
View File
@@ -1,32 +1,38 @@
module MassiveDecks.Models.JSON.Encode exposing (..)
import Json.Encode as Json
import MassiveDecks.Models.Player as Player
encodeCommand : String -> Player.Secret -> List (String, Json.Value) -> Json.Value
encodeCommand : String -> Player.Secret -> List ( String, Json.Value ) -> Json.Value
encodeCommand action playerSecret rest =
Json.object
(List.append [ ("command", Json.string action)
, ("secret", encodePlayerSecret playerSecret)
] rest)
Json.object
(List.append
[ ( "command", Json.string action )
, ( "secret", encodePlayerSecret playerSecret )
]
rest
)
encodeDeckId : String -> (String, Json.Value)
encodeDeckId id = ("deckId", Json.string id)
encodeDeckId : String -> ( String, Json.Value )
encodeDeckId id =
( "deckId", Json.string id )
encodePlayerSecret : Player.Secret -> Json.Value
encodePlayerSecret playerSecret = Json.object
[ ("id", encodePlayerId playerSecret.id)
, ("secret", Json.string playerSecret.secret)
]
encodePlayerSecret playerSecret =
Json.object
[ ( "id", encodePlayerId playerSecret.id )
, ( "secret", Json.string playerSecret.secret )
]
encodePlayerId : Player.Id -> Json.Value
encodePlayerId playerId = Json.int playerId
encodePlayerId playerId =
Json.int playerId
encodeName : String -> Json.Value
encodeName name = Json.object [ ("name", Json.string name) ]
encodeName name =
Json.object [ ( "name", Json.string name ) ]
client/src/MassiveDecks/Models/Notification.elm
+19 -14
View File
@@ -6,45 +6,50 @@ import MassiveDecks.Models.Player as Player exposing (Player)
{-| A notification about a player.
-}
type alias Notification =
{ icon : String
, name : String
, description : String
, visible : Bool
}
{ icon : String
, name : String
, description : String
, visible : Bool
}
{-| Hide the given notificaiton.
-}
hide : Notification -> Notification
hide notification = { notification | visible = False }
hide notification =
{ notification | visible = False }
{-| Create a notification for a player joining the game.
-}
playerJoin : Player.Id -> List Player -> Maybe Notification
playerJoin id players = playerFromIdAndPlayers id players "sign-in" " has joined the game."
playerJoin id players =
playerFromIdAndPlayers id players "sign-in" " has joined the game."
{-| Create a notification for a player reconnecting to the game.
-}
playerReconnect : Player.Id -> List Player -> Maybe Notification
playerReconnect id players = playerFromIdAndPlayers id players "sign-in" " has reconnected to the game."
playerReconnect id players =
playerFromIdAndPlayers id players "sign-in" " has reconnected to the game."
{-| Create a notification for a player disconnecting from the game.
-}
playerDisconnect : Player.Id -> List Player -> Maybe Notification
playerDisconnect id players = playerFromIdAndPlayers id players "minus-circle" " has disconnected from the game."
playerDisconnect id players =
playerFromIdAndPlayers id players "minus-circle" " has disconnected from the game."
{-| Create a notification for a player leaving the game.
-}
playerLeft : Player.Id -> List Player -> Maybe Notification
playerLeft id players = playerFromIdAndPlayers id players "sign-out" " has left the game."
playerLeft id players =
playerFromIdAndPlayers id players "sign-out" " has left the game."
playerFromIdAndPlayers : Player.Id -> List Player -> String -> String -> Maybe Notification
playerFromIdAndPlayers id players icon suffix
= Player.byId id players
|> Maybe.map .name
|> Maybe.map (\name -> Notification icon name (name ++ suffix) True)
playerFromIdAndPlayers id players icon suffix =
Player.byId id players
|> Maybe.map .name
|> Maybe.map (\name -> Notification icon name (name ++ suffix) True)
client/src/MassiveDecks/Models/Player.elm
+64 -36
View File
@@ -5,74 +5,102 @@ import MassiveDecks.Util as Util
{-| A game-unique identifier for a player.
-}
type alias Id = Int
type alias Id =
Int
{-| A player.
-}
type alias Player =
{ id : Id
, name : String
, status : Status
, score : Int
, disconnected : Bool
, left : Bool
}
{ id : Id
, name : String
, status : Status
, score : Int
, disconnected : Bool
, left : Bool
}
{-| A list of ids to identify who played what responses into a round and the id of the winner of the round.
-}
type alias PlayedByAndWinner =
{ playedBy : List Id
, winner : Id
}
{ playedBy : List Id
, winner : Id
}
{-| A secret that a player uses to authenticate themselves to the server.
-}
type alias Secret =
{ id : Id
, secret : String
}
{ id : Id
, secret : String
}
{-| The status of a player.
-}
type Status
= NotPlayed
| Played
| Czar
| Ai
| Neutral
| Skipping
= NotPlayed
| Played
| Czar
| Ai
| Neutral
| Skipping
{-| The name of the status.
-}
statusName : Status -> String
statusName status = case status of
NotPlayed -> "not-played"
Played -> "played"
Czar -> "czar"
Ai -> "ai"
Neutral -> "neutral"
Skipping -> "skipping"
statusName status =
case status of
NotPlayed ->
"not-played"
Played ->
"played"
Czar ->
"czar"
Ai ->
"ai"
Neutral ->
"neutral"
Skipping ->
"skipping"
{-| Get a status from a name.
-}
nameToStatus : String -> Maybe Status
nameToStatus name = case name of
"not-played" -> Just NotPlayed
"played" -> Just Played
"czar" -> Just Czar
"ai" -> Just Ai
"neutral" -> Just Neutral
"skipping" -> Just Skipping
_ -> Nothing
nameToStatus name =
case name of
"not-played" ->
Just NotPlayed
"played" ->
Just Played
"czar" ->
Just Czar
"ai" ->
Just Ai
"neutral" ->
Just Neutral
"skipping" ->
Just Skipping
_ ->
Nothing
{-| Get a player from a list of players by their id.
-}
byId : Id -> List Player -> Maybe Player
byId id players = Util.find (\player -> player.id == id) players
byId id players =
Util.find (\player -> player.id == id) players
client/src/MassiveDecks/Scenes/Config.elm
+74 -58
View File
@@ -1,9 +1,7 @@
module MassiveDecks.Scenes.Config exposing (update, view, init, subscriptions)
import String
import Html exposing (Html)
import MassiveDecks.API as API
import MassiveDecks.API.Request as Request
import MassiveDecks.Components.Input as Input
@@ -19,104 +17,122 @@ import MassiveDecks.Util as Util exposing ((:>))
-}
init : Model
init =
{ decks = []
, deckIdInput = Input.initWithExtra DeckId "deck-id-input" UI.deckIdInputLabel "" "Play Code" UI.addDeckButton (Util.cmd AddDeck) InputMessage
, passwordInput = Input.init Password "password-input" UI.passwordInputLabel "" "Password" (Cmd.none) InputMessage
, loadingDecks = []
}
{ decks = []
, deckIdInput = Input.initWithExtra DeckId "deck-id-input" UI.deckIdInputLabel "" "Play Code" UI.addDeckButton (Util.cmd AddDeck) InputMessage
, passwordInput = Input.init Password "password-input" UI.passwordInputLabel "" "Password" (Cmd.none) InputMessage
, loadingDecks = []
}
{-| Subscriptions for the config screen.
-}
subscriptions : Model -> Sub ConsumerMessage
subscriptions model = Sub.none
subscriptions model =
Sub.none
{-| Render the config screen.
-}
view : Lobby.Model -> Html ConsumerMessage
view lobbyModel = UI.view lobbyModel |> Html.map LocalMessage
view lobbyModel =
UI.view lobbyModel |> Html.map LocalMessage
{-| Handles messages and alters the model as appropriate.
-}
update : Message -> Lobby.Model -> (Model, Cmd ConsumerMessage)
update : Message -> Lobby.Model -> ( Model, Cmd ConsumerMessage )
update message lobbyModel =
let
lobby = lobbyModel.lobby
gameCode = lobbyModel.lobby.gameCode
secret = lobbyModel.secret
model = lobbyModel.config
in
case message of
ConfigureDecks (Request rawDeckId) ->
let
deckId = String.toUpper rawDeckId
in
{ model | loadingDecks = model.loadingDecks ++ [ deckId ] } !
[ Request.send (API.addDeck gameCode secret deckId) (addDeckErrorHandler deckId) ErrorMessage (\_ -> (Add deckId) |> ConfigureDecks |> LocalMessage)
, inputClearErrorCmd DeckId
]
let
lobby =
lobbyModel.lobby
AddDeck ->
(model, Util.cmd (LocalMessage (ConfigureDecks (Request model.deckIdInput.value))))
gameCode =
lobbyModel.lobby.gameCode
ConfigureDecks (Add deckId) ->
(removeDeckLoadingSpinner deckId model, Cmd.none)
secret =
lobbyModel.secret
ConfigureDecks (Fail deckId errorMessage) ->
(removeDeckLoadingSpinner deckId model, inputSetErrorCmd DeckId errorMessage)
model =
lobbyModel.config
in
case message of
ConfigureDecks (Request rawDeckId) ->
let
deckId =
String.toUpper rawDeckId
in
{ model | loadingDecks = model.loadingDecks ++ [ deckId ] }
! [ Request.send (API.addDeck gameCode secret deckId) (addDeckErrorHandler deckId) ErrorMessage (\_ -> (Add deckId) |> ConfigureDecks |> LocalMessage)
, inputClearErrorCmd DeckId
]
InputMessage message ->
let
(deckIdInput, msg) = Input.update message lobbyModel.config.deckIdInput
in
({ model | deckIdInput = deckIdInput }, Cmd.map LocalMessage msg)
AddDeck ->
( model, Util.cmd (LocalMessage (ConfigureDecks (Request model.deckIdInput.value))) )
AddAi ->
(model, Request.send_ (API.newAi gameCode secret) ErrorMessage (\_ -> LocalMessage NoOp))
ConfigureDecks (Add deckId) ->
( removeDeckLoadingSpinner deckId model, Cmd.none )
StartGame ->
(model, Request.send (API.newGame gameCode secret) newGameErrorHandler ErrorMessage HandUpdate)
ConfigureDecks (Fail deckId errorMessage) ->
( removeDeckLoadingSpinner deckId model, inputSetErrorCmd DeckId errorMessage )
EnableRule rule ->
(model, Request.send_ (API.enableRule rule gameCode secret) ErrorMessage ignore)
InputMessage message ->
let
( deckIdInput, msg ) =
Input.update message lobbyModel.config.deckIdInput
in
( { model | deckIdInput = deckIdInput }, Cmd.map LocalMessage msg )
DisableRule rule ->
(model, Request.send_ (API.disableRule rule gameCode secret) ErrorMessage ignore)
AddAi ->
( model, Request.send_ (API.newAi gameCode secret) ErrorMessage (\_ -> LocalMessage NoOp) )
NoOp ->
(model, Cmd.none)
StartGame ->
( model, Request.send (API.newGame gameCode secret) newGameErrorHandler ErrorMessage HandUpdate )
EnableRule rule ->
( model, Request.send_ (API.enableRule rule gameCode secret) ErrorMessage ignore )
DisableRule rule ->
( model, Request.send_ (API.disableRule rule gameCode secret) ErrorMessage ignore )
NoOp ->
( model, Cmd.none )
ignore : () -> ConsumerMessage
ignore = (\_ -> LocalMessage NoOp)
ignore =
(\_ -> LocalMessage NoOp)
inputClearErrorCmd : InputId -> Cmd ConsumerMessage
inputClearErrorCmd inputId = (inputId, Nothing |> Input.Error) |> InputMessage |> LocalMessage |> Util.cmd
inputClearErrorCmd inputId =
( inputId, Nothing |> Input.Error ) |> InputMessage |> LocalMessage |> Util.cmd
inputSetErrorCmd : InputId -> String -> Cmd ConsumerMessage
inputSetErrorCmd inputId error = (inputId, Just error |> Input.Error) |> InputMessage |> LocalMessage |> Util.cmd
inputSetErrorCmd inputId error =
( inputId, Just error |> Input.Error ) |> InputMessage |> LocalMessage |> Util.cmd
removeDeckLoadingSpinner : String -> Model -> Model
removeDeckLoadingSpinner deckId model = { model | loadingDecks = List.filter ((/=) deckId) model.loadingDecks }
removeDeckLoadingSpinner deckId model =
{ model | loadingDecks = List.filter ((/=) deckId) model.loadingDecks }
addDeckErrorHandler : String -> API.AddDeckError -> ConsumerMessage
addDeckErrorHandler deckId error =
case error of
API.CardcastTimeout ->
ConfigureDecks (Fail deckId "There was a problem accessing CardCast, please try again after a short wait.") |> LocalMessage
case error of
API.CardcastTimeout ->
ConfigureDecks (Fail deckId "There was a problem accessing CardCast, please try again after a short wait.") |> LocalMessage
API.DeckNotFound ->
ConfigureDecks (Fail deckId "The given play code doesn't exist, please check you have the correct code.") |> LocalMessage
API.DeckNotFound ->
ConfigureDecks (Fail deckId "The given play code doesn't exist, please check you have the correct code.") |> LocalMessage
newGameErrorHandler : API.NewGameError -> ConsumerMessage
newGameErrorHandler error =
case error of
API.GameInProgress -> ErrorMessage <| Errors.New "Can't start the game - it is already in progress." False
API.NotEnoughPlayers required -> ErrorMessage <| Errors.New ("Can't start the game - you need at least " ++ (toString required) ++ " players to start the game.") False
case error of
API.GameInProgress ->
ErrorMessage <| Errors.New "Can't start the game - it is already in progress." False
API.NotEnoughPlayers required ->
ErrorMessage <| Errors.New ("Can't start the game - you need at least " ++ (toString required) ++ " players to start the game.") False
client/src/MassiveDecks/Scenes/Config/Messages.elm
+20 -18
View File
@@ -9,38 +9,40 @@ import MassiveDecks.Scenes.Playing.HouseRule.Id as HouseRule
{-| This type is used for all sending of messages, allowing us to send messages handled outside this scene.
-}
type ConsumerMessage
= HandUpdate Card.Hand
| ErrorMessage Errors.Message
| LocalMessage Message
= HandUpdate Card.Hand
| ErrorMessage Errors.Message
| LocalMessage Message
{-| The messages used in the start screen.
-}
type Message
= AddDeck
| ConfigureDecks Deck
| InputMessage (Input.Message InputId)
| AddAi
| StartGame
| EnableRule HouseRule.Id
| DisableRule HouseRule.Id
| NoOp
= AddDeck
| ConfigureDecks Deck
| InputMessage (Input.Message InputId)
| AddAi
| StartGame
| EnableRule HouseRule.Id
| DisableRule HouseRule.Id
| NoOp
type Deck
= Request DeckId
| Add DeckId
| Fail DeckId FailureMessage
= Request DeckId
| Add DeckId
| Fail DeckId FailureMessage
type alias DeckId = String
type alias DeckId =
String
type alias FailureMessage = String
type alias FailureMessage =
String
{-| IDs for the inputs to differentiate between them in messages.
-}
type InputId
= DeckId
| Password
= DeckId
| Password
client/src/MassiveDecks/Scenes/Config/Models.elm
+5 -5
View File
@@ -8,8 +8,8 @@ import MassiveDecks.Scenes.Config.Messages exposing (Message, InputId)
{-| The state of the config screen.
-}
type alias Model =
{ decks : List Game.DeckInfo
, deckIdInput : Input.Model InputId Message
, passwordInput : Input.Model InputId Message
, loadingDecks : List String
}
{ decks : List Game.DeckInfo
, deckIdInput : Input.Model InputId Message
, passwordInput : Input.Model InputId Message
, loadingDecks : List String
}
client/src/MassiveDecks/Scenes/Config/UI.elm
+205 -143
View File
@@ -1,11 +1,9 @@
module MassiveDecks.Scenes.Config.UI exposing (view, deckIdInputLabel, passwordInputLabel, addDeckButton)
import String
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import MassiveDecks.Components.Icon as Icon
import MassiveDecks.Components.Input as Input
import MassiveDecks.Models.Game as Game
@@ -19,202 +17,266 @@ import MassiveDecks.Util as Util
view : Lobby.Model -> Html Message
view lobbyModel =
let
model = lobbyModel.config
lobby = lobbyModel.lobby
decks = lobby.config.decks
enoughPlayers = ((List.length lobby.players) > 1)
enoughCards = not (List.isEmpty decks)
canNotChangeConfig = lobbyModel.lobby.owner /= lobbyModel.secret.id
in
div [ id "config" ]
( (if canNotChangeConfig then infoBar else [])
++ [ div [ id "config-content", class "mui-panel" ]
[ invite lobbyModel.init.url lobby.gameCode
, div [ class "mui-divider" ] []
, h1 [] [ text "Game Setup" ]
, ul [ class "mui-tabs__bar" ]
[ li [ class "mui--is-active" ] [ a [ attribute "data-mui-toggle" "tab"
, attribute "data-mui-controls" "decks" ]
[ text "Decks" ]
]
, li [] [ a [ attribute "data-mui-toggle" "tab"
, attribute "data-mui-controls" "house-rules"
] [ text "House Rules" ]
]
, li [] [ a [ attribute "data-mui-toggle" "tab"
, attribute "data-mui-controls" "lobby-settings"
] [ text "Lobby Settings" ]
]
let
model =
lobbyModel.config
lobby =
lobbyModel.lobby
decks =
lobby.config.decks
enoughPlayers =
((List.length lobby.players) > 1)
enoughCards =
not (List.isEmpty decks)
canNotChangeConfig =
lobbyModel.lobby.owner /= lobbyModel.secret.id
in
div [ id "config" ]
((if canNotChangeConfig then
infoBar
else
[]
)
++ [ div [ id "config-content", class "mui-panel" ]
[ invite lobbyModel.init.url lobby.gameCode
, div [ class "mui-divider" ] []
, h1 [] [ text "Game Setup" ]
, ul [ class "mui-tabs__bar" ]
[ li [ class "mui--is-active" ]
[ a
[ attribute "data-mui-toggle" "tab"
, attribute "data-mui-controls" "decks"
]
[ text "Decks" ]
]
, li []
[ a
[ attribute "data-mui-toggle" "tab"
, attribute "data-mui-controls" "house-rules"
]
[ text "House Rules" ]
]
, li []
[ a
[ attribute "data-mui-toggle" "tab"
, attribute "data-mui-controls" "lobby-settings"
]
[ text "Lobby Settings" ]
]
]
, div [ id "decks", class "mui-tabs__pane mui--is-active" ]
[ deckList canNotChangeConfig decks model.loadingDecks model.deckIdInput ]
, div [ id "house-rules", class "mui-tabs__pane" ]
([ rando canNotChangeConfig ] ++ (List.map (\rule -> houseRule canNotChangeConfig (List.member rule.id lobbyModel.lobby.config.houseRules) rule) houseRules))
, div [ id "lobby-settings", class "mui-tabs__pane" ]
[ password model.passwordInput ]
, div [ class "mui-divider" ] []
, startGameButton canNotChangeConfig enoughPlayers enoughCards
]
]
, div [ id "decks", class "mui-tabs__pane mui--is-active" ]
[ deckList canNotChangeConfig decks model.loadingDecks model.deckIdInput ]
, div [ id "house-rules", class "mui-tabs__pane" ]
([ rando canNotChangeConfig ] ++ (List.map (\rule -> houseRule canNotChangeConfig (List.member rule.id lobbyModel.lobby.config.houseRules) rule) houseRules))
, div [ id "lobby-settings", class "mui-tabs__pane" ]
[ password model.passwordInput ]
, div [ class "mui-divider" ] []
, startGameButton canNotChangeConfig enoughPlayers enoughCards
]
])
)
infoBar : List (Html msg)
infoBar =
[ div [ id "info-bar", class "mui--z1" ]
[ Icon.icon "info-circle"
, text " "
, text "You can't change the configuration of the game, as you are not the owner."
[ div [ id "info-bar", class "mui--z1" ]
[ Icon.icon "info-circle"
, text " "
, text "You can't change the configuration of the game, as you are not the owner."
]
]
]
passwordInputLabel : List (Html msg)
passwordInputLabel = [ text "If blank, no password will be needed - anyone with the game code can play." ]
passwordInputLabel =
[ text "If blank, no password will be needed - anyone with the game code can play." ]
password : Input.Model InputId Message -> Html Message
password passwordInputModel =
div [] [ h3 [] [ Icon.icon "key", text " Privacy" ]
, p [] [ text "A password that players will need to enter to get in the game." ]
, Input.view passwordInputModel
]
div []
[ h3 [] [ Icon.icon "key", text " Privacy" ]
, p [] [ text "A password that players will need to enter to get in the game." ]
, Input.view passwordInputModel
]
invite : String -> String -> Html msg
invite appUrl lobbyId =
let
url = Util.lobbyUrl appUrl lobbyId
in
div []
[ p [] [ text "Invite others to the game with the code '"
, strong [ class "game-code" ] [ text lobbyId ]
, text "' to enter on the main page, or give them this link: " ]
, p [] [ a [ href url ] [ text url ] ]
]
let
url =
Util.lobbyUrl appUrl lobbyId
in
div []
[ p []
[ text "Invite others to the game with the code '"
, strong [ class "game-code" ] [ text lobbyId ]
, text "' to enter on the main page, or give them this link: "
]
, p [] [ a [ href url ] [ text url ] ]
]
deckIdInputLabel : List (Html msg)
deckIdInputLabel =
[ text " A "
, a [ href "https://www.cardcastgame.com/browse", target "_blank", rel "noopener" ] [ text "Cardcast" ]
, text " Play Code"
]
[ text " A "
, a [ href "https://www.cardcastgame.com/browse", target "_blank", rel "noopener" ] [ text "Cardcast" ]
, text " Play Code"
]
addDeckButton : String -> List (Html Message)
addDeckButton deckId =
[ button [ class "mui-btn mui-btn--small mui-btn--primary mui-btn--fab", disabled (String.isEmpty deckId)
, onClick (ConfigureDecks (Request deckId))
, title "Add deck to game."
] [ Icon.icon "plus" ]
]
[ button
[ class "mui-btn mui-btn--small mui-btn--primary mui-btn--fab"
, disabled (String.isEmpty deckId)
, onClick (ConfigureDecks (Request deckId))
, title "Add deck to game."
]
[ Icon.icon "plus" ]
]
deckList : Bool -> List Game.DeckInfo -> List String -> Input.Model InputId Message -> Html Message
deckList canNotChangeConfig decks loadingDecks deckId =
table [ class "decks mui-table" ]
[ thead []
[ tr []
[ th [] [ text "Id" ]
, th [] [ text "Name" ]
, th [ title "Calls" ] [ Icon.icon "square" ]
, th [ title "Responses" ] [ Icon.icon "square-o" ]
table [ class "decks mui-table" ]
[ thead []
[ tr []
[ th [] [ text "Id" ]
, th [] [ text "Name" ]
, th [ title "Calls" ] [ Icon.icon "square" ]
, th [ title "Responses" ] [ Icon.icon "square-o" ]
]
]
, Util.tbody []
(List.concat
[ if (canNotChangeConfig && (List.isEmpty decks)) then
[ ( "!!emptyInfo", tr [] [ td [ colspan 4 ] [ text "No decks have been added yet." ] ] ) ]
else
[]
, emptyDeckListInfo ((not canNotChangeConfig) && (List.isEmpty decks) && List.isEmpty loadingDecks)
, List.map loadedDeckEntry decks
, List.map loadingDeckEntry loadingDecks
, if (canNotChangeConfig) then
[]
else
[ ( "!!input", tr [] [ td [ colspan 4 ] [ Input.view deckId ] ] ) ]
]
)
]
]
, Util.tbody [] (List.concat
[ if (canNotChangeConfig && (List.isEmpty decks) ) then
[ ("!!emptyInfo", tr [] [ td [ colspan 4 ] [ text "No decks have been added yet." ] ]) ]
else
[]
, emptyDeckListInfo ((not canNotChangeConfig) && (List.isEmpty decks) && List.isEmpty loadingDecks)
, List.map loadedDeckEntry decks
, List.map loadingDeckEntry loadingDecks
, if (canNotChangeConfig) then [] else [ ("!!input", tr [] [ td [ colspan 4 ] [ Input.view deckId ] ]) ]
])
]
loadedDeckEntry : Game.DeckInfo -> (String, Html msg)
loadedDeckEntry : Game.DeckInfo -> ( String, Html msg )
loadedDeckEntry deck =
let
row = tr [] [ td [] [ deckLink deck.id ]
let
row =
tr []
[ td [] [ deckLink deck.id ]
, td [ title deck.name ] [ text deck.name ]
, td [] [ text (toString deck.calls) ]
, td [] [ text (toString deck.responses) ]
]
in
(deck.id, row)
in
( deck.id, row )
loadingDeckEntry : String -> (String, Html msg)
loadingDeckEntry : String -> ( String, Html msg )
loadingDeckEntry deckId =
let
row = tr [] [ td [] [ deckLink deckId ], td [ colspan 3 ] [ Icon.spinner ] ]
in
(deckId, row)
let
row =
tr [] [ td [] [ deckLink deckId ], td [ colspan 3 ] [ Icon.spinner ] ]
in
( deckId, row )
deckLink : String -> Html msg
deckLink id = a [ href ("https://www.cardcastgame.com/browse/deck/" ++ id), target "_blank", rel "noopener" ] [ text id ]
deckLink id =
a [ href ("https://www.cardcastgame.com/browse/deck/" ++ id), target "_blank", rel "noopener" ] [ text id ]
emptyDeckListInfo : Bool -> List (String, Html Message)
emptyDeckListInfo : Bool -> List ( String, Html Message )
emptyDeckListInfo display =
if display then
[ ("!!emptyInfo", tr [] [ td [ colspan 4 ]
[ Icon.icon "info-circle"
, text " You will need to add at least one "
, a [ href "https://www.cardcastgame.com/browse", target "_blank", rel "noopener" ] [ text "Cardcast deck" ]
, text " to the game."
, text " Not sure? Try "
, a [ class "link"
, attribute "tabindex" "0"
, attribute "role" "button"
, onClick (ConfigureDecks (Request "CAHBS"))
] [ text "clicking here to add the Cards Against Humanity base set" ]
, text "."
if display then
[ ( "!!emptyInfo"
, tr []
[ td [ colspan 4 ]
[ Icon.icon "info-circle"
, text " You will need to add at least one "
, a [ href "https://www.cardcastgame.com/browse", target "_blank", rel "noopener" ] [ text "Cardcast deck" ]
, text " to the game."
, text " Not sure? Try "
, a
[ class "link"
, attribute "tabindex" "0"
, attribute "role" "button"
, onClick (ConfigureDecks (Request "CAHBS"))
]
[ text "clicking here to add the Cards Against Humanity base set" ]
, text "."
]
]
)
]
])
]
else
[]
else
[]
houseRule : Bool -> Bool -> HouseRule -> Html Message
houseRule canNotChangeConfig enabled rule =
let
(buttonText, command) =
if enabled then
("Disable", DisableRule rule.id)
else
("Enable", EnableRule rule.id)
in
houseRuleTemplate canNotChangeConfig (HouseRule.toString rule.id) rule.name rule.icon rule.description buttonText command
let
( buttonText, command ) =
if enabled then
( "Disable", DisableRule rule.id )
else
( "Enable", EnableRule rule.id )
in
houseRuleTemplate canNotChangeConfig (HouseRule.toString rule.id) rule.name rule.icon rule.description buttonText command
houseRuleTemplate : Bool -> String -> String -> String -> String -> String -> msg -> Html msg
houseRuleTemplate canNotChangeConfig id_ title icon description buttonText message =
div [ id id_, class "house-rule" ]
[ div [] [ h3 [] [ Icon.icon icon, text " ", text title ]
, button [ class "mui-btn mui-btn--small mui-btn--primary", onClick message, disabled canNotChangeConfig ]
[ text buttonText ]
]
, p [] [ text description ]
]
div [ id id_, class "house-rule" ]
[ div []
[ h3 [] [ Icon.icon icon, text " ", text title ]
, button [ class "mui-btn mui-btn--small mui-btn--primary", onClick message, disabled canNotChangeConfig ]
[ text buttonText ]
]
, p [] [ text description ]
]
rando : Bool -> Html Message
rando canNotChangeConfig = houseRuleTemplate canNotChangeConfig "rando" "Rando Cardrissian" "cogs"
"Every round, one random card will be played for an imaginary player named Rando Cardrissian, if he wins, all players go home in a state of everlasting shame."
"Add an AI player" AddAi
rando canNotChangeConfig =
houseRuleTemplate canNotChangeConfig
"rando"
"Rando Cardrissian"
"cogs"
"Every round, one random card will be played for an imaginary player named Rando Cardrissian, if he wins, all players go home in a state of everlasting shame."
"Add an AI player"
AddAi
startGameWarning : Bool -> Html msg
startGameWarning canStart = if canStart then text "" else
span [] [ Icon.icon "info-circle", text " You will need at least two players to start the game." ]
startGameWarning canStart =
if canStart then
text ""
else
span [] [ Icon.icon "info-circle", text " You will need at least two players to start the game." ]
startGameButton : Bool -> Bool -> Bool -> Html Message
startGameButton notOwner enoughPlayers enoughCards = div [ id "start-game" ]
[ startGameWarning enoughPlayers
, button
[ class "mui-btn mui-btn--primary mui-btn--raised"
, onClick StartGame
, disabled ((not (enoughPlayers && enoughCards)) || notOwner)
] [ text "Start Game" ]
]
startGameButton notOwner enoughPlayers enoughCards =
div [ id "start-game" ]
[ startGameWarning enoughPlayers
, button
[ class "mui-btn mui-btn--primary mui-btn--raised"
, onClick StartGame
, disabled ((not (enoughPlayers && enoughCards)) || notOwner)
]
[ text "Start Game" ]
]
client/src/MassiveDecks/Scenes/History.elm
+13 -12
View File
@@ -1,7 +1,6 @@
module MassiveDecks.Scenes.History exposing (init, subscriptions, view, update)
import Html exposing (Html)
import MassiveDecks.API as API
import MassiveDecks.API.Request as Request
import MassiveDecks.Scenes.History.Messages exposing (Message(..), ConsumerMessage(..))
@@ -10,30 +9,32 @@ import MassiveDecks.Scenes.History.UI as UI
import MassiveDecks.Models.Player as Player exposing (Player)
init : String -> (Model, Cmd ConsumerMessage)
init : String -> ( Model, Cmd ConsumerMessage )
init gameCode =
( { rounds = Nothing
}
, Request.send_ (API.getHistory gameCode) ErrorMessage (LocalMessage << Load)
)
( { rounds = Nothing
}
, Request.send_ (API.getHistory gameCode) ErrorMessage (LocalMessage << Load)
)
{-| Subscriptions for the playing scene.
-}
subscriptions : Model -> Sub ConsumerMessage
subscriptions model = Sub.none
subscriptions model =
Sub.none
{-| Render the history.
-}
view : Model -> List Player -> Html ConsumerMessage
view = UI.view
view =
UI.view
{-| Update the model.
-}
update : Message -> Model -> (Model, Cmd ConsumerMessage)
update : Message -> Model -> ( Model, Cmd ConsumerMessage )
update message model =
case message of
Load rounds ->
({ model | rounds = Just rounds }, Cmd.none)
case message of
Load rounds ->
( { model | rounds = Just rounds }, Cmd.none )
client/src/MassiveDecks/Scenes/History/Messages.elm
+4 -4
View File
@@ -7,12 +7,12 @@ import MassiveDecks.Models.Game.Round as Round
{-| This type is used for all sending of messages, allowing us to send messages handled outside this scene.
-}
type ConsumerMessage
= ErrorMessage Errors.Message
| Close
| LocalMessage Message
= ErrorMessage Errors.Message
| Close
| LocalMessage Message
{-| The messages used in the history scene.
-}
type Message
= Load (List Round.FinishedRound)
= Load (List Round.FinishedRound)
client/src/MassiveDecks/Scenes/History/Models.elm
+2 -2
View File
@@ -6,5 +6,5 @@ import MassiveDecks.Models.Game.Round as Round
{-| The state of the lobby.
-}
type alias Model =
{ rounds : Maybe (List Round.FinishedRound)
}
{ rounds : Maybe (List Round.FinishedRound)
}
client/src/MassiveDecks/Scenes/History/UI.elm
+65 -49
View File
@@ -1,12 +1,10 @@
module MassiveDecks.Scenes.History.UI exposing (view)
import Dict
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Html.Keyed as Keyed
import MassiveDecks.Scenes.History.Models exposing (Model)
import MassiveDecks.Scenes.History.Messages exposing (ConsumerMessage(..))
import MassiveDecks.Scenes.Playing.UI.Cards as CardsUI
@@ -18,63 +16,81 @@ import MassiveDecks.Components.Icon as Icon
view : Model -> List Player -> Html ConsumerMessage
view model players =
let
content = case model.rounds of
Just rounds ->
Keyed.ul [] (List.map (\round -> (round.call.id, finishedRound players round)) rounds)
let
content =
case model.rounds of
Just rounds ->
Keyed.ul [] (List.map (\round -> ( round.call.id, finishedRound players round )) rounds)
Nothing ->
Icon.spinner
in
div
[ id "history" ]
[ h1 [ class "mui--divider-bottom" ] [ text "Previous Rounds" ]
, closeButton
, content
]
Nothing ->
Icon.spinner
in
div
[ id "history" ]
[ h1 [ class "mui--divider-bottom" ] [ text "Previous Rounds" ]
, closeButton
, content
]
finishedRound : List Player -> Round.FinishedRound -> Html msg
finishedRound players round =
let
state = round.state
playedBy = state.playedByAndWinner.playedBy
winner = state.playedByAndWinner.winner
czar =
Maybe.map
(\player -> [ Icon.icon "gavel", text " ", text player.name ])
(Player.byId round.czar players) |> Maybe.withDefault []
playedCardsByPlayer = Card.playedCardsByPlayer playedBy state.responses |> Dict.toList
in
li
[ class "round" ]
[ div [] [ div [ class "who" ] czar, CardsUI.call round.call [] ]
, Keyed.ul [ class "plays" ] (List.map (\(id, cards) -> (toString id, responses players winner id cards)) playedCardsByPlayer)
]
let
state =
round.state
playedBy =
state.playedByAndWinner.playedBy
winner =
state.playedByAndWinner.winner
czar =
Maybe.map
(\player -> [ Icon.icon "gavel", text " ", text player.name ])
(Player.byId round.czar players)
|> Maybe.withDefault []
playedCardsByPlayer =
Card.playedCardsByPlayer playedBy state.responses |> Dict.toList
in
li
[ class "round" ]
[ div [] [ div [ class "who" ] czar, CardsUI.call round.call [] ]
, Keyed.ul [ class "plays" ] (List.map (\( id, cards ) -> ( toString id, responses players winner id cards )) playedCardsByPlayer)
]
responses : List Player -> Player.Id -> Player.Id -> List Card.Response -> Html msg
responses players winnerId playerId responses =
let
winner = playerId == winnerId
winnerPrefix = if (winner) then [ Icon.icon "trophy", text " " ] else []
player =
Maybe.map
(\player -> winnerPrefix ++ [ text player.name ])
(Player.byId playerId players) |> Maybe.withDefault []
in
li []
[ div [ class "responses" ]
[ div [ classList [ ("who", True), ("won", winner) ] ] player
, Keyed.ul [] (List.map (\r -> (r.id, li [] [ CardsUI.response False [] r ])) responses)
]
]
let
winner =
playerId == winnerId
winnerPrefix =
if (winner) then
[ Icon.icon "trophy", text " " ]
else
[]
player =
Maybe.map
(\player -> winnerPrefix ++ [ text player.name ])
(Player.byId playerId players)
|> Maybe.withDefault []
in
li []
[ div [ class "responses" ]
[ div [ classList [ ( "who", True ), ( "won", winner ) ] ] player
, Keyed.ul [] (List.map (\r -> ( r.id, li [] [ CardsUI.response False [] r ] )) responses)
]
]
closeButton : Html ConsumerMessage
closeButton =
button
[ class "mui-btn mui-btn--small mui-btn--fab"
, onClick Close
]
[ Icon.icon "times" ]
button
[ class "mui-btn mui-btn--small mui-btn--fab"
, onClick Close
]
[ Icon.icon "times" ]
client/src/MassiveDecks/Scenes/Lobby.elm
+319 -243
View File
@@ -4,13 +4,9 @@ import String
import Json.Encode exposing (encode)
import Task
import Time
import WebSocket
import AnimationFrame
import Html exposing (Html)
import MassiveDecks.Components.Errors as Errors
import MassiveDecks.Components.QR as QR
import MassiveDecks.Components.BrowserNotifications as BrowserNotifications
@@ -36,340 +32,420 @@ import MassiveDecks.Util as Util exposing ((:>))
{-| Create the initial model for the lobby.
-}
init : Init -> Game.LobbyAndHand -> Player.Secret -> (Model, Cmd ConsumerMessage)
init : Init -> Game.LobbyAndHand -> Player.Secret -> ( Model, Cmd ConsumerMessage )
init init lobbyAndHand secret =
{ lobby = lobbyAndHand.lobby
, hand = lobbyAndHand.hand
, config = Config.init
, playing = Playing.init init
, browserNotifications = BrowserNotifications.init init.browserNotificationsSupported False
, secret = secret
, init = init
, notification = Nothing
, qrNeedsRendering = False
, sidebar = Sidebar.init 768 {- Should match the enhance-width in less. -}
, tts = TTS.init
} ! []
{ lobby = lobbyAndHand.lobby
, hand = lobbyAndHand.hand
, config = Config.init
, playing = Playing.init init
, browserNotifications = BrowserNotifications.init init.browserNotificationsSupported False
, secret = secret
, init = init
, notification = Nothing
, qrNeedsRendering = False
, sidebar = Sidebar.init 768 {- Should match the enhance-width in less. -}
, tts = TTS.init
}
! []
{-| Subscriptions for the lobby.
-}
subscriptions : Model -> Sub ConsumerMessage
subscriptions model =
let
delegated = case model.lobby.game of
Game.Configuring -> Config.subscriptions model.config |> Sub.map ConfigMessage
Game.Playing round -> Playing.subscriptions model.playing |> Sub.map PlayingMessage
Game.Finished -> Sub.none
let
delegated =
case model.lobby.game of
Game.Configuring ->
Config.subscriptions model.config |> Sub.map ConfigMessage
websocket = WebSocket.listen (webSocketUrl model.init.url model.lobby.gameCode) webSocketResponseDecoder
Game.Playing round ->
Playing.subscriptions model.playing |> Sub.map PlayingMessage
browserNotifications = BrowserNotifications.subscriptions model.browserNotifications |> Sub.map BrowserNotificationsMessage
Game.Finished ->
Sub.none
render = if model.qrNeedsRendering then [ AnimationFrame.diffs (\_ -> LocalMessage RenderQr) ] else []
in
Sub.batch ([ delegated |> Sub.map LocalMessage
, websocket
, browserNotifications |> Sub.map LocalMessage
] ++ render)
websocket =
WebSocket.listen (webSocketUrl model.init.url model.lobby.gameCode) webSocketResponseDecoder
browserNotifications =
BrowserNotifications.subscriptions model.browserNotifications |> Sub.map BrowserNotificationsMessage
render =
if model.qrNeedsRendering then
[ AnimationFrame.diffs (\_ -> LocalMessage RenderQr) ]
else
[]
in
Sub.batch
([ delegated |> Sub.map LocalMessage
, websocket
, browserNotifications |> Sub.map LocalMessage
]
++ render
)
webSocketUrl : String -> String -> String
webSocketUrl url gameCode =
let
(protocol, rest) = case String.split ":" url of
[] -> ("No protocol.", [])
protocol :: rest -> (protocol, rest)
host = String.join ":" rest
let
( protocol, rest ) =
case String.split ":" url of
[] ->
( "No protocol.", [] )
baseUrl = case protocol of
"http" ->
"ws:" ++ host
"https" ->
"wss:" ++ host
unknown ->
let
_ = Debug.log "Assuming https due to unknown protocol for URL" unknown
in
"wss:" ++ host
in
baseUrl ++ "api/lobbies/" ++ gameCode ++ "/notifications"
protocol :: rest ->
( protocol, rest )
host =
String.join ":" rest
baseUrl =
case protocol of
"http" ->
"ws:" ++ host
"https" ->
"wss:" ++ host
unknown ->
let
_ =
Debug.log "Assuming https due to unknown protocol for URL" unknown
in
"wss:" ++ host
in
baseUrl ++ "api/lobbies/" ++ gameCode ++ "/notifications"
webSocketResponseDecoder : String -> ConsumerMessage
webSocketResponseDecoder response =
if (response == "identify") then
Identify |> LocalMessage
else
case Event.fromJson response of
Ok event ->
LocalMessage <| Batch <| handleEvent event
if (response == "identify") then
Identify |> LocalMessage
else
case Event.fromJson response of
Ok event ->
LocalMessage <| Batch <| handleEvent event
Err message ->
ErrorMessage <| Errors.New ("Error handling notification: " ++ message) True
Err message ->
ErrorMessage <| Errors.New ("Error handling notification: " ++ message) True
{-| Render the lobby.
-}
view : Model -> Html ConsumerMessage
view model = UI.view model
view model =
UI.view model
{-| Handles messages and alters the model as appropriate.
-}
update : Message -> Model -> (Model, Cmd ConsumerMessage)
update : Message -> Model -> ( Model, Cmd ConsumerMessage )
update message model =
let
lobby = model.lobby
in
case message of
ConfigMessage configMessage ->
case configMessage of
Config.ErrorMessage errorMessage ->
(model, ErrorMessage errorMessage |> Util.cmd)
let
lobby =
model.lobby
in
case message of
ConfigMessage configMessage ->
case configMessage of
Config.ErrorMessage errorMessage ->
( model, ErrorMessage errorMessage |> Util.cmd )
Config.HandUpdate hand ->
model |> updateLobbyAndHand (Game.LobbyAndHand model.lobby hand)
Config.HandUpdate hand ->
model |> updateLobbyAndHand (Game.LobbyAndHand model.lobby hand)
Config.LocalMessage localMessage ->
let
(config, cmd) = Config.update localMessage model
in
({ model | config = config }, Cmd.map (LocalMessage << ConfigMessage) cmd)
Config.LocalMessage localMessage ->
let
( config, cmd ) =
Config.update localMessage model
in
( { model | config = config }, Cmd.map (LocalMessage << ConfigMessage) cmd )
PlayingMessage playingMessage ->
case playingMessage of
Playing.ErrorMessage errorMessage ->
(model, ErrorMessage errorMessage |> Util.cmd)
PlayingMessage playingMessage ->
case playingMessage of
Playing.ErrorMessage errorMessage ->
( model, ErrorMessage errorMessage |> Util.cmd )
Playing.HandUpdate hand ->
model |> updateLobbyAndHand (Game.LobbyAndHand model.lobby hand)
Playing.HandUpdate hand ->
model |> updateLobbyAndHand (Game.LobbyAndHand model.lobby hand)
Playing.TTSMessage ttsMessage ->
(model, TTSMessage ttsMessage |> LocalMessage |> Util.cmd)
Playing.TTSMessage ttsMessage ->
( model, TTSMessage ttsMessage |> LocalMessage |> Util.cmd )
Playing.LocalMessage localMessage ->
case model.lobby.game of
Game.Playing round ->
Playing.LocalMessage localMessage ->
case model.lobby.game of
Game.Playing round ->
let
( playing, cmd ) =
Playing.update localMessage model round
in
( { model | playing = playing }, Cmd.map (LocalMessage << PlayingMessage) cmd )
_ ->
( model, Cmd.none )
SidebarMessage sidebarMessage ->
let
(playing, cmd) = Playing.update localMessage model round
( sidebarModel, cmd ) =
Sidebar.update sidebarMessage model.sidebar
in
({ model | playing = playing }, Cmd.map (LocalMessage << PlayingMessage) cmd)
( { model | sidebar = sidebarModel }, Cmd.map (LocalMessage << SidebarMessage) cmd )
_ ->
(model, Cmd.none)
TTSMessage ttsMessage ->
let
( ttsModel, cmd ) =
TTS.update ttsMessage model.tts
in
( { model | tts = ttsModel }, Cmd.map (LocalMessage << TTSMessage) cmd )
SidebarMessage sidebarMessage ->
let
(sidebarModel, cmd) = Sidebar.update sidebarMessage model.sidebar
in
({ model | sidebar = sidebarModel }, Cmd.map (LocalMessage << SidebarMessage) cmd)
BrowserNotificationsMessage notificationMessage ->
let
( browserNotifications, localCmd, cmd ) =
BrowserNotifications.update notificationMessage model.browserNotifications
in
{ model | browserNotifications = browserNotifications }
! [ Cmd.map (LocalMessage << BrowserNotificationsMessage) localCmd
, Cmd.map overlayAlert cmd
]
TTSMessage ttsMessage ->
let
(ttsModel, cmd) = TTS.update ttsMessage model.tts
in
({ model | tts = ttsModel }, Cmd.map (LocalMessage << TTSMessage) cmd)
BrowserNotificationForUser getUserId title iconName ->
let
cmd =
case (getUserId lobby) of
Just id ->
if (id == model.secret.id) then
Util.cmd (BrowserNotifications.notify { title = title, icon = icon model iconName } |> BrowserNotificationsMessage |> LocalMessage)
else
Cmd.none
BrowserNotificationsMessage notificationMessage ->
let
(browserNotifications, localCmd, cmd) = BrowserNotifications.update notificationMessage model.browserNotifications
in
{ model | browserNotifications = browserNotifications } !
[ Cmd.map (LocalMessage << BrowserNotificationsMessage) localCmd
, Cmd.map overlayAlert cmd
]
Nothing ->
Cmd.none
in
( model, cmd )
BrowserNotificationForUser getUserId title iconName ->
let
cmd = case (getUserId lobby) of
Just(id) ->
if (id == model.secret.id) then
Util.cmd (BrowserNotifications.notify { title = title, icon = icon model iconName } |> BrowserNotificationsMessage |> LocalMessage)
else
Cmd.none
Nothing ->
Cmd.none
in
(model, cmd)
UpdateLobbyAndHand lobbyAndHand ->
model |> updateLobbyAndHand lobbyAndHand
UpdateLobbyAndHand lobbyAndHand ->
model |> updateLobbyAndHand lobbyAndHand
UpdateLobby update ->
model |> updateLobbyAndHand (Game.LobbyAndHand (update lobby) model.hand)
UpdateLobby update ->
model |> updateLobbyAndHand (Game.LobbyAndHand (update lobby) model.hand)
UpdateHand hand ->
model |> updateLobbyAndHand (Game.LobbyAndHand model.lobby hand)
UpdateHand hand ->
model |> updateLobbyAndHand (Game.LobbyAndHand model.lobby hand)
SetNotification notification ->
notificationChange model (notification lobby.players)
SetNotification notification ->
notificationChange model (notification lobby.players)
Identify ->
( model, Cmd.map LocalMessage (WebSocket.send (webSocketUrl model.init.url model.lobby.gameCode) (encodePlayerSecret model.secret |> encode 0)) )
Identify ->
(model, Cmd.map LocalMessage (WebSocket.send (webSocketUrl model.init.url model.lobby.gameCode) (encodePlayerSecret model.secret |> encode 0)))
DisplayInviteOverlay ->
{ model | qrNeedsRendering = True } ! [ Util.cmd (UI.inviteOverlay model.init.url model.lobby.gameCode |> OverlayMessage) ]
DisplayInviteOverlay ->
{ model | qrNeedsRendering = True } ! [ Util.cmd (UI.inviteOverlay model.init.url model.lobby.gameCode |> OverlayMessage) ]
RenderQr ->
{ model | qrNeedsRendering = False } ! [ QR.encodeAndRender "invite-qr-code" (Util.lobbyUrl model.init.url model.lobby.gameCode) ]
RenderQr ->
{ model | qrNeedsRendering = False } ! [ QR.encodeAndRender "invite-qr-code" (Util.lobbyUrl model.init.url model.lobby.gameCode) ]
DismissNotification notification ->
let
newModel =
if model.notification == Just notification then
{ model | notification = Maybe.map Notification.hide model.notification }
else
model
in
( newModel, Cmd.none )
DismissNotification notification ->
let
newModel =
if model.notification == Just notification then
{ model | notification = Maybe.map Notification.hide model.notification }
else
model
in
(newModel, Cmd.none)
Batch messages ->
model ! (List.map (Util.cmd << LocalMessage) messages)
Batch messages ->
model ! (List.map (Util.cmd << LocalMessage) messages)
NoOp ->
(model, Cmd.none)
NoOp ->
( model, Cmd.none )
handleEvent : Event -> List Message
handleEvent event =
case event of
Event.Sync lobbyAndHand ->
[ UpdateLobbyAndHand lobbyAndHand ]
case event of
Event.Sync lobbyAndHand ->
[ UpdateLobbyAndHand lobbyAndHand ]
Event.PlayerJoin player ->
[ SetNotification (Notification.playerJoin player.id)
, UpdateLobby (\lobby -> { lobby | players = lobby.players ++ [ player ] })
]
Event.PlayerStatus player status ->
let
browserNotification = case status of
Player.NotPlayed ->
[ BrowserNotificationForUser (\_ -> Just player) "You need to play a card for the round." "hourglass" ]
Player.Skipping ->
[ BrowserNotificationForUser (\_ -> Just player) "You are being skipped due to inactivity." "fast-forward" ]
_ ->
[]
in
[ updatePlayer player (\player -> { player | status = status })
] ++ browserNotification
Event.PlayerLeft player ->
[ SetNotification (Notification.playerLeft player)
, updatePlayer player (\player -> { player | left = True })
]
Event.PlayerDisconnect player ->
[ SetNotification (Notification.playerDisconnect player)
, updatePlayer player (\player -> { player | disconnected = True })
]
Event.PlayerReconnect player ->
[ SetNotification (Notification.playerReconnect player)
, updatePlayer player (\player -> { player | disconnected = False })
]
Event.PlayerScoreChange player score ->
[ updatePlayer player (\player -> { player | score = score }) ]
Event.PlayerJoin player ->
[ SetNotification (Notification.playerJoin player.id)
, UpdateLobby (\lobby -> { lobby | players = lobby.players ++ [ player ] })
]
Event.HandChange hand ->
[ UpdateHand hand ]
Event.PlayerStatus player status ->
let
browserNotification =
case status of
Player.NotPlayed ->
[ BrowserNotificationForUser (\_ -> Just player) "You need to play a card for the round." "hourglass" ]
Event.RoundStart czar call ->
[ UpdateLobby (\lobby -> { lobby | game = Game.Playing (Round czar call (Round.playing 0 False)) }) ]
Event.RoundPlayed playedCards ->
[ updateRoundState (\state -> Round.playing playedCards (Round.afterTimeLimit state)) ]
Event.RoundJudging playedCards ->
[ updateRoundState (\state -> Round.judging playedCards False)
, BrowserNotificationForUser (\lobby -> lobbyRound lobby |> Maybe.map .czar) "You need to pick a winner for the round." "gavel"
]
Event.RoundEnd finishedRound ->
[ updateRoundState (\state -> Round.F finishedRound.state)
, PlayingMessage <| Playing.LocalMessage <| Playing.FinishRound finishedRound
]
Player.Skipping ->
[ BrowserNotificationForUser (\_ -> Just player) "You are being skipped due to inactivity." "fast-forward" ]
Event.GameStart czar call ->
[ UpdateLobby (\lobby -> { lobby | game = Game.Playing (Round czar call (Round.playing 0 False)) }) ]
Event.GameEnd ->
[ UpdateLobby (\lobby -> { lobby | game = Game.Finished })
, UpdateHand { hand = [] }
]
_ ->
[]
in
[ updatePlayer player (\player -> { player | status = status })
]
++ browserNotification
Event.ConfigChange config ->
[ UpdateLobby (\lobby -> { lobby | config = config }) ]
Event.PlayerLeft player ->
[ SetNotification (Notification.playerLeft player)
, updatePlayer player (\player -> { player | left = True })
]
Event.RoundTimeLimitHit ->
[ updateRound (\round -> Round.setAfterTimeLimit round True) ]
Event.PlayerDisconnect player ->
[ SetNotification (Notification.playerDisconnect player)
, updatePlayer player (\player -> { player | disconnected = True })
]
Event.PlayerReconnect player ->
[ SetNotification (Notification.playerReconnect player)
, updatePlayer player (\player -> { player | disconnected = False })
]
Event.PlayerScoreChange player score ->
[ updatePlayer player (\player -> { player | score = score }) ]
Event.HandChange hand ->
[ UpdateHand hand ]
Event.RoundStart czar call ->
[ UpdateLobby (\lobby -> { lobby | game = Game.Playing (Round czar call (Round.playing 0 False)) }) ]
Event.RoundPlayed playedCards ->
[ updateRoundState (\state -> Round.playing playedCards (Round.afterTimeLimit state)) ]
Event.RoundJudging playedCards ->
[ updateRoundState (\state -> Round.judging playedCards False)
, BrowserNotificationForUser (\lobby -> lobbyRound lobby |> Maybe.map .czar) "You need to pick a winner for the round." "gavel"
]
Event.RoundEnd finishedRound ->
[ updateRoundState (\state -> Round.F finishedRound.state)
, PlayingMessage <| Playing.LocalMessage <| Playing.FinishRound finishedRound
]
Event.GameStart czar call ->
[ UpdateLobby (\lobby -> { lobby | game = Game.Playing (Round czar call (Round.playing 0 False)) }) ]
Event.GameEnd ->
[ UpdateLobby (\lobby -> { lobby | game = Game.Finished })
, UpdateHand { hand = [] }
]
Event.ConfigChange config ->
[ UpdateLobby (\lobby -> { lobby | config = config }) ]
Event.RoundTimeLimitHit ->
[ updateRound (\round -> Round.setAfterTimeLimit round True) ]
lobbyRound : Game.Lobby -> Maybe Round
lobbyRound lobby = case lobby.game of
Game.Playing round -> Just round
_ -> Nothing
lobbyRound lobby =
case lobby.game of
Game.Playing round ->
Just round
_ ->
Nothing
updatePlayer : Player.Id -> (Player -> Player) -> Message
updatePlayer playerId playerUpdate =
UpdateLobby (\lobby -> { lobby | players = List.map (\player -> if player.id == playerId then playerUpdate player else player) lobby.players })
UpdateLobby
(\lobby ->
{ lobby
| players =
List.map
(\player ->
if player.id == playerId then
playerUpdate player
else
player
)
lobby.players
}
)
updateRound : (Round -> Round) -> Message
updateRound roundUpdate =
UpdateLobby (\lobby ->
let
game = case lobby.game of
Game.Playing round ->
Game.Playing (roundUpdate round)
UpdateLobby
(\lobby ->
let
game =
case lobby.game of
Game.Playing round ->
Game.Playing (roundUpdate round)
other ->
other
in
{ lobby | game = game })
other ->
other
in
{ lobby | game = game }
)
updateRoundState : (Round.State -> Round.State) -> Message
updateRoundState roundStateUpdate =
updateRound (\round -> { round | state = roundStateUpdate round.state })
updateRound (\round -> { round | state = roundStateUpdate round.state })
overlayAlert : BrowserNotifications.ConsumerMessage -> ConsumerMessage
overlayAlert message =
case message of
BrowserNotifications.PermissionChanged permission ->
case permission of
BrowserNotifications.Denied ->
(Overlay.Show (Overlay "times-circle" "Can't enable desktop notifications."
[ Html.text "You did not give Massive Decks permission to give you desktop notifications." ])
) |> OverlayMessage
case message of
BrowserNotifications.PermissionChanged permission ->
case permission of
BrowserNotifications.Denied ->
(Overlay.Show
(Overlay "times-circle"
"Can't enable desktop notifications."
[ Html.text "You did not give Massive Decks permission to give you desktop notifications." ]
)
)
|> OverlayMessage
_ ->
NoOp |> LocalMessage
_ ->
NoOp |> LocalMessage
icon : Model -> String -> Maybe String
icon model name = Just (model.init.url ++ "assets/images/icons/" ++ name ++ ".png")
icon model name =
Just (model.init.url ++ "assets/images/icons/" ++ name ++ ".png")
type alias Update = Model -> (Model, Cmd ConsumerMessage)
type alias Update =
Model -> ( Model, Cmd ConsumerMessage )
updateLobbyAndHand : Game.LobbyAndHand -> Update
updateLobbyAndHand lobbyAndHand model =
{ model | lobby = lobbyAndHand.lobby
, hand = lobbyAndHand.hand} !
[ Util.cmd (Playing.LobbyAndHandUpdated |> Playing.LocalMessage |> PlayingMessage |> LocalMessage) ]
{ model
| lobby = lobbyAndHand.lobby
, hand = lobbyAndHand.hand
}
! [ Util.cmd (Playing.LobbyAndHandUpdated |> Playing.LocalMessage |> PlayingMessage |> LocalMessage) ]
{-| Handles a change to the displayed notification.
-}
notificationChange : Model -> Maybe Notification -> (Model, Cmd ConsumerMessage)
notificationChange : Model -> Maybe Notification -> ( Model, Cmd ConsumerMessage )
notificationChange model notification =
let
newNotification = notification |> Util.or model.notification
cmd = case newNotification of
Just nn ->
let
dismiss = Util.after (Time.second * 5) (Task.succeed nn)
in
Task.perform (LocalMessage << DismissNotification) dismiss
let
newNotification =
notification |> Util.or model.notification
Nothing ->
Cmd.none
in
({ model | notification = newNotification }, cmd)
cmd =
case newNotification of
Just nn ->
let
dismiss =
Util.after (Time.second * 5) (Task.succeed nn)
in
Task.perform (LocalMessage << DismissNotification) dismiss
Nothing ->
Cmd.none
in
( { model | notification = newNotification }, cmd )
client/src/MassiveDecks/Scenes/Lobby/Messages.elm
+20 -20
View File
@@ -16,28 +16,28 @@ import MassiveDecks.Components.TTS as TTS
{-| This type is used for all sending of messages, allowing us to send messages handled outside this scene.
-}
type ConsumerMessage
= ErrorMessage Errors.Message
| OverlayMessage (Overlay.Message Message)
| Leave
| LocalMessage Message
= ErrorMessage Errors.Message
| OverlayMessage (Overlay.Message Message)
| Leave
| LocalMessage Message
{-| The messages used in the start screen.
-}
type Message
= DismissNotification Notification
| SetNotification (List Player -> Maybe Notification)
| UpdateLobbyAndHand Game.LobbyAndHand
| UpdateLobby (Game.Lobby -> Game.Lobby)
| UpdateHand Card.Hand
| Identify
| DisplayInviteOverlay
| BrowserNotificationForUser (Game.Lobby -> Maybe Player.Id) String String
| RenderQr
| Batch (List Message)
| NoOp
| BrowserNotificationsMessage BrowserNotifications.Message
| ConfigMessage Config.ConsumerMessage
| PlayingMessage Playing.ConsumerMessage
| SidebarMessage Sidebar.Message
| TTSMessage TTS.Message
= DismissNotification Notification
| SetNotification (List Player -> Maybe Notification)
| UpdateLobbyAndHand Game.LobbyAndHand
| UpdateLobby (Game.Lobby -> Game.Lobby)
| UpdateHand Card.Hand
| Identify
| DisplayInviteOverlay
| BrowserNotificationForUser (Game.Lobby -> Maybe Player.Id) String String
| RenderQr
| Batch (List Message)
| NoOp
| BrowserNotificationsMessage BrowserNotifications.Message
| ConfigMessage Config.ConsumerMessage
| PlayingMessage Playing.ConsumerMessage
| SidebarMessage Sidebar.Message
| TTSMessage TTS.Message
client/src/MassiveDecks/Scenes/Lobby/Models.elm
+12 -12
View File
@@ -15,15 +15,15 @@ import MassiveDecks.Components.TTS as TTS
{-| The state of the lobby.
-}
type alias Model =
{ lobby : Game.Lobby
, hand : Card.Hand
, config : Config.Model
, playing : Playing.Model
, browserNotifications : BrowserNotifications.Model
, secret : Player.Secret
, init : Init
, notification : Maybe Notification
, qrNeedsRendering : Bool
, sidebar : Sidebar.Model
, tts : TTS.Model
}
{ lobby : Game.Lobby
, hand : Card.Hand
, config : Config.Model
, playing : Playing.Model
, browserNotifications : BrowserNotifications.Model
, secret : Player.Secret
, init : Init
, notification : Maybe Notification
, qrNeedsRendering : Bool
, sidebar : Sidebar.Model
, tts : TTS.Model
}
client/src/MassiveDecks/Scenes/Lobby/Sidebar.elm
+24 -28
View File
@@ -1,9 +1,7 @@
port module MassiveDecks.Scenes.Lobby.Sidebar exposing (Model, Message(..), init, update)
import Task
import Window
import MassiveDecks.Util as Util
@@ -13,42 +11,40 @@ lobby.
No rendering is done within this module - instead the model should be inspected and the sidebar rendered as required.
-}
type alias Model =
{ enhanceWidth : Int
, hidden : Bool
, shownAsOverlay : Bool
}
{ enhanceWidth : Int
, hidden : Bool
, shownAsOverlay : Bool
}
type Message
= Toggle
| Show Int
| Hide
= Toggle
| Show Int
| Hide
init : Int -> Model
init enhanceWidth =
{ enhanceWidth = enhanceWidth
, hidden = False
, shownAsOverlay = False
}
{ enhanceWidth = enhanceWidth
, hidden = False
, shownAsOverlay = False
}
update : Message -> Model -> (Model, Cmd Message)
update : Message -> Model -> ( Model, Cmd Message )
update message model =
case message of
Toggle ->
(model, Task.perform Show Window.width)
case message of
Toggle ->
( model, Task.perform Show Window.width )
Show screenWidth ->
if model.shownAsOverlay then
({ model | shownAsOverlay = False }, Cmd.none)
else if screenWidth > model.enhanceWidth then
({ model | hidden = not model.hidden }, Cmd.none)
else
({ model | shownAsOverlay = True }, Cmd.none)
Show screenWidth ->
if model.shownAsOverlay then
( { model | shownAsOverlay = False }, Cmd.none )
else if screenWidth > model.enhanceWidth then
( { model | hidden = not model.hidden }, Cmd.none )
else
( { model | shownAsOverlay = True }, Cmd.none )
Hide ->
({ model | shownAsOverlay = False }, Cmd.none)
Hide ->
( { model | shownAsOverlay = False }, Cmd.none )
client/src/MassiveDecks/Scenes/Lobby/UI.elm
+334 -193
View File
@@ -3,7 +3,6 @@ module MassiveDecks.Scenes.Lobby.UI exposing (view, inviteOverlay)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import MassiveDecks.Components.About as About
import MassiveDecks.Components.Errors as Errors
import MassiveDecks.Components.QR as QR
@@ -24,263 +23,405 @@ import MassiveDecks.Util as Util
view : Model -> Html ConsumerMessage
view model =
let
lobby = model.lobby
url = model.init.url
gameCode = lobby.gameCode
players = lobby.players
(header, contents) = case lobby.game of
Game.Configuring ->
([], [ Config.view model |> Html.map (ConfigMessage >> LocalMessage) ])
let
lobby =
model.lobby
Game.Playing round ->
let
(h, c) = Playing.view model round
in
(h |> List.map (Html.map (PlayingMessage >> LocalMessage)), c |> List.map (Html.map (PlayingMessage >> LocalMessage)))
url =
model.init.url
Game.Finished ->
([], [])
in
root model.sidebar.hidden
[ appHeader header model
, spacer
, scores model.secret.id model.lobby.owner model.sidebar.shownAsOverlay players
, contentWrapper contents
]
gameCode =
lobby.gameCode
players =
lobby.players
( header, contents ) =
case lobby.game of
Game.Configuring ->
( [], [ Config.view model |> Html.map (ConfigMessage >> LocalMessage) ] )
Game.Playing round ->
let
( h, c ) =
Playing.view model round
in
( h |> List.map (Html.map (PlayingMessage >> LocalMessage)), c |> List.map (Html.map (PlayingMessage >> LocalMessage)) )
Game.Finished ->
( [], [] )
in
root model.sidebar.hidden
[ appHeader header model
, spacer
, scores model.secret.id model.lobby.owner model.sidebar.shownAsOverlay players
, contentWrapper contents
]
root : Bool -> List (Html msg) -> Html msg
root hideScores contents = div [ classList [ ("content", True), ("hide-scores", hideScores) ] ] contents
root hideScores contents =
div [ classList [ ( "content", True ), ( "hide-scores", hideScores ) ] ] contents
contentWrapper : List (Html msg) -> Html msg
contentWrapper contents = div [ id "content-wrapper" ] contents
contentWrapper contents =
div [ id "content-wrapper" ] contents
spacer : Html msg
spacer = div [ class "mui--appbar-height" ] []
spacer =
div [ class "mui--appbar-height" ] []
scores : Player.Id -> Player.Id -> Bool -> List Player -> Html ConsumerMessage
scores client owner shownAsOverlay players =
let
hideMessage = LocalMessage (SidebarMessage Sidebar.Hide)
closeLink = if shownAsOverlay then
[ a [ class "link close-link"
, title "Hide."
, attribute "tabindex" "0"
, attribute "role" "button"
, onClick hideMessage
] [ Icon.icon "times" ]
]
else
[]
sidebar =
div [ id "scores", classList [ ("shownAsOverlay", shownAsOverlay), ("mui--z1", True) ] ]
[ div [ id "scores-title", class "mui--appbar-line-height mui--text-headline" ] ([ text "Players" ] ++ closeLink)
, div [ class "mui-divider" ] []
, table [ class "mui-table" ]
[ thead [] [ tr [] [ th [ class "state", title "State" ] [ Icon.icon "tasks" ]
, th [ class "name" ] [ text "Player" ]
, th [ class "score", title "Score" ] [ Icon.icon "trophy" ]
]
]
, tbody [] (List.map (score client owner) players)
]
]
in
if shownAsOverlay then
div [ id "mui-overlay"
, Util.onClickIfId "mui-overlay" hideMessage (LocalMessage NoOp)
, Util.onKeyDown "Escape" hideMessage (LocalMessage NoOp)
, tabindex 0
]
[ sidebar ]
else
sidebar
let
hideMessage =
LocalMessage (SidebarMessage Sidebar.Hide)
closeLink =
if shownAsOverlay then
[ a
[ class "link close-link"
, title "Hide."
, attribute "tabindex" "0"
, attribute "role" "button"
, onClick hideMessage
]
[ Icon.icon "times" ]
]
else
[]
sidebar =
div [ id "scores", classList [ ( "shownAsOverlay", shownAsOverlay ), ( "mui--z1", True ) ] ]
[ div [ id "scores-title", class "mui--appbar-line-height mui--text-headline" ] ([ text "Players" ] ++ closeLink)
, div [ class "mui-divider" ] []
, table [ class "mui-table" ]
[ thead []
[ tr []
[ th [ class "state", title "State" ] [ Icon.icon "tasks" ]
, th [ class "name" ] [ text "Player" ]
, th [ class "score", title "Score" ] [ Icon.icon "trophy" ]
]
]
, tbody [] (List.map (score client owner) players)
]
]
in
if shownAsOverlay then
div
[ id "mui-overlay"
, Util.onClickIfId "mui-overlay" hideMessage (LocalMessage NoOp)
, Util.onKeyDown "Escape" hideMessage (LocalMessage NoOp)
, tabindex 0
]
[ sidebar ]
else
sidebar
score : Player.Id -> Player.Id -> Player -> Html msg
score client owner player =
let
classes = classList
[ (Player.statusName player.status, True)
, ("disconnected", player.disconnected)
, ("left", player.left)
]
prename = ((if player.id == owner then [ Icon.icon "star", text " " ] else [])
++ (if player.disconnected then [ Icon.icon "minus-circle", text " " ] else []))
afterNameTitle = (if player.id == owner then " (Owner)" else "")
++ (if player.id == client then " (You)" else "")
++ (if player.disconnected then " (Disconnected)" else "")
in
tr [ classes ]
[ td [ class "state", title (statusDescription player) ] [ (playerIcon player) ]
, td [ class "name", title (player.name ++ afterNameTitle) ] (List.append prename [ text player.name ])
, td [ class "score" ] [ text (toString player.score) ]
]
let
classes =
classList
[ ( Player.statusName player.status, True )
, ( "disconnected", player.disconnected )
, ( "left", player.left )
]
prename =
((if player.id == owner then
[ Icon.icon "star", text " " ]
else
[]
)
++ (if player.disconnected then
[ Icon.icon "minus-circle", text " " ]
else
[]
)
)
afterNameTitle =
(if player.id == owner then
" (Owner)"
else
""
)
++ (if player.id == client then
" (You)"
else
""
)
++ (if player.disconnected then
" (Disconnected)"
else
""
)
in
tr [ classes ]
[ td [ class "state", title (statusDescription player) ] [ (playerIcon player) ]
, td [ class "name", title (player.name ++ afterNameTitle) ] (List.append prename [ text player.name ])
, td [ class "score" ] [ text (toString player.score) ]
]
appHeader : List (Html ConsumerMessage) -> Model -> Html ConsumerMessage
appHeader contents model = (header [] [ div [ class "mui-appbar mui--z1 mui--appbar-line-height" ]
[ div [ class "mui--appbar-line-height" ]
[ span [ class "score-buttons" ] ([ scoresButton ] ++ (notificationPopup model.notification))
, span [ id "title", class "mui--text-title mui--visible-xs-inline-block" ] contents
, gameMenu model ] ] ])
appHeader contents model =
(header []
[ div [ class "mui-appbar mui--z1 mui--appbar-line-height" ]
[ div [ class "mui--appbar-line-height" ]
[ span [ class "score-buttons" ] ([ scoresButton ] ++ (notificationPopup model.notification))
, span [ id "title", class "mui--text-title mui--visible-xs-inline-block" ] contents
, gameMenu model
]
]
]
)
scoresButton : Html ConsumerMessage
scoresButton =
button [ class ("scores-toggle mui-btn mui-btn--small mui-btn--primary badged")
, title "Players."
, onClick (LocalMessage (SidebarMessage Sidebar.Toggle))
]
[ Icon.fwIcon "users" ]
button
[ class ("scores-toggle mui-btn mui-btn--small mui-btn--primary badged")
, title "Players."
, onClick (LocalMessage (SidebarMessage Sidebar.Toggle))
]
[ Icon.fwIcon "users" ]
notificationPopup : Maybe Notification -> List (Html ConsumerMessage)
notificationPopup notification =
case notification of
Just notification ->
let
hidden = if notification.visible then "" else "hide"
in
[ div [ class ("badge mui--z2 " ++ hidden)
, title notification.description
, onClick (LocalMessage (DismissNotification notification))
]
[ Icon.icon notification.icon, text (" " ++ notification.name) ]
]
Nothing ->
[ div [ class ("badge mui--z2 hide") ] [] ]
case notification of
Just notification ->
let
hidden =
if notification.visible then
""
else
"hide"
in
[ div
[ class ("badge mui--z2 " ++ hidden)
, title notification.description
, onClick (LocalMessage (DismissNotification notification))
]
[ Icon.icon notification.icon, text (" " ++ notification.name) ]
]
Nothing ->
[ div [ class ("badge mui--z2 hide") ] [] ]
statusDescription : Player -> String
statusDescription player = case player.status of
NotPlayed -> "Choosing"
Played -> "Played"
Czar -> "Round Czar"
Ai -> "A Computer"
Neutral -> ""
Skipping -> "Being Skipped"
statusDescription player =
case player.status of
NotPlayed ->
"Choosing"
Played ->
"Played"
Czar ->
"Round Czar"
Ai ->
"A Computer"
Neutral ->
""
Skipping ->
"Being Skipped"
statusIcon : Status -> Html msg
statusIcon status = Maybe.map Icon.fwIcon (statusIconName status) |> Maybe.withDefault (text "")
statusIcon status =
Maybe.map Icon.fwIcon (statusIconName status) |> Maybe.withDefault (text "")
statusIconName : Status -> Maybe String
statusIconName status = case status of
NotPlayed -> Just "hourglass"
Played -> Just "check"
Czar -> Just "gavel"
Ai -> Just "cogs"
Neutral -> Nothing
Skipping -> Just "fast-forward"
statusIconName status =
case status of
NotPlayed ->
Just "hourglass"
Played ->
Just "check"
Czar ->
Just "gavel"
Ai ->
Just "cogs"
Neutral ->
Nothing
Skipping ->
Just "fast-forward"
playerIcon : Player -> Html msg
playerIcon player =
if player.left then
Icon.icon "sign-out"
else
statusIcon player.status
if player.left then
Icon.icon "sign-out"
else
statusIcon player.status
{-| The overlay for inviting players to a lobby.
-}
inviteOverlay : String -> String -> Overlay.Message msg
inviteOverlay appUrl gameCode =
let
url = Util.lobbyUrl appUrl gameCode
contents =
[ p [] [ text "To invite other players, simply send them this link: " ]
, p [] [ a [ href url ] [ text url ] ]
, p [] [ text "Have them scan this QR code: " ]
, QR.view "invite-qr-code"
, p [] [ text "Or give them this game code to enter on the start page: " ]
, p [] [ input [ readonly True, value gameCode ] [] ]
]
in
Overlay.Show
{ icon = "bullhorn"
, title = "Invite Players"
, contents = contents
}
let
url =
Util.lobbyUrl appUrl gameCode
contents =
[ p [] [ text "To invite other players, simply send them this link: " ]
, p [] [ a [ href url ] [ text url ] ]
, p [] [ text "Have them scan this QR code: " ]
, QR.view "invite-qr-code"
, p [] [ text "Or give them this game code to enter on the start page: " ]
, p [] [ input [ readonly True, value gameCode ] [] ]
]
in
Overlay.Show
{ icon = "bullhorn"
, title = "Invite Players"
, contents = contents
}
notificationsMenuItem : BrowserNotifications.Model -> List (Html ConsumerMessage)
notificationsMenuItem model =
let
(notClickable, enabled) =
if not model.supported then
(Just "Your browser does not support desktop notifications.", False)
else if model.permission == Just BrowserNotifications.Denied then
(Just "You have denied Massive Decks permission to display desktop notifications.", False)
else
(Nothing, model.enabled)
let
( notClickable, enabled ) =
if not model.supported then
( Just "Your browser does not support desktop notifications.", False )
else if model.permission == Just BrowserNotifications.Denied then
( Just "You have denied Massive Decks permission to display desktop notifications.", False )
else
( Nothing, model.enabled )
classes = classList
[ ("link", True)
, ("disabled", not (Util.isNothing notClickable))
]
classes =
classList
[ ( "link", True )
, ( "disabled", not (Util.isNothing notClickable) )
]
extraAttrs =
case notClickable of
Nothing ->
[ onClick (LocalMessage <| BrowserNotificationsMessage <| (if enabled then BrowserNotifications.disable else BrowserNotifications.enable)) ]
Just msg ->
[ title msg ]
extraAttrs =
case notClickable of
Nothing ->
[ onClick
(LocalMessage <|
BrowserNotificationsMessage <|
(if enabled then
BrowserNotifications.disable
else
BrowserNotifications.enable
)
)
]
attributes = [ classes, attribute "tabindex" "0", attribute "role" "button" ] ++ extraAttrs
Just msg ->
[ title msg ]
description = " " ++ (if enabled then "Disable" else "Enable") ++ " Notifications"
in
[ li [] [ a attributes [ Icon.fwIcon (if enabled then "bell-slash" else "bell"), text description ] ]
]
attributes =
[ classes, attribute "tabindex" "0", attribute "role" "button" ] ++ extraAttrs
description =
" "
++ (if enabled then
"Disable"
else
"Enable"
)
++ " Notifications"
in
[ li []
[ a attributes
[ Icon.fwIcon
(if enabled then
"bell-slash"
else
"bell"
)
, text description
]
]
]
{-| The menu for the game.
-}
gameMenu : Model -> Html ConsumerMessage
gameMenu model =
let
url = (Errors.reportUrl { url = model.init.url, version = model.init.version }
"I was [a short explanation of what you were doing] when [a short explanation of the bug].")
in
div [ class "menu mui-dropdown" ]
[ button [ class "mui-btn mui-btn--small mui-btn--primary"
, attribute "data-mui-toggle" "dropdown"
, title "Game menu."
] [ Icon.fwIcon "ellipsis-h" ]
, ul [ class "mui-dropdown__menu mui-dropdown__menu--right" ]
([ li [] [ a [ class "link"
let
url =
(Errors.reportUrl { url = model.init.url, version = model.init.version }
"I was [a short explanation of what you were doing] when [a short explanation of the bug]."
)
in
div [ class "menu mui-dropdown" ]
[ button
[ class "mui-btn mui-btn--small mui-btn--primary"
, attribute "data-mui-toggle" "dropdown"
, title "Game menu."
]
[ Icon.fwIcon "ellipsis-h" ]
, ul [ class "mui-dropdown__menu mui-dropdown__menu--right" ]
([ li []
[ a
[ class "link"
, attribute "tabindex" "0"
, attribute "role" "button"
, onClick (DisplayInviteOverlay |> LocalMessage)
] [ Icon.fwIcon "bullhorn", text " Invite Players" ] ]
] ++ (notificationsMenuItem model.browserNotifications) ++
[ li [] [ a [ class "link"
, attribute "tabindex" "0"
, attribute "role" "button"
, onClick (TTS.Enabled (not model.tts.enabled) |> TTSMessage |> LocalMessage)
]
(if model.tts.enabled then [ Icon.fwIcon "volume-off", text " Disable Speech" ]
else [ Icon.fwIcon "volume-up", text " Enable Speech" ])
[ Icon.fwIcon "bullhorn", text " Invite Players" ]
]
, li [] [ a [ class "link"
, attribute "tabindex" "0"
, attribute "role" "button"
, onClick Leave
] [ Icon.fwIcon "sign-out", text " Leave Game" ] ]
, li [ class "mui-divider" ] []
, li [] [ a [ class "link"
, attribute "tabindex" "0"
, attribute "role" "button"
, onClick (About.show model.init.version |> OverlayMessage)
] [ Icon.fwIcon "info-circle", text " About" ] ]
, li [] [ a [ href url, target "_blank", rel "noopener" ]
[ Icon.fwIcon "bug", text " Report a bug" ] ]
])
]
]
++ (notificationsMenuItem model.browserNotifications)
++ [ li []
[ a
[ class "link"
, attribute "tabindex" "0"
, attribute "role" "button"
, onClick (TTS.Enabled (not model.tts.enabled) |> TTSMessage |> LocalMessage)
]
(if model.tts.enabled then
[ Icon.fwIcon "volume-off", text " Disable Speech" ]
else
[ Icon.fwIcon "volume-up", text " Enable Speech" ]
)
]
, li []
[ a
[ class "link"
, attribute "tabindex" "0"
, attribute "role" "button"
, onClick Leave
]
[ Icon.fwIcon "sign-out", text " Leave Game" ]
]
, li [ class "mui-divider" ] []
, li []
[ a
[ class "link"
, attribute "tabindex" "0"
, attribute "role" "button"
, onClick (About.show model.init.version |> OverlayMessage)
]
[ Icon.fwIcon "info-circle", text " About" ]
]
, li []
[ a [ href url, target "_blank", rel "noopener" ]
[ Icon.fwIcon "bug", text " Report a bug" ]
]
]
)
]
client/src/MassiveDecks/Scenes/Playing.elm
+236 -183
View File
@@ -2,11 +2,8 @@ module MassiveDecks.Scenes.Playing exposing (update, view, init, subscriptions)
import Random
import String
import Html exposing (..)
import AnimationFrame
import MassiveDecks.API as API
import MassiveDecks.API.Request as Request
import MassiveDecks.Models exposing (Init)
@@ -31,258 +28,314 @@ import MassiveDecks.Util as Util
-}
init : Init -> Model
init init =
{ picked = []
, considering = Nothing
, finishedRound = Nothing
, shownPlayed = { animated = [], toAnimate = [] }
, seed = Random.initialSeed (hack init.seed)
, history = Nothing
}
{ picked = []
, considering = Nothing
, finishedRound = Nothing
, shownPlayed = { animated = [], toAnimate = [] }
, seed = Random.initialSeed (hack init.seed)
, history = Nothing
}
houseRule : HouseRule.Id -> HouseRule
houseRule id =
case id of
HouseRule.Reboot -> Reboot.rule
case id of
HouseRule.Reboot ->
Reboot.rule
{-| We shouldn't need to do this!
int flags blow up at the moment. For now, we pass a string, but we should take an int from JS in the future.
-}
hack : String -> Int
hack seed = String.toInt seed |> Result.withDefault 0
hack seed =
String.toInt seed |> Result.withDefault 0
{-| Subscriptions for the playing scene.
-}
subscriptions : Model -> Sub ConsumerMessage
subscriptions model =
if List.isEmpty model.shownPlayed.toAnimate then
Sub.none
else
AnimationFrame.diffs (\_ -> LocalMessage AnimatePlayedCards)
if List.isEmpty model.shownPlayed.toAnimate then
Sub.none
else
AnimationFrame.diffs (\_ -> LocalMessage AnimatePlayedCards)
{-| Render the playing scene.
-}
view : Lobby.Model -> Round -> (List (Html ConsumerMessage), List (Html ConsumerMessage))
view : Lobby.Model -> Round -> ( List (Html ConsumerMessage), List (Html ConsumerMessage) )
view model round =
let
(header, content) = UI.view model round
in
(header |> List.map (Html.map LocalMessage), content |> List.map (Html.map LocalMessage))
let
( header, content ) =
UI.view model round
in
( header |> List.map (Html.map LocalMessage), content |> List.map (Html.map LocalMessage) )
{-| Handles messages and alters the model as appropriate.
-}
update : Message -> Lobby.Model -> Round -> (Model, Cmd ConsumerMessage)
update : Message -> Lobby.Model -> Round -> ( Model, Cmd ConsumerMessage )
update message lobbyModel round =
let
model = lobbyModel.playing
lobby = lobbyModel.lobby
secret = lobbyModel.secret
gameCode = lobby.gameCode
in
case message of
Pick cardId ->
let
slots = Card.slots round.call
canPlay = (List.length model.picked) < slots
playing = case round.state of
Round.P _ -> True
_ -> False
in
if playing && canPlay then
({ model | picked = model.picked ++ [ cardId ] }, Cmd.none)
else
(model, Cmd.none)
let
model =
lobbyModel.playing
Withdraw cardId ->
({ model | picked = List.filter ((/=) cardId) model.picked }, Cmd.none)
lobby =
lobbyModel.lobby
Play ->
( { model | picked = [] }
, Request.send (API.play gameCode secret model.picked) playErrorHandler ErrorMessage HandUpdate
)
secret =
lobbyModel.secret
Consider potentialWinnerIndex ->
let
speech = (case round.state of
Round.J judging ->
Util.get judging.responses potentialWinnerIndex |> Maybe.map (\fill -> (round, fill))
_ ->
Nothing)
|> Maybe.map (\(round, callFill) -> TTS.Say (CardsUI.callText round.call callFill) |> TTSMessage |> Util.cmd)
|> Maybe.withDefault Cmd.none
in
( { model | considering = Just potentialWinnerIndex }
, speech
)
Choose winnerIndex ->
( { model | considering = Nothing }
, Request.send (API.choose gameCode secret winnerIndex) chooseErrorHandler ErrorMessage ignore
)
NextRound ->
( { model | considering = Nothing
, finishedRound = Nothing
}
, Cmd.none
)
AnimatePlayedCards ->
let
(shownPlayed, seed) = updatePositioning model.shownPlayed model.seed
in
( { model | seed = seed
, shownPlayed = shownPlayed
}
, Cmd.none
)
Skip playerIds ->
(model, Request.send (API.skip gameCode secret playerIds) skipErrorHandler ErrorMessage ignore)
Back ->
(model, Request.send_ (API.back gameCode secret) ErrorMessage ignore)
LobbyAndHandUpdated ->
lobbyAndHandUpdated lobbyModel round
Redraw ->
(model, Request.send (API.redraw lobbyModel.lobby.gameCode lobbyModel.secret) redrawErrorHandler ErrorMessage HandUpdate)
FinishRound finishedRound ->
let
cards = finishedRound.state.responses
winning = Card.winningCards cards finishedRound.state.playedByAndWinner |> Maybe.withDefault []
speech = Card.filled finishedRound.call winning
in
({ model | finishedRound = Just finishedRound}, TTS.Say speech |> TTSMessage |> Util.cmd)
HistoryMessage historyMessage ->
case model.history of
Just history ->
case historyMessage of
History.ErrorMessage errorMessage ->
(model, ErrorMessage errorMessage |> Util.cmd)
History.Close ->
({ model | history = Nothing }, Cmd.none)
History.LocalMessage localMessage ->
gameCode =
lobby.gameCode
in
case message of
Pick cardId ->
let
(newHistory, cmd) = History.update localMessage history
slots =
Card.slots round.call
canPlay =
(List.length model.picked) < slots
playing =
case round.state of
Round.P _ ->
True
_ ->
False
in
({ model | history = Just newHistory }, Cmd.map (LocalMessage << HistoryMessage) cmd)
if playing && canPlay then
( { model | picked = model.picked ++ [ cardId ] }, Cmd.none )
else
( model, Cmd.none )
Nothing ->
(model, Cmd.none)
Withdraw cardId ->
( { model | picked = List.filter ((/=) cardId) model.picked }, Cmd.none )
ViewHistory ->
let
(historyModel, command) = History.init lobbyModel.lobby.gameCode
in
({ model | history = Just historyModel }, Cmd.map (LocalMessage << HistoryMessage) command)
Play ->
( { model | picked = [] }
, Request.send (API.play gameCode secret model.picked) playErrorHandler ErrorMessage HandUpdate
)
NoOp ->
(model, Cmd.none)
Consider potentialWinnerIndex ->
let
speech =
(case round.state of
Round.J judging ->
Util.get judging.responses potentialWinnerIndex |> Maybe.map (\fill -> ( round, fill ))
_ ->
Nothing
)
|> Maybe.map (\( round, callFill ) -> TTS.Say (CardsUI.callText round.call callFill) |> TTSMessage |> Util.cmd)
|> Maybe.withDefault Cmd.none
in
( { model | considering = Just potentialWinnerIndex }
, speech
)
Choose winnerIndex ->
( { model | considering = Nothing }
, Request.send (API.choose gameCode secret winnerIndex) chooseErrorHandler ErrorMessage ignore
)
NextRound ->
( { model
| considering = Nothing
, finishedRound = Nothing
}
, Cmd.none
)
AnimatePlayedCards ->
let
( shownPlayed, seed ) =
updatePositioning model.shownPlayed model.seed
in
( { model
| seed = seed
, shownPlayed = shownPlayed
}
, Cmd.none
)
Skip playerIds ->
( model, Request.send (API.skip gameCode secret playerIds) skipErrorHandler ErrorMessage ignore )
Back ->
( model, Request.send_ (API.back gameCode secret) ErrorMessage ignore )
LobbyAndHandUpdated ->
lobbyAndHandUpdated lobbyModel round
Redraw ->
( model, Request.send (API.redraw lobbyModel.lobby.gameCode lobbyModel.secret) redrawErrorHandler ErrorMessage HandUpdate )
FinishRound finishedRound ->
let
cards =
finishedRound.state.responses
winning =
Card.winningCards cards finishedRound.state.playedByAndWinner |> Maybe.withDefault []
speech =
Card.filled finishedRound.call winning
in
( { model | finishedRound = Just finishedRound }, TTS.Say speech |> TTSMessage |> Util.cmd )
HistoryMessage historyMessage ->
case model.history of
Just history ->
case historyMessage of
History.ErrorMessage errorMessage ->
( model, ErrorMessage errorMessage |> Util.cmd )
History.Close ->
( { model | history = Nothing }, Cmd.none )
History.LocalMessage localMessage ->
let
( newHistory, cmd ) =
History.update localMessage history
in
( { model | history = Just newHistory }, Cmd.map (LocalMessage << HistoryMessage) cmd )
Nothing ->
( model, Cmd.none )
ViewHistory ->
let
( historyModel, command ) =
History.init lobbyModel.lobby.gameCode
in
( { model | history = Just historyModel }, Cmd.map (LocalMessage << HistoryMessage) command )
NoOp ->
( model, Cmd.none )
ignore : () -> ConsumerMessage
ignore = (\_ -> LocalMessage NoOp)
ignore =
(\_ -> LocalMessage NoOp)
lobbyAndHandUpdated : Lobby.Model -> Round -> (Model, Cmd ConsumerMessage)
lobbyAndHandUpdated : Lobby.Model -> Round -> ( Model, Cmd ConsumerMessage )
lobbyAndHandUpdated lobbyModel round =
let
lobby = lobbyModel.lobby
model = lobbyModel.playing
shownPlayed = model.shownPlayed
playedCards = case round.state of
Round.P playing -> Just playing.numberPlayed
_ -> Nothing
(newShownPlayed, seed) = case playedCards of
Just amount ->
let
toShow = amount * (Card.slots round.call)
existing = (List.length shownPlayed.animated) + (List.length shownPlayed.toAnimate)
(new, seed) = addShownPlayed (toShow - existing) model.seed
in
(ShownPlayedCards shownPlayed.animated (shownPlayed.toAnimate ++ new), seed)
let
lobby =
lobbyModel.lobby
Nothing ->
(ShownPlayedCards [] [], model.seed)
model =
lobbyModel.playing
newModel = { model | shownPlayed = newShownPlayed
, seed = seed}
in
(newModel, Cmd.none)
shownPlayed =
model.shownPlayed
playedCards =
case round.state of
Round.P playing ->
Just playing.numberPlayed
_ ->
Nothing
( newShownPlayed, seed ) =
case playedCards of
Just amount ->
let
toShow =
amount * (Card.slots round.call)
existing =
(List.length shownPlayed.animated) + (List.length shownPlayed.toAnimate)
( new, seed ) =
addShownPlayed (toShow - existing) model.seed
in
( ShownPlayedCards shownPlayed.animated (shownPlayed.toAnimate ++ new), seed )
Nothing ->
( ShownPlayedCards [] [], model.seed )
newModel =
{ model
| shownPlayed = newShownPlayed
, seed = seed
}
in
( newModel, Cmd.none )
redrawErrorHandler : API.RedrawError -> ConsumerMessage
redrawErrorHandler error =
case error of
API.NotEnoughPoints -> ErrorMessage <| Errors.New "You do not have enough points to redraw your hand." False
case error of
API.NotEnoughPoints ->
ErrorMessage <| Errors.New "You do not have enough points to redraw your hand." False
chooseErrorHandler : API.ChooseError -> ConsumerMessage
chooseErrorHandler error =
case error of
API.NotCzar -> ErrorMessage <| Errors.New "You can't pick a winner as you are not the card czar this round." False
case error of
API.NotCzar ->
ErrorMessage <| Errors.New "You can't pick a winner as you are not the card czar this round." False
playErrorHandler : API.PlayError -> ConsumerMessage
playErrorHandler error =
case error of
API.NotInRound ->
ErrorMessage <| Errors.New "You can't play as you are not in this round." False
case error of
API.NotInRound ->
ErrorMessage <| Errors.New "You can't play as you are not in this round." False
API.AlreadyPlayed ->
ErrorMessage <| Errors.New "You can't play as you have already played in this round." False
API.AlreadyPlayed ->
ErrorMessage <| Errors.New "You can't play as you have already played in this round." False
API.AlreadyJudging ->
ErrorMessage <| Errors.New "You can't play as the round is already in it's judging phase." False
API.AlreadyJudging ->
ErrorMessage <| Errors.New "You can't play as the round is already in it's judging phase." False
API.WrongNumberOfCards got expected ->
ErrorMessage <| Errors.New ("You played the wrong number of cards - you played " ++ (toString got) ++ " cards, but the call needs " ++ (toString expected) ++ "cards.") False
API.WrongNumberOfCards got expected ->
ErrorMessage <| Errors.New ("You played the wrong number of cards - you played " ++ (toString got) ++ " cards, but the call needs " ++ (toString expected) ++ "cards.") False
skipErrorHandler : API.SkipError -> ConsumerMessage
skipErrorHandler error =
case error of
API.NotEnoughPlayersToSkip required ->
ErrorMessage <| Errors.New ("There are not enough players in the game to skip (must have at least " ++ (toString required) ++ ").") False
case error of
API.NotEnoughPlayersToSkip required ->
ErrorMessage <| Errors.New ("There are not enough players in the game to skip (must have at least " ++ (toString required) ++ ").") False
API.PlayersNotSkippable ->
ErrorMessage <| Errors.New "The players can't be skipped as they are not inactive." False
API.PlayersNotSkippable ->
ErrorMessage <| Errors.New "The players can't be skipped as they are not inactive." False
addShownPlayed : Int -> Random.Seed -> (List ShownCard, Random.Seed)
addShownPlayed new seed = Random.step (Random.list new initialRandomPositioning) seed
addShownPlayed : Int -> Random.Seed -> ( List ShownCard, Random.Seed )
addShownPlayed new seed =
Random.step (Random.list new initialRandomPositioning) seed
updatePositioning : ShownPlayedCards -> Random.Seed -> (ShownPlayedCards, Random.Seed)
updatePositioning : ShownPlayedCards -> Random.Seed -> ( ShownPlayedCards, Random.Seed )
updatePositioning shownPlayed seed =
let
(newAnimated, newSeed) = Random.step (Random.list (List.length shownPlayed.toAnimate) randomPositioning) seed
in
(ShownPlayedCards (shownPlayed.animated ++ newAnimated) [], newSeed)
let
( newAnimated, newSeed ) =
Random.step (Random.list (List.length shownPlayed.toAnimate) randomPositioning) seed
in
( ShownPlayedCards (shownPlayed.animated ++ newAnimated) [], newSeed )
initialRandomPositioning : Random.Generator ShownCard
initialRandomPositioning =
Random.map3 (\r h l -> ShownCard r h l -100)
(Random.int -75 75)
(Random.int 0 50)
Random.bool
Random.map3 (\r h l -> ShownCard r h l -100)
(Random.int -75 75)
(Random.int 0 50)
Random.bool
randomPositioning : Random.Generator ShownCard
randomPositioning =
Random.map4 ShownCard
(Random.int -90 90)
(Random.int 25 50)
Random.bool
(Random.int -5 1)
Random.map4 ShownCard
(Random.int -90 90)
(Random.int 25 50)
Random.bool
(Random.int -5 1)
client/src/MassiveDecks/Scenes/Playing/HouseRule.elm
+12 -12
View File
@@ -6,18 +6,18 @@ import MassiveDecks.Scenes.Lobby.Models as Lobby
type alias HouseRule =
{ id : Id
, icon : String
, name : String
, description : String
, actions : List Action
}
{ id : Id
, icon : String
, name : String
, description : String
, actions : List Action
}
type alias Action =
{ icon : String
, text : String
, description : String
, onClick : Playing.Message
, enabled : Lobby.Model -> Bool
}
{ icon : String
, text : String
, description : String
, onClick : Playing.Message
, enabled : Lobby.Model -> Bool
}
client/src/MassiveDecks/Scenes/Playing/HouseRule/Available.elm
+2 -1
View File
@@ -5,4 +5,5 @@ import MassiveDecks.Scenes.Playing.HouseRule.Reboot as Reboot
houseRules : List HouseRule
houseRules = [ Reboot.rule ]
houseRules =
[ Reboot.rule ]
client/src/MassiveDecks/Scenes/Playing/HouseRule/Id.elm
+4 -3
View File
@@ -2,10 +2,11 @@ module MassiveDecks.Scenes.Playing.HouseRule.Id exposing (Id(..), toString)
type Id
= Reboot
= Reboot
toString : Id -> String
toString id =
case id of
Reboot -> "reboot"
case id of
Reboot ->
"reboot"
client/src/MassiveDecks/Scenes/Playing/HouseRule/Reboot.elm
+15 -15
View File
@@ -9,26 +9,26 @@ import MassiveDecks.Scenes.Lobby.Models as Lobby
rule : HouseRule
rule =
{ id = HouseRule.Reboot
, icon = "recycle"
, name = "Rebooting the Universe"
, description = "At any time, players may trade in a point to discard their hand and redraw."
, actions = [ rebootAction ]
}
{ id = HouseRule.Reboot
, icon = "recycle"
, name = "Rebooting the Universe"
, description = "At any time, players may trade in a point to discard their hand and redraw."
, actions = [ rebootAction ]
}
rebootAction : HouseRule.Action
rebootAction =
{ icon = "recycle"
, text = "Redraw"
, description = "Lose one point to discard your hand and draw a new one."
, onClick = Playing.Redraw
, enabled = checkEnabled
}
{ icon = "recycle"
, text = "Redraw"
, description = "Lose one point to discard your hand and draw a new one."
, onClick = Playing.Redraw
, enabled = checkEnabled
}
checkEnabled : Lobby.Model -> Bool
checkEnabled lobbyModel =
Player.byId lobbyModel.secret.id lobbyModel.lobby.players
|> Maybe.map (\player -> player.score > 0)
|> Maybe.withDefault False
Player.byId lobbyModel.secret.id lobbyModel.lobby.players
|> Maybe.map (\player -> player.score > 0)
|> Maybe.withDefault False
client/src/MassiveDecks/Scenes/Playing/Messages.elm
+19 -19
View File
@@ -11,27 +11,27 @@ import MassiveDecks.Models.Card as Card
{-| This type is used for all sending of messages, allowing us to send messages handled outside this scene.
-}
type ConsumerMessage
= HandUpdate Card.Hand
| TTSMessage TTS.Message
| ErrorMessage Errors.Message
| LocalMessage Message
= HandUpdate Card.Hand
| TTSMessage TTS.Message
| ErrorMessage Errors.Message
| LocalMessage Message
{-| The messages used in the start screen.
-}
type Message
= LobbyAndHandUpdated
| Pick String
| Withdraw String
| Play
| Consider Int
| Choose Int
| NextRound
| AnimatePlayedCards
| Skip (List Player.Id)
| Back
| Redraw
| FinishRound Round.FinishedRound
| ViewHistory
| HistoryMessage History.ConsumerMessage
| NoOp
= LobbyAndHandUpdated
| Pick String
| Withdraw String
| Play
| Consider Int
| Choose Int
| NextRound
| AnimatePlayedCards
| Skip (List Player.Id)
| Back
| Redraw
| FinishRound Round.FinishedRound
| ViewHistory
| HistoryMessage History.ConsumerMessage
| NoOp
client/src/MassiveDecks/Scenes/Playing/Models.elm
+15 -16
View File
@@ -1,7 +1,6 @@
module MassiveDecks.Scenes.Playing.Models exposing (Model, ShownPlayedCards, ShownCard)
import Random
import MassiveDecks.Models.Game.Round as Round
import MassiveDecks.Scenes.History.Models as History
@@ -9,24 +8,24 @@ import MassiveDecks.Scenes.History.Models as History
{-| The state of the lobby.
-}
type alias Model =
{ picked : List String
, considering : Maybe Int
, finishedRound : Maybe Round.FinishedRound
, shownPlayed : ShownPlayedCards
, seed : Random.Seed
, history : Maybe History.Model
}
{ picked : List String
, considering : Maybe Int
, finishedRound : Maybe Round.FinishedRound
, shownPlayed : ShownPlayedCards
, seed : Random.Seed
, history : Maybe History.Model
}
type alias ShownPlayedCards =
{ animated : List (ShownCard)
, toAnimate : List (ShownCard)
}
{ animated : List ShownCard
, toAnimate : List ShownCard
}
type alias ShownCard =
{ rotation : Int
, horizontalPos : Int
, isLeft : Bool
, verticalPos : Int
}
{ rotation : Int
, horizontalPos : Int
, isLeft : Bool
, verticalPos : Int
}
client/src/MassiveDecks/Scenes/Playing/UI.elm
+457 -311
View File
@@ -4,7 +4,6 @@ import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Html.Keyed as Keyed
import MassiveDecks.Components.Icon as Icon
import MassiveDecks.Models.Game as Game
import MassiveDecks.Models.Game.Round as Round exposing (Round)
@@ -20,449 +19,596 @@ import MassiveDecks.Scenes.Playing.HouseRule.Available exposing (houseRules)
import MassiveDecks.Util as Util
view : Lobby.Model -> Round -> (List (Html Message), List (Html Message))
view : Lobby.Model -> Round -> ( List (Html Message), List (Html Message) )
view lobbyModel round =
let
model = lobbyModel.playing
lobby = lobbyModel.lobby
let
model =
lobbyModel.playing
(header, content) = case model.finishedRound of
Just round ->
winnerHeaderAndContents round lobby.players
lobby =
lobbyModel.lobby
Nothing ->
([ Icon.icon "gavel", text (" " ++ (czarName lobby.players round.czar)) ], roundContents lobbyModel round)
( header, content ) =
case model.finishedRound of
Just round ->
winnerHeaderAndContents round lobby.players
timedOut = Round.afterTimeLimit round.state
judging = case round.state of
Round.J _ -> True
_ -> False
in
case model.history of
Nothing ->
(header, List.concat [ infoBar lobby lobbyModel.secret
, content
, [ warningDrawer (List.concat [ skippingNotice lobby.players lobbyModel.secret.id
, timeoutNotice lobbyModel.secret.id lobby.players judging timedOut
, disconnectedNotice lobby.players
])
]
])
Just history ->
([], [ History.view history lobbyModel.lobby.players |> Html.map HistoryMessage ])
Nothing ->
( [ Icon.icon "gavel", text (" " ++ (czarName lobby.players round.czar)) ], roundContents lobbyModel round )
timedOut =
Round.afterTimeLimit round.state
judging =
case round.state of
Round.J _ ->
True
_ ->
False
in
case model.history of
Nothing ->
( header
, List.concat
[ infoBar lobby lobbyModel.secret
, content
, [ warningDrawer
(List.concat
[ skippingNotice lobby.players lobbyModel.secret.id
, timeoutNotice lobbyModel.secret.id lobby.players judging timedOut
, disconnectedNotice lobby.players
]
)
]
]
)
Just history ->
( [], [ History.view history lobbyModel.lobby.players |> Html.map HistoryMessage ] )
gameMenu : Lobby.Model -> Html Message
gameMenu lobbyModel =
let
enabled = List.filter (\rule -> List.member rule.id lobbyModel.lobby.config.houseRules) houseRules
in
div [ class "action-menu mui-dropdown"]
[ button [ class "mui-btn mui-btn--small mui-btn--fab"
, title "Game actions."
, attribute "data-mui-toggle" "dropdown"
let
enabled =
List.filter (\rule -> List.member rule.id lobbyModel.lobby.config.houseRules) houseRules
in
div [ class "action-menu mui-dropdown" ]
[ button
[ class "mui-btn mui-btn--small mui-btn--fab"
, title "Game actions."
, attribute "data-mui-toggle" "dropdown"
]
[ Icon.icon "bars" ]
, ul [ class "mui-dropdown__menu mui-dropdown__menu--right" ]
([ li []
[ a
[ classList [ ( "link", True ) ]
, title "View previous rounds from the game."
, attribute "tabindex" "0"
, attribute "role" "button"
, onClick ViewHistory
]
[ Icon.fwIcon "history", text " ", text "Game History" ]
]
]
[ Icon.icon "bars" ]
, ul [ class "mui-dropdown__menu mui-dropdown__menu--right" ]
( [ li [] [ a [ classList [ ("link", True) ]
, title "View previous rounds from the game."
, attribute "tabindex" "0"
, attribute "role" "button"
, onClick ViewHistory
]
[ Icon.fwIcon "history", text " ", text "Game History" ]
]
] ++ (List.concatMap (gameMenuItems lobbyModel) enabled)
)
]
++ (List.concatMap (gameMenuItems lobbyModel) enabled)
)
]
gameMenuItems : Lobby.Model -> HouseRule -> List (Html Message)
gameMenuItems lobbyModel rule = List.map (gameMenuItem lobbyModel rule) rule.actions
gameMenuItems lobbyModel rule =
List.map (gameMenuItem lobbyModel rule) rule.actions
gameMenuItem : Lobby.Model -> HouseRule -> HouseRule.Action -> Html Message
gameMenuItem lobbyModel rule action =
let
enabled = action.enabled lobbyModel
message = if enabled then action.onClick else NoOp
in
li [] [ a [ classList [ ("link", True), ("disabled", not enabled) ]
, title action.description
, attribute "tabindex" "0"
, attribute "role" "button"
, onClick message
]
[ Icon.fwIcon action.icon, text " ", text action.text ]
]
let
enabled =
action.enabled lobbyModel
message =
if enabled then
action.onClick
else
NoOp
in
li []
[ a
[ classList [ ( "link", True ), ( "disabled", not enabled ) ]
, title action.description
, attribute "tabindex" "0"
, attribute "role" "button"
, onClick message
]
[ Icon.fwIcon action.icon, text " ", text action.text ]
]
roundContents : Lobby.Model -> Round -> List (Html Message)
roundContents lobbyModel round =
let
lobby = lobbyModel.lobby
hand = lobbyModel.hand.hand
model = lobbyModel.playing
picked = getAllById model.picked hand
id = lobbyModel.secret.id
isCzar = round.czar == id
canPlay = List.filter (\player -> player.id == id) lobby.players
|> List.all (\player -> player.status == Player.NotPlayed)
let
lobby =
lobbyModel.lobby
callFill = case round.state of
Round.P _ -> picked
Round.J judging -> Maybe.withDefault [] (model.considering |> Maybe.andThen (Util.get judging.responses))
Round.F _ -> []
hand =
lobbyModel.hand.hand
pickedOrChosen = case round.state of
Round.P _ ->
pickedView picked (Card.slots round.call) (model.shownPlayed.animated ++ model.shownPlayed.toAnimate)
model =
lobbyModel.playing
Round.J judging ->
case model.considering of
Just considering ->
case Util.get judging.responses considering of
Just consideringCards -> [ consideringView considering consideringCards isCzar ]
Nothing -> []
Nothing -> []
picked =
getAllById model.picked hand
Round.F _ ->
[]
id =
lobbyModel.secret.id
playedOrHand = case round.state of
Round.P _ -> handView model.picked (not canPlay) hand
Round.J judging -> playedView isCzar judging.responses
Round.F _ -> div [] []
in
[ playArea
([ div [ class "round-area" ] (List.concat [ [ CardsUI.call round.call callFill ], pickedOrChosen ])
, playedOrHand
, gameMenu lobbyModel
])
]
isCzar =
round.czar == id
canPlay =
List.filter (\player -> player.id == id) lobby.players
|> List.all (\player -> player.status == Player.NotPlayed)
callFill =
case round.state of
Round.P _ ->
picked
Round.J judging ->
Maybe.withDefault [] (model.considering |> Maybe.andThen (Util.get judging.responses))
Round.F _ ->
[]
pickedOrChosen =
case round.state of
Round.P _ ->
pickedView picked (Card.slots round.call) (model.shownPlayed.animated ++ model.shownPlayed.toAnimate)
Round.J judging ->
case model.considering of
Just considering ->
case Util.get judging.responses considering of
Just consideringCards ->
[ consideringView considering consideringCards isCzar ]
Nothing ->
[]
Nothing ->
[]
Round.F _ ->
[]
playedOrHand =
case round.state of
Round.P _ ->
handView model.picked (not canPlay) hand
Round.J judging ->
playedView isCzar judging.responses
Round.F _ ->
div [] []
in
[ playArea
([ div [ class "round-area" ] (List.concat [ [ CardsUI.call round.call callFill ], pickedOrChosen ])
, playedOrHand
, gameMenu lobbyModel
]
)
]
getAllById : List String -> List Card.Response -> List Card.Response
getAllById ids cards =
List.filterMap (getById cards) ids
List.filterMap (getById cards) ids
getById : List Card.Response -> String -> Maybe Card.Response
getById cards id = List.filter (\card -> card.id == id) cards |> List.head
getById cards id =
List.filter (\card -> card.id == id) cards |> List.head
consideringView : Int -> List Card.Response -> Bool -> Html Message
consideringView considering consideringCards isCzar =
let
extra = if isCzar then [ ("!!button", chooseButton considering) ] else []
in
div [] ([ Keyed.ol [ class "considering" ] ((List.map (\card -> (card.id, li [] [ (playedResponse card) ])) consideringCards) ++ extra) ])
let
extra =
if isCzar then
[ ( "!!button", chooseButton considering ) ]
else
[]
in
div [] ([ Keyed.ol [ class "considering" ] ((List.map (\card -> ( card.id, li [] [ (playedResponse card) ] )) consideringCards) ++ extra) ])
winnerHeaderAndContents : Round.FinishedRound -> List Player -> (List (Html Message), List (Html Message))
winnerHeaderAndContents : Round.FinishedRound -> List Player -> ( List (Html Message), List (Html Message) )
winnerHeaderAndContents round players =
let
cards = round.state.responses
winning = Card.winningCards cards round.state.playedByAndWinner |> Maybe.withDefault []
winner = Maybe.map .name (Util.get players round.state.playedByAndWinner.winner) |> Maybe.withDefault ""
in
( [ Icon.icon "trophy", text (" " ++ winner) ]
, [ div [ class "winner mui-panel" ]
[ h1 [] [ Icon.icon "trophy" ]
, h2 [] [ text (" " ++ Card.filled round.call winning) ]
, h3 [] [ text ("- " ++ winner) ]
]
, button [ id "next-round-button", class "mui-btn mui-btn--primary mui-btn--raised", onClick NextRound ]
[ text "Next Round" ]
]
)
let
cards =
round.state.responses
winning =
Card.winningCards cards round.state.playedByAndWinner |> Maybe.withDefault []
winner =
Maybe.map .name (Util.get players round.state.playedByAndWinner.winner) |> Maybe.withDefault ""
in
( [ Icon.icon "trophy", text (" " ++ winner) ]
, [ div [ class "winner mui-panel" ]
[ h1 [] [ Icon.icon "trophy" ]
, h2 [] [ text (" " ++ Card.filled round.call winning) ]
, h3 [] [ text ("- " ++ winner) ]
]
, button [ id "next-round-button", class "mui-btn mui-btn--primary mui-btn--raised", onClick NextRound ]
[ text "Next Round" ]
]
)
czarName : List Player -> Player.Id -> String
czarName players czarId =
(List.filter (\player -> player.id == czarId) players) |> List.head |> Maybe.map .name |> Maybe.withDefault ""
(List.filter (\player -> player.id == czarId) players) |> List.head |> Maybe.map .name |> Maybe.withDefault ""
playArea : List (Html Message) -> Html Message
playArea contents = div [ class "play-area" ] contents
playArea contents =
div [ class "play-area" ] contents
response : List String -> Bool -> Card.Response -> (String, Html Message)
response : List String -> Bool -> Card.Response -> ( String, Html Message )
response picked disabled response =
let
isPicked = List.member response.id picked
clickHandler = if isPicked || disabled then [] else [ onClick (Pick response.id) ]
in
(response.id, CardsUI.response isPicked clickHandler response)
let
isPicked =
List.member response.id picked
clickHandler =
if isPicked || disabled then
[]
else
[ onClick (Pick response.id) ]
in
( response.id, CardsUI.response isPicked clickHandler response )
blankResponse : ShownCard -> Html Message
blankResponse shownCard = div [ class "card mui-panel", positioning shownCard ] []
blankResponse shownCard =
div [ class "card mui-panel", positioning shownCard ] []
positioning : ShownCard -> Html.Attribute msg
positioning shownCard =
let
horizontalDirection = if shownCard.isLeft then "left" else "right"
in
style
[ ("transform", "rotate(" ++ (toString shownCard.rotation) ++ "deg)")
, (horizontalDirection, (toString shownCard.horizontalPos) ++ "%")
, ("top", (toString shownCard.verticalPos) ++ "%")
]
let
horizontalDirection =
if shownCard.isLeft then
"left"
else
"right"
in
style
[ ( "transform", "rotate(" ++ (toString shownCard.rotation) ++ "deg)" )
, ( horizontalDirection, (toString shownCard.horizontalPos) ++ "%" )
, ( "top", (toString shownCard.verticalPos) ++ "%" )
]
handRender : Bool -> List (String, Html Message) -> Html Message
handRender : Bool -> List ( String, Html Message ) -> Html Message
handRender disabled contents =
let
classes = "hand mui--divider-top" ++ if disabled then " disabled" else ""
in
Keyed.ul [ class classes ] (List.map (\(key, item) -> (key, li [] [ item ])) contents)
let
classes =
"hand mui--divider-top"
++ if disabled then
" disabled"
else
""
in
Keyed.ul [ class classes ] (List.map (\( key, item ) -> ( key, li [] [ item ] )) contents)
handView : List String -> Bool -> List Card.Response -> Html Message
handView picked disabled responses =
handRender disabled (List.map (response picked disabled) responses)
handRender disabled (List.map (response picked disabled) responses)
pickedResponse : Card.Response -> (String, Html Message)
pickedResponse : Card.Response -> ( String, Html Message )
pickedResponse response =
let
item = li []
[ div [ class "card response mui-panel" ] [ div [ class "response-text" ]
[ text (Util.firstLetterToUpper response.text)
, text "."
]
, withdrawButton response.id
]
]
in
(response.id, item)
let
item =
li []
[ div [ class "card response mui-panel" ]
[ div [ class "response-text" ]
[ text (Util.firstLetterToUpper response.text)
, text "."
]
, withdrawButton response.id
]
]
in
( response.id, item )
pickedView : List Card.Response -> Int -> List (ShownCard) -> List (Html Message)
pickedView : List Card.Response -> Int -> List ShownCard -> List (Html Message)
pickedView picked slots shownPlayed =
let
numberPicked = List.length picked
pb = if (numberPicked < slots) then [] else [ playButton ]
in
[ div [ class "picked" ]
([ Keyed.ol [] (List.map pickedResponse picked) ] ++ pb)
, div [ class "others-picked" ] (List.map blankResponse shownPlayed)
]
let
numberPicked =
List.length picked
pb =
if (numberPicked < slots) then
[]
else
[ playButton ]
in
[ div [ class "picked" ]
([ Keyed.ol [] (List.map pickedResponse picked) ] ++ pb)
, div [ class "others-picked" ] (List.map blankResponse shownPlayed)
]
withdrawButton : String -> Html Message
withdrawButton id = button
[ class "withdraw-button mui-btn mui-btn--small mui-btn--danger mui-btn--fab"
, title "Take back this response."
, onClick (Withdraw id) ]
[ Icon.icon "times" ]
withdrawButton id =
button
[ class "withdraw-button mui-btn mui-btn--small mui-btn--danger mui-btn--fab"
, title "Take back this response."
, onClick (Withdraw id)
]
[ Icon.icon "times" ]
playButton : Html Message
playButton = button
[ class "play-button mui-btn mui-btn--small mui-btn--accent mui-btn--fab", title "Play these responses.", onClick Play ]
[ Icon.icon "check" ]
playButton =
button
[ class "play-button mui-btn mui-btn--small mui-btn--accent mui-btn--fab", title "Play these responses.", onClick Play ]
[ Icon.icon "check" ]
playedView : Bool -> List Card.PlayedCards -> Html Message
playedView isCzar responses =
ol [ class "played mui--divider-top" ]
(List.indexedMap (\index pc -> li [] [ (playedCards isCzar index pc) ]) responses)
ol [ class "played mui--divider-top" ]
(List.indexedMap (\index pc -> li [] [ (playedCards isCzar index pc) ]) responses)
playedCards : Bool -> Int -> Card.PlayedCards -> Html Message
playedCards isCzar playedId cards =
ol
[ onClick (Consider playedId) ]
(List.map (\card -> li [] [ (playedResponse card) ]) cards)
[ onClick (Consider playedId) ]
(List.map (\card -> li [] [ (playedResponse card) ]) cards)
playedResponse : Card.Response -> Html Message
playedResponse response =
div [ class "card response mui-panel" ]
[ div [ class "response-text" ]
[ text (Util.firstLetterToUpper response.text), text "." ] ]
div [ class "card response mui-panel" ]
[ div [ class "response-text" ]
[ text (Util.firstLetterToUpper response.text), text "." ]
]
chooseButton : Int -> Html Message
chooseButton playedId =
button [ class "choose-button mui-btn mui-btn--small mui-btn--accent mui-btn--fab", onClick (Choose playedId) ]
[ Icon.icon "trophy" ]
button [ class "choose-button mui-btn mui-btn--small mui-btn--accent mui-btn--fab", onClick (Choose playedId) ]
[ Icon.icon "trophy" ]
infoBar : Game.Lobby -> Player.Secret -> List (Html Message)
infoBar lobby secret =
let
content = statusInfo lobby.players secret.id |> Util.or (stateInfo lobby.game)
in
case content of
Just message ->
[ div [ id "info-bar", class "mui--z1" ]
[ Icon.icon "info-circle"
, text " "
, text message
]
]
Nothing ->
[]
let
content =
statusInfo lobby.players secret.id |> Util.or (stateInfo lobby.game)
in
case content of
Just message ->
[ div [ id "info-bar", class "mui--z1" ]
[ Icon.icon "info-circle"
, text " "
, text message
]
]
Nothing ->
[]
statusInfo : List Player -> Player.Id -> Maybe String
statusInfo players id =
case players |> Util.find (\player -> player.id == id) |> Maybe.map .status of
Just status ->
case status of
Player.Skipping ->
Nothing {- There is a warning for this instead. -}
Player.Neutral ->
Just "You joined while this round was already in play, you will be able to play next round."
Player.Czar ->
Just "As card czar for this round - you don't play into the round, you pick the winner."
_ ->
Nothing
Nothing ->
Nothing
case players |> Util.find (\player -> player.id == id) |> Maybe.map .status of
Just status ->
case status of
Player.Skipping ->
Nothing
{- There is a warning for this instead. -}
Player.Neutral ->
Just "You joined while this round was already in play, you will be able to play next round."
Player.Czar ->
Just "As card czar for this round - you don't play into the round, you pick the winner."
_ ->
Nothing
Nothing ->
Nothing
stateInfo : Game.State -> Maybe String
stateInfo state =
case state of
Game.Playing round ->
case round.state of
Round.J _ ->
Just "The card czar is now picking a winner."
case state of
Game.Playing round ->
case round.state of
Round.J _ ->
Just "The card czar is now picking a winner."
_ ->
Nothing
_ ->
Nothing
_ ->
Nothing
Nothing
warningDrawer : List (Html Message) -> Html Message
warningDrawer contents =
let
hidden = List.isEmpty contents
classes =
[ ("hidden", hidden)
]
in
div [ id "warning-drawer", classList classes ]
[ button [ attribute "onClick" "toggleWarningDrawer()"
, class "toggle mui-btn mui-btn--small mui-btn--fab"
, title "Warning notices."
] [ Icon.icon "exclamation-triangle" ]
, div [ class "top" ] []
, div [ class "contents" ] contents
]
let
hidden =
List.isEmpty contents
classes =
[ ( "hidden", hidden )
]
in
div [ id "warning-drawer", classList classes ]
[ button
[ attribute "onClick" "toggleWarningDrawer()"
, class "toggle mui-btn mui-btn--small mui-btn--fab"
, title "Warning notices."
]
[ Icon.icon "exclamation-triangle" ]
, div [ class "top" ] []
, div [ class "contents" ] contents
]
skippingNotice : List Player -> Player.Id -> List (Html Message)
skippingNotice players id =
let
status = players |> Util.find (\player -> player.id == id) |> Maybe.map .status
renderSkippingNoticeIfSkipping = (\status ->
case status of
Player.Skipping ->
renderSkippingNotice
_ ->
[])
in
Maybe.map renderSkippingNoticeIfSkipping status |> Maybe.withDefault []
let
status =
players |> Util.find (\player -> player.id == id) |> Maybe.map .status
renderSkippingNoticeIfSkipping =
(\status ->
case status of
Player.Skipping ->
renderSkippingNotice
_ ->
[]
)
in
Maybe.map renderSkippingNoticeIfSkipping status |> Maybe.withDefault []
renderSkippingNotice : List (Html Message)
renderSkippingNotice =
[ div [ class "notice" ]
[ h3 [] [ Icon.icon "fast-forward" ]
, span [] [ text "You are currently being skipped because you took too long to play." ]
, div [ class "actions" ]
[ button [ class "mui-btn mui-btn--small"
, onClick Back
, title "Rejoin the game."
]
[ Icon.icon "sign-in", text " Rejoin" ]
]
[ div [ class "notice" ]
[ h3 [] [ Icon.icon "fast-forward" ]
, span [] [ text "You are currently being skipped because you took too long to play." ]
, div [ class "actions" ]
[ button
[ class "mui-btn mui-btn--small"
, onClick Back
, title "Rejoin the game."
]
[ Icon.icon "sign-in", text " Rejoin" ]
]
]
]
]
timeoutNotice : Player.Id -> List Player -> Bool -> Bool -> List (Html Message)
timeoutNotice playerId players judging timeout =
let
description = if judging then "picked a winnner for the round" else "played into the round"
requiredStatus = if judging then Player.Czar else Player.NotPlayed
timedOutPlayers = List.filter (\player -> player.status == requiredStatus) players
timedOutNames = Util.joinWithAnd (List.map .name timedOutPlayers)
timedOutIds = List.map .id timedOutPlayers
includesPlayer = List.member playerId timedOutIds
in
if timeout then
Maybe.map (renderTimeoutNotice includesPlayer description timedOutIds (Util.pluralHas timedOutPlayers)) timedOutNames
|> Maybe.map (\item -> [ item ])
|> Maybe.withDefault []
else
[]
let
description =
if judging then
"picked a winnner for the round"
else
"played into the round"
requiredStatus =
if judging then
Player.Czar
else
Player.NotPlayed
timedOutPlayers =
List.filter (\player -> player.status == requiredStatus) players
timedOutNames =
Util.joinWithAnd (List.map .name timedOutPlayers)
timedOutIds =
List.map .id timedOutPlayers
includesPlayer =
List.member playerId timedOutIds
in
if timeout then
Maybe.map (renderTimeoutNotice includesPlayer description timedOutIds (Util.pluralHas timedOutPlayers)) timedOutNames
|> Maybe.map (\item -> [ item ])
|> Maybe.withDefault []
else
[]
renderTimeoutNotice : Bool -> String -> List Player.Id -> String -> String -> Html Message
renderTimeoutNotice includesPlayer description ids has names =
if includesPlayer then
div [ class "notice" ]
[ h3 [] [ Icon.icon "exclamation-circle" ]
, span [] [ text "The time has run out for you to have "
, text description
, text " and you can now be skipped."
]
, div [ class "actions" ] []
]
else
div [ class "notice" ]
[ h3 [] [ Icon.icon "minus-circle" ]
, span [] [ text names
, text " "
, text has
, text " not "
, text description
, text " before the round timer ran out."
]
, div [ class "actions" ]
[ button [ class "mui-btn mui-btn--small"
, onClick (Skip ids)
, title "They will be removed from this round, and won't be in future rounds until they come back."
]
[ Icon.icon "fast-forward", text " Skip" ]
]
]
if includesPlayer then
div [ class "notice" ]
[ h3 [] [ Icon.icon "exclamation-circle" ]
, span []
[ text "The time has run out for you to have "
, text description
, text " and you can now be skipped."
]
, div [ class "actions" ] []
]
else
div [ class "notice" ]
[ h3 [] [ Icon.icon "minus-circle" ]
, span []
[ text names
, text " "
, text has
, text " not "
, text description
, text " before the round timer ran out."
]
, div [ class "actions" ]
[ button
[ class "mui-btn mui-btn--small"
, onClick (Skip ids)
, title "They will be removed from this round, and won't be in future rounds until they come back."
]
[ Icon.icon "fast-forward", text " Skip" ]
]
]
disconnectedNotice : List Player -> List (Html Message)
disconnectedNotice players =
let
disconnected = List.filter (\player -> player.disconnected && (not (player.status == Player.Skipping))) players
disconnectedNames = Util.joinWithAnd (List.map .name disconnected)
disconnectedIds = List.map .id disconnected
in
Maybe.map (renderDisconnectedNotice disconnectedIds (Util.pluralHas disconnected)) disconnectedNames
|> Maybe.map (\item -> [ item ])
|> Maybe.withDefault []
let
disconnected =
List.filter (\player -> player.disconnected && (not (player.status == Player.Skipping))) players
disconnectedNames =
Util.joinWithAnd (List.map .name disconnected)
disconnectedIds =
List.map .id disconnected
in
Maybe.map (renderDisconnectedNotice disconnectedIds (Util.pluralHas disconnected)) disconnectedNames
|> Maybe.map (\item -> [ item ])
|> Maybe.withDefault []
renderDisconnectedNotice : List Player.Id -> String -> String -> Html Message
renderDisconnectedNotice ids has disconnectedNames =
div [ class "notice" ]
[ h3 [] [ Icon.icon "minus-circle" ]
, span [] [ text disconnectedNames
, text " "
, text has
, text " disconnected from the game."
]
, div [ class "actions" ]
[ button [ class "mui-btn mui-btn--small"
, onClick (Skip ids)
, title "They will be removed from this round, and won't be in future rounds until they reconnect."
]
[ Icon.icon "fast-forward", text " Skip" ]
div [ class "notice" ]
[ h3 [] [ Icon.icon "minus-circle" ]
, span []
[ text disconnectedNames
, text " "
, text has
, text " disconnected from the game."
]
]
, div [ class "actions" ]
[ button
[ class "mui-btn mui-btn--small"
, onClick (Skip ids)
, title "They will be removed from this round, and won't be in future rounds until they reconnect."
]
[ Icon.icon "fast-forward", text " Skip" ]
]
]
client/src/MassiveDecks/Scenes/Playing/UI/Cards.elm
+59 -36
View File
@@ -1,62 +1,85 @@
module MassiveDecks.Scenes.Playing.UI.Cards exposing (call, callText, response)
import String
import Html exposing (..)
import Html.Attributes exposing (..)
import MassiveDecks.Models.Card as Card
import MassiveDecks.Util as Util
call : Card.Call -> List Card.Response -> Html msg
call call picked =
let
responseFirst = call.parts |> List.head |> Maybe.map ((==) "") |> Maybe.withDefault False
pickedText = List.map .text picked
(parts, responses) = if responseFirst then
(call.parts, Util.mapFirst Util.firstLetterToUpper pickedText)
else
(Util.mapFirst Util.firstLetterToUpper call.parts, pickedText)
spanned = List.map (\part -> span [] [ text part ]) call.parts
withSlots = Util.interleave (slots (Card.slots call) "" responses) spanned
callContents = if responseFirst then List.tail withSlots |> Maybe.withDefault withSlots else withSlots
in
div [ class "card call mui-panel" ] [ div [ class "call-text" ] callContents ]
let
responseFirst =
call.parts |> List.head |> Maybe.map ((==) "") |> Maybe.withDefault False
pickedText =
List.map .text picked
( parts, responses ) =
if responseFirst then
( call.parts, Util.mapFirst Util.firstLetterToUpper pickedText )
else
( Util.mapFirst Util.firstLetterToUpper call.parts, pickedText )
spanned =
List.map (\part -> span [] [ text part ]) call.parts
withSlots =
Util.interleave (slots (Card.slots call) "" responses) spanned
callContents =
if responseFirst then
List.tail withSlots |> Maybe.withDefault withSlots
else
withSlots
in
div [ class "card call mui-panel" ] [ div [ class "call-text" ] callContents ]
callText : Card.Call -> List Card.Response -> String
callText call picked =
let
responseFirst = call.parts |> List.head |> Maybe.map ((==) "") |> Maybe.withDefault False
pickedText = List.map .text picked
(parts, responses) = if responseFirst then
(call.parts, Util.mapFirst Util.firstLetterToUpper pickedText)
else
(Util.mapFirst Util.firstLetterToUpper call.parts, pickedText)
extra = (Card.slots call) - List.length picked
withSlots = Util.interleave (List.concat [pickedText, List.repeat extra "blank"]) call.parts
in
String.join " " withSlots
let
responseFirst =
call.parts |> List.head |> Maybe.map ((==) "") |> Maybe.withDefault False
pickedText =
List.map .text picked
( parts, responses ) =
if responseFirst then
( call.parts, Util.mapFirst Util.firstLetterToUpper pickedText )
else
( Util.mapFirst Util.firstLetterToUpper call.parts, pickedText )
extra =
(Card.slots call) - List.length picked
withSlots =
Util.interleave (List.concat [ pickedText, List.repeat extra "blank" ]) call.parts
in
String.join " " withSlots
slot : String -> Html msg
slot value = (span [ class "slot" ] [ text value ])
slot value =
(span [ class "slot" ] [ text value ])
slots : Int -> String -> List String -> List (Html msg)
slots count placeholder picked =
let
extra = count - List.length picked
in
List.concat [picked, List.repeat extra placeholder] |> List.map slot
let
extra =
count - List.length picked
in
List.concat [ picked, List.repeat extra placeholder ] |> List.map slot
response : Bool -> List (Attribute msg) -> Card.Response -> Html msg
response picked attributes response =
let
classes = [ classList [ ("card", True), ("response", True), ("mui-panel", True), ("picked", picked) ] ]
in
div (List.concat [ classes, attributes ])
[ div [ class "response-text" ] [ text (Util.firstLetterToUpper response.text), text "." ] ]
let
classes =
[ classList [ ( "card", True ), ( "response", True ), ( "mui-panel", True ), ( "picked", picked ) ] ]
in
div (List.concat [ classes, attributes ])
[ div [ class "response-text" ] [ text (Util.firstLetterToUpper response.text), text "." ] ]
client/src/MassiveDecks/Scenes/Start.elm
+268 -220
View File
@@ -1,11 +1,8 @@
module MassiveDecks.Scenes.Start exposing (update, urlUpdate, view, init, subscriptions)
import String
import Html exposing (..)
import Navigation
import MassiveDecks.Models exposing (Init, Path, pathFromLocation)
import MassiveDecks.Models.Game as Game
import MassiveDecks.Components.Tabs as Tabs
@@ -26,266 +23,317 @@ import MassiveDecks.Util as Util
{-| Create the initial model for the start screen.
-}
init : Init -> Navigation.Location -> (Model, Cmd Message)
init : Init -> Navigation.Location -> ( Model, Cmd Message )
init init location =
let
path = pathFromLocation location
tab = if path.gameCode |> Maybe.withDefault "" |> String.isEmpty then Create else Join
in
( { lobby = Nothing
, init = init
, path = path
, nameInput = Input.init Name "name-input" [ text "Your name in the game." ] "" "Nickname" (Util.cmd SubmitCurrentTab) InputMessage
, gameCodeInput = Input.init GameCode "game-code-input" [ text "The code for the game to join." ] (path.gameCode |> Maybe.withDefault "") "" (Util.cmd JoinLobbyAsNewPlayer) InputMessage
, errors = Errors.init
, overlay = Overlay.init OverlayMessage
, buttonsEnabled = True
, tabs = Tabs.init [ Tabs.Tab Create [ text "Create" ], Tabs.Tab Join [ text "Join" ] ] tab TabsMessage
, storage = init.existingGames
}
, Maybe.map (TryExistingGame >> Util.cmd) path.gameCode |> Maybe.withDefault Cmd.none)
let
path =
pathFromLocation location
tab =
if path.gameCode |> Maybe.withDefault "" |> String.isEmpty then
Create
else
Join
in
( { lobby = Nothing
, init = init
, path = path
, nameInput = Input.init Name "name-input" [ text "Your name in the game." ] "" "Nickname" (Util.cmd SubmitCurrentTab) InputMessage
, gameCodeInput = Input.init GameCode "game-code-input" [ text "The code for the game to join." ] (path.gameCode |> Maybe.withDefault "") "" (Util.cmd JoinLobbyAsNewPlayer) InputMessage
, errors = Errors.init
, overlay = Overlay.init OverlayMessage
, buttonsEnabled = True
, tabs = Tabs.init [ Tabs.Tab Create [ text "Create" ], Tabs.Tab Join [ text "Join" ] ] tab TabsMessage
, storage = init.existingGames
}
, Maybe.map (TryExistingGame >> Util.cmd) path.gameCode |> Maybe.withDefault Cmd.none
)
{-| Subscriptions for the start screen.
-}
subscriptions : Model -> Sub Message
subscriptions model =
case model.lobby of
Nothing ->
Sub.none
case model.lobby of
Nothing ->
Sub.none
Just lobby ->
Lobby.subscriptions lobby |> Sub.map LobbyMessage
Just lobby ->
Lobby.subscriptions lobby |> Sub.map LobbyMessage
{-| Render the start scene.
-}
view : Model -> Html Message
view model =
let
contents = case model.lobby of
Nothing ->
UI.view model
let
contents =
case model.lobby of
Nothing ->
UI.view model
Just lobby ->
Html.map LobbyMessage (Lobby.view lobby)
in
div []
([ contents
, Errors.view { url = model.init.url, version = model.init.version } model.errors |> Html.map ErrorMessage
] ++ Overlay.view model.overlay)
Just lobby ->
Html.map LobbyMessage (Lobby.view lobby)
in
div []
([ contents
, Errors.view { url = model.init.url, version = model.init.version } model.errors |> Html.map ErrorMessage
]
++ Overlay.view model.overlay
)
{-| Handles changes to the url.
-}
urlUpdate : Path -> Model -> (Model, Cmd Message)
urlUpdate : Path -> Model -> ( Model, Cmd Message )
urlUpdate path model =
let
noGameCode = case path.gameCode of
Just _ -> False
Nothing -> True
setInput =
path.gameCode |> Maybe.map (\gameCode -> (GameCode, Input.SetDefaultValue gameCode) |> InputMessage |> Util.cmd)
in
{ model | path = path
, lobby = if noGameCode then Nothing else model.lobby
, buttonsEnabled = True } !
[ (if noGameCode then Cmd.none else Tabs.SetTab Join |> TabsMessage |> Util.cmd)
, setInput
|> Maybe.withDefault Cmd.none
, path.gameCode
|> Maybe.map (\gc -> Title.set ("Game " ++ gc ++ " - " ++ title))
|> Maybe.withDefault (Title.set title)
, path.gameCode
|> Maybe.map (TryExistingGame >> Util.cmd)
|> Maybe.withDefault Cmd.none
]
let
noGameCode =
case path.gameCode of
Just _ ->
False
Nothing ->
True
setInput =
path.gameCode |> Maybe.map (\gameCode -> ( GameCode, Input.SetDefaultValue gameCode ) |> InputMessage |> Util.cmd)
in
{ model
| path = path
, lobby =
if noGameCode then
Nothing
else
model.lobby
, buttonsEnabled = True
}
! [ (if noGameCode then
Cmd.none
else
Tabs.SetTab Join |> TabsMessage |> Util.cmd
)
, setInput
|> Maybe.withDefault Cmd.none
, path.gameCode
|> Maybe.map (\gc -> Title.set ("Game " ++ gc ++ " - " ++ title))
|> Maybe.withDefault (Title.set title)
, path.gameCode
|> Maybe.map (TryExistingGame >> Util.cmd)
|> Maybe.withDefault Cmd.none
]
{-| Handles messages and alters the model as appropriate.
-}
update : Message -> Model -> (Model, Cmd Message)
update : Message -> Model -> ( Model, Cmd Message )
update message model =
case message of
ErrorMessage message ->
let
(newErrors, cmd) = Errors.update message model.errors
in
({ model | errors = newErrors }, Cmd.map ErrorMessage cmd)
case message of
ErrorMessage message ->
let
( newErrors, cmd ) =
Errors.update message model.errors
in
( { model | errors = newErrors }, Cmd.map ErrorMessage cmd )
PathChange path ->
urlUpdate path model
PathChange path ->
urlUpdate path model
TabsMessage tabsMessage ->
({ model | tabs = (Tabs.update tabsMessage model.tabs) }, Cmd.none)
TabsMessage tabsMessage ->
( { model | tabs = (Tabs.update tabsMessage model.tabs) }, Cmd.none )
ClearExistingGame existingGame ->
{ model | storage = Storage.leave existingGame model.storage } !
[ Overlay "info-circle" "Game over." [ text ("The game " ++ existingGame.gameCode ++ " has ended.") ]
|> Overlay.Show
|> OverlayMessage
|> Util.cmd
, Storage.Store |> StorageMessage |> Util.cmd
, Navigation.newUrl model.init.url
]
TryExistingGame gameCode ->
let
existing = List.filter (.gameCode >> ((==) gameCode)) model.storage |> List.head
cmd =
Maybe.map (\existing -> JoinLobbyAsExistingPlayer existing.secret existing.gameCode |> Util.cmd) existing
|> Maybe.withDefault (Navigation.modifyUrl model.init.url)
in
(model, cmd)
CreateLobby ->
( { model | buttonsEnabled = False }
, Request.send_
(API.createLobby model.nameInput.value)
ErrorMessage
(\gameCodeAndSecret -> StoreCredentialsAndMoveToLobby gameCodeAndSecret.gameCode gameCodeAndSecret.secret))
SubmitCurrentTab ->
case model.tabs.current of
Create ->
(model, Util.cmd CreateLobby)
Join ->
(model, Util.cmd JoinLobbyAsNewPlayer)
SetButtonsEnabled enabled ->
({ model | buttonsEnabled = enabled }, Cmd.none)
JoinLobbyAsNewPlayer ->
({ model | buttonsEnabled = False }, Util.cmd (JoinGivenLobbyAsNewPlayer model.gameCodeInput.value))
JoinGivenLobbyAsNewPlayer gameCode ->
case List.filter (.gameCode >> ((==) gameCode)) model.storage |> List.head of
Nothing ->
model !
[ Request.send (API.newPlayer gameCode model.nameInput.value)
newPlayerErrorHandler
ErrorMessage
(StoreCredentialsAndMoveToLobby gameCode)
]
Just _ ->
model !
[ MoveToLobby gameCode |> Util.cmd
, UI.alreadyInGameOverlay
|> Overlay.Show
|> OverlayMessage
|> Util.cmd
]
StoreCredentialsAndMoveToLobby gameCode secret ->
{ model | storage = Storage.join (Game.GameCodeAndSecret gameCode secret) model.storage } !
[ Storage.Store |> StorageMessage |> Util.cmd
, MoveToLobby gameCode |> Util.cmd
]
MoveToLobby gameCode ->
model ! [ Navigation.newUrl (model.init.url ++ "#" ++ gameCode) ]
JoinLobbyAsExistingPlayer secret gameCode ->
model !
[ Request.send (API.getLobbyAndHand gameCode secret)
(getLobbyAndHandErrorHandler (Game.GameCodeAndSecret gameCode secret))
ErrorMessage
(JoinLobby secret)
]
JoinLobby secret lobbyAndHand ->
let
(lobby, cmd) = Lobby.init model.init lobbyAndHand secret
in
{ model | lobby = Just lobby } !
[ cmd |> Cmd.map LobbyMessage
]
InputMessage message ->
let
(nameInput, nameCmd) = Input.update message model.nameInput
(gameCodeInput, gameCodeCmd) = Input.update message model.gameCodeInput
in
({ model | nameInput = nameInput
, gameCodeInput = gameCodeInput
}, Cmd.batch [ nameCmd, gameCodeCmd ])
OverlayMessage overlayMessage ->
({ model | overlay = Overlay.update overlayMessage model.overlay }, Cmd.none)
StorageMessage storageMessage ->
let
(storageModel, cmd) = Storage.update storageMessage model.storage
in
({ model | storage = storageModel }, cmd |> Cmd.map StorageMessage)
LobbyMessage message ->
case message of
Lobby.ErrorMessage message ->
(model, Util.cmd (ErrorMessage message))
Lobby.OverlayMessage message ->
(model, Util.cmd (OverlayMessage (Overlay.map (Lobby.LocalMessage >> LobbyMessage) message)))
Lobby.Leave ->
let
(leave, storage) = case model.lobby of
Nothing ->
([], model.storage)
Just lobby ->
( [ Request.send_ (API.leave lobby.lobby.gameCode lobby.secret) ErrorMessage (\_ -> NoOp)
ClearExistingGame existingGame ->
{ model | storage = Storage.leave existingGame model.storage }
! [ Overlay "info-circle" "Game over." [ text ("The game " ++ existingGame.gameCode ++ " has ended.") ]
|> Overlay.Show
|> OverlayMessage
|> Util.cmd
, Storage.Store |> StorageMessage |> Util.cmd
, Navigation.newUrl model.init.url
]
, Storage.leave (Game.GameCodeAndSecret lobby.lobby.gameCode lobby.secret) model.storage
TryExistingGame gameCode ->
let
existing =
List.filter (.gameCode >> ((==) gameCode)) model.storage |> List.head
cmd =
Maybe.map (\existing -> JoinLobbyAsExistingPlayer existing.secret existing.gameCode |> Util.cmd) existing
|> Maybe.withDefault (Navigation.modifyUrl model.init.url)
in
( model, cmd )
CreateLobby ->
( { model | buttonsEnabled = False }
, Request.send_
(API.createLobby model.nameInput.value)
ErrorMessage
(\gameCodeAndSecret -> StoreCredentialsAndMoveToLobby gameCodeAndSecret.gameCode gameCodeAndSecret.secret)
)
SubmitCurrentTab ->
case model.tabs.current of
Create ->
( model, Util.cmd CreateLobby )
Join ->
( model, Util.cmd JoinLobbyAsNewPlayer )
SetButtonsEnabled enabled ->
( { model | buttonsEnabled = enabled }, Cmd.none )
JoinLobbyAsNewPlayer ->
( { model | buttonsEnabled = False }, Util.cmd (JoinGivenLobbyAsNewPlayer model.gameCodeInput.value) )
JoinGivenLobbyAsNewPlayer gameCode ->
case List.filter (.gameCode >> ((==) gameCode)) model.storage |> List.head of
Nothing ->
model
! [ Request.send (API.newPlayer gameCode model.nameInput.value)
newPlayerErrorHandler
ErrorMessage
(StoreCredentialsAndMoveToLobby gameCode)
]
Just _ ->
model
! [ MoveToLobby gameCode |> Util.cmd
, UI.alreadyInGameOverlay
|> Overlay.Show
|> OverlayMessage
|> Util.cmd
]
StoreCredentialsAndMoveToLobby gameCode secret ->
{ model | storage = Storage.join (Game.GameCodeAndSecret gameCode secret) model.storage }
! [ Storage.Store |> StorageMessage |> Util.cmd
, MoveToLobby gameCode |> Util.cmd
]
MoveToLobby gameCode ->
model ! [ Navigation.newUrl (model.init.url ++ "#" ++ gameCode) ]
JoinLobbyAsExistingPlayer secret gameCode ->
model
! [ Request.send (API.getLobbyAndHand gameCode secret)
(getLobbyAndHandErrorHandler (Game.GameCodeAndSecret gameCode secret))
ErrorMessage
(JoinLobby secret)
]
JoinLobby secret lobbyAndHand ->
let
( lobby, cmd ) =
Lobby.init model.init lobbyAndHand secret
in
{ model | lobby = Just lobby }
! [ cmd |> Cmd.map LobbyMessage
]
InputMessage message ->
let
( nameInput, nameCmd ) =
Input.update message model.nameInput
( gameCodeInput, gameCodeCmd ) =
Input.update message model.gameCodeInput
in
( { model
| nameInput = nameInput
, gameCodeInput = gameCodeInput
}
, Cmd.batch [ nameCmd, gameCodeCmd ]
)
in
{ model | lobby = Nothing
, buttonsEnabled = True
, storage = storage
} !
([ Navigation.newUrl model.init.url
] ++ leave)
Lobby.LocalMessage message ->
case model.lobby of
Nothing ->
(model, Cmd.none)
OverlayMessage overlayMessage ->
( { model | overlay = Overlay.update overlayMessage model.overlay }, Cmd.none )
Just lobby ->
let
(newLobby, cmd) = Lobby.update message lobby
in
({ model | lobby = Just newLobby }, Cmd.map LobbyMessage cmd)
StorageMessage storageMessage ->
let
( storageModel, cmd ) =
Storage.update storageMessage model.storage
in
( { model | storage = storageModel }, cmd |> Cmd.map StorageMessage )
Batch messages ->
(model, messages |> List.map Util.cmd |> Cmd.batch)
LobbyMessage message ->
case message of
Lobby.ErrorMessage message ->
( model, Util.cmd (ErrorMessage message) )
NoOp ->
(model, Cmd.none)
Lobby.OverlayMessage message ->
( model, Util.cmd (OverlayMessage (Overlay.map (Lobby.LocalMessage >> LobbyMessage) message)) )
Lobby.Leave ->
let
( leave, storage ) =
case model.lobby of
Nothing ->
( [], model.storage )
Just lobby ->
( [ Request.send_ (API.leave lobby.lobby.gameCode lobby.secret) ErrorMessage (\_ -> NoOp)
, Storage.Store |> StorageMessage |> Util.cmd
]
, Storage.leave (Game.GameCodeAndSecret lobby.lobby.gameCode lobby.secret) model.storage
)
in
{ model
| lobby = Nothing
, buttonsEnabled = True
, storage = storage
}
! ([ Navigation.newUrl model.init.url
]
++ leave
)
Lobby.LocalMessage message ->
case model.lobby of
Nothing ->
( model, Cmd.none )
Just lobby ->
let
( newLobby, cmd ) =
Lobby.update message lobby
in
( { model | lobby = Just newLobby }, Cmd.map LobbyMessage cmd )
Batch messages ->
( model, messages |> List.map Util.cmd |> Cmd.batch )
NoOp ->
( model, Cmd.none )
title : String
title = "Massive Decks"
title =
"Massive Decks"
newPlayerErrorHandler : API.NewPlayerError -> Message
newPlayerErrorHandler error =
let
errorMessage = case error of
API.NameInUse -> (Name, Just "This name is already in use in this game, try something else." |> Input.Error) |> InputMessage
API.NewPlayerLobbyNotFound -> (GameCode, Just "This game doesn't exist - check you have the right code." |> Input.Error) |> InputMessage
in
Batch [ SetButtonsEnabled True, errorMessage ]
let
errorMessage =
case error of
API.NameInUse ->
( Name, Just "This name is already in use in this game, try something else." |> Input.Error ) |> InputMessage
API.NewPlayerLobbyNotFound ->
( GameCode, Just "This game doesn't exist - check you have the right code." |> Input.Error ) |> InputMessage
in
Batch [ SetButtonsEnabled True, errorMessage ]
getLobbyAndHandErrorHandler : Game.GameCodeAndSecret -> API.GetLobbyAndHandError -> Message
getLobbyAndHandErrorHandler gameCodeAndSecret error =
let
errorMessage = case error of
API.LobbyNotFound -> ClearExistingGame gameCodeAndSecret
API.SecretWrongOrNotAPlayer -> ClearExistingGame gameCodeAndSecret
in
Batch [ SetButtonsEnabled True, errorMessage ]
let
errorMessage =
case error of
API.LobbyNotFound ->
ClearExistingGame gameCodeAndSecret
API.SecretWrongOrNotAPlayer ->
ClearExistingGame gameCodeAndSecret
in
Batch [ SetButtonsEnabled True, errorMessage ]
client/src/MassiveDecks/Scenes/Start/Messages.elm
+24 -24
View File
@@ -14,37 +14,37 @@ import MassiveDecks.Models.Player as Player
{-| The messages used in the start screen.
-}
type Message
= SubmitCurrentTab
| PathChange Path
| CreateLobby
| SetButtonsEnabled Bool
| JoinLobbyAsNewPlayer
| JoinGivenLobbyAsNewPlayer String
| JoinLobbyAsExistingPlayer Player.Secret String
| StoreCredentialsAndMoveToLobby String Player.Secret
| MoveToLobby String
| JoinLobby Player.Secret Game.LobbyAndHand
| TryExistingGame String
| ClearExistingGame Game.GameCodeAndSecret
| InputMessage (Input.Message InputId)
| LobbyMessage Lobby.ConsumerMessage
| ErrorMessage Errors.Message
| OverlayMessage (Overlay.Message Message)
| TabsMessage (Tabs.Message Tab)
| StorageMessage (Storage.Message)
| Batch (List Message)
| NoOp
= SubmitCurrentTab
| PathChange Path
| CreateLobby
| SetButtonsEnabled Bool
| JoinLobbyAsNewPlayer
| JoinGivenLobbyAsNewPlayer String
| JoinLobbyAsExistingPlayer Player.Secret String
| StoreCredentialsAndMoveToLobby String Player.Secret
| MoveToLobby String
| JoinLobby Player.Secret Game.LobbyAndHand
| TryExistingGame String
| ClearExistingGame Game.GameCodeAndSecret
| InputMessage (Input.Message InputId)
| LobbyMessage Lobby.ConsumerMessage
| ErrorMessage Errors.Message
| OverlayMessage (Overlay.Message Message)
| TabsMessage (Tabs.Message Tab)
| StorageMessage Storage.Message
| Batch (List Message)
| NoOp
{-| IDs for the inputs to differentiate between them in messages.
-}
type InputId
= Name
| GameCode
= Name
| GameCode
{-| Tabs for the start page.
-}
type Tab
= Create
| Join
= Create
| Join
client/src/MassiveDecks/Scenes/Start/Models.elm
+11 -11
View File
@@ -13,14 +13,14 @@ import MassiveDecks.Scenes.Start.Messages exposing (Message, InputId, Tab)
{-| The state of the start screen.
-}
type alias Model =
{ lobby : Maybe Lobby.Model
, init : Init
, path : Path
, nameInput : Input.Model InputId Message
, gameCodeInput : Input.Model InputId Message
, errors : Errors.Model
, overlay : Overlay.Model Message
, buttonsEnabled : Bool
, tabs : Tabs.Model Tab Message
, storage : Storage.Model
}
{ lobby : Maybe Lobby.Model
, init : Init
, path : Path
, nameInput : Input.Model InputId Message
, gameCodeInput : Input.Model InputId Message
, errors : Errors.Model
, overlay : Overlay.Model Message
, buttonsEnabled : Bool
, tabs : Tabs.Model Tab Message
, storage : Storage.Model
}
client/src/MassiveDecks/Scenes/Start/UI.elm
+94 -71
View File
@@ -1,12 +1,10 @@
module MassiveDecks.Scenes.Start.UI exposing (view, alreadyInGameOverlay)
import String
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Html.Keyed as Keyed
import MassiveDecks.Models.Game as Game
import MassiveDecks.Components.Tabs as Tabs
import MassiveDecks.Components.Icon as Icon
@@ -20,101 +18,126 @@ import MassiveDecks.Scenes.Lobby.Messages as Lobby
alreadyInGameOverlay : Overlay Message
alreadyInGameOverlay =
Overlay
"info-circle"
"Already in game."
[ p [] [ text "You are already in this game, so you have joined as an existing player." ]
, p [] [ text "If you want to join as a new player, please "
, a [ class "link"
, title "Leave the game."
, attribute "tabindex" "0"
, attribute "role" "button"
, onClick (Batch [ Lobby.Leave |> LobbyMessage
, Overlay.Hide |> OverlayMessage
])
]
[ text "leave the game" ]
, text " first."
]
]
Overlay
"info-circle"
"Already in game."
[ p [] [ text "You are already in this game, so you have joined as an existing player." ]
, p []
[ text "If you want to join as a new player, please "
, a
[ class "link"
, title "Leave the game."
, attribute "tabindex" "0"
, attribute "role" "button"
, onClick
(Batch
[ Lobby.Leave |> LobbyMessage
, Overlay.Hide |> OverlayMessage
]
)
]
[ text "leave the game" ]
, text " first."
]
]
{-| Render the start screen.
-}
view : Model -> Html Message
view model =
let
nameEntered = not (String.isEmpty model.nameInput.value)
gameCodeEntered = not (String.isEmpty model.gameCodeInput.value)
versionInfo = if String.isEmpty model.init.version then [] else [ text " Version ", text model.init.version ]
in
div [ id "start-screen" ]
[ div [ id "start-screen-content", class "mui-panel" ]
([ h1 [ class "mui--divider-bottom" ] [ text "Massive Decks" ]
] ++ (existingGames model.storage)
++ [ Input.view model.nameInput
] ++ (Tabs.view (renderTab nameEntered gameCodeEntered model) model.tabs)
++ [ a [ class "about-link mui--divider-top link"
, attribute "tabindex" "0"
, attribute "role" "button"
, onClick (About.show model.init.version |> OverlayMessage)
]
[ Icon.icon "question-circle" , text " About" ]
, div [ id "forkongithub" ] [ div [] [ a [ href "https://github.com/lattyware/massivedecks", target "_blank", rel "noopener" ]
[ Icon.icon "github", text " Fork me on GitHub" ] ] ]
])
, footer []
[ a [ href "https://github.com/Lattyware/massivedecks" ]
[ img [ src "images/icon.svg", alt "The Massive Decks logo.", title "Massive Decks" ] [] ]
, p [] versionInfo
let
nameEntered =
not (String.isEmpty model.nameInput.value)
gameCodeEntered =
not (String.isEmpty model.gameCodeInput.value)
versionInfo =
if String.isEmpty model.init.version then
[]
else
[ text " Version ", text model.init.version ]
in
div [ id "start-screen" ]
[ div [ id "start-screen-content", class "mui-panel" ]
([ h1 [ class "mui--divider-bottom" ] [ text "Massive Decks" ]
]
]
++ (existingGames model.storage)
++ [ Input.view model.nameInput
]
++ (Tabs.view (renderTab nameEntered gameCodeEntered model) model.tabs)
++ [ a
[ class "about-link mui--divider-top link"
, attribute "tabindex" "0"
, attribute "role" "button"
, onClick (About.show model.init.version |> OverlayMessage)
]
[ Icon.icon "question-circle", text " About" ]
, div [ id "forkongithub" ]
[ div []
[ a [ href "https://github.com/lattyware/massivedecks", target "_blank", rel "noopener" ]
[ Icon.icon "github", text " Fork me on GitHub" ]
]
]
]
)
, footer []
[ a [ href "https://github.com/Lattyware/massivedecks" ]
[ img [ src "images/icon.svg", alt "The Massive Decks logo.", title "Massive Decks" ] [] ]
, p [] versionInfo
]
]
renderTab : Bool -> Bool -> Model -> Tab -> List (Html Message)
renderTab nameEntered gameCodeEntered model tab =
case tab of
Create ->
[ createLobbyButton (nameEntered && model.buttonsEnabled) ]
case tab of
Create ->
[ createLobbyButton (nameEntered && model.buttonsEnabled) ]
Join ->
[ Input.view model.gameCodeInput
, joinLobbyButton (nameEntered && gameCodeEntered && model.buttonsEnabled)
]
Join ->
[ Input.view model.gameCodeInput
, joinLobbyButton (nameEntered && gameCodeEntered && model.buttonsEnabled)
]
existingGames : List Game.GameCodeAndSecret -> List (Html msg)
existingGames games =
if List.isEmpty games then
[]
else
[ div [ class "rejoin mui--divider-bottom" ]
[ span [] [ text "You can rejoin " ]
, Keyed.ul [] (List.map existingGame games)
]
]
if List.isEmpty games then
[]
else
[ div [ class "rejoin mui--divider-bottom" ]
[ span [] [ text "You can rejoin " ]
, Keyed.ul [] (List.map existingGame games)
]
]
existingGame : Game.GameCodeAndSecret -> (String, Html msg)
existingGame : Game.GameCodeAndSecret -> ( String, Html msg )
existingGame game =
(game.gameCode, li [] [ a [ href ("#" ++ game.gameCode) ] [ text ("Game \"" ++ game.gameCode ++ "\"") ] ])
( game.gameCode, li [] [ a [ href ("#" ++ game.gameCode) ] [ text ("Game \"" ++ game.gameCode ++ "\"") ] ] )
{-| A button to join an existing lobby.
-}
joinLobbyButton : Bool -> Html Message
joinLobbyButton enabled =
button [ class "mui-btn mui-btn--large mui-btn--primary"
, onClick JoinLobbyAsNewPlayer
, disabled (not enabled)
]
[ text "Join Game" ]
button
[ class "mui-btn mui-btn--large mui-btn--primary"
, onClick JoinLobbyAsNewPlayer
, disabled (not enabled)
]
[ text "Join Game" ]
{-| A button to create a new lobby.
-}
createLobbyButton : Bool -> Html Message
createLobbyButton enabled =
button [ class "mui-btn mui-btn--large mui-btn--primary"
, onClick CreateLobby
, disabled (not enabled)
]
[ text "Create Game" ]
button
[ class "mui-btn mui-btn--large mui-btn--primary"
, onClick CreateLobby
, disabled (not enabled)
]
[ text "Create Game" ]
client/src/MassiveDecks/Util.elm
+113 -52
View File
@@ -5,7 +5,6 @@ import Task exposing (Task)
import String
import Process
import Time exposing (Time)
import Html exposing (..)
import Html.Keyed as Keyed
import Html.Events exposing (..)
@@ -15,148 +14,198 @@ import Html.Events exposing (..)
requires a method, but it'll never get called.
-}
impossible : Never -> a
impossible n = impossible n
impossible n =
impossible n
{-| Add an item to a list if the value is not nothing.
-}
andMaybe : Maybe a -> List a -> List a
andMaybe maybeExtra values = List.append values (Maybe.map (\value -> [ value ]) maybeExtra |> Maybe.withDefault [])
andMaybe maybeExtra values =
List.append values (Maybe.map (\value -> [ value ]) maybeExtra |> Maybe.withDefault [])
or : Maybe a -> Maybe a -> Maybe a
or a b = case a of
Just _ -> a
Nothing -> b
or a b =
case a of
Just _ ->
a
Nothing ->
b
{-| Give the first value from the list that matches the given condition. If none do, return `Nothing`.
-}
find : (a -> Bool) -> List a -> Maybe a
find check items
= List.filter check items
|> List.head
find check items =
List.filter check items
|> List.head
{-| Take two lists and inteleave them into each other. The first element will come from the second list.
-}
interleave : List a -> List a -> List a
interleave list1 list2 =
case list1 of
[] ->
list2
x :: xs ->
case list2 of
case list1 of
[] ->
list1
list2
y :: ys ->
y :: x :: interleave xs ys
x :: xs ->
case list2 of
[] ->
list1
y :: ys ->
y :: x :: interleave xs ys
{-| An url to a lobby from the base url and the lobby id.
-}
lobbyUrl : String -> String -> String
lobbyUrl url lobbyId = url ++ "#" ++ lobbyId
lobbyUrl url lobbyId =
url ++ "#" ++ lobbyId
{-| Create a command that just sends the given message instantly.
-}
cmd : msg -> Cmd msg
cmd message = Task.perform identity (Task.succeed message)
cmd message =
Task.perform identity (Task.succeed message)
{-| Chains two updates together to produce a single update.
-}
(:>) : (model -> (model, Cmd msg)) -> (model -> (model, Cmd msg)) -> model -> (model, Cmd msg)
(:>) : (model -> ( model, Cmd msg )) -> (model -> ( model, Cmd msg )) -> model -> ( model, Cmd msg )
(:>) a b model =
let
(aModel, aMsg) = a model
(bModel, bMsg) = b aModel
in
bModel ! [ aMsg, bMsg ]
let
( aModel, aMsg ) =
a model
( bModel, bMsg ) =
b aModel
in
bModel ! [ aMsg, bMsg ]
{-| Reduce the list to the given indices, and give those indicies with the elements.
-}
getAllWithIndex : List a -> List Int -> List (Int, a)
getAllWithIndex : List a -> List Int -> List ( Int, a )
getAllWithIndex list indices =
getAll (List.indexedMap (,) list) indices
getAll (List.indexedMap (,) list) indices
{-| Reduce the list to the given indices.
-}
getAll : List a -> List Int -> List a
getAll list indices =
List.filterMap (get list) indices
List.filterMap (get list) indices
{-| Get the element at the given index, or nothing.
-}
get : List a -> Int -> Maybe a
get list index = case List.drop index list of
[] -> Nothing
(item :: _) -> Just item
get list index =
case List.drop index list of
[] ->
Nothing
item :: _ ->
Just item
{-| Make the first character of the string uppercase.
-}
firstLetterToUpper : String -> String
firstLetterToUpper str = (String.toUpper (String.left 1 str)) ++ (String.dropLeft 1 str)
firstLetterToUpper str =
(String.toUpper (String.left 1 str)) ++ (String.dropLeft 1 str)
{-| map over the first element of a list only, returning the rest as-is.
-}
mapFirst : (a -> a) -> List a -> List a
mapFirst f xs = List.indexedMap (\index x -> if index == 0 then f x else x) xs
mapFirst f xs =
List.indexedMap
(\index x ->
if index == 0 then
f x
else
x
)
xs
{-| Get "has" or "have" as appropriate for the given number of items.
-}
pluralHas : List a -> String
pluralHas items = case List.length items of
1 -> "has"
_ -> "have"
pluralHas items =
case List.length items of
1 ->
"has"
_ ->
"have"
{-| Join the given strings together with commas and spacing, as in a list, adding an 'and' between the last two
elements.
-}
joinWithAnd : List String -> Maybe String
joinWithAnd items = case items of
[] -> Nothing
head :: [] -> Just head
first :: second :: [] -> Just (first ++ " and " ++ second)
head :: rest -> Just (head ++ ", " ++ (joinWithAnd rest |> Maybe.withDefault ""))
joinWithAnd items =
case items of
[] ->
Nothing
head :: [] ->
Just head
first :: second :: [] ->
Just (first ++ " and " ++ second)
head :: rest ->
Just (head ++ ", " ++ (joinWithAnd rest |> Maybe.withDefault ""))
{-| Apply every function in the list to the given element.
-}
apply : List (a -> b) -> a -> List b
apply fs value = List.map (\f -> f value) fs
apply fs value =
List.map (\f -> f value) fs
{-| Perform a task after a given period of time.
-}
after : Time -> Task x a -> Task x a
after waitFor task =
Process.sleep waitFor |> Task.andThen (\_ -> task)
Process.sleep waitFor |> Task.andThen (\_ -> task)
{-| Check if a Maybe is Nothing.
-}
isNothing : Maybe a -> Bool
isNothing m =
case m of
Just _ -> False
Nothing -> True
case m of
Just _ ->
False
Nothing ->
True
{-| Add an event handler for keyboard key presses.
-}
onKeyDown : String -> msg -> msg -> Attribute msg
onKeyDown key message noOp =
on "keydown" (Json.at [ "key" ] Json.string |> Json.map (\pressed -> if pressed == key then message else noOp))
on "keydown"
(Json.at [ "key" ] Json.string
|> Json.map
(\pressed ->
if pressed == key then
message
else
noOp
)
)
{-| Perform an action on click, only if the id of the clicked element matches (i.e: only on click for a given element
@@ -164,13 +213,25 @@ in the tree).
-}
onClickIfId : String -> msg -> msg -> Attribute msg
onClickIfId targetId message noOp =
on "click" (ifIdDecoder |> Json.map (\clickedId -> if clickedId == targetId then message else noOp))
on "click"
(ifIdDecoder
|> Json.map
(\clickedId ->
if clickedId == targetId then
message
else
noOp
)
)
ifIdDecoder : Json.Decoder String
ifIdDecoder = Json.at [ "target", "id" ] Json.string
ifIdDecoder =
Json.at [ "target", "id" ] Json.string
{-| Create a tbody where each row is keyed.
-}
tbody : List (Attribute msg) -> List (String, Html msg) -> Html msg
tbody = Keyed.node "tbody"
tbody : List (Attribute msg) -> List ( String, Html msg ) -> Html msg
tbody =
Keyed.node "tbody"