Resolve #94: Reintroduced TTS support. Resolve #68: Added voice selection for TTS.

client/Dockerfile

@@ -7,7 +7,6 @@ WORKDIR /md
 
 COPY ["./package.json", "./package-lock.json", "./"]
 
-
 RUN ["apk", "add", "--no-cache", "--virtual", ".gyp", "python", "make", "g++"]
 RUN ["npm", "ci"]
 

client/src/elm/MassiveDecks.elm

@@ -7,6 +7,7 @@ import Html.Attributes as HtmlA
 import Json.Decode as Json
 import MassiveDecks.Cast.Client as Cast
 import MassiveDecks.Cast.Model as Cast
+import MassiveDecks.Error.Messages as Error
 import MassiveDecks.Error.Model as Error
 import MassiveDecks.Error.Overlay as Overlay
 import MassiveDecks.Messages exposing (..)
@@ -82,6 +83,7 @@ subscriptions : Model -> Sub Msg
 subscriptions model =
     Sub.batch
         [ Cast.subscriptions
+        , Settings.subscriptions (Error.Add >> ErrorMsg) SettingsMsg
         , model.page |> Pages.subscriptions
         ]
 
@@ -205,7 +207,7 @@ update msg model =
         LobbyMsg lobbyMsg ->
             case model.page of
                 Pages.Lobby lobbyModel ->
-                    Lobby.update model.shared.key lobbyMsg lobbyModel
+                    Lobby.update model.shared lobbyMsg lobbyModel
                         |> Util.modelLift (\newLobbyModel -> { model | page = Pages.Lobby newLobbyModel })
 
                 _ ->

client/src/elm/MassiveDecks/Card/Parts.elm

@@ -8,7 +8,7 @@ module MassiveDecks.Card.Parts exposing
     , unsafeFromList
     , view
     , viewFilled
-    , viewSingleLine
+    , viewFilledString
     )
 
 import Html exposing (Html)
@@ -94,56 +94,78 @@ view parts =
     viewFilled [] parts
 
 
-viewSingleLine : Parts -> List (Html msg)
-viewSingleLine (Parts lines) =
-    lines |> List.concat |> viewParts []
+{-| Render the `Parts` to a string.
+-}
+viewFilledString : String -> List String -> Parts -> String
+viewFilledString blankString play (Parts lines) =
+    viewLinesString blankString play lines |> String.join "\n"
 
 
 {-| Render the `Parts` with slots filled with the given values.
 -}
 viewFilled : List String -> Parts -> List (Html msg)
 viewFilled play (Parts lines) =
-    viewLines play lines
+    viewLinesHtml play lines
 
 
 
 {- Private -}
 
 
-viewLines : List String -> List Line -> List (Html msg)
-viewLines play lines =
+viewLines : (List String -> List Part -> a) -> List String -> List Line -> List a
+viewLines renderParts play lines =
     case lines of
         firstLine :: restLines ->
             let
                 slots =
                     firstLine |> List.filter isSlot |> List.length
             in
-            (viewParts (List.take slots play) firstLine |> Html.p []) :: viewLines (List.drop slots play) restLines
+            renderParts (List.take slots play) firstLine :: viewLines renderParts (List.drop slots play) restLines
 
         [] ->
             []
 
 
-viewParts : List String -> List Part -> List (Html msg)
-viewParts play parts =
+viewLinesHtml : List String -> List Line -> List (Html msg)
+viewLinesHtml =
+    viewLines (\s -> \p -> viewPartsHtml s p |> Html.p [])
+
+
+viewLinesString : String -> List String -> List Line -> List String
+viewLinesString blankPhrase =
+    viewLines (\s -> \p -> viewPartsString blankPhrase s p |> String.join "")
+
+
+viewParts : (Bool -> String -> List a) -> a -> List String -> List Part -> List a
+viewParts viewText emptySlot play parts =
     case parts of
         firstPart :: restParts ->
             case firstPart of
                 Text string ->
-                    viewText False string ++ viewParts play restParts
+                    viewText False string ++ viewParts viewText emptySlot play restParts
 
                 Slot transform ->
                     case play of
                         firstPlay :: restPlay ->
-                            viewText True (applyTransform transform firstPlay) ++ viewParts restPlay restParts
+                            viewText True (applyTransform transform firstPlay) ++ viewParts viewText emptySlot restPlay restParts
 
                         [] ->
