aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJasper Van der Jeugt2020-08-04 20:20:12 +0200
committerJasper Van der Jeugt2020-08-04 20:20:12 +0200
commit6034f1617392d09e3a5f9af19b064cc369f546e0 (patch)
tree98f726c9a18d36f24ba7745c409caf01e58736d5
parenta2e72144746fdecc0539286798c0a46a02e47d5f (diff)
Make it look decent
Diffstat
-rw-r--r--client/index.html1
-rw-r--r--client/src/Client.elm142
-rw-r--r--client/src/Messages.elm9
-rw-r--r--client/style.css48
-rw-r--r--config.mk2
-rw-r--r--server/lib/Cafp/Main/Server.hs1
-rw-r--r--server/lib/Cafp/Messages.hs3
7 files changed, 142 insertions, 64 deletions
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 @@
<meta charset="UTF-8">
<title>Client</title>
<link rel="stylesheet" type="text/css" href="$CAFP_BASE/assets/style.css">
+ <meta name="viewport" content="width=device-width">
</head>
<body>
<div id="main"></div>
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;
}
diff --git a/config.mk b/config.mk
index add25a1..63235ac 100644
--- a/config.mk
+++ b/config.mk
@@ -1,3 +1,3 @@
-CAFP_HOSTNAME=127.0.0.1
+CAFP_HOSTNAME=0.0.0.0
CAFP_PORT=8002
CAFP_BASE=/cafp
diff --git a/server/lib/Cafp/Main/Server.hs b/server/lib/Cafp/Main/Server.hs
index 799f26e..4b1bfe7 100644
--- a/server/lib/Cafp/Main/Server.hs
+++ b/server/lib/Cafp/Main/Server.hs
@@ -142,6 +142,7 @@ wsApp server pc = case routePendingConnection pc of
roomEmpty <- atomically $ leaveRoom room playerId
if roomEmpty then deleteRoom server roomId else syncRoom room)
(\playerId -> do
+ sink . Aeson.encode $ Welcome roomId
syncRoom room
cards <- fmap (^. gameCards) . atomically . STM.readTVar $
roomGame room
diff --git a/server/lib/Cafp/Messages.hs b/server/lib/Cafp/Messages.hs
index b572fb7..a02058f 100644
--- a/server/lib/Cafp/Messages.hs
+++ b/server/lib/Cafp/Messages.hs
@@ -62,10 +62,9 @@ data GameView = GameView
} deriving (Show)
data ServerMessage
- = Welcome !Int
+ = Welcome !Text
| SyncCards !Cards
| SyncGameView !GameView
- | Bye
deriving (Show)
data ClientMessage
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-22 11:04:25 +0000