Full game flow

3 files changed, 82 insertions, 23 deletions

diff --git a/client/src/Client.elm b/client/src/Client.elm
index e3ecbf6..7cac663 100644
--- a/client/src/Client.elm
+++ b/client/src/Client.elm
@@ -26,6 +26,8 @@ type Msg
     -- Voting
     | SelectVote Int
     | SubmitVote
+    -- Tally
+    | ConfirmTally
 
 type alias Cards = {black : Array String, white : Array String}
 
@@ -49,12 +51,12 @@ parseRoomId url = case String.split "/" url.path of
     _ :: "rooms" :: roomId :: _ -> Ok roomId
     _ -> Err <| "Invalid path: " ++ url.path
 
-viewOpponent : Messages.Opponent -> Html msg
-viewOpponent opponent = Html.div [] <|
-    [ Html.text opponent.name
+viewPlayer : Messages.PlayerView -> Html msg
+viewPlayer player = Html.div [] <|
+    [ Html.text player.name
     ] ++
-    (if opponent.admin then [Html.text " 👑"] else []) ++
-    (if opponent.ready then [Html.text " ✅"] else [])
+    (if player.admin then [Html.text " 👑"] else []) ++
+    (if player.ready then [Html.text " ✅"] else [])
 
 view : Model -> List (Html Msg)
 view model = case model of
@@ -67,10 +69,10 @@ view model = case model of
             [Html.text <| "Connecting to room " ++ state.roomId ++ "..."]
         ]
     Game game ->