-                            Html.span [ HtmlA.class "slot" ] [] :: viewParts [] restParts
+                            emptySlot :: viewParts viewText emptySlot [] restParts
 
         [] ->
             []
 
 
+viewPartsHtml : List String -> List Part -> List (Html msg)
+viewPartsHtml =
+    viewParts viewTextHtml (Html.span [ HtmlA.class "slot" ] [])
+
+
+viewPartsString : String -> List String -> List Part -> List String
+viewPartsString blankPhrase =
+    viewParts (\_ -> \s -> [ s ]) blankPhrase
+
+
 applyTransform : Transform -> String -> String
 applyTransform transform value =
     case transform of
@@ -157,8 +179,8 @@ applyTransform transform value =
             value
 
 
-viewText : Bool -> String -> List (Html msg)
-viewText slot string =
+viewTextHtml : Bool -> String -> List (Html msg)
+viewTextHtml slot string =
     let
         words =
             string |> splitWords |> List.map (\word -> Html.span [] [ Html.text word ])

client/src/elm/MassiveDecks/Game.elm

@@ -15,7 +15,8 @@ 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
+import MassiveDecks.Card.Model as Card exposing (Call)
+import MassiveDecks.Card.Parts as Parts
 import MassiveDecks.Card.Play as Play exposing (Play)
 import MassiveDecks.Components as Components
 import MassiveDecks.Game.Action as Action
@@ -36,6 +37,8 @@ import MassiveDecks.Pages.Lobby.Configure.Model exposing (Config)
 import MassiveDecks.Pages.Lobby.Events as Events
 import MassiveDecks.Pages.Lobby.Messages as Lobby
 import MassiveDecks.Pages.Lobby.Model as Lobby exposing (Lobby)
+import MassiveDecks.Settings.Model exposing (Settings)
+import MassiveDecks.Speech as Speech
 import MassiveDecks.Strings as Strings exposing (MdString)
 import MassiveDecks.Strings.Languages as Lang
 import MassiveDecks.User as User exposing (User)
@@ -64,8 +67,8 @@ init game hand pick =
     ( { model | hand = hand, game = { game | round = round } }, cmd )
 
 
-update : Msg -> Model -> ( Model, Cmd Global.Msg )
-update msg model =
+update : Shared -> Msg -> Model -> ( Model, Cmd Global.Msg )
+update shared msg model =
     let
         game =
             model.game
@@ -189,8 +192,15 @@ update msg model =
         AdvanceRound ->
             case model.completeRound of
                 Just _ ->
+                    let
+                        round =
+                            model.game.round
+
+                        tts =
+                            speak shared (round |> Round.data |> .call) Nothing
+                    in
                     ( { model | completeRound = Nothing }
-                    , Cmd.none
+                    , tts
                     )
 
                 Nothing ->
@@ -340,8 +350,8 @@ viewAction shared visible =
     Html.div [] (Action.actions |> List.map (Action.view shared visible))
 
 
-applyGameEvent : Lobby.Auth -> Events.GameEvent -> Model -> ( Model, Cmd Global.Msg )
-applyGameEvent auth gameEvent model =
+applyGameEvent : Lobby.Auth -> Shared -> Events.GameEvent -> Model -> ( Model, Cmd Global.Msg )
+applyGameEvent auth shared gameEvent model =
     case gameEvent of
         Events.HandRedrawn { player, hand } ->
             let
@@ -369,7 +379,7 @@ applyGameEvent auth gameEvent model =
                 game =
                     model.game
 
-                newRound =
+                ( newRound, speech ) =
                     case model.game.round of
                         Round.R r ->
                             let
@@ -378,18 +388,24 @@ applyGameEvent auth gameEvent model =
 
                                 known =
                                     plays |> List.filterMap Play.asKnown
-                            in
-                            if List.length known == List.length plays then
-                                Round.judging r.id r.czar r.players r.call known |> Round.J
 
-                            else
-                                { r | plays = plays } |> Round.R
+                                round =
+                                    if List.length known == List.length plays then
+                                        Round.judging r.id r.czar r.players r.call known |> Round.J
+
+                                    else
+                                        { r | plays = plays } |> Round.R
+
+                                tts =
+                                    speak shared r.call (Just play)
+                            in
+                            ( round, tts )
 
                         _ ->
                             -- TODO: Error
