diff --git a/elm.json b/elm.json new file mode 100644 index 0000000..948924e --- /dev/null +++ b/elm.json @@ -0,0 +1,39 @@ +{ + "type": "application", + "source-directories": [ + "elm" + ], + "elm-version": "0.19.1", + "dependencies": { + "direct": { + "Orasund/elm-ui-widgets": "3.4.0", + "avh4/elm-color": "1.0.0", + "elm/browser": "1.0.2", + "elm/core": "1.0.5", + "elm/html": "1.0.1", + "elm/http": "2.0.0", + "elm/json": "1.1.4", + "elm/svg": "1.0.1", + "elm/time": "1.0.0", + "ianmackenzie/elm-units": "2.10.0", + "icidasset/elm-material-icons": "11.0.0", + "mdgriffith/elm-ui": "1.1.8", + "noordstar/elm-palette": "1.0.0" + }, + "indirect": { + "elm/bytes": "1.0.8", + "elm/file": "1.0.5", + "elm/regex": "1.0.0", + "elm/url": "1.0.0", + "elm/virtual-dom": "1.0.5", + "elm-community/intdict": "3.1.0", + "fredcy/elm-parseint": "2.0.1", + "noahzgordon/elm-color-extra": "1.0.2", + "turboMaCk/queue": "1.2.0" + } + }, + "test-dependencies": { + "direct": {}, + "indirect": {} + } +} diff --git a/elm/Api.elm b/elm/Api.elm new file mode 100644 index 0000000..2e064a9 --- /dev/null +++ b/elm/Api.elm @@ -0,0 +1,167 @@ +module Api exposing + ( GameDetails + , Player + , gameDetails + , profile + , startGame + ) + +import Dict exposing (Dict) +import Http +import Json.Decode as D +import Json.Encode as E + + +endpointGameDetails = + "/game-details" + + +endpointGetProfile = + "/profile" + + +endpointStartGame = + "/start-game" + + +{-| Full report on how a game is going. +-} +type alias GameDetails gameState = + { name : String + , turns : List { player : Int, action : E.Value, state : gameState } + , winner : Maybe Int + } + + +{-| General format of a player who's allowed to participate. +-} +type alias Player = + { name : String + , games : Dict String (Dict String E.Value) + , profile : Dict String E.Value + , url : String + } + + +{-| Builds a generalized API call to the webclient server. +-} +callWebClient : + { body : Maybe D.Value + , decoder : D.Decoder a + , method : String + , toMsg : Result Http.Error a -> msg + , url : String + } + -> Cmd msg +callWebClient data = + Http.request + { method = data.method + , headers = [] + , url = data.url + , body = + data.body + |> Maybe.map Http.jsonBody + |> Maybe.withDefault Http.emptyBody + , expect = Http.expectJson data.toMsg data.decoder + , timeout = Nothing + , tracker = Nothing + } + + +{-| Retrieves all the latest details about a game. A game might still be +ongoing and therefore might be incomplete. +-} +gameDetails : + { baseUrl : String + , decoder : D.Decoder gameState + , gameId : String + , toMsg : Result Http.Error (GameDetails gameState) -> msg + } + -> Cmd msg +gameDetails data = + callWebClient + { body = Just (E.object [ ( "game_id", E.string data.gameId ) ]) + , decoder = gameDetailsDecoder data.decoder + , method = "GET" + , toMsg = data.toMsg + , url = data.baseUrl ++ endpointGameDetails + } + + +{-| Decodes a game's details from JSON. +-} +gameDetailsDecoder : D.Decoder gameState -> D.Decoder (GameDetails gameState) +gameDetailsDecoder decoder = + D.map3 GameDetails + (D.field "name" D.string) + (D.map3 + (\action player state -> + { player = player, action = action, state = state } + ) + (D.field "action" D.value) + (D.field "player" D.int) + (D.field "state" decoder) + |> D.list + |> D.field "turns" + ) + (D.field "winner" <| D.oneOf [ D.map Just D.int, D.null Nothing ]) + + +{-| Decodes a Player from JSON. +-} +playerDecoder : D.Decoder Player +playerDecoder = + D.map4 Player + (D.field "name" D.string) + (D.field "games" <| D.dict <| D.dict D.value) + (D.field "profile" <| D.dict D.value) + (D.field "url" D.string) + + +{-| Gets the profile of a given player with a given URL. +-} +profile : + { baseUrl : String + , playerUrl : String + , toMsg : Result Http.Error Player -> msg + } + -> Cmd msg +profile data = + callWebClient + { body = Just (E.object [ ( "url", E.string data.playerUrl ) ]) + , decoder = playerDecoder + , method = "GET" + , toMsg = data.toMsg + , url = data.baseUrl ++ endpointGetProfile + } + + +{-| Instructs the server to start a game with the PyClient. The players list +provides a set of URLs that should be considered as its players, even if the +players haven't been verified (yet). + +The server responds with a unique identifier for the game. This allows the +front-end to query updates about the game while it's still being processed. + +-} +startGame : + { baseUrl : String + , game : String + , players : List String + , toMsg : Result Http.Error String -> msg + } + -> Cmd msg +startGame data = + callWebClient + { body = + Just + (E.object + [ ( "game", E.string data.game ) + , ( "players", E.list E.string data.players ) + ] + ) + , decoder = D.string + , method = "POST" + , toMsg = data.toMsg + , url = data.baseUrl ++ endpointStartGame + } diff --git a/elm/GameList.elm b/elm/GameList.elm new file mode 100644 index 0000000..4b4e2e0 --- /dev/null +++ b/elm/GameList.elm @@ -0,0 +1,238 @@ +module GameList exposing (..) + +import Dict exposing (Dict) +import Duration +import Element exposing (Element) +import Element.Background +import Element.Events +import Games.TicTacToe as TicTacToe exposing (TicTacToe) +import Layout +import Match exposing (Match) +import Material.Icons as Icons +import Pixels exposing (Pixels) +import Quantity exposing (Quantity) +import Theme + + + +-- MODEL + + +type CreateGameType + = CreateTicTacToe + + +type Game + = GameTicTacToe String (Match TicTacToe) + + +type GameList + = GameList + { ticTacToe : Dict String (Match TicTacToe) + } + + +type Msg + = AddTicTacToe { baseUrl : String, matchId : String } + | OnTicTacToe String (Match.Msg TicTacToe) + + +init : {} -> ( GameList, Cmd Msg ) +init _ = + ( GameList + { ticTacToe = Dict.empty + } + , Cmd.none + ) + + + +-- UPDATE + + +update : Msg -> GameList -> ( GameList, Cmd Msg ) +update msg ((GameList data) as model) = + case msg of + AddTicTacToe newGame -> + let + ( newMdl, newM ) = + Match.init + { autoScroll = Just (Duration.seconds 0.75) + , baseUrl = newGame.baseUrl + , decoder = TicTacToe.decoder + , empty = TicTacToe.empty + , matchId = newGame.matchId + } + in + ( GameList { data | ticTacToe = Dict.insert newGame.matchId newMdl data.ticTacToe } + , Cmd.map (OnTicTacToe newGame.matchId) newM + ) + + OnTicTacToe key m -> + case Dict.get key data.ticTacToe of + Nothing -> + ( model, Cmd.none ) + + Just mdl -> + case Match.update m mdl of + ( newMdl, newM ) -> + ( GameList { data | ticTacToe = Dict.insert key newMdl data.ticTacToe } + , Cmd.map (OnTicTacToe key) newM + ) + + + +-- SUBSCRIPTIONS + + +subscriptions : GameList -> Sub Msg +subscriptions (GameList data) = + Sub.batch + [ Dict.toList data.ticTacToe + |> List.map + (\( key, mdl ) -> + Sub.map (OnTicTacToe key) (Match.subscriptions mdl) + ) + |> Sub.batch + ] + + + +-- VIEW + + +createGameToString : CreateGameType -> String +createGameToString cg = + case cg of + CreateTicTacToe -> + "tic-tac-toe" + + +viewCreateGame : + { baseUrl : String + , flavor : Theme.Flavor + , height : Quantity Int Pixels + , onBaseUrl : String -> msg + , onPlayers : List String -> msg + , players : List String + , width : Quantity Int Pixels + } + -> Element msg +viewCreateGame data = + Element.none + + +viewGame : + { flavor : Theme.Flavor + , game : Game + , height : Quantity Int Pixels + , onNavigateBack : msg + , toMsg : Msg -> msg + , width : Quantity Int Pixels + } + -> Element msg +viewGame data = + let + navBarHeight = + Pixels.pixels 200 + + showNavBar = + Quantity.ratio (Quantity.toFloatQuantity data.height) navBarHeight <= 3 + + gameHeight = + if showNavBar then + data.height |> Quantity.minus navBarHeight + + else + data.height + in + Element.column + [ Element.height <| Element.px <| Pixels.inPixels data.height + , Element.width <| Element.px <| Pixels.inPixels data.width + ] + [ if showNavBar then + Element.row + [ Element.Background.color (Theme.blueUI data.flavor) + , Element.height <| Element.px <| Pixels.inPixels navBarHeight + , Element.width <| Element.px <| Pixels.inPixels data.width + ] + [ Layout.iconAsElement + { color = Theme.blue data.flavor + , height = Pixels.inPixels navBarHeight + , icon = Icons.arrow_back + , width = Pixels.inPixels data.width + } + |> Element.el [ Element.Events.onClick data.onNavigateBack ] + ] + + else + Element.none + , viewMatch + { flavor = data.flavor + , game = data.game + , height = gameHeight + , width = data.width + } + |> Element.map data.toMsg + ] + + +viewMatch : + { flavor : Theme.Flavor + , game : Game + , height : Quantity Int Pixels + , width : Quantity Int Pixels + } + -> Element Msg +viewMatch data = + case data.game of + GameTicTacToe key match -> + Match.view + { flavor = data.flavor + , height = data.height + , match = match + , toMsg = OnTicTacToe key + , viewGame = TicTacToe.view + , width = data.width + } + + +viewSelection : + { flavor : Theme.Flavor + , height : Quantity Int Pixels + , model : GameList + , onCreateGame : msg + , onNavigateToGame : Game -> msg + , width : Quantity Int Pixels + } + -> Element msg +viewSelection data = + case data.model of + GameList model -> + [ Layout.itemWithSubtext + { color = Theme.mantle data.flavor + , leftIcon = always Element.none + , onPress = Just data.onCreateGame + , rightIcon = always Element.none + , text = "Create new game" + , title = "CREATE" + } + [] + |> List.singleton + , model.ticTacToe + |> Dict.toList + |> List.map + (\( key, match ) -> + Match.viewListItem + { flavor = data.flavor + , height = Pixels.pixels 80 + , match = match + , onPress = Just <| data.onNavigateToGame <| GameTicTacToe key match + , width = data.width + } + ) + ] + |> List.concat + |> Element.column + [ Element.centerX + ] diff --git a/elm/Games/TicTacToe.elm b/elm/Games/TicTacToe.elm new file mode 100644 index 0000000..23110f2 --- /dev/null +++ b/elm/Games/TicTacToe.elm @@ -0,0 +1,201 @@ +module Games.TicTacToe exposing (..) + +{-| This module exposes a library for the simple game of tic-tac-toe. +-} + +import Color +import Element exposing (Element) +import Json.Decode as D +import Layout +import Pixels exposing (Pixels) +import Quantity exposing (Quantity) +import Svg +import Svg.Attributes +import Theme + + + +-- MODEL + + +type Field + = X + | O + | Empty + + +type alias TicTacToe = + { field_1 : Field + , field_2 : Field + , field_3 : Field + , field_4 : Field + , field_5 : Field + , field_6 : Field + , field_7 : Field + , field_8 : Field + , field_9 : Field + } + + +decoder : D.Decoder TicTacToe +decoder = + D.map3 + (\( a, b, c ) ( d, e, f ) ( g, h, i ) -> + TicTacToe a b c d e f g h i + ) + (D.map3 (\a b c -> ( a, b, c )) fieldDecoder fieldDecoder fieldDecoder) + (D.map3 (\a b c -> ( a, b, c )) fieldDecoder fieldDecoder fieldDecoder) + (D.map3 (\a b c -> ( a, b, c )) fieldDecoder fieldDecoder fieldDecoder) + + +empty : TicTacToe +empty = + { field_1 = Empty + , field_2 = Empty + , field_3 = Empty + , field_4 = Empty + , field_5 = Empty + , field_6 = Empty + , field_7 = Empty + , field_8 = Empty + , field_9 = Empty + } + + +fieldDecoder : D.Decoder Field +fieldDecoder = + D.andThen + (\s -> + case s of + "X" -> + D.succeed X + + "O" -> + D.succeed O + + "" -> + D.succeed Empty + + _ -> + D.fail "Unknown field type" + ) + D.string + + + +-- VIEW + + +view : + { flavor : Theme.Flavor + , game : TicTacToe + , height : Quantity Int Pixels + , width : Quantity Int Pixels + } + -> Element msg +view data = + Layout.svg + { aspectRatio = 1 / 1 + , height = Pixels.inPixels data.height + , width = Pixels.inPixels data.width + , viewMinX = 0 + , viewMaxX = 300 + , viewMinY = 0 + , viewMaxY = 300 + , svg = + Svg.g + [ Svg.Attributes.strokeLinecap "round" + ] + [ svgField { field = data.game.field_1, flavor = data.flavor, offsetX = 0, offsetY = 0 } + , svgField { field = data.game.field_2, flavor = data.flavor, offsetX = 1, offsetY = 0 } + , svgField { field = data.game.field_3, flavor = data.flavor, offsetX = 2, offsetY = 0 } + , svgField { field = data.game.field_4, flavor = data.flavor, offsetX = 0, offsetY = 1 } + , svgField { field = data.game.field_5, flavor = data.flavor, offsetX = 1, offsetY = 1 } + , svgField { field = data.game.field_6, flavor = data.flavor, offsetX = 2, offsetY = 1 } + , svgField { field = data.game.field_7, flavor = data.flavor, offsetX = 0, offsetY = 2 } + , svgField { field = data.game.field_8, flavor = data.flavor, offsetX = 1, offsetY = 2 } + , svgField { field = data.game.field_9, flavor = data.flavor, offsetX = 2, offsetY = 2 } + , Svg.g + [ Svg.Attributes.fill <| Color.toCssString <| Theme.text data.flavor + , Svg.Attributes.strokeWidth "7.5" + ] + [ Svg.line + [ Svg.Attributes.x1 "100" + , Svg.Attributes.x1 "100" + , Svg.Attributes.y1 "20" + , Svg.Attributes.y2 "280" + ] + [] + , Svg.line + [ Svg.Attributes.x1 "200" + , Svg.Attributes.x1 "200" + , Svg.Attributes.y1 "20" + , Svg.Attributes.y2 "280" + ] + [] + , Svg.line + [ Svg.Attributes.x1 "20" + , Svg.Attributes.x1 "280" + , Svg.Attributes.y1 "100" + , Svg.Attributes.y2 "100" + ] + [] + , Svg.line + [ Svg.Attributes.x1 "20" + , Svg.Attributes.x1 "280" + , Svg.Attributes.y1 "200" + , Svg.Attributes.y2 "200" + ] + [] + ] + ] + } + + +svgField : + { field : Field + , flavor : Theme.Flavor + , offsetX : Int + , offsetY : Int + } + -> Svg.Svg svg +svgField data = + let + radius = + 35 + in + Svg.g + [ Svg.Attributes.fill <| Color.toCssString <| Theme.subtext0 data.flavor + , Svg.Attributes.strokeWidth "10" + ] + [ case data.field of + Empty -> + Svg.g [] [] + + O -> + Svg.circle + [ Svg.Attributes.cx (String.fromInt (50 + 100 * data.offsetX)) + , Svg.Attributes.cy (String.fromInt (50 + 100 * data.offsetY)) + , Svg.Attributes.r (String.fromInt radius) + ] + [] + + X -> + Svg.g + [] + [ Svg.line + [ Svg.Attributes.x1 (String.fromInt (50 - radius)) + , Svg.Attributes.x2 (String.fromInt (50 + radius)) + , Svg.Attributes.y1 (String.fromInt (50 - radius)) + , Svg.Attributes.y2 (String.fromInt (50 + radius)) + ] + [] + , Svg.line + [ Svg.Attributes.x1 (String.fromInt (50 - radius)) + , Svg.Attributes.x2 (String.fromInt (50 + radius)) + , Svg.Attributes.y1 (String.fromInt (50 + radius)) + , Svg.Attributes.y2 (String.fromInt (50 - radius)) + ] + [] + ] + ] diff --git a/elm/Layout.elm b/elm/Layout.elm new file mode 100644 index 0000000..fc1836b --- /dev/null +++ b/elm/Layout.elm @@ -0,0 +1,515 @@ +module Layout exposing + ( twoBlocks + , tab, sideIconBar + , iconAsElement, iconAsIcon + , containedButton, outlinedButton, textButton + , textInput, passwordInput + , header, stdText + , itemWithSubtext + , sideList, radioButtons + , loadingIndicator, svg + ) + +{-| + + +# Layout + +The layout module exposes some boilerplate functions that have produce a +beautiful Material design Elm webpage. + + +## Screen layout + +@docs twoBlocks + + +## Elements + +@docs tab, sideIconBar + + +## Icons + +@docs iconAsElement, iconAsIcon + + +## Buttons + +@docs containedButton, outlinedButton, textButton + + +## Text fields + +@docs textInput, passwordInput + + +## Text + +@docs header, stdText + + +## Items in a list + +@docs itemWithSubtext + + +## Lists + +@docs sideList, radioButtons + + +## Other elements + +@docs loadingIndicator, svg + +-} + +import Color exposing (Color) +import Element exposing (Element) +import Element.Background +import Element.Events +import Element.Font +import Element.Input +import Html.Attributes +import Material.Icons.Types +import Svg exposing (Svg) +import Svg.Attributes +import Theme +import Widget +import Widget.Customize as Customize +import Widget.Icon exposing (Icon) +import Widget.Material as Material +import Widget.Material.Typography + + +{-| A contained button representing the most important action of a group. +-} +containedButton : + { buttonColor : Color + , clickColor : Color + , icon : Icon msg + , onPress : Maybe msg + , text : String + } + -> Element msg +containedButton data = + Widget.button + ({ primary = data.buttonColor, onPrimary = data.clickColor } + |> singlePalette + |> Material.containedButton + |> Customize.elementButton [ Element.width Element.fill ] + ) + { text = data.text, icon = data.icon, onPress = data.onPress } + + +header : String -> Element msg +header = + Element.text + >> Element.el Widget.Material.Typography.h1 + >> List.singleton + >> Element.paragraph [] + + +iconAsElement : + { color : Color + , height : Int + , icon : Material.Icons.Types.Icon msg + , width : Int + } + -> Element msg +iconAsElement data = + data.icon + |> iconAsIcon + |> (|>) { size = Basics.min data.height data.width, color = data.color } + |> Element.el [ Element.centerX, Element.centerY ] + |> Element.el + [ Element.height (Element.px data.height) + , Element.width (Element.px data.width) + ] + + +iconAsIcon : Material.Icons.Types.Icon msg -> Widget.Icon.Icon msg +iconAsIcon = + Widget.Icon.elmMaterialIcons Material.Icons.Types.Color + + +{-| Multiline item +-} +itemWithSubtext : + { color : Color + , leftIcon : Widget.Icon.Icon msg + , onPress : Maybe msg + , rightIcon : Widget.Icon.Icon msg + , text : String + , title : String + } + -> Widget.Item msg +itemWithSubtext data = + Widget.multiLineItem + ({ primary = data.color, onPrimary = data.color } + |> singlePalette + |> Material.multiLineItem + ) + { content = data.rightIcon + , icon = data.leftIcon + , onPress = data.onPress + , title = data.title + , text = data.text + } + + +{-| Circular loading bar indicator +-} +loadingIndicator : + { color : Color + } + -> Element msg +loadingIndicator data = + Widget.circularProgressIndicator + ({ primary = data.color, onPrimary = data.color } + |> singlePalette + |> Material.progressIndicator + ) + Nothing + + +{-| An outlined button representing an important action within a group. +-} +outlinedButton : + { color : Color + , icon : Icon msg + , onPress : Maybe msg + , text : String + } + -> Element msg +outlinedButton data = + Widget.button + ({ primary = data.color, onPrimary = data.color } + |> singlePalette + |> Material.outlinedButton + ) + { text = data.text, icon = data.icon, onPress = data.onPress } + + +{-| Show a password field +-} +passwordInput : + { color : Color + , label : String + , onChange : String -> msg + , placeholder : Maybe String + , show : Bool + , text : String + } + -> Element msg +passwordInput data = + Widget.currentPasswordInputV2 + ({ primary = data.color, onPrimary = data.color } + |> singlePalette + |> Material.passwordInput + |> Customize.elementRow [ Element.width Element.fill ] + ) + { label = data.label + , onChange = data.onChange + , placeholder = + data.placeholder + |> Maybe.map Element.text + |> Maybe.map (Element.Input.placeholder []) + , show = data.show + , text = data.text + } + + +{-| Redio buttons are side-by-side buttons that only allowed up to one to be +selected. +-} +radioButtons : + { color : Color + , items : List ( Bool, a ) + , toIcon : a -> Icon msg + , toString : a -> String + , onChange : a -> msg + } + -> Element msg +radioButtons data = + data.items + |> List.map + (Tuple.mapSecond + (\item -> + { text = data.toString item + , icon = + \{ size, color } -> + Element.text (data.toString item) + , onPress = Just (data.onChange item) + } + ) + ) + |> Widget.toggleRow + { elementRow = Material.toggleRow + , content = + { primary = data.color, onPrimary = data.color } + |> singlePalette + |> Material.toggleButton + } + + +{-| Create a simple palette. +-} +singlePalette : { primary : Color, onPrimary : Color } -> Material.Palette +singlePalette { primary, onPrimary } = + { primary = primary + , secondary = primary + , background = primary + , surface = primary + , error = primary + , on = + { primary = onPrimary + , secondary = onPrimary + , background = onPrimary + , surface = onPrimary + , error = onPrimary + } + } + + +sideIconBar : + { colorBackground : Color + , colorText : Color + , height : Int + , items : List { icon : Widget.Icon.Icon msg, onPress : msg, text : String } + , width : Int + } + -> Element msg +sideIconBar data = + let + buttonHeight = + round (toFloat data.width * 1.618) + + fontSize = + data.width // 6 + + iconSize = + data.width * 3 // 5 + in + data.items + |> List.map + (\item -> + [ item.icon { size = iconSize, color = data.colorText } + |> Element.el [ Element.centerX ] + , Element.paragraph [] [ Element.text item.text ] + ] + |> Element.column + [ Element.centerX + , Element.centerY + , Element.Font.bold + , Element.Font.center + , Element.Font.size fontSize + , Element.htmlAttribute (Html.Attributes.style "cursor" "pointer") + ] + |> Element.el + [ Element.centerY + , Element.Events.onClick item.onPress + , Element.height (Element.px data.width) + , Element.width (Element.px data.width) + ] + |> Element.el + [ Element.height (Element.px buttonHeight) + ] + ) + |> Element.column + [ Element.Background.color (Theme.toElmUiColor data.colorBackground) + , Element.height (Element.px data.height) + , Element.scrollbarY + , Element.width (Element.px data.width) + ] + + +sideList : { color : Color, items : List (Widget.Item msg), width : Int } -> Element msg +sideList data = + let + width px = + Element.width (Element.px px) + in + Widget.itemList + ({ primary = data.color, onPrimary = data.color } + |> singlePalette + |> Material.sideSheet + ) + data.items + |> Element.el [ Element.centerX, width (Basics.min 360 data.width) ] + |> Element.el [ width data.width ] + + +stdText : String -> Element msg +stdText = + Element.text >> List.singleton >> Element.paragraph [] + + +svg : + { aspectRatio : Float + , height : Int + , svg : Svg msg + , width : Int + , viewMinX : Float + , viewMaxX : Float + , viewMinY : Float + , viewMaxY : Float + } + -> Element msg +svg data = + let + givenWidth = + toFloat data.width + + givenHeight = + toFloat data.height + + scaleFactorWidth = + givenHeight / givenWidth + + innerWidth = + if scaleFactorWidth > data.aspectRatio then + givenWidth + + else + givenHeight / data.aspectRatio + + innerHeight = + if scaleFactorWidth > data.aspectRatio then + givenWidth * data.aspectRatio + + else + givenHeight + in + Svg.svg + [ [ data.viewMinX, data.viewMinY, data.viewMaxX - data.viewMinX, data.viewMaxY - data.viewMinY ] + |> List.map String.fromFloat + |> String.join " " + |> Svg.Attributes.viewBox + , Svg.Attributes.width (String.fromFloat innerWidth) + , Svg.Attributes.height (String.fromFloat innerHeight) + ] + [ data.svg ] + |> Element.html + |> Element.el [ Element.centerX, Element.centerY ] + |> Element.el + [ Element.height (Element.px data.height) + , Element.width (Element.px data.width) + ] + + +{-| A tab selector that always has an item selected. +-} +tab : + { color : Color + , content : Int -> Element msg + , items : List { text : String, icon : Icon msg } + , onSelect : Int -> msg + , selected : Int + } + -> Element msg +tab data = + Widget.tab + ({ primary = data.color, onPrimary = data.color } + |> singlePalette + |> Material.tab + ) + { tabs = + { onSelect = data.onSelect >> Just + , options = data.items + , selected = Just data.selected + } + , content = \_ -> data.content data.selected + } + + +{-| A text button representing an important action within a group. +-} +textButton : + { icon : Icon msg + , onPress : Maybe msg + , text : String + , color : Color + } + -> Element msg +textButton data = + Widget.button + ({ primary = data.color, onPrimary = data.color } + |> singlePalette + |> Material.textButton + ) + { text = data.text, icon = data.icon, onPress = data.onPress } + + +{-| Text input element. +-} +textInput : + { color : Color + , label : String + , onChange : String -> msg + , placeholder : Maybe String + , text : String + } + -> Element msg +textInput data = + Widget.textInput + ({ primary = data.color, onPrimary = data.color } + |> singlePalette + |> Material.textInput + |> Customize.elementRow [ Element.width Element.fill ] + ) + { chips = [] + , text = data.text + , placeholder = + data.placeholder + |> Maybe.map Element.text + |> Maybe.map (Element.Input.placeholder []) + , label = data.label + , onChange = data.onChange + } + + +{-| Two blocks either next to each other or below each other, depending on the +screen shape. +-} +twoBlocks : + { height : Int + , el1 : { height : Int, width : Int } -> Element msg + , el2 : { height : Int, width : Int } -> Element msg + , width : Int + } + -> Element msg +twoBlocks data = + let + goesVertical = + 2 * data.width <= 3 * data.height + + direction = + if goesVertical then + Element.column + + else + Element.row + + width = + if goesVertical then + data.width + + else + data.width // 2 + + height = + if goesVertical then + data.height // 2 + + else + data.height + in + direction + [ Element.height (Element.px data.height) + , Element.width (Element.px data.width) + ] + [ data.el1 { height = height, width = width } + , data.el2 { height = height, width = width } + ] diff --git a/elm/Main.elm b/elm/Main.elm new file mode 100644 index 0000000..fdb55d3 --- /dev/null +++ b/elm/Main.elm @@ -0,0 +1,147 @@ +module Main exposing (main) + +import Api +import Browser +import Element exposing (Element) +import Element.Background +import GameList exposing (Game, GameList) +import Http +import ScreenSize exposing (ScreenSize) +import Theme + + +main : Program () Model Msg +main = + Browser.document + { init = init + , view = view + , update = update + , subscriptions = subscriptions + } + + + +-- MODEL + + +type alias Model = + { baseUrl : String + , flavor : Theme.Flavor + , games : GameList + , screen : Screen + , size : ScreenSize + } + + +type Screen + = ViewCreateGame + | ViewGameSelectionMenu + | ViewGame Game + + +type Msg + = OnGameList GameList.Msg + | OnScreen Screen + | OnScreenSize ScreenSize + + +init : () -> ( Model, Cmd Msg ) +init () = + let + ( gmdl, gmsg ) = + GameList.init {} + in + ( { baseUrl = "http://localhost:5000" + , flavor = Theme.Latte + , games = gmdl + , screen = ViewGameSelectionMenu + , size = ScreenSize.init + } + , Cmd.batch + [ ScreenSize.updateScreenSize OnScreenSize + , Cmd.map OnGameList gmsg + ] + ) + + + +-- UPDATE + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + OnGameList m -> + case GameList.update m model.games of + ( newMdl, newM ) -> + ( { model | games = newMdl }, Cmd.map OnGameList newM ) + + OnScreen screen -> + ( { model | screen = screen }, Cmd.none ) + + OnScreenSize size -> + ( { model | size = size }, Cmd.none ) + + + +-- SUBSCRIPTIONS + + +subscriptions : Model -> Sub Msg +subscriptions model = + Sub.batch + [ ScreenSize.onResize OnScreenSize + , Sub.map OnGameList (GameList.subscriptions model.games) + ] + + + +-- VIEW + + +view : Model -> Browser.Document Msg +view model = + { title = + case model.screen of + ViewCreateGame -> + "Create Game | Bot-Man-Toe" + + ViewGameSelectionMenu -> + "Menu | Bot-Man-Toe" + + ViewGame _ -> + "Replay | Bot-Man-Toe" + , body = + viewScreen model + |> Element.layout + [ Element.Background.color (Theme.baseUI model.flavor) + ] + |> List.singleton + } + + +viewScreen : Model -> Element Msg +viewScreen model = + case model.screen of + ViewCreateGame -> + Element.text "Create game menu!" + + ViewGameSelectionMenu -> + GameList.viewSelection + { flavor = model.flavor + , height = model.size.height + , model = model.games + , onCreateGame = OnScreen ViewCreateGame + , onNavigateToGame = OnScreen << ViewGame + , width = model.size.width + } + + ViewGame game -> + GameList.viewGame + { flavor = model.flavor + , game = game + , height = model.size.height + , onNavigateBack = OnScreen ViewGameSelectionMenu + , toMsg = OnGameList + , width = model.size.width + } diff --git a/elm/Match.elm b/elm/Match.elm new file mode 100644 index 0000000..29f2f5e --- /dev/null +++ b/elm/Match.elm @@ -0,0 +1,256 @@ +module Match exposing (..) + +{-| A match describes a game's history. It shows what took place. +-} + +import Api +import Duration exposing (Duration) +import Element exposing (Element) +import Element.Background +import Http +import Json.Decode as D +import Layout +import Pixels exposing (Pixels) +import Quantity exposing (Quantity) +import Theme +import Time +import Zipper exposing (Zipper) + + + +-- MODEL + + +type Match gameState + = Match + { autoScroll : Maybe Duration + , baseUrl : String + , decoder : D.Decoder gameState + , empty : gameState + , matchId : String + , turns : Zipper gameState + , winner : Maybe Int + } + + +type Msg gameState + = AskUpdate + | Autoscroll + | OnUpdate (Result Http.Error (Api.GameDetails gameState)) + | PageEnd + | PageNext + | PagePrev + | PageStart + + +init : + { autoScroll : Maybe Duration + , baseUrl : String + , decoder : D.Decoder gameState + , empty : gameState + , matchId : String + } + -> ( Match gameState, Cmd (Msg gameState) ) +init data = + ( Match + { autoScroll = data.autoScroll + , baseUrl = data.baseUrl + , decoder = data.decoder + , empty = data.empty + , matchId = data.matchId + , turns = Zipper.init data.empty + , winner = Nothing + } + , Cmd.none + ) + + + +-- UPDATE + + +update : Msg gameState -> Match gameState -> ( Match gameState, Cmd (Msg gameState) ) +update msg (Match data) = + case msg of + AskUpdate -> + ( Match data + , Api.gameDetails + { baseUrl = data.baseUrl + , decoder = data.decoder + , gameId = data.matchId + , toMsg = OnUpdate + } + ) + + Autoscroll -> + ( Match { data | turns = Zipper.next data.turns } + , Cmd.none + ) + + OnUpdate (Err _) -> + -- For now, do nothing with failed API requests + ( Match data, Cmd.none ) + + OnUpdate (Ok details) -> + ( Match + { data + | turns = + details.turns + |> List.map .state + |> Zipper.fromList data.empty + |> Zipper.samePageAs data.turns + , winner = details.winner + } + , Cmd.none + ) + + PageEnd -> + ( Match + { data + | autoScroll = Nothing + , turns = Zipper.toEnd data.turns + } + , Cmd.none + ) + + PageNext -> + ( Match + { data + | autoScroll = Nothing + , turns = Zipper.next data.turns + } + , Cmd.none + ) + + PagePrev -> + ( Match + { data + | autoScroll = Nothing + , turns = Zipper.prev data.turns + } + , Cmd.none + ) + + PageStart -> + ( Match + { data + | autoScroll = Nothing + , turns = Zipper.toStart data.turns + } + , Cmd.none + ) + + + +-- SUBSCRIPTIONS + + +subscriptions : Match gameState -> Sub (Msg gameState) +subscriptions (Match data) = + Sub.batch + [ case data.autoScroll of + Just duration -> + Time.every (Duration.inMilliseconds duration) (always Autoscroll) + + Nothing -> + Sub.none + , case data.winner of + Just _ -> + Sub.none + + Nothing -> + Time.every 550 (always AskUpdate) + ] + + + +-- VIEW + + +view : + { flavor : Theme.Flavor + , height : Quantity Int Pixels + , match : Match gameState + , toMsg : Msg gameState -> msg + , width : Quantity Int Pixels + , viewGame : + { flavor : Theme.Flavor + , game : gameState + , height : Quantity Int Pixels + , width : Quantity Int Pixels + } + -> Element msg + } + -> Element msg +view data = + let + menuHeight = + data.height + |> Quantity.toFloatQuantity + |> Quantity.multiplyBy (1 / 8) + |> Quantity.floor + + tinyScreen = + data.height |> Quantity.lessThan (Pixels.pixels 300) + + gameHeight = + if tinyScreen then + data.height + |> Quantity.minus menuHeight + + else + data.height + in + Element.column + [ Element.height (Element.px (Pixels.inPixels data.height)) + , Element.width (Element.px (Pixels.inPixels data.width)) + ] + [ case data.match of + Match { turns } -> + data.viewGame + { flavor = data.flavor + , game = Zipper.current turns + , height = gameHeight + , width = data.width + } + , if tinyScreen then + viewMenu + { height = menuHeight + , width = data.width + } + |> Element.map data.toMsg + + else + Element.none + ] + + +viewListItem : + { flavor : Theme.Flavor + , height : Quantity Int Pixels + , match : Match gameState + , onPress : Maybe msg + , width : Quantity Int Pixels + } + -> Element msg +viewListItem data = + case data.match of + Match match -> + Layout.itemWithSubtext + { color = Theme.mantle data.flavor + , leftIcon = always Element.none + , onPress = data.onPress + , rightIcon = always Element.none + , text = "Subtext" + , title = match.matchId + } + [] + + +viewMenu : + { height : Quantity Int Pixels + , width : Quantity Int Pixels + } + -> Element (Msg gameState) +viewMenu data = + Element.none diff --git a/elm/ScreenSize.elm b/elm/ScreenSize.elm new file mode 100644 index 0000000..0ec133e --- /dev/null +++ b/elm/ScreenSize.elm @@ -0,0 +1,41 @@ +module ScreenSize exposing (..) + +import Browser.Dom +import Browser.Events +import Pixels exposing (Pixels) +import Quantity exposing (Quantity) +import Task + + +type alias ScreenSize = + { height : Quantity Int Pixels + , width : Quantity Int Pixels + } + + +init : ScreenSize +init = + { width = Pixels.pixels 960, height = Pixels.pixels 480 } + + +onResize : (ScreenSize -> msg) -> Sub msg +onResize toMsg = + Browser.Events.onResize + (\w h -> + toMsg + { height = Pixels.pixels h + , width = Pixels.pixels w + } + ) + + +updateScreenSize : (ScreenSize -> msg) -> Cmd msg +updateScreenSize toMsg = + Browser.Dom.getViewport + |> Task.map + (\viewport -> + { height = Pixels.pixels (floor viewport.viewport.height) + , width = Pixels.pixels (floor viewport.viewport.width) + } + ) + |> Task.perform toMsg diff --git a/elm/Theme.elm b/elm/Theme.elm new file mode 100644 index 0000000..fd8da46 --- /dev/null +++ b/elm/Theme.elm @@ -0,0 +1,606 @@ +module Theme exposing (..) + +{-| + + +# Theme + +The Theme helps pick colors from different color schemes. + +-} + +import Catppuccin.Frappe as CF +import Catppuccin.Latte as CL +import Catppuccin.Macchiato as CA +import Catppuccin.Mocha as CO +import Color +import Element +import Element.Background + + +{-| Catppuccin flavor used for display. +-} +type Flavor + = Frappe + | Latte + | Macchiato + | Mocha + + +background : (Flavor -> Color.Color) -> Flavor -> Element.Attribute msg +background toColor = + toColor >> toElmUiColor >> Element.Background.color + + +toElmUiColor : Color.Color -> Element.Color +toElmUiColor = + Color.toRgba >> Element.fromRgb + + +rosewater : Flavor -> Color.Color +rosewater flavor = + case flavor of + Frappe -> + CF.rosewater + + Latte -> + CL.rosewater + + Macchiato -> + CA.rosewater + + Mocha -> + CO.rosewater + + +rosewaterUI : Flavor -> Element.Color +rosewaterUI = + rosewater >> toElmUiColor + + +flamingo : Flavor -> Color.Color +flamingo flavor = + case flavor of + Frappe -> + CF.flamingo + + Latte -> + CL.flamingo + + Macchiato -> + CA.flamingo + + Mocha -> + CO.flamingo + + +flamingoUI : Flavor -> Element.Color +flamingoUI = + flamingo >> toElmUiColor + + +pink : Flavor -> Color.Color +pink flavor = + case flavor of + Frappe -> + CF.pink + + Latte -> + CL.pink + + Macchiato -> + CA.pink + + Mocha -> + CO.pink + + +pinkUI : Flavor -> Element.Color +pinkUI = + pink >> toElmUiColor + + +mauve : Flavor -> Color.Color +mauve flavor = + case flavor of + Frappe -> + CF.mauve + + Latte -> + CL.mauve + + Macchiato -> + CA.mauve + + Mocha -> + CO.mauve + + +mauveUI : Flavor -> Element.Color +mauveUI = + mauve >> toElmUiColor + + +red : Flavor -> Color.Color +red flavor = + case flavor of + Frappe -> + CF.red + + Latte -> + CL.red + + Macchiato -> + CA.red + + Mocha -> + CO.red + + +redUI : Flavor -> Element.Color +redUI = + red >> toElmUiColor + + +maroon : Flavor -> Color.Color +maroon flavor = + case flavor of + Frappe -> + CF.maroon + + Latte -> + CL.maroon + + Macchiato -> + CA.maroon + + Mocha -> + CO.maroon + + +maroonUI : Flavor -> Element.Color +maroonUI = + maroon >> toElmUiColor + + +peach : Flavor -> Color.Color +peach flavor = + case flavor of + Frappe -> + CF.peach + + Latte -> + CL.peach + + Macchiato -> + CA.peach + + Mocha -> + CO.peach + + +peachUI : Flavor -> Element.Color +peachUI = + peach >> toElmUiColor + + +yellow : Flavor -> Color.Color +yellow flavor = + case flavor of + Frappe -> + CF.yellow + + Latte -> + CL.yellow + + Macchiato -> + CA.yellow + + Mocha -> + CO.yellow + + +yellowUI : Flavor -> Element.Color +yellowUI = + yellow >> toElmUiColor + + +green : Flavor -> Color.Color +green flavor = + case flavor of + Frappe -> + CF.green + + Latte -> + CL.green + + Macchiato -> + CA.green + + Mocha -> + CO.green + + +greenUI : Flavor -> Element.Color +greenUI = + green >> toElmUiColor + + +teal : Flavor -> Color.Color +teal flavor = + case flavor of + Frappe -> + CF.teal + + Latte -> + CL.teal + + Macchiato -> + CA.teal + + Mocha -> + CO.teal + + +tealUI : Flavor -> Element.Color +tealUI = + teal >> toElmUiColor + + +sky : Flavor -> Color.Color +sky flavor = + case flavor of + Frappe -> + CF.sky + + Latte -> + CL.sky + + Macchiato -> + CA.sky + + Mocha -> + CO.sky + + +skyUI : Flavor -> Element.Color +skyUI = + sky >> toElmUiColor + + +sapphire : Flavor -> Color.Color +sapphire flavor = + case flavor of + Frappe -> + CF.sapphire + + Latte -> + CL.sapphire + + Macchiato -> + CA.sapphire + + Mocha -> + CO.sapphire + + +sapphireUI : Flavor -> Element.Color +sapphireUI = + sapphire >> toElmUiColor + + +blue : Flavor -> Color.Color +blue flavor = + case flavor of + Frappe -> + CF.blue + + Latte -> + CL.blue + + Macchiato -> + CA.blue + + Mocha -> + CO.blue + + +blueUI : Flavor -> Element.Color +blueUI = + blue >> toElmUiColor + + +lavender : Flavor -> Color.Color +lavender flavor = + case flavor of + Frappe -> + CF.lavender + + Latte -> + CL.lavender + + Macchiato -> + CA.lavender + + Mocha -> + CO.lavender + + +lavenderUI : Flavor -> Element.Color +lavenderUI = + lavender >> toElmUiColor + + +text : Flavor -> Color.Color +text flavor = + case flavor of + Frappe -> + CF.text + + Latte -> + CL.text + + Macchiato -> + CA.text + + Mocha -> + CO.text + + +textUI : Flavor -> Element.Color +textUI = + text >> toElmUiColor + + +subtext1 : Flavor -> Color.Color +subtext1 flavor = + case flavor of + Frappe -> + CF.subtext1 + + Latte -> + CL.subtext1 + + Macchiato -> + CA.subtext1 + + Mocha -> + CO.subtext1 + + +subtext1UI : Flavor -> Element.Color +subtext1UI = + subtext1 >> toElmUiColor + + +subtext0 : Flavor -> Color.Color +subtext0 flavor = + case flavor of + Frappe -> + CF.subtext0 + + Latte -> + CL.subtext0 + + Macchiato -> + CA.subtext0 + + Mocha -> + CO.subtext0 + + +subtext0UI : Flavor -> Element.Color +subtext0UI = + subtext0 >> toElmUiColor + + +overlay2 : Flavor -> Color.Color +overlay2 flavor = + case flavor of + Frappe -> + CF.overlay2 + + Latte -> + CL.overlay2 + + Macchiato -> + CA.overlay2 + + Mocha -> + CO.overlay2 + + +overlay2UI : Flavor -> Element.Color +overlay2UI = + overlay2 >> toElmUiColor + + +overlay1 : Flavor -> Color.Color +overlay1 flavor = + case flavor of + Frappe -> + CF.overlay1 + + Latte -> + CL.overlay1 + + Macchiato -> + CA.overlay1 + + Mocha -> + CO.overlay1 + + +overlay1UI : Flavor -> Element.Color +overlay1UI = + overlay1 >> toElmUiColor + + +overlay0 : Flavor -> Color.Color +overlay0 flavor = + case flavor of + Frappe -> + CF.overlay0 + + Latte -> + CL.overlay0 + + Macchiato -> + CA.overlay0 + + Mocha -> + CO.overlay0 + + +overlay0UI : Flavor -> Element.Color +overlay0UI = + overlay0 >> toElmUiColor + + +surface2 : Flavor -> Color.Color +surface2 flavor = + case flavor of + Frappe -> + CF.surface2 + + Latte -> + CL.surface2 + + Macchiato -> + CA.surface2 + + Mocha -> + CO.surface2 + + +surface2UI : Flavor -> Element.Color +surface2UI = + surface2 >> toElmUiColor + + +surface1 : Flavor -> Color.Color +surface1 flavor = + case flavor of + Frappe -> + CF.surface1 + + Latte -> + CL.surface1 + + Macchiato -> + CA.surface1 + + Mocha -> + CO.surface1 + + +surface1UI : Flavor -> Element.Color +surface1UI = + surface1 >> toElmUiColor + + +surface0 : Flavor -> Color.Color +surface0 flavor = + case flavor of + Frappe -> + CF.surface0 + + Latte -> + CL.surface0 + + Macchiato -> + CA.surface0 + + Mocha -> + CO.surface0 + + +surface0UI : Flavor -> Element.Color +surface0UI = + surface0 >> toElmUiColor + + +base : Flavor -> Color.Color +base flavor = + case flavor of + Frappe -> + CF.base + + Latte -> + CL.base + + Macchiato -> + CA.base + + Mocha -> + CO.base + + +baseUI : Flavor -> Element.Color +baseUI = + base >> toElmUiColor + + +mantle : Flavor -> Color.Color +mantle flavor = + case flavor of + Frappe -> + CF.mantle + + Latte -> + CL.mantle + + Macchiato -> + CA.mantle + + Mocha -> + CO.mantle + + +mantleUI : Flavor -> Element.Color +mantleUI = + mantle >> toElmUiColor + + +crust : Flavor -> Color.Color +crust flavor = + case flavor of + Frappe -> + CF.crust + + Latte -> + CL.crust + + Macchiato -> + CA.crust + + Mocha -> + CO.crust + + +crustUI : Flavor -> Element.Color +crustUI = + crust >> toElmUiColor + + +brown : Flavor -> Color.Color +brown flavor = + case flavor of + Frappe -> + Color.rgb 165 42 42 + + -- Example RGB for a brown color + Latte -> + Color.rgb 139 69 19 + + -- Example RGB for another shade of brown + Macchiato -> + Color.rgb 160 82 45 + + Mocha -> + Color.rgb 101 67 33 + + +brownUI : Flavor -> Element.Color +brownUI = + brown >> toElmUiColor diff --git a/elm/Zipper.elm b/elm/Zipper.elm new file mode 100644 index 0000000..e9df740 --- /dev/null +++ b/elm/Zipper.elm @@ -0,0 +1,143 @@ +module Zipper exposing (Zipper, current, currentPage, fromList, init, isAtEnd, isAtStart, length, next, prev, samePageAs, toEnd, toStart) + +{-| The Zipper allows to dynamically paginate between items. +-} + + +type Zipper a + = Zipper + { prev : List a + , current : a + , next : List a + } + + +{-| Gets the current item in the zipper. +-} +current : Zipper a -> a +current (Zipper data) = + data.current + + +{-| If counting from 1, determines the number corresponding to the currently selected item. +-} +currentPage : Zipper a -> Int +currentPage (Zipper data) = + List.length data.prev + 1 + + +{-| Builds a zipper from a list of items. +-} +fromList : a -> List a -> Zipper a +fromList head tail = + Zipper { prev = [], current = head, next = tail } + + +{-| Create a new zipper from nothing. +-} +init : a -> Zipper a +init x = + Zipper { prev = [], current = x, next = [] } + + +{-| Determines whether the zipper is at the end. +-} +isAtEnd : Zipper a -> Bool +isAtEnd (Zipper data) = + List.isEmpty data.next + + +{-| Determines whether the zipper is at the start. +-} +isAtStart : Zipper a -> Bool +isAtStart (Zipper data) = + List.isEmpty data.prev + + +{-| Determine the total number of items in the zipper. +-} +length : Zipper a -> Int +length (Zipper data) = + List.length data.prev + List.length data.next + 1 + + +{-| Paginates one further in the zipper. +-} +next : Zipper a -> Zipper a +next (Zipper data) = + case data.next of + [] -> + Zipper data + + head :: tail -> + Zipper + { prev = data.current :: data.prev + , current = head + , next = tail + } + + +{-| Paginates one back in the zipper. +-} +prev : Zipper a -> Zipper a +prev (Zipper data) = + case data.prev of + [] -> + Zipper data + + head :: tail -> + Zipper + { prev = tail + , current = head + , next = data.current :: data.next + } + + +{-| Synchronize a zipper to be at the same page as another, if possible. +-} +samePageAs : Zipper a -> Zipper a -> Zipper a +samePageAs goal z = + let + cp = + currentPage z + + tp = + currentPage goal + in + if cp == tp then + z + + else if cp < tp then + if isAtEnd z then + z + + else + samePageAs goal (next z) + + else if isAtStart z then + z + + else + samePageAs goal (prev z) + + +{-| Navigate all the way to the end of the zipper. +-} +toEnd : Zipper a -> Zipper a +toEnd z = + if isAtEnd z then + z + + else + toEnd (next z) + + +{-| Navigate all the way to the start of the zipper. +-} +toStart : Zipper a -> Zipper a +toStart z = + if isAtStart z then + z + + else + toStart (prev z)