From e3a2052522471d39e410f4ea13d51d3d18f52b80 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Fri, 31 Jul 2020 17:13:37 +0200 Subject: Multiple \BLANK in black cards --- client/src/Client.elm | 61 ++++++++++++++++++++++++++++++------------------- client/src/Messages.elm | 12 +++++----- 2 files changed, 43 insertions(+), 30 deletions(-) (limited to 'client/src') diff --git a/client/src/Client.elm b/client/src/Client.elm index 178e406..9639ec9 100644 --- a/client/src/Client.elm +++ b/client/src/Client.elm @@ -30,7 +30,7 @@ type alias GameState = { cards : Cards , view : GameView , changeMyName : String - , selectedWhiteCard : Maybe WhiteCard + , selectedWhiteCards : List WhiteCard } type Model @@ -89,26 +89,27 @@ view model = case model of (\c -> whiteCard game.cards c (cardIsSelected game c)) game.view.hand) -selectedWhiteCard : GameState -> Maybe WhiteCard -selectedWhiteCard game = case game.view.table of - Messages.Proposing _ (Just my) -> Just my - _ -> game.selectedWhiteCard +tableBlackCard : GameState -> Maybe BlackCard +tableBlackCard game = case game.view.table of + Messages.Proposing b _ -> Just b + +selectedWhiteCards : GameState -> List WhiteCard +selectedWhiteCards game = case game.view.table of + Messages.Proposing _ (x :: xs) -> x :: xs + _ -> game.selectedWhiteCards cardIsSelected : GameState -> WhiteCard -> Bool -cardIsSelected game card = selectedWhiteCard game == Just card +cardIsSelected game card = List.member card <| selectedWhiteCards game viewTable : GameState -> Html Msg viewTable game = case game.view.table of Messages.Proposing c my -> Html.div [] <| - [ blackCard game.cards c <| case selectedWhiteCard game of - Nothing -> [] - Just wc -> [wc] + [ blackCard game.cards c <| selectedWhiteCards game , Html.button - [ Html.Attributes.disabled <| case my of - Just _ -> True - _ -> case selectedWhiteCard game of - Nothing -> True - Just _ -> False + [ Html.Attributes.disabled <| + List.length my > 0 || + List.length (selectedWhiteCards game) /= + blackCardBlanks game.cards c , Html.Events.onClick ProposeWhiteCards ] [Html.text "Propose"] @@ -122,8 +123,15 @@ intersperseWith values def list = case list of [] -> x :: def :: intersperseWith values def (y :: t) v :: vs -> x :: v :: intersperseWith vs def (y :: t) +blackCardContent : Cards -> BlackCard -> List String +blackCardContent cards (Messages.BlackCard idx) = + String.split "\\BLANK" <| Maybe.withDefault "" <| Array.get idx cards.black + +blackCardBlanks : Cards -> BlackCard -> Int +blackCardBlanks cards c = List.length (blackCardContent cards c) - 1 + blackCard : Cards -> BlackCard -> List WhiteCard -> Html a -blackCard cards (Messages.BlackCard idx) whites = +blackCard cards black whites = let blank mbWhite = Html.span [Html.Attributes.class "blank"] <| case mbWhite of @@ -131,9 +139,7 @@ blackCard cards (Messages.BlackCard idx) whites = Just w -> [Html.text <| whiteCardContent cards w] in Html.div [Html.Attributes.class "card", Html.Attributes.class "black"] <| intersperseWith (List.map (\c -> blank (Just c)) whites) (blank Nothing) <| - List.map Html.text <| - String.split "\\BLANK" <| Maybe.withDefault "" <| - Array.get idx cards.black + List.map Html.text <| blackCardContent cards black whiteCardContent : Cards -> WhiteCard -> String whiteCardContent cards (Messages.WhiteCard idx) = @@ -173,7 +179,7 @@ update msg model = case msg of { cards = {black = Array.empty, white = Array.empty} , view = gameView , changeMyName = gameView.myName - , selectedWhiteCard = Nothing + , selectedWhiteCards = [] } , Cmd.none ) @@ -194,15 +200,22 @@ update msg model = case msg of _ -> (model, Cmd.none) SelectWhiteCard card -> case model of - Game game -> (Game {game | selectedWhiteCard = Just card}, Cmd.none) + Game game -> + let cards = case List.member card game.selectedWhiteCards of + True -> List.filter (\c -> c /= card) game.selectedWhiteCards + False -> List.take + (case tableBlackCard game of + Nothing -> 0 + Just c -> blackCardBlanks game.cards c - 1) + game.selectedWhiteCards ++ + [card] in + (Game {game | selectedWhiteCards = cards}, Cmd.none) _ -> (model, Cmd.none) ProposeWhiteCards -> case model of Game game -> - ( Game {game | selectedWhiteCard = Nothing} - , case game.selectedWhiteCard of - Nothing -> Cmd.none - Just c -> send <| Messages.ProposeWhiteCards c + ( Game {game | selectedWhiteCards = []} + , send <| Messages.ProposeWhiteCards game.selectedWhiteCards ) _ -> (model, Cmd.none) diff --git a/client/src/Messages.elm b/client/src/Messages.elm index b38fbd5..11c34ca 100644 --- a/client/src/Messages.elm +++ b/client/src/Messages.elm @@ -77,16 +77,16 @@ jsonEncOpponent val = type TableView = - Proposing BlackCard (Maybe WhiteCard) + Proposing BlackCard (List WhiteCard) jsonDecTableView : Json.Decode.Decoder ( TableView ) jsonDecTableView = - Json.Decode.lazy (\_ -> Json.Decode.map2 Proposing (Json.Decode.index 0 (jsonDecBlackCard)) (Json.Decode.index 1 (Json.Decode.maybe (jsonDecWhiteCard)))) + Json.Decode.lazy (\_ -> Json.Decode.map2 Proposing (Json.Decode.index 0 (jsonDecBlackCard)) (Json.Decode.index 1 (Json.Decode.list (jsonDecWhiteCard)))) jsonEncTableView : TableView -> Value jsonEncTableView (Proposing v1 v2) = - Json.Encode.list identity [jsonEncBlackCard v1, (maybeEncode (jsonEncWhiteCard)) v2] + Json.Encode.list identity [jsonEncBlackCard v1, (Json.Encode.list jsonEncWhiteCard) v2] @@ -145,13 +145,13 @@ jsonEncServerMessage val = type ClientMessage = ChangeMyName String - | ProposeWhiteCards WhiteCard + | ProposeWhiteCards (List WhiteCard) jsonDecClientMessage : Json.Decode.Decoder ( ClientMessage ) jsonDecClientMessage = let jsonDecDictClientMessage = Dict.fromList [ ("ChangeMyName", Json.Decode.lazy (\_ -> Json.Decode.map ChangeMyName (Json.Decode.string))) - , ("ProposeWhiteCards", Json.Decode.lazy (\_ -> Json.Decode.map ProposeWhiteCards (jsonDecWhiteCard))) + , ("ProposeWhiteCards", Json.Decode.lazy (\_ -> Json.Decode.map ProposeWhiteCards (Json.Decode.list (jsonDecWhiteCard)))) ] in decodeSumObjectWithSingleField "ClientMessage" jsonDecDictClientMessage @@ -159,7 +159,7 @@ jsonEncClientMessage : ClientMessage -> Value jsonEncClientMessage val = let keyval v = case v of ChangeMyName v1 -> ("ChangeMyName", encodeValue (Json.Encode.string v1)) - ProposeWhiteCards v1 -> ("ProposeWhiteCards", encodeValue (jsonEncWhiteCard v1)) + ProposeWhiteCards v1 -> ("ProposeWhiteCards", encodeValue ((Json.Encode.list jsonEncWhiteCard) v1)) in encodeSumObjectWithSingleField keyval val -- cgit v1.2.3