-                            model.game.round
+                            ( model.game.round, Cmd.none )
             in
-            ( { model | game = { game | round = newRound } }, Cmd.none )
+            ( { model | game = { game | round = newRound } }, speech )
 
         Events.PlaySubmitted { by } ->
             case model.game.round of
@@ -429,7 +445,7 @@ applyGameEvent auth gameEvent model =
                 newPlayers =
                     game.players |> Dict.update winner (Maybe.map (\p -> { p | score = p.score + 1 }))
 
-                ( newRound, history ) =
+                ( newRound, history, speech ) =
                     case game.round of
                         Round.J r ->
                             let
@@ -438,14 +454,19 @@ applyGameEvent auth gameEvent model =
 
                                 complete =
                                     Round.complete r.id r.czar r.players r.call plays winner
+
+                                tts =
+                                    Dict.get winner plays
+                                        |> Maybe.map (\p -> speak shared r.call (Just p))
+                                        |> Maybe.withDefault Cmd.none
                             in
-                            ( complete |> Round.C, complete :: game.history )
+                            ( complete |> Round.C, complete :: game.history, tts )
 
                         _ ->
                             -- TODO: Error
-                            ( game.round, game.history )
+                            ( game.round, game.history, Cmd.none )
             in
-            ( { model | game = { game | round = newRound, players = newPlayers, history = history } }, Cmd.none )
+            ( { model | game = { game | round = newRound, players = newPlayers, history = history } }, speech )
 
         Events.RoundStarted { id, czar, players, call, drawn } ->
             let
@@ -529,6 +550,16 @@ applyGameStarted lobby round hand =
 {- Private -}
 
 
+speak : Shared -> Card.Call -> Maybe (List Card.Response) -> Cmd msg
+speak shared call play =
+    Speech.speak shared.settings.settings.speech
+        (Parts.viewFilledString
+            (Strings.Blank |> Lang.string shared)
+            (play |> Maybe.map (List.map .body) |> Maybe.withDefault [])
+            call.body
+        )
+
+
 reveal : Play.Id -> List Card.Response -> Play -> Play
 reveal target responses play =
     case play.responses of

client/src/elm/MassiveDecks/Models/Decoders.elm

@@ -39,6 +39,7 @@ import MassiveDecks.Pages.Lobby.GameCode as GameCode exposing (GameCode)
 import MassiveDecks.Pages.Lobby.Model as Lobby exposing (Lobby)
 import MassiveDecks.Pages.Start.LobbyBrowser.Model as LobbyBrowser
 import MassiveDecks.Settings.Model as Settings exposing (Settings)
+import MassiveDecks.Speech as Speech
 import MassiveDecks.Strings.Languages as Lang
 import MassiveDecks.Strings.Languages.Model as Lang exposing (Language)
 import MassiveDecks.User as User exposing (User)
@@ -91,13 +92,21 @@ flags =
 
 settings : Json.Decoder Settings
 settings =
-    Json.map6 Settings
+    Json.map7 Settings
         (Json.field "tokens" (Json.dict lobbyToken))
         (Json.field "openUserList" Json.bool)
         (Json.maybe (Json.field "lastUsedName" Json.string))
         (Json.field "recentDecks" (Json.list externalSource))
         (Json.maybe (Json.field "chosenLanguage" language))
         (Json.field "compactCards" cardSize)
+        (Json.maybe (Json.field "speech" speech) |> Json.map (Maybe.withDefault Speech.default))
+
+
+speech : Json.Decoder Speech.Settings
+speech =
+    Json.map2 Speech.Settings
+        (Json.field "enabled" Json.bool)
+        (Json.maybe (Json.field "selectedVoice" Json.string))
 
 
 cardSize : Json.Decoder Settings.CardSize

client/src/elm/MassiveDecks/Models/Encoders.elm

@@ -19,6 +19,7 @@ import MassiveDecks.Game.Rules as Rules
 import MassiveDecks.Pages.Lobby.Model as Lobby
 import MassiveDecks.Pages.Start.Model as Start
 import MassiveDecks.Settings.Model as Settings exposing (Settings)
+import MassiveDecks.Speech as Speech
 import MassiveDecks.Strings.Languages as Lang
 import MassiveDecks.Strings.Languages.Model as Lang exposing (Language)
 import MassiveDecks.User as User
@@ -44,6 +45,7 @@ settings s =
                   , ( "openUserList", Json.bool s.openUserList )
                   , ( "recentDecks", Json.list source s.recentDecks )
                   , ( "compactCards", s.cardSize |> cardSize )
+                  , ( "speech", s.speech |> speech )
                   ]
                 , lun
                 , cl
@@ -52,6 +54,21 @@ settings s =
     Json.object fields
 
 
+speech : Speech.Settings -> Json.Value
+speech speechSettings =
+    let
+        enabledField =
+            [ ( "enabled", speechSettings.enabled |> Json.bool ) ]
+
+        selectedVoiceField =
+            speechSettings.selectedVoice
+                |> Maybe.map (\sv -> [ ( "selectedVoice", Json.string sv ) ])
+                |> Maybe.withDefault []
+    in
+    Json.object
+        (List.concat [ enabledField, selectedVoiceField ])
+
+
 cardSize : Settings.CardSize -> Json.Value
 cardSize =
     Settings.cardSizeToValue >> Json.int

client/src/elm/MassiveDecks/Pages/Lobby.elm

@@ -46,7 +46,7 @@ import MassiveDecks.Pages.Start.Route as Start
 import MassiveDecks.ServerConnection as ServerConnection
 import MassiveDecks.Settings as Settings
 import MassiveDecks.Settings.Messages as Settings
-import MassiveDecks.Settings.Model as Settings
+import MassiveDecks.Settings.Model as Settings exposing (Settings)
 import MassiveDecks.Strings as Strings exposing (MdString)
 import MassiveDecks.Strings.Languages as Lang
 import MassiveDecks.User as User exposing (User)
@@ -108,15 +108,19 @@ subscriptions model =
         ]
 
 
-update : Navigation.Key -> Msg -> Model -> ( Model, Cmd Global.Msg )
-update key msg model =
+update : Shared -> Msg -> Model -> ( Model, Cmd Global.Msg )
+update shared msg model =
+    let
+        key =
+            shared.key
+    in
     case msg of
         GameMsg gameMsg ->
             case model.lobby of
                 Just l ->
                     l.game
                         |> Maybe.map
-                            (Game.update gameMsg
+                            (Game.update shared gameMsg
                                 >> Util.modelLift (\newGame -> { model | lobby = Just { l | game = Just newGame } })
                             )
                         |> Maybe.withDefault ( model, Cmd.none )
@@ -149,7 +153,7 @@ update key msg model =
                                     (\game ->
                                         Util.modelLift
                                             (\g -> { model | lobby = Just { lobby | game = Just g } })
-                                            (Game.applyGameEvent model.auth gameEvent game)
+                                            (Game.applyGameEvent model.auth shared gameEvent game)
                                     )
                                 |> Maybe.withDefault ( model, Cmd.none )
 

client/src/elm/MassiveDecks/Ports.elm

@@ -3,6 +3,8 @@ port module MassiveDecks.Ports exposing
     , copyText
     , serverRecv
     , serverSend
+    , speechCommands
+    , speechVoices
     , storeSettings
     , tryCast
     )
@@ -26,3 +28,9 @@ port serverRecv : (String -> msg) -> Sub msg
 
 
 port copyText : String -> Cmd msg
+
+
+port speechCommands : Json.Value -> Cmd msg
+
+
+port speechVoices : (Json.Value -> msg) -> Sub msg

client/src/elm/MassiveDecks/Settings.elm

@@ -4,6 +4,7 @@ module MassiveDecks.Settings exposing
     , init
     , onJoinLobby
     , onTokenUpdate
+    , subscriptions
     , update
     , view
     )
@@ -20,6 +21,7 @@ import Http
 import MassiveDecks.Components as Components
 import MassiveDecks.Components.Form as Form
 import MassiveDecks.Components.Form.Message as Message
+import MassiveDecks.Error.Model as Error exposing (Error)
 import MassiveDecks.Icon as Icon
 import MassiveDecks.LocalStorage as LocalStorage
 import MassiveDecks.Messages as Global
@@ -31,6 +33,7 @@ import MassiveDecks.Requests.Api as Api
 import MassiveDecks.Requests.Request as Request
 import MassiveDecks.Settings.Messages exposing (..)
 import MassiveDecks.Settings.Model exposing (..)
