From 6034f1617392d09e3a5f9af19b064cc369f546e0 Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt
Date: Tue, 4 Aug 2020 20:20:12 +0200
Subject: Make it look decent
---
client/index.html | 1 +
client/src/Client.elm | 142 +++++++++++++++++++++++++++++++-----------------
client/src/Messages.elm | 9 +--
client/style.css | 48 ++++++++++++++--
4 files changed, 139 insertions(+), 61 deletions(-)
(limited to 'client')
diff --git a/client/index.html b/client/index.html
index 9b09840..518b71d 100644
--- a/client/index.html
+++ b/client/index.html
@@ -4,6 +4,7 @@
Client
+
diff --git a/client/src/Client.elm b/client/src/Client.elm
index 6d64050..2d43ae2 100644
--- a/client/src/Client.elm
+++ b/client/src/Client.elm
@@ -32,7 +32,8 @@ type Msg
type alias Cards = {black : Array String, white : Array String}
type alias GameState =
- { cards : Cards
+ { room : Maybe String
+ , cards : Cards
, view : GameView
, changeMyName : String
, selectedWhiteCards : List WhiteCard
@@ -41,58 +42,87 @@ type alias GameState =
type Model
= Error String
- | Connecting
+ | Connecting (Maybe String)
| Game GameState
-viewPlayer : Messages.PlayerView -> Html msg
-viewPlayer player = Html.div [] <|
- [ Html.text player.name
- ] ++
- (if player.admin then [Html.text " 👑"] else []) ++
- (if player.ready then [Html.text " ✅"] else []) ++
- [Html.text <| " (" ++ String.fromInt player.points ++ " points)"]
+viewPlayers : List Messages.PlayerView -> Html msg
+viewPlayers players = Html.table [] <|
+ Html.tr []
+ [ Html.th
+ [Html.Attributes.style "width" "100%"]
+ [Html.text "Name"]
+ , Html.th [] [Html.text "Score"]
+ ] ::
+ List.map (\player -> Html.tr []
+ [ Html.td [] [Html.text player.name]
+ , Html.td
+ [Html.Attributes.style "text-align" "right"]
+ [Html.text <| String.fromInt player.points]
+ , Html.td []
+ (if player.admin then [Html.text " 👑"] else [])
+ , Html.td []
+ (if player.ready then [Html.text " ✅"] else [])
+ ])
+ (List.sortBy (\player -> (-player.points, player.name)) players)
-view : Model -> List (Html Msg)
+view : Model -> Browser.Document Msg
view model = case model of
Error str ->
- [ Html.h1 [] [Html.text "Error"]
- , Html.p [] [Html.text str]
- ]
- Connecting -> [Html.h1 [] [Html.text "Connecting to room..."]]
+ { title = "CaFP: Error"
+ , body =
+ [ Html.h1 [] [Html.text "Error"]
+ , Html.p [] [Html.text str]
+ ]
+ }
+ Connecting roomId ->
+ { title = "CaFP: Connecting"
+ , body =
+ [ Html.h1 []
+ [ Html.text <|
+ "Connecting to room " ++ Maybe.withDefault "??" roomId
+ ]
+ ]
+ }
Game game ->
- [ Html.div [Html.Attributes.class "players"]
- [ Html.h1 [] [Html.text "Players"]
- , Html.ul [] <| List.map
- (\o -> Html.li [] [viewPlayer o])
- (game.view.me :: game.view.players)
- , Html.form
- [ Html.Attributes.action ""
- , Html.Events.onSubmit SubmitMyName
+ { title = case game.room of
+ Nothing -> "CaFP"
+ Just room -> "CaFP | " ++ room
+ , body =
+ [ Html.div [Html.Attributes.class "main"] <|
+ [ Html.div [Html.Attributes.class "table"]
+ [Html.h1 [] [Html.text "Table"]
+ , viewTable game
+ ]
+ , Html.h1 [] [Html.text "Your cards"]
]
- [ Html.input
- [ Html.Attributes.value game.changeMyName
- , Html.Events.onInput ChangeMyName
+ ++
+ (List.map
+ (\c -> whiteCard game.cards c (cardIsSelected game c))
+ game.view.hand)
+ , Html.div [Html.Attributes.class "players"]
+ [ Html.h1 [] [Html.text "Players"]
+ , viewPlayers <| game.view.me :: game.view.players
+ , Html.form
+ [ Html.Attributes.class "change-name"
+ , Html.Attributes.action ""
+ , Html.Events.onSubmit SubmitMyName
]
- []
- , Html.button
- [ Html.Attributes.type_ "submit"
- , Html.Attributes.disabled <|
- game.view.me.name == game.changeMyName ||
- String.length game.changeMyName > 32
+ [ Html.input
+ [ Html.Attributes.value game.changeMyName
+ , Html.Events.onInput ChangeMyName
+ ]
+ []
+ , Html.button
+ [ Html.Attributes.type_ "submit"
+ , Html.Attributes.disabled <|
+ game.view.me.name == game.changeMyName ||
+ String.length game.changeMyName > 32
+ ]
+ [Html.text "Change my name"]
]
- [Html.text "Change name"]
]
]
- , Html.div [Html.Attributes.class "main"] <|
- [ Html.h1 [] [Html.text "Table"]
- , viewTable game
- , Html.h1 [] [Html.text "Your cards"]
- ]
- ++
- (List.map
- (\c -> whiteCard game.cards c (cardIsSelected game c))
- game.view.hand)
- ]
+ }
tableBlackCard : GameState -> Maybe BlackCard
tableBlackCard game = case game.view.table of
@@ -111,7 +141,14 @@ 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 <| selectedWhiteCards game
+ [ Html.p []
+ [ Html.text <| "Select " ++
+ String.fromInt (blackCardBlanks game.cards c) ++
+ " card" ++
+ (if blackCardBlanks game.cards c < 2 then "" else "s") ++
+ " from your hand"
+ ]
+ , blackCard [] game.cards c <| selectedWhiteCards game
, Html.button
[ Html.Attributes.disabled <|
List.length my > 0 ||
@@ -122,8 +159,7 @@ viewTable game = case game.view.table of
[Html.text "Propose"]
]
Messages.Voting black proposals myProposal myVote -> Html.div [] <|
- [ Html.h2 [] [Html.text "Opponent proposals"]
- ] ++
+ [Html.p [] [Html.text <| "Vote for the funniest combination"]] ++
List.indexedMap (\i proposal ->
let attrs =
if Just i == myProposal then
@@ -148,7 +184,7 @@ viewTable game = case game.view.table of
]
Messages.Tally black results -> Html.div [] <|
- [Html.h2 [] [Html.text "Vote results"]] ++
+ [Html.p [] [Html.text "Vote results"]] ++
List.map (\voted ->
let attrs =
if List.length voted.winners > 0 then
@@ -227,14 +263,18 @@ update msg model = case msg of
WebSocketIn json ->
case Json.Decode.decodeString Messages.jsonDecServerMessage json of
Err str -> (Error <| Json.Decode.errorToString str, Cmd.none)
- Ok (Messages.Welcome playerId) -> (model, Cmd.none)
- Ok Messages.Bye -> (model, Cmd.none)
+ Ok (Messages.Welcome roomId) -> case model of
+ Connecting _ -> (Connecting (Just roomId), Cmd.none)
+ _ -> (model, Cmd.none)
Ok (Messages.SyncGameView gameView) ->
case model of
Game game -> (Game {game | view = gameView}, Cmd.none)
_ ->
( Game
- { cards = {black = Array.empty, white = Array.empty}
+ { room = case model of
+ Connecting roomId -> roomId
+ _ -> Nothing
+ , cards = {black = Array.empty, white = Array.empty}
, view = gameView
, changeMyName = gameView.me.name
, selectedWhiteCards = []
@@ -298,10 +338,10 @@ update msg model = case msg of
main : Program () Model Msg
main = Browser.application
- { init = \() url key -> (Connecting, Cmd.none)
+ { init = \() url key -> (Connecting Nothing, Cmd.none)
, update = update
, subscriptions = subscriptions
- , view = \model -> {title = "Client", body = view model}
+ , view = \model -> view model
, onUrlChange = \url -> Ignore
, onUrlRequest = \urlRequest -> Ignore
}
diff --git a/client/src/Messages.elm b/client/src/Messages.elm
index 434efb0..fb244f9 100644
--- a/client/src/Messages.elm
+++ b/client/src/Messages.elm
@@ -156,28 +156,25 @@ jsonEncGameView val =
type ServerMessage =
- Welcome Int
+ Welcome String
| SyncCards Cards
| SyncGameView GameView
- | Bye
jsonDecServerMessage : Json.Decode.Decoder ( ServerMessage )
jsonDecServerMessage =
let jsonDecDictServerMessage = Dict.fromList
- [ ("Welcome", Json.Decode.lazy (\_ -> Json.Decode.map Welcome (Json.Decode.int)))
+ [ ("Welcome", Json.Decode.lazy (\_ -> Json.Decode.map Welcome (Json.Decode.string)))
, ("SyncCards", Json.Decode.lazy (\_ -> Json.Decode.map SyncCards (jsonDecCards)))
, ("SyncGameView", Json.Decode.lazy (\_ -> Json.Decode.map SyncGameView (jsonDecGameView)))
- , ("Bye", Json.Decode.lazy (\_ -> Json.Decode.succeed Bye))
]
in decodeSumObjectWithSingleField "ServerMessage" jsonDecDictServerMessage
jsonEncServerMessage : ServerMessage -> Value
jsonEncServerMessage val =
let keyval v = case v of
- Welcome v1 -> ("Welcome", encodeValue (Json.Encode.int v1))
+ Welcome v1 -> ("Welcome", encodeValue (Json.Encode.string v1))
SyncCards v1 -> ("SyncCards", encodeValue (jsonEncCards v1))
SyncGameView v1 -> ("SyncGameView", encodeValue (jsonEncGameView v1))
- Bye -> ("Bye", encodeValue (Json.Encode.list identity []))
in encodeSumObjectWithSingleField keyval val
diff --git a/client/style.css b/client/style.css
index 735c5f8..8f1f293 100644
--- a/client/style.css
+++ b/client/style.css
@@ -1,9 +1,46 @@
html {
font-size: 18px;
+ font-family: sans-serif;
+ text-align: center;
}
-body {
- display: flex;
+h1 {
+ font-weight: lighter;
+ text-transform: uppercase;
+ font-size: 24px;
+ border-bottom: 1px solid black;
+}
+
+@media screen and (min-width: 800px) {
+ .players {
+ position: absolute;
+ top: 0px;
+ left: 18px;
+ width: 250px;
+ }
+
+ .main {
+ position: absolute;
+ top: 0px;
+ left: 280px;
+ }
+}
+
+.table {
+ margin-bottom: 60px;
+}
+
+table {
+ text-align: left;
+}
+
+.change-name {
+ margin-top: 18px;
+}
+
+button, input {
+ display: block;
+ margin: 12px auto 12px auto;
}
.card {
@@ -12,13 +49,17 @@ body {
margin: 18px;
padding: 18px;
width: 300px;
+ border: 2px solid black;
vertical-align: text-top;
+ max-width: calc(100% - 76px);
+ filter: drop-shadow(3px 3px 3px black);
}
.black {
color: white;
background: black;
- width: 600px;
+ width: inherit;
+ margin: 12px auto 12px auto;
}
.votable {
@@ -41,7 +82,6 @@ body {
.white {
color: black;
background: white;
- border: 2px solid black;
cursor: pointer;
}
--
cgit v1.2.3