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

Resolve #102: Allow spectators to like plays.

Browse Source
This commit is contained in:
Gareth Latty
2020-09-06 21:57:47 +01:00
parent de7cf37d75
commit 54c4c16a38
17 changed files with 273 additions and 182 deletions
Download Patch File Download Diff File Expand all files Collapse all files
client/src/elm/MassiveDecks/Card/Play.elm
+14 -3
View File
@@ -3,7 +3,8 @@ module MassiveDecks.Card.Play exposing
, Id
, Known
, Play
, WithLikes
, Potential
, WithDetails
, asKnown
, asPlay
)
@@ -34,10 +35,20 @@ type alias Details =
}
{-| A play with the number of likes it received.
{-| A play with its details.
-}
type alias WithLikes =
type alias WithDetails =
{ play : List Card.Response
, playedBy : User.Id
, likes : Maybe Int
}
{-| A known or unknown play that may or may not have details.
-}
type alias Potential =
{ play : Maybe (List Card.Response)
, playedBy : Maybe User.Id
, likes : Maybe Int
}
client/src/elm/MassiveDecks/Game.elm
+65 -45
View File
@@ -238,11 +238,14 @@ update wrap shared msg model =
newStage =
case round.stage of
Round.J judging ->
makePick judging Round.J
Round.J stage ->
makePick stage Round.J
Round.R revealing ->
makePick revealing Round.R
Round.R stage ->
makePick stage Round.R
Round.C stage ->
makePick stage Round.C
stage ->
stage
@@ -315,15 +318,17 @@ update wrap shared msg model =
Judge ->
let
cmd =
( newStage, cmd ) =
case round.stage of
Round.J judging ->
judging.pick |> Maybe.map Actions.judge |> Maybe.withDefault Cmd.none
Round.J stage ->
( Round.J { stage | pick = Nothing }
, stage.pick |> Maybe.map Actions.judge |> Maybe.withDefault Cmd.none
)
_ ->
Cmd.none
stage ->
( stage, Cmd.none )
in
( model, cmd )
( { model | game = { game | round = { round | stage = newStage } } }, cmd )
Like ->
let
@@ -347,11 +352,14 @@ update wrap shared msg model =
)
in
case round.stage of
Round.J judging ->
like judging Round.J
Round.J stage ->
like stage Round.J
Round.R revealing ->
like revealing Round.R
Round.R stage ->
like stage Round.R
Round.C stage ->
like stage Round.C
stage ->
( stage, Cmd.none )
@@ -575,10 +583,22 @@ applyGameEvent wrap wrapEvent auth shared gameEvent model =
increment withLikes =
{ withLikes | likes = withLikes.likes |> Maybe.withDefault 0 |> (+) 1 |> Just }
playedBy =
stage.plays |> Dict.get play |> Maybe.map .playedBy
incrementPlayer player =
{ player | likes = player.likes + 1 }
updatePlayer player =
game.players |> Dict.update player (Maybe.map incrementPlayer)
players =
playedBy |> Maybe.map updatePlayer |> Maybe.withDefault game.players
newStage =
{ stage | plays = Dict.update play (Maybe.map increment) stage.plays }
in
( { model | game = { game | round = { round | stage = Round.C newStage } } }
( { model | game = { game | players = players, round = { round | stage = Round.C newStage } } }
, Cmd.none
)
@@ -656,14 +676,13 @@ applyGameEvent wrap wrapEvent auth shared gameEvent model =
case round.stage of
Round.J r ->
let
( by, plays, playOrder ) =
( plays, playOrder ) =
resolvePlayedBy r.plays playedBy
complete =
Round.Complete
r.likeDetail
r.pick
by
plays
playOrder
winner
@@ -680,7 +699,7 @@ applyGameEvent wrap wrapEvent auth shared gameEvent model =
|> Maybe.withDefault Cmd.none
ps =
playersWithWinner |> Dict.map (updateLikes plays)
playersWithWinner |> updateLikes plays
in
{ newRound = Round.withStage (Round.C complete) round
, history = Round.withStage complete round :: game.history
@@ -973,33 +992,39 @@ hotJoinPlayer player user model =
resolvePlayedBy :
List Play.Known
-> Dict Play.Id Play.Details
-> ( Dict User.Id Play.Id, Dict Play.Id Play.WithLikes, List User.Id )
resolvePlayedBy plays playedBy =
-> ( Dict Play.Id Play.WithDetails, List Play.Id )
resolvePlayedBy knownPlays details =
let
step known ( pb, ps, po ) =
step known ( plays, playOrder ) =
let
( newPb, newPs ) =
case playedBy |> Dict.get known.id of
Just details ->
( pb |> Dict.insert details.playedBy known.id
, ps |> Dict.insert known.id (Play.WithLikes known.responses details.likes)
)
newPs =
case details |> Dict.get known.id of
Just { playedBy, likes } ->
plays |> Dict.insert known.id (Play.WithDetails known.responses playedBy likes)
Nothing ->
( pb, ps )
plays
in
( newPb, newPs, known.id :: po )
( newPs, known.id :: playOrder )
in
plays |> List.foldr step ( Dict.empty, Dict.empty, [] )
knownPlays |> List.foldr step ( Dict.empty, [] )
updateLikes : Dict User.Id Play.WithLikes -> User.Id -> Player -> Player
updateLikes plays uid player =
plays
|> Dict.get uid
|> Maybe.andThen .likes
|> Maybe.map (\likes -> { player | likes = likes + player.likes })
|> Maybe.withDefault player
updateLikes : Dict Play.Id Play.WithDetails -> Dict User.Id Player -> Dict User.Id Player
updateLikes plays initialPlayers =
let
incrementBy likes player =
{ player | likes = player.likes + likes }
step _ play players =
case play.likes of
Just likes ->
players |> Dict.update play.playedBy (Maybe.map (incrementBy likes))
Nothing ->
players
in
plays |> Dict.foldl step initialPlayers
confettiId : String
@@ -1053,7 +1078,7 @@ viewRound wrap shared auth timeAnchor config users model =
( call, { instruction, action, content, slotAttrs, fillCallWith, roundAttrs } ) =
case model.completeRound of
Just completeRound ->
( completeRound.call, Complete.view wrap shared auth True config users completeRound )
( completeRound.call, Complete.view wrap shared True config users completeRound )
Nothing ->
case round.stage of
@@ -1067,7 +1092,7 @@ viewRound wrap shared auth timeAnchor config users model =
( round.call, Judging.view wrap auth shared users config (Round.withStage stage round) )
Round.C stage ->
( round.call, Complete.view wrap shared auth False config users (Round.withStage stage round) )
( round.call, Complete.view wrap shared False config users (Round.withStage stage round) )
game =
model.game
@@ -1085,7 +1110,7 @@ viewRound wrap shared auth timeAnchor config users model =
, timer timeAnchor model
, Html.div [ HtmlA.class "top-row" ] [ minorActions wrap shared auth game model.helpVisible ]
]
, Html.div (HtmlA.class "round" :: roundAttrs) [ renderedCall, viewAction wrap shared action ]
, Html.div (HtmlA.class "round" :: roundAttrs) [ renderedCall, Action.view wrap shared action ]
, content
, Html.div [ HtmlA.class "scroll-top-spacer" ] []
@@ -1297,11 +1322,6 @@ rebootButton wrap shared score reboot =
action
viewAction : (Msg -> msg) -> Shared -> Maybe Action -> Html msg
viewAction wrap shared visible =
Html.div [] (Action.actions |> List.map (Action.view wrap shared visible))
gameOverlay : Shared -> MdString -> Maybe ( MdString, msg ) -> List (Html msg)
gameOverlay shared message action =
[ Html.div [ HtmlA.id "game-overlay" ]
client/src/elm/MassiveDecks/Game/Action.elm
+8 -3
View File
@@ -1,4 +1,4 @@
module MassiveDecks.Game.Action exposing (actions, view)
module MassiveDecks.Game.Action exposing (view)
import FontAwesome.Icon as Icon exposing (Icon)
import FontAwesome.Solid as Icon
@@ -30,8 +30,13 @@ normal =
[ HtmlA.class "normal" ]
view : (Msg -> msg) -> Shared -> Maybe Action -> Action -> Html msg
view wrap shared visible action =
view : (Msg -> msg) -> Shared -> Maybe Action -> Html msg
view wrap shared visible =
Html.div [] (actions |> List.map (viewSingle wrap shared visible))
viewSingle : (Msg -> msg) -> Shared -> Maybe Action -> Action -> Html msg
viewSingle wrap shared visible action =
let
{ icon, attrs, type_, title, onClick } =
case action of
client/src/elm/MassiveDecks/Game/History.elm
+3 -3
View File
@@ -78,15 +78,15 @@ viewRound shared config users round =
)
viewPlay : Shared -> Config -> Dict User.Id User -> User.Id -> ( User.Id, Play.WithLikes ) -> ( String, Html msg )
viewPlay shared config users winner ( id, { play, likes } ) =
viewPlay : Shared -> Config -> Dict User.Id User -> User.Id -> ( Play.Id, Play.WithDetails ) -> ( String, Html msg )
viewPlay shared config users winner ( id, { play, playedBy, likes } ) =
let
cards =
play |> List.map (\r -> ( r.details.id, Html.li [] [ Response.view shared config Card.Front [] r ] ))
in
( id
, Html.li [ HtmlA.class "with-byline" ]
[ Plays.viewByLine shared users (Plays.ByLine id (Plays.Winner |> Maybe.justIf (winner == id)) likes)
[ Plays.viewByLine shared users (Plays.ByLine playedBy (Plays.Winner |> Maybe.justIf (winner == playedBy)) likes)
, HtmlK.ol [ HtmlA.class "play card-set" ] cards
]
)
client/src/elm/MassiveDecks/Game/Round.elm
+2 -3
View File
@@ -208,8 +208,7 @@ type alias Judging =
type alias Complete =
{ likeDetail : LikeDetail
, pick : Maybe Play.Id
, playedBy : Dict User.Id Play.Id
, plays : Dict Play.Id Play.WithLikes
, playOrder : List User.Id
, plays : Dict Play.Id Play.WithDetails
, playOrder : List Play.Id
, winner : User.Id
}
client/src/elm/MassiveDecks/Game/Round/Complete.elm
+21 -46
View File
@@ -1,10 +1,7 @@
module MassiveDecks.Game.Round.Complete exposing (view)
import Dict exposing (Dict)
import FontAwesome.Solid as Icon
import Html exposing (Html)
import Html.Attributes as HtmlA
import Html.Keyed as HtmlK
import MassiveDecks.Card.Model as Card
import MassiveDecks.Card.Parts as Parts
import MassiveDecks.Card.Play as Play
@@ -12,61 +9,39 @@ import MassiveDecks.Card.Response as Response
import MassiveDecks.Game.Action.Model as Action
import MassiveDecks.Game.Messages exposing (..)
import MassiveDecks.Game.Model exposing (..)
import MassiveDecks.Game.Player as Player
import MassiveDecks.Game.Round as Round exposing (Round)
import MassiveDecks.Game.Round.Plays as Plays
import MassiveDecks.Model exposing (..)
import MassiveDecks.Pages.Lobby.Configure.Model exposing (Config)
import MassiveDecks.Pages.Lobby.Model exposing (Auth)
import MassiveDecks.Strings as Strings
import MassiveDecks.User as User exposing (User)
import MassiveDecks.Util.Maybe as Maybe
import Set
view : (Msg -> msg) -> Shared -> Auth -> Bool -> Config -> Dict User.Id User -> Round.Specific Round.Complete -> RoundView msg
view _ shared auth nextRoundReady config users round =
view : (Msg -> msg) -> Shared -> Bool -> Config -> Dict User.Id User -> Round.Specific Round.Complete -> RoundView msg
view wrap shared nextRoundReady config users round =
let
role =
Player.role round auth.claims.uid
stage =
round.stage
winning =
stage.plays |> Dict.get stage.winner
canBeLiked play =
Just play /= stage.likeDetail.played && not (Set.member play stage.likeDetail.liked)
likeIfCanBeLiked pick =
Action.Like |> Maybe.justIf (canBeLiked pick)
pickMsg play =
play |> PickPlay |> wrap |> Maybe.justIf (canBeLiked play)
likeAction =
let
canBeLiked play =
Just play /= stage.likeDetail.played && not (Set.member play stage.likeDetail.liked)
stage.pick |> Maybe.andThen likeIfCanBeLiked
likeIfCanBeLiked pick =
Maybe.justIf (canBeLiked pick) Action.Like
in
case role of
Player.RCzar ->
Nothing
Player.RPlayer ->
stage.pick |> Maybe.andThen likeIfCanBeLiked
msg _ =
Nothing
userAndPlay userId =
let
tuple : Play.Id -> Play.WithLikes -> ( User.Id, Play.Id, Play.WithLikes )
tuple id p =
( userId, id, p )
play id =
Dict.get id stage.plays
playId =
Dict.get userId stage.playedBy
in
Maybe.map2 tuple playId (playId |> Maybe.andThen play)
playById playId =
Dict.get playId stage.plays |> Maybe.map (Tuple.pair playId)
in
{ instruction = Strings.AdvanceRoundInstruction |> Maybe.justIf nextRoundReady
, action =
@@ -76,8 +51,8 @@ view _ shared auth nextRoundReady config users round =
]
, content =
stage.playOrder
|> List.filterMap userAndPlay
|> List.map (details shared config stage.winner msg)
|> List.filterMap playById
|> List.map (details shared config stage.winner pickMsg)
|> Plays.view shared users [ ( "complete", True ) ] stage.likeDetail.liked stage.pick
, slotAttrs = always []
, fillCallWith = winning |> Maybe.map (.play >> Parts.fillsFromPlay) |> Maybe.withDefault Dict.empty
@@ -85,20 +60,20 @@ view _ shared auth nextRoundReady config users round =
}
details : Shared -> Config -> User.Id -> (Play.Id -> Maybe msg) -> ( User.Id, Play.Id, Play.WithLikes ) -> Plays.Details msg
details shared config winner maybeMsg ( player, id, play ) =
details : Shared -> Config -> User.Id -> (Play.Id -> Maybe msg) -> ( Play.Id, Play.WithDetails ) -> Plays.Details msg
details shared config winner maybeMsg ( id, { play, playedBy, likes } ) =
let
cards =
play.play |> List.map (\r -> Html.li [] [ Response.view shared config Card.Front [] r ])
play |> List.map (\r -> Html.li [] [ Response.view shared config Card.Front [] r ])
specialRole =
if winner == player then
if winner == playedBy then
Just Plays.Winner
else
Nothing
byLine =
Plays.ByLine player specialRole play.likes
Plays.ByLine playedBy specialRole likes
in
Plays.Details id cards (id |> maybeMsg) (Just byLine)
client/src/elm/MassiveDecks/Models/Decoders.elm
+41 -33
View File
@@ -275,12 +275,12 @@ languageFromCode code =
lobby : Maybe LikeDetail -> Json.Decoder Lobby
lobby ld =
Json.map5 Lobby
(Json.field "users" users)
(Json.field "owner" userId)
(Json.field "config" config)
(Json.maybe (Json.field "game" (game ld) |> Json.map Game.emptyModel))
(Json.maybe (Json.field "errors" (Json.list gameStateError)) |> Json.map (Maybe.withDefault []))
Json.succeed Lobby
|> Json.required "users" users
|> Json.required "owner" userId
|> Json.required "config" config
|> Json.optional "game" (game ld |> Json.map (Game.emptyModel >> Just)) Nothing
|> Json.optional "errors" (Json.list gameStateError) []
game : Maybe LikeDetail -> Json.Decoder Game
@@ -673,6 +673,9 @@ eventByName name =
"PlayTakenBack" ->
gameEvent playTakenBack
"PlayLiked" ->
gameEvent playLiked
"StartRevealing" ->
timedGameEvent startRevealing
@@ -843,6 +846,12 @@ playTakenBack =
(Json.field "by" userId)
playLiked : Json.Decoder Events.GameEvent
playLiked =
Json.map (\id -> Events.PlayLiked { play = id })
(Json.field "id" playId)
roundStarted : Json.Decoder Events.TimedGameEvent
roundStarted =
Json.map5 (\id -> \ca -> \cz -> \pl -> \d -> { id = id, call = ca, czar = cz, players = pl, drawn = d } |> Events.RoundStarted)
@@ -1114,7 +1123,7 @@ round ld =
unknownValue "round stage" name
byName stageName =
specificRound (Json.field "stage" (stageDetailsByName stageName))
specificRound (stageDetailsByName stageName)
in
Json.field "stage" Json.string |> Json.andThen byName
@@ -1166,17 +1175,17 @@ judgingRound ld =
completeRound : Maybe Round.LikeDetail -> Json.Decoder Round.Complete
completeRound ld =
Json.succeed (Round.Complete (ld |> Maybe.withDefault Round.defaultLikeDetail) Nothing)
|> Json.required "playedBy" (Json.dict playId)
|> Json.required "plays" (Json.dict playWithLikes)
|> Json.required "plays" (Json.dict playWithDetails)
|> Json.required "playOrder" (Json.list userId)
|> Json.required "winner" userId
playWithLikes : Json.Decoder Play.WithLikes
playWithLikes =
Json.map2 Play.WithLikes
(Json.field "play" (Json.list response))
(Json.maybe (Json.field "likes" Json.int))
playWithDetails : Json.Decoder Play.WithDetails
playWithDetails =
Json.succeed Play.WithDetails
|> Json.required "play" (Json.list response)
|> Json.required "playedBy" userId
|> Json.optional "likes" (Json.int |> Json.map Just) Nothing
playerRole : Json.Decoder Player.Role
@@ -1279,28 +1288,27 @@ gameStateErrorByName name =
stage : Json.Decoder Round.Stage
stage =
let
stageByName name =
case name of
"Playing" ->
Json.succeed Round.SPlaying
"Revealing" ->
Json.succeed Round.SRevealing
"Judging" ->
Json.succeed Round.SJudging
"Complete" ->
Json.succeed Round.SComplete
_ ->
unknownValue "round stage" name
in
Json.string |> Json.andThen stageByName
stageByName : String -> Json.Decoder Round.Stage
stageByName name =
case name of
"Playing" ->
Json.succeed Round.SPlaying
"Revealing" ->
Json.succeed Round.SRevealing
"Judging" ->
Json.succeed Round.SJudging
"Complete" ->
Json.succeed Round.SComplete
_ ->
unknownValue "round stage" name
invalidActionError : Json.Decoder MdError.ActionExecutionError
invalidActionError =
Json.map (\r -> MdError.InvalidAction { reason = r })
client/src/elm/MassiveDecks/Pages/Lobby.elm
+1 -1
View File
@@ -487,7 +487,7 @@ view wrap wrapSettings changePage shared model =
viewWithUsers wrap wrapSettings shared s viewContent model
Spectate ->
Spectate.view (SpectateMsg >> wrap) changePage shared model
Spectate.view (SpectateMsg >> wrap) (GameMsg >> wrap) changePage shared model
client/src/elm/MassiveDecks/Pages/Lobby/Spectate.elm
+7 -6
View File
@@ -10,6 +10,7 @@ import FontAwesome.Icon as Icon
import FontAwesome.Solid as Icon
import Html exposing (Html)
import Html.Attributes as HtmlA
import MassiveDecks.Game.Messages as Game
import MassiveDecks.Model exposing (Shared)
import MassiveDecks.Pages.Lobby.Actions as Actions
import MassiveDecks.Pages.Lobby.GameCode as GameCode exposing (GameCode)
@@ -36,8 +37,8 @@ init =
{ advertise = True }
view : (Msg -> msg) -> (Route.Route -> msg) -> Shared -> Lobby.Model -> List (Html msg)
view wrap changePage shared lobby =
view : (Msg -> msg) -> (Game.Msg -> msg) -> (Route.Route -> msg) -> Shared -> Lobby.Model -> List (Html msg)
view wrap wrapGame changePage shared lobby =
let
advert =
if lobby.spectate.advertise then
@@ -50,7 +51,7 @@ view wrap changePage shared lobby =
(List.concat
[ viewSettings wrap changePage shared lobby
, advert
, viewStage shared lobby
, viewStage wrapGame shared lobby
]
)
]
@@ -115,8 +116,8 @@ viewSettings wrap changePage shared lobby =
[]
viewStage : Shared -> Lobby.Model -> List (Html msg)
viewStage shared lobbyModel =
viewStage : (Game.Msg -> msg) -> Shared -> Lobby.Model -> List (Html msg)
viewStage wrapGame shared lobbyModel =
case lobbyModel.lobbyAndConfigure |> Maybe.map .lobby of
Just lobby ->
case lobby.game of
@@ -126,7 +127,7 @@ viewStage shared lobbyModel =
Postgame.view shared lobby game.game winner
Nothing ->
Round.view shared lobby.config lobby.users game
Round.view wrapGame shared lobby.config lobby.users game
Nothing ->
Pregame.view shared lobby
client/src/elm/MassiveDecks/Pages/Lobby/Spectate/Messages.elm
+2
View File
@@ -1,5 +1,7 @@
module MassiveDecks.Pages.Lobby.Spectate.Messages exposing (Msg(..))
import MassiveDecks.Card.Play as Play
type Msg
= BecomePlayer
client/src/elm/MassiveDecks/Pages/Lobby/Spectate/Model.elm
+1 -2
View File
@@ -2,5 +2,4 @@ module MassiveDecks.Pages.Lobby.Spectate.Model exposing (..)
type alias Model =
{ advertise : Bool
}
{ advertise : Bool }
client/src/elm/MassiveDecks/Pages/Lobby/Spectate/Stages/Round.elm
+80 -31
View File
@@ -5,11 +5,15 @@ import FontAwesome.Icon as Icon
import FontAwesome.Solid as Icon
import Html exposing (Html)
import Html.Attributes as HtmlA
import Html.Events as HtmlE
import MassiveDecks.Card.Call as Call
import MassiveDecks.Card.Model as Card exposing (Call)
import MassiveDecks.Card.Parts as Parts
import MassiveDecks.Card.Play as Play exposing (Play)
import MassiveDecks.Card.Response as Response
import MassiveDecks.Game.Action as Action
import MassiveDecks.Game.Action.Model as Action
import MassiveDecks.Game.Messages as Game
import MassiveDecks.Game.Model as Game
import MassiveDecks.Game.Round as Round exposing (Round)
import MassiveDecks.Model exposing (Shared)
@@ -17,13 +21,14 @@ import MassiveDecks.Pages.Lobby.Configure.Model exposing (Config)
import MassiveDecks.Strings as Strings
import MassiveDecks.Strings.Languages as Lang
import MassiveDecks.User as User exposing (User)
import MassiveDecks.Util.Dict as Dict
import MassiveDecks.Util.Maybe as Maybe
import Round
import Set exposing (Set)
view : Shared -> Config -> Dict User.Id User -> Game.Model -> List (Html msg)
view shared config users game =
view : (Game.Msg -> msg) -> Shared -> Config -> Dict User.Id User -> Game.Model -> List (Html msg)
view wrapGame shared config users game =
let
round =
game.game.round
@@ -33,13 +38,13 @@ view shared config users game =
viewPlaying shared config game.playStyles round playing
Round.R revealing ->
viewRevealing shared config users round revealing
viewRevealing wrapGame shared config users round revealing
Round.J judging ->
viewJudging shared config users round judging
viewJudging wrapGame shared config users round judging
Round.C complete ->
viewComplete shared config users round complete
viewComplete wrapGame shared config users round complete
@@ -57,8 +62,8 @@ viewPlaying shared config playStyles round stage =
]
viewRevealing : Shared -> Config -> Dict User.Id User -> Round -> Round.Revealing -> List (Html msg)
viewRevealing shared config users round stage =
viewRevealing : (Game.Msg -> msg) -> Shared -> Config -> Dict User.Id User -> Round -> Round.Revealing -> List (Html msg)
viewRevealing wrapGame shared config users round stage =
let
fillWith =
case stage.plays |> List.filter (\p -> Just p.id == stage.lastRevealed) of
@@ -68,36 +73,63 @@ viewRevealing shared config users round stage =
_ ->
Nothing
potential { id, responses } =
( id
, { play = responses
, playedBy = Nothing
, likes = Nothing
}
)
plays =
stage.plays |> List.map (\p -> ( Nothing, p.responses |> Maybe.map (\r -> { play = r, likes = Nothing }) ))
stage.plays |> List.map potential
in
[ viewCall shared config fillWith round.call
, viewPlays shared config (round.call |> Call.slotCount) users Nothing plays
, viewPlays wrapGame shared config (round.call |> Call.slotCount) users Nothing stage.pick stage.likeDetail plays
, Action.view wrapGame shared (Action.Like |> Maybe.justIf (stage.pick /= Nothing))
]
viewJudging : Shared -> Config -> Dict User.Id User -> Round -> Round.Judging -> List (Html msg)
viewJudging shared config users round stage =
viewJudging : (Game.Msg -> msg) -> Shared -> Config -> Dict User.Id User -> Round -> Round.Judging -> List (Html msg)
viewJudging wrapGame shared config users round stage =
let
potential { id, responses } =
( id
, { play = Just responses
, playedBy = Nothing
, likes = Nothing
}
)
plays =
stage.plays |> List.map (\p -> ( Nothing, Just { play = p.responses, likes = Nothing } ))
stage.plays |> List.map potential
in
[ viewCall shared config Nothing round.call
, viewPlays shared config (round.call |> Call.slotCount) users Nothing plays
, viewPlays wrapGame shared config (round.call |> Call.slotCount) users Nothing stage.pick stage.likeDetail plays
, Action.view wrapGame shared (Action.Like |> Maybe.justIf (stage.pick /= Nothing))
]
viewComplete : Shared -> Config -> Dict User.Id User -> Round -> Round.Complete -> List (Html msg)
viewComplete shared config users round stage =
viewComplete : (Game.Msg -> msg) -> Shared -> Config -> Dict User.Id User -> Round -> Round.Complete -> List (Html msg)
viewComplete wrapGame shared config users round stage =
let
potential id { play, playedBy, likes } =
( id
, { play = Just play
, playedBy = Just playedBy
, likes = likes
}
)
plays =
stage.playOrder |> List.map (\u -> ( Just u, Dict.get u stage.plays ))
stage.playOrder |> List.filterMap (\id -> id |> Dict.getFrom stage.plays |> Maybe.map (potential id))
winner =
Dict.get stage.winner stage.plays |> Maybe.map (.play >> Parts.fillsFromPlay)
in
[ viewCall shared config winner round.call
, viewPlays shared config (round.call |> Call.slotCount) users (Just stage.winner) plays
, viewPlays wrapGame shared config (round.call |> Call.slotCount) users (Just stage.winner) stage.pick stage.likeDetail plays
, Action.view wrapGame shared (Action.Like |> Maybe.justIf (stage.pick /= Nothing))
]
@@ -124,27 +156,27 @@ viewUnknownPlays shared slotCount playStyles players played =
)
viewPlays : Shared -> Config -> Int -> Dict User.Id User -> Maybe User.Id -> List ( Maybe User.Id, Maybe Play.WithLikes ) -> Html msg
viewPlays shared config slotCount users winner plays =
viewPlays : (Game.Msg -> msg) -> Shared -> Config -> Int -> Dict User.Id User -> Maybe User.Id -> Maybe Play.Id -> Round.LikeDetail -> List ( Play.Id, Play.Potential ) -> Html msg
viewPlays wrapGame shared config slotCount users winner picked likeDetail plays =
let
angle =
plays |> List.length |> anglePerPlay
in
Html.ul [ HtmlA.id "plays" ] (plays |> List.indexedMap (viewPlayByIndex shared config slotCount users winner angle))
Html.ul [ HtmlA.id "plays" ] (plays |> List.indexedMap (viewPlayByIndex wrapGame shared config slotCount users winner picked likeDetail angle))
viewPlayByIndex : Shared -> Config -> Int -> Dict User.Id User -> Maybe User.Id -> Float -> Int -> ( Maybe User.Id, Maybe Play.WithLikes ) -> Html msg
viewPlayByIndex shared config slotCount users winner angle index ( user, play ) =
viewPlayByIndex : (Game.Msg -> msg) -> Shared -> Config -> Int -> Dict User.Id User -> Maybe User.Id -> Maybe Play.Id -> Round.LikeDetail -> Float -> Int -> ( Play.Id, Play.Potential ) -> Html msg
viewPlayByIndex wrapGame shared config slotCount users winner picked likeDetail angle index ( playId, play ) =
let
isWinner =
case winner of
Just w ->
user == Just w
play.playedBy == Just w
Nothing ->
False
in
viewPlay shared config slotCount (toFloat index * angle) (user |> Maybe.andThen (\u -> Dict.get u users)) isWinner play
viewPlay wrapGame shared config slotCount (toFloat index * angle) (play.playedBy |> Maybe.andThen (Dict.getFrom users)) isWinner picked likeDetail playId play
anglePerPlay : Int -> Float
@@ -162,23 +194,40 @@ farDistance =
150
viewPlay : Shared -> Config -> Int -> Float -> Maybe User -> Bool -> Maybe Play.WithLikes -> Html msg
viewPlay shared config slotCount angle playedBy isWinner play =
viewPlay : (Game.Msg -> msg) -> Shared -> Config -> Int -> Float -> Maybe User -> Bool -> Maybe Play.Id -> Round.LikeDetail -> Play.Id -> Play.Potential -> Html msg
viewPlay wrapGame shared config slotCount angle playedByUser isWinner picked likeDetail playId { play, playedBy, likes } =
let
isLiked =
likeDetail.liked |> Set.member playId
action =
if play /= Nothing && likeDetail.played /= Just playId && not isLiked then
playId |> Game.PickPlay |> wrapGame |> HtmlE.onClick |> Just
else
Nothing
in
Html.li
(positionFromAngle angle closeDistance)
[ Html.div [ HtmlA.class "with-byline" ]
[ Html.div [ HtmlA.class "with-byline", action |> Maybe.withDefault (HtmlA.disabled True) ]
[ Html.span [ HtmlA.class "byline" ]
(List.filterMap identity
[ Icon.viewIcon Icon.trophy |> Maybe.justIf isWinner
, playedBy |> Maybe.map (.name >> Html.text)
, play |> Maybe.andThen .likes |> Maybe.map (\l -> Strings.Likes { total = l } |> Lang.html shared)
, playedByUser |> Maybe.map (.name >> Html.text)
, likes |> Maybe.map (\l -> Strings.Likes { total = l } |> Lang.html shared)
]
)
, Html.ol
[ HtmlA.classList [ ( "play", True ), ( "card-set", True ) ]
[ HtmlA.classList
[ ( "play", True )
, ( "card-set", True )
, ( "active", action /= Nothing )
, ( "picked", picked == Just playId )
, ( "liked", isLiked )
]
]
(play
|> Maybe.map (.play >> List.map (\response -> Html.li [] [ Response.view shared config Card.Front [] response ]))
|> Maybe.map (List.map (\response -> Html.li [] [ Response.view shared config Card.Front [] response ]))
|> Maybe.withDefault (List.repeat slotCount (Html.li [] [ Response.viewUnknown shared [] ]))
)
]
client/src/elm/MassiveDecks/Util/Dict.elm
+11
View File
@@ -0,0 +1,11 @@
module MassiveDecks.Util.Dict exposing (getFrom)
import Dict exposing (..)
{-| It is very common to have the key as the thing you are chaining, so this is a convenience function to swap the
argument order.
-}
getFrom : Dict.Dict comparable value -> comparable -> Maybe value
getFrom dict key =
get key dict
client/src/scss/pages/_spectate.scss
+8
View File
@@ -30,6 +30,14 @@
bottom: 0;
overflow: hidden;
.action {
position: fixed;
bottom: 1em;
right: 1rem;
z-index: 999;
}
#players {
list-style: none;
display: flex;
server/src/ts/action/game-action/like.ts
+1
View File
@@ -40,6 +40,7 @@ class LikeActions extends Actions.Implementation<
target.playedBy !== auth.uid &&
target.likes.find((id) => id === auth.uid) === undefined
) {
lobby.game.players[target.playedBy].likes += 1;
target.likes.push(auth.uid);
const events =
lobby.game.round.stage === "Complete"
server/src/ts/games/game/round.ts
+3 -2
View File
@@ -127,11 +127,12 @@ export class Complete extends Base<"Complete"> {
return obj;
}
private playsObj(): { [player: string]: PublicRound.PlayWithLikes } {
const obj: { [player: string]: PublicRound.PlayWithLikes } = {};
private playsObj(): { [player: string]: PublicRound.PlayWithDetails } {
const obj: { [player: string]: PublicRound.PlayWithDetails } = {};
for (const roundPlay of this.plays) {
obj[roundPlay.playedBy] = {
play: roundPlay.play,
playedBy: roundPlay.playedBy,
...(roundPlay.likes.length > 0
? { likes: roundPlay.likes.length }
: {}),
server/src/ts/games/game/round/public.ts
+5 -4
View File
@@ -38,16 +38,17 @@ export interface Judging extends Base, Timed {
plays: Play.Revealed[];
}
export interface PlayWithLikes {
export interface PlayWithDetails {
play: Play.Play;
likes?: number;
playedBy: User.Id;
likes?: Player.Likes;
}
export interface Complete extends Base {
stage: "Complete";
winner: User.Id;
plays: { [player: string]: PlayWithLikes };
playOrder: User.Id[];
plays: { [id: string]: PlayWithDetails };
playOrder: Play.Id[];
}
export interface PlayDetails {