+import MassiveDecks.Speech as Speech
 import MassiveDecks.Strings as Strings
 import MassiveDecks.Strings.Languages as Lang
 import MassiveDecks.Strings.Languages.Model as Lang exposing (Language)
@@ -51,11 +54,15 @@ init settings =
                     |> Dict.values
                     |> Api.checkAlive (Request.map ignore ignore (RemoveInvalid >> Global.SettingsMsg))
                     |> Http.request
+
+        ( speech, speechCmd ) =
+            Speech.init
     in
     ( { settings = settings
       , open = False
+      , speech = speech
       }
-    , cmd
+    , Cmd.batch [ cmd, speechCmd ]
     )
 
 
@@ -67,9 +74,15 @@ defaults =
     , recentDecks = []
     , chosenLanguage = Nothing
     , cardSize = Full
+    , speech = Speech.default
     }
 
 
+subscriptions : (Error -> msg) -> (Msg -> msg) -> Sub msg
+subscriptions wrapError wrapMsg =
+    Speech.subscriptions (Error.Json >> wrapError) (SpeechMsg >> wrapMsg)
+
+
 update : Msg -> Model -> ( Model, Cmd Msg )
 update msg model =
     case msg of
@@ -93,6 +106,23 @@ update msg model =
             in
             changeSettings (\s -> { s | tokens = newTokens }) model
 
+        ToggleSpeech enabled ->
+            let
+                newSpeechSettings =
+                    model.settings.speech |> Speech.toggle enabled
+            in
+            changeSettings (\s -> { s | speech = newSpeechSettings }) model
+
+        ChangeSpeech voice ->
+            let
+                newSpeechSettings =
+                    model.settings.speech |> Speech.selectVoice voice
+            in
+            changeSettings (\s -> { s | speech = newSpeechSettings }) model
+
+        SpeechMsg speechMsg ->
+            ( { model | speech = model.speech |> Speech.update speechMsg }, Cmd.none )
+
 
 view : Shared -> Html Global.Msg
 view shared =
@@ -121,7 +151,7 @@ view shared =
                 , Html.div [ HtmlA.class "body" ]
                     [ languageSelector shared
                     , cardSize shared
-                    , speechSwitch shared
+                    , speechVoiceSelector shared
                     , notificationsSwitch shared
                     ]
                 ]
@@ -193,11 +223,8 @@ changeSettings f model =
 cardSize : Shared -> Html Global.Msg
 cardSize shared =
     let
-        model =
-            shared.settings
-
         settings =
-            model.settings
+            shared.settings.settings
     in
     Form.section shared
         "card-size"
@@ -217,10 +244,10 @@ cardSize shared =
                     >> ChangeCardSize
                     >> Global.SettingsMsg
                     |> HtmlE.onInput
-                , model.settings.cardSize |> cardSizeToValue |> String.fromInt |> WlA.value
+                , settings.cardSize |> cardSizeToValue |> String.fromInt |> WlA.value
                 ]
                 [ Icon.viewStyled [ Slider.slot Slider.Before ] Icon.searchMinus
-                , [ model.settings.cardSize |> cardSizeThumb ] |> Html.span [ Slider.slot Slider.ThumbLabel ]
+                , [ settings.cardSize |> cardSizeThumb ] |> Html.span [ Slider.slot Slider.ThumbLabel ]
                 , Icon.viewStyled [ Slider.slot Slider.After ] Icon.searchPlus
                 ]
             ]
@@ -241,22 +268,85 @@ cardSizeThumb size =
             Icon.viewIcon Icon.callCard
 
 