-        [ Html.h1 [] [Html.text "Opponents"]
+        [ Html.h1 [] [Html.text "Players"]
         , Html.ul [] <| List.map
-            (\o -> Html.li [] [viewOpponent o])
-            game.view.opponents
+            (\o -> Html.li [] [viewPlayer o])
+            game.view.players
         , Html.h1 [] [Html.text "You"]
         , Html.form
             [ Html.Attributes.action ""
@@ -84,7 +86,8 @@ view model = case model of
             , Html.button
                 [ Html.Attributes.type_ "submit"
                 , Html.Attributes.disabled <|
-                    game.view.myName == game.changeMyName
+                    game.view.me.name == game.changeMyName ||
+                    String.length game.changeMyName > 32
                 ]
                 [Html.text "Update name"]
             ]
@@ -100,6 +103,7 @@ tableBlackCard : GameState -> Maybe BlackCard
 tableBlackCard game = case game.view.table of
     Messages.Proposing b _ -> Just b
     Messages.Voting b _ _ _ -> Just b
+    Messages.Tally b _ -> Just b
 
 selectedWhiteCards : GameState -> List WhiteCard
 selectedWhiteCards game = case game.view.table of
@@ -148,6 +152,23 @@ viewTable game = case game.view.table of
             [Html.text "Vote"]
         ]
 
+    Messages.Tally black results -> Html.div [] <|
+        [Html.h2 [] [Html.text "Vote results"]] ++
+        List.map (\voted ->
+            let attrs =
+                    if List.length voted.winners > 0 then
+                        [Html.Attributes.class "winner"]
+                    else
+                        [] in
+            blackCard attrs game.cards black voted.proposal)
+            results ++
+        if not game.view.me.admin then
+            []
+        else
+            [ Html.button
+                [Html.Events.onClick ConfirmTally] [Html.text "Next round"]
+            ]
+
 intersperseWith : List a -> a -> List a -> List a
 intersperseWith values def list = case list of
     [] -> []
@@ -222,7 +243,7 @@ update msg model = case msg of
                         ( Game
                             { cards = {black = Array.empty, white = Array.empty}
                             , view = gameView
-                            , changeMyName = gameView.myName
+                            , changeMyName = gameView.me.name
                             , selectedWhiteCards = []
                             , selectedVote = Nothing
                             }
@@ -280,6 +301,8 @@ update msg model = case msg of
             _ -> (model, Cmd.none)
         _ -> (model, Cmd.none)
 
+    ConfirmTally -> (model, send <| Messages.ConfirmTally)
+
 main : Program () Model Msg
 main = Browser.application
     { init = \() url key -> case parseRoomId url of
diff --git a/client/src/Messages.elm b/client/src/Messages.elm
index 3324886..a100dbf 100644
--- a/client/src/Messages.elm
+++ b/client/src/Messages.elm
@@ -56,25 +56,51 @@ jsonEncCards  val =
 
 
 
-type alias Opponent  =
+type alias PlayerView  =
    { name: String
    , admin: Bool
    , ready: Bool
+   , points: Int
    }
 
-jsonDecOpponent : Json.Decode.Decoder ( Opponent )
-jsonDecOpponent =
-   Json.Decode.succeed (\pname padmin pready -> {name = pname, admin = padmin, ready = pready})
+jsonDecPlayerView : Json.Decode.Decoder ( PlayerView )
+jsonDecPlayerView =
+   Json.Decode.succeed (\pname padmin pready ppoints -> {name = pname, admin = padmin, ready = pready, points = ppoints})
    |> required "name" (Json.Decode.string)
    |> required "admin" (Json.Decode.bool)
    |> required "ready" (Json.Decode.bool)
+   |> required "points" (Json.Decode.int)
 
-jsonEncOpponent : Opponent -> Value
-jsonEncOpponent  val =
+jsonEncPlayerView : PlayerView -> Value
+jsonEncPlayerView  val =
    Json.Encode.object
    [ ("name", Json.Encode.string val.name)
    , ("admin", Json.Encode.bool val.admin)
    , ("ready", Json.Encode.bool val.ready)
+   , ("points", Json.Encode.int val.points)
+   ]
+
+
+
+type alias VotedView  =
+   { proposal: (List WhiteCard)
+   , score: Int
+   , winners: (List String)
+   }
+
+jsonDecVotedView : Json.Decode.Decoder ( VotedView )
+jsonDecVotedView =
+   Json.Decode.succeed (\pproposal pscore pwinners -> {proposal = pproposal, score = pscore, winners = pwinners})
+   |> required "proposal" (Json.Decode.list (jsonDecWhiteCard))
+   |> required "score" (Json.Decode.int)
+   |> required "winners" (Json.Decode.list (Json.Decode.string))
+
+jsonEncVotedView : VotedView -> Value
+jsonEncVotedView  val =
+   Json.Encode.object
+   [ ("proposal", (Json.Encode.list jsonEncWhiteCard) val.proposal)
+   , ("score", Json.Encode.int val.score)
+   , ("winners", (Json.Encode.list Json.Encode.string) val.winners)
    ]
 
 
@@ -82,12 +108,14 @@ jsonEncOpponent  val =
 type TableView  =
     Proposing BlackCard (List WhiteCard)
     | Voting BlackCard (List (List WhiteCard)) Int (Maybe Int)
+    | Tally BlackCard (List VotedView)
 
 jsonDecTableView : Json.Decode.Decoder ( TableView )
 jsonDecTableView =
     let jsonDecDictTableView = Dict.fromList
             [ ("Proposing", Json.Decode.lazy (\_ -> Json.Decode.map2 Proposing (Json.Decode.index 0 (jsonDecBlackCard)) (Json.Decode.index 1 (Json.Decode.list (jsonDecWhiteCard)))))
             , ("Voting", Json.Decode.lazy (\_ -> Json.Decode.map4 Voting (Json.Decode.index 0 (jsonDecBlackCard)) (Json.Decode.index 1 (Json.Decode.list (Json.Decode.list (jsonDecWhiteCard)))) (Json.Decode.index 2 (Json.Decode.int)) (Json.Decode.index 3 (Json.Decode.maybe (Json.Decode.int)))))
+            , ("Tally", Json.Decode.lazy (\_ -> Json.Decode.map2 Tally (Json.Decode.index 0 (jsonDecBlackCard)) (Json.Decode.index 1 (Json.Decode.list (jsonDecVotedView)))))
             ]
     in  decodeSumObjectWithSingleField  "TableView" jsonDecDictTableView
 
@@ -96,30 +124,31 @@ jsonEncTableView  val =
     let keyval v = case v of
                     Proposing v1 v2 -> ("Proposing", encodeValue (Json.Encode.list identity [jsonEncBlackCard v1, (Json.Encode.list jsonEncWhiteCard) v2]))
                     Voting v1 v2 v3 v4 -> ("Voting", encodeValue (Json.Encode.list identity [jsonEncBlackCard v1, (Json.Encode.list (Json.Encode.list jsonEncWhiteCard)) v2, Json.Encode.int v3, (maybeEncode (Json.Encode.int)) v4]))
+                    Tally v1 v2 -> ("Tally", encodeValue (Json.Encode.list identity [jsonEncBlackCard v1, (Json.Encode.list jsonEncVotedView) v2]))
     in encodeSumObjectWithSingleField keyval val
 
 
 
 type alias GameView  =
-   { opponents: (List Opponent)
-   , myName: String
+   { players: (List PlayerView)
+   , me: PlayerView
    , table: TableView
    , hand: (List WhiteCard)
    }
 
 jsonDecGameView : Json.Decode.Decoder ( GameView )
 jsonDecGameView =
-   Json.Decode.succeed (\popponents pmyName ptable phand -> {opponents = popponents, myName = pmyName, table = ptable, hand = phand})
-   |> required "opponents" (Json.Decode.list (jsonDecOpponent))
-   |> required "myName" (Json.Decode.string)
+   Json.Decode.succeed (\pplayers pme ptable phand -> {players = pplayers, me = pme, table = ptable, hand = phand})
+   |> required "players" (Json.Decode.list (jsonDecPlayerView))
+   |> required "me" (jsonDecPlayerView)
    |> required "table" (jsonDecTableView)
    |> required "hand" (Json.Decode.list (jsonDecWhiteCard))
 
 jsonEncGameView : GameView -> Value
 jsonEncGameView  val =
    Json.Encode.object
-   [ ("opponents", (Json.Encode.list jsonEncOpponent) val.opponents)
-   , ("myName", Json.Encode.string val.myName)
+   [ ("players", (Json.Encode.list jsonEncPlayerView) val.players)
+   , ("me", jsonEncPlayerView val.me)
    , ("table", jsonEncTableView val.table)
    , ("hand", (Json.Encode.list jsonEncWhiteCard) val.hand)
    ]
@@ -157,6 +186,7 @@ type ClientMessage  =
     ChangeMyName String
     | ProposeWhiteCards (List WhiteCard)
     | SubmitVote Int
+    | ConfirmTally 
 
 jsonDecClientMessage : Json.Decode.Decoder ( ClientMessage )
 jsonDecClientMessage =
@@ -164,6 +194,7 @@ jsonDecClientMessage =
             [ ("ChangeMyName", Json.Decode.lazy (\_ -> Json.Decode.map ChangeMyName (Json.Decode.string)))
             , ("ProposeWhiteCards", Json.Decode.lazy (\_ -> Json.Decode.map ProposeWhiteCards (Json.Decode.list (jsonDecWhiteCard))))
             , ("SubmitVote", Json.Decode.lazy (\_ -> Json.Decode.map SubmitVote (Json.Decode.int)))
+            , ("ConfirmTally", Json.Decode.lazy (\_ -> Json.Decode.succeed ConfirmTally))
             ]
     in  decodeSumObjectWithSingleField  "ClientMessage" jsonDecDictClientMessage
 
@@ -173,6 +204,7 @@ jsonEncClientMessage  val =
                     ChangeMyName v1 -> ("ChangeMyName", encodeValue (Json.Encode.string v1))
                     ProposeWhiteCards v1 -> ("ProposeWhiteCards", encodeValue ((Json.Encode.list jsonEncWhiteCard) v1))
                     SubmitVote v1 -> ("SubmitVote", encodeValue (Json.Encode.int v1))
+                    ConfirmTally  -> ("ConfirmTally", encodeValue (Json.Encode.list identity []))
     in encodeSumObjectWithSingleField keyval val
 
 
diff --git a/client/style.css b/client/style.css
index 4a134c6..e3824b6 100644
--- a/client/style.css
+++ b/client/style.css
@@ -25,6 +25,10 @@ html {
   background: #003300;
 }
 
+.winner {
+  background: #701e58;
+}
+
 .white {
   color: black;
   background: white;