-speechSwitch : Shared -> Html Global.Msg
-speechSwitch shared =
-    -- TODO: Impl
-    Form.section shared
-        "speech"
-        (Html.div
-            [ HtmlA.class "multipart" ]
-            [ Wl.switch [ WlA.disabled ]
-            , Html.label []
-                [ Icon.viewIcon Icon.volumeUp
-                , Html.text " "
-                , Strings.SpeechSetting |> Lang.html shared
+speechVoiceSelector : Shared -> Html Global.Msg
+speechVoiceSelector shared =
+    let
+        selectedVoice =
+            shared.settings.settings.speech.selectedVoice
+
+        voices =
+            shared.settings.speech.voices
+
+        enabled =
+            shared.settings.settings.speech.enabled
+
+        isDisabled =
+            List.isEmpty voices
+
+        notPossibleWarning =
+            if isDisabled then
+                Message.warning Strings.SpeechNotSupportedExplanation
+
+            else
+                Message.none
+    in
+    Html.div []
+        [ Form.section shared
+            "speech"
+            (Html.div []
+                [ Html.div
+                    [ HtmlA.class "multipart" ]
+                    [ Wl.switch
+                        [ HtmlE.onCheck (ToggleSpeech >> Global.SettingsMsg)
+                        , HtmlA.disabled isDisabled
+                        , HtmlA.checked enabled
+                        ]
+                    , Html.label []
+                        [ Icon.viewIcon Icon.commentDots
+                        , Html.text " "
+                        , Strings.SpeechSetting |> Lang.html shared
+                        ]
+                    ]
+                , Wl.select
+                    [ HtmlE.onInput (ChangeSpeech >> Global.SettingsMsg)
+                    , Strings.VoiceSetting |> Lang.string shared |> WlA.label
+                    , WlA.outlined
+                    , HtmlA.disabled (not enabled || isDisabled)
+                    ]
+                    (voices |> List.sortWith defaultFirst |> List.map (speechVoiceOption selectedVoice))
                 ]
+            )
+            [ Message.info Strings.SpeechExplanation
+            , notPossibleWarning
             ]
-        )
-        [ Message.info Strings.SpeechExplanation ]
+        ]
+
+
+defaultFirst : Speech.Voice -> Speech.Voice -> Order
+defaultFirst a b =
+    if a.default && b.default then
+        EQ
+
+    else if a.default then
+        LT
+
+    else
+        GT
+
+
+speechVoiceOption : Maybe String -> Speech.Voice -> Html Global.Msg
+speechVoiceOption selectedVoice voice =
+    let
+        selected =
+            if selectedVoice == Just voice.name then
+                [ WlA.selected ]
+
+            else
+                []
+    in
+    Html.option
+        (HtmlA.value voice.name :: selected)
+        [ Html.text (voice.name ++ " (" ++ voice.lang ++ ")") ]
 
 
 notificationsSwitch : Shared -> Html Global.Msg

client/src/elm/MassiveDecks/Settings/Messages.elm

@@ -3,6 +3,7 @@ module MassiveDecks.Settings.Messages exposing (Msg(..))
 import Dict exposing (Dict)
 import MassiveDecks.Pages.Lobby.Model as Lobby
 import MassiveDecks.Settings.Model exposing (..)
+import MassiveDecks.Speech as Speech
 import MassiveDecks.Strings.Languages.Model exposing (Language)
 
 
@@ -12,3 +13,6 @@ type Msg
     | ChangeOpenUserList Bool
     | ToggleOpen
     | RemoveInvalid (Dict Lobby.Token Bool)
+    | ToggleSpeech Bool
+    | ChangeSpeech String
+    | SpeechMsg Speech.Msg

client/src/elm/MassiveDecks/Settings/Model.elm

@@ -10,6 +10,7 @@ module MassiveDecks.Settings.Model exposing
 import Dict exposing (Dict)
 import MassiveDecks.Card.Source.Model as Source exposing (Source)
 import MassiveDecks.Pages.Lobby.Model as Lobby
+import MassiveDecks.Speech as Speech
 import MassiveDecks.Strings.Languages.Model exposing (Language)
 
 
@@ -18,6 +19,7 @@ import MassiveDecks.Strings.Languages.Model exposing (Language)
 type alias Model =
     { settings : Settings
     , open : Bool
+    , speech : Speech.Model
     }
 
 
@@ -31,6 +33,7 @@ type alias Settings =
     , recentDecks : List Source.External
     , chosenLanguage : Maybe Language
     , cardSize : CardSize
+    , speech : Speech.Settings
     }
 
 

client/src/elm/MassiveDecks/Speech.elm

@@ -0,0 +1,138 @@
+module MassiveDecks.Speech exposing
+    ( Model
+    , Msg(..)
+    , Settings
+    , Voice
+    , default
+    , init
+    , selectVoice
+    , speak
+    , subscriptions
+    , toggle
+    , update
+    )
+
+import Json.Decode
+import Json.Encode as Json
+import MassiveDecks.Ports as Ports
+
+
+{-| A voice that can be used to speak phrases.
+-}
+type alias Voice =
+    { name : String
+    , lang : String
+    , default : Bool
+    }
+
+
+{-| The configurable settings for speech.
+-}
+type alias Settings =
+    { enabled : Bool
+    , selectedVoice : Maybe String
+    }
+
+
+{-| Runtime data used for speech.
+-}
+type alias Model =
+    { voices : List Voice
+    }
+
+
+{-| Messages used for speech.
+-}
+type Msg
+    = UpdateVoices (List Voice)
+
+
+{-| Initialize the model.
+-}
+init : ( Model, Cmd msg )
+init =
+    ( { voices = [] }, requestVoices )
+
+
+{-| The default settings for speech.
+-}
+default : Settings
+default =
+    { enabled = False
+    , selectedVoice = Nothing
+    }
+
+
+{-| Speak the given phrase.
+-}
+speak : Settings -> String -> Cmd msg
+speak settings phrase =
+    if settings.enabled then
+        case settings.selectedVoice of
+            Just voice ->
+                Json.object [ ( "voice", Json.string voice ), ( "phrase", Json.string phrase ) ] |> Ports.speechCommands
+
+            Nothing ->
+                Cmd.none
+
+    else
+        Cmd.none
+
+
+{-| Enable or disable speech.
+-}
+toggle : Bool -> Settings -> Settings
+toggle enabled settings =
+    { settings | enabled = enabled }
+
+
+{-| Select a new voice for speech.
+-}
+selectVoice : String -> Settings -> Settings
+selectVoice voice settings =
+    { settings | selectedVoice = Just voice }
+
+
+{-| Subscriptions for speech.
+-}
+subscriptions : (Json.Decode.Error -> msg) -> (Msg -> msg) -> Sub msg
+subscriptions wrapError wrapMsg =
+    Ports.speechVoices (Json.Decode.decodeValue (Json.Decode.list decodeVoice) >> toMsg wrapError wrapMsg)
+
+
+{-| Update the model based on messages.
+-}
+update : Msg -> Model -> Model
+update msg model =
+    case msg of
+        UpdateVoices voices ->
+            { model | voices = voices }
+
+
+
+{- Internal -}
+
+
+requestVoices : Cmd msg
+requestVoices =
+    Json.object [ ( "name", Json.null ) ] |> Ports.speechCommands
+
+
+decodeVoice : Json.Decode.Decoder Voice
+decodeVoice =
+    Json.Decode.map3 Voice
+        (Json.Decode.field "name" Json.Decode.string)
+        (Json.Decode.field "lang" Json.Decode.string)
+        (Json.Decode.maybe (Json.Decode.field "default" Json.Decode.bool)
+            |> Json.Decode.map (Maybe.withDefault False)
+        )
+
+
+toMsg : (Json.Decode.Error -> msg) -> (Msg -> msg) -> Result Json.Decode.Error (List Voice) -> msg
+toMsg wrapError wrapMsg result =
+    case result of
+        Ok value ->
+            UpdateVoices value |> wrapMsg
+
+        Err error ->
+            error |> wrapError

client/src/elm/MassiveDecks/Strings.elm

@@ -73,6 +73,8 @@ type MdString
     | CardSizeExplanation -- An explanation of what the card size does (changes the size of the card).
     | SpeechSetting -- The label for the speech setting.
     | SpeechExplanation -- An explanation of what the speech setting does (enables TTS on cards).
+    | SpeechNotSupportedExplanation -- An explanation that speech can't be enabled because the user's browser doesn't support it.
+    | VoiceSetting -- The label for the voice setting.
     | NotificationsSetting -- The label for the notifications setting.
     | NotificationsExplanation -- An explanation of what the notifications setting does (enables browser notifications).
     | NotificationsBrowserPermissions -- An explanation that the user will need to give the game permission for notifications.
@@ -186,6 +188,7 @@ type MdString
     | Judging -- A description of the stage of the round where the czar is picking a winner.
     | Complete -- A description of the stage of the round where it is finished.
     | ViewGameHistoryAction -- A description of the action of viewing the history of the game.
+    | Blank -- A term used in speech to denote a blank "slot" on a card the player will give a value to fill.
       -- Instructions
     | WhatToDo -- A description of the action of asking for help on what to do in the game at this time.
     | PlayInstruction { numberOfCards : Int } -- Instruction to the player on how to play cards.

client/src/elm/MassiveDecks/Strings/Languages/En.elm

@@ -270,6 +270,12 @@ translate mdString =
         SpeechExplanation ->
             [ Text "Read out cards using text to speech." ]
 
+        SpeechNotSupportedExplanation ->
+            [ Text "Your browser does not support text to speech, or has no voices installed." ]
+
+        VoiceSetting ->
+            [ Text "Speech Voice" ]
+
         NotificationsSetting ->
             [ Text "Browser Notifications" ]
 
@@ -653,6 +659,9 @@ translate mdString =
         ViewGameHistoryAction ->
             [ Text "View previous rounds from this game." ]
 
+        Blank ->
+            [ Text "Blank" ]
+
         -- Instructions
         WhatToDo ->
             [ Text "What should I be doing?" ]

client/src/elm/MassiveDecks/index.d.ts

@@ -1,3 +1,5 @@
+import { Say, Voice } from "../../ts/speech";
+
 type Token = string;
 
 interface Settings {
@@ -46,6 +48,8 @@ export namespace Elm {
   namespace MassiveDecks {
     export interface App {
       ports: {
+        speechCommands: InboundPort<Say>;
+        speechVoices: OutboundPort<Array<Voice>>;
         storeSettings: InboundPort<Settings>;
         tryCast: InboundPort<CastFlags>;
         castStatus: OutboundPort<CastStatus>;

client/src/ts/index.ts

@@ -3,6 +3,7 @@ import "./weightless";
 import { Client as CastClient } from "./chromecast";
 import { OutboundPort, Settings, Token } from "../elm/MassiveDecks";
 import { ServerConnection } from "./server-connection";
+import { Speech } from "./speech";
 
 /**
  * Settings storage/retrieval in local storage.
@@ -53,6 +54,10 @@ import(/* webpackChunkName: "massive-decks" */ "../elm/MassiveDecks").then(
       SettingsStorage.save(settings)
     );
 
+    if ("speechSynthesis" in window) {
+      new Speech(app.ports.speechVoices, app.ports.speechCommands);
+    }
+
     new ServerConnection(app.ports.serverRecv, app.ports.serverSend);
 
     new CastClient(app.ports.tryCast, app.ports.castStatus);

client/src/ts/speech.ts

@@ -0,0 +1,55 @@
+import { InboundPort, OutboundPort } from "../elm/MassiveDecks";
+
+export interface Voice {
+  name: string;
+  lang: string;
+  default?: boolean;
+}
+
+export interface Say {
+  voice: string;
+  phrase: string;
+}
+
+export class Speech {
+  speech: SpeechSynthesis;
+  voices: Map<string, SpeechSynthesisVoice>;
+  out: OutboundPort<Voice[]>;
+
+  constructor(out: OutboundPort<Array<Voice>>, inbound: InboundPort<Say>) {
+    this.speech = window.speechSynthesis;
+    this.voices = new Map<string, SpeechSynthesisVoice>();
+    this.out = out;
+    this.get_voices();
+
+    inbound.subscribe(command => {
+      this.say(command.voice, command.phrase);
+    });
+
+    this.speech.addEventListener("voiceschanged", () => this.get_voices());
+  }
+
+  get_voices(): void {
+    const voices = this.speech.getVoices();
+    this.voices.clear();
+    for (const voice of voices) {
+      this.voices.set(voice.name, voice);
+    }
+    this.out.send(
+      voices.map(voice => ({
+        name: voice.name,
+        lang: voice.lang,
+        ...(voice.default ? { default: true } : {})
+      }))
+    );
+  }
+
+  say(voiceName: string, phrase: string): void {
+    const voice = this.voices.get(voiceName);
+    if (voice !== undefined) {
+      const utterance = new SpeechSynthesisUtterance(phrase);
+      utterance.voice = voice;
+      this.speech.speak(utterance);
+    }
+  }
+}

server/Dockerfile

@@ -37,4 +37,5 @@ COPY ["./config.json5", "./"]
 COPY --from=0 ["/md/dist", "./"]
 
 EXPOSE 8081
+USER node
 CMD ["node", "--es-module-specifier-resolution=node", "./index.js"]