diff --git a/public/main.js b/public/main.js index 6d6988a..4735128 100644 --- a/public/main.js +++ b/public/main.js @@ -3,7 +3,7 @@ var flags = null // Start our Elm application -var app = Elm.Main.init({ flags: flags }) +var app = Elm.Main.init({ flags: { width: window.innerWidth, height: window.innerHeight } }) // Ports go here // https://guide.elm-lang.org/interop/ports.html \ No newline at end of file diff --git a/src/Game.elm b/src/Game.elm index 7754444..61beb39 100644 --- a/src/Game.elm +++ b/src/Game.elm @@ -116,8 +116,15 @@ update msg (Model model) = ( ComputerSelectedCell name, InPlay Computer (ChoosingCellToPlay piece) ) -> Model model |> noCmds - |> map (playerMakesPlay name piece) - |> andThen (checkForWin Computer) + |> map (playerTryPlay name piece) + |> (\( maybeModel, c ) -> + case maybeModel of + Just m -> + andThen (checkForWin Computer) ( m, c ) + + Nothing -> + Model model |> noCmds + ) ( ComputerSelectedPiece piece, InPlay Computer ChoosingPiece ) -> Model model @@ -127,8 +134,15 @@ update msg (Model model) = ( HumanSelectedCell name, InPlay Human (ChoosingCellToPlay piece) ) -> Model model |> noCmds - |> map (playerMakesPlay name piece) - |> andThen (checkForWin Human) + |> map (playerTryPlay name piece) + |> (\( maybeModel, c ) -> + case maybeModel of + Just m -> + andThen (checkForWin Human) ( m, c ) + + Nothing -> + Model model |> noCmds + ) ( RestartWanted, _ ) -> init |> noCmds @@ -161,7 +175,7 @@ computerChooses msgConstructor boardfunc (Model model) = items |> Listn.sample |> msgGenerator msgConstructor - |> delay 2 + |> delay 3 in boardfunc model.board |> Listn.fromList @@ -170,13 +184,17 @@ computerChooses msgConstructor boardfunc (Model model) = |> (\cmds -> ( Model model, cmds )) -playerMakesPlay : Cellname -> Gamepiece -> Model -> Model -playerMakesPlay name piece (Model model) = +playerTryPlay : Cellname -> Gamepiece -> Model -> Maybe Model +playerTryPlay name piece (Model model) = let newBoard = Board.update name piece model.board in - Model { model | board = newBoard } + if newBoard == model.board then + Nothing + + else + Just (Model { model | board = newBoard }) checkForWin : ActivePlayer -> Model -> ( Model, Cmd Msg ) diff --git a/src/Helpers.elm b/src/Helpers.elm index 3131190..69a244d 100644 --- a/src/Helpers.elm +++ b/src/Helpers.elm @@ -11,12 +11,12 @@ noCmds model = ( model, Cmd.none ) -map : (a -> a) -> ( a, Cmd msg ) -> ( a, Cmd msg ) +map : (a -> b) -> ( a, Cmd msg ) -> ( b, Cmd msg ) map f ma = andThen (noCmds << f) ma -andThen : (a -> ( a, Cmd msg )) -> ( a, Cmd msg ) -> ( a, Cmd msg ) +andThen : (a -> ( b, Cmd msg )) -> ( a, Cmd msg ) -> ( b, Cmd msg ) andThen f ( model, cmds ) = let ( newa, moreCmds ) = diff --git a/src/Pages/About.elm b/src/Pages/About.elm new file mode 100644 index 0000000..b6a10b4 --- /dev/null +++ b/src/Pages/About.elm @@ -0,0 +1,131 @@ +module Pages.About exposing (Model, Msg, Params, page) + +import Element + exposing + ( Attribute + , DeviceClass(..) + , centerX + , column + , el + , fill + , height + , padding + , paragraph + , px + , spacing + , text + , width + ) +import Element.Font as Font +import Element.Region as Region +import Helpers exposing (noCmds) +import Shared exposing (Dimensions) +import Spa.Document exposing (Document) +import Spa.Page as Page exposing (Page) +import Spa.Url exposing (Url) +import Styles + + +page : Page Params Model Msg +page = + Page.application + { init = init + , update = update + , subscriptions = subscriptions + , view = view + , save = save + , load = load + } + + + +-- INIT + + +type alias Params = + () + + +type alias Model = + Shared.Dimensions + + +init : Shared.Model -> Url Params -> ( Model, Cmd Msg ) +init shared _ = + ( shared.dimensions, Cmd.none ) + + + +-- UPDATE + + +type Msg + = NoOp + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + NoOp -> + model |> noCmds + + +save : Model -> Shared.Model -> Shared.Model +save _ shared = + shared + + +load : Shared.Model -> Model -> ( Model, Cmd Msg ) +load shared _ = + ( shared.dimensions, Cmd.none ) + + +subscriptions : Model -> Sub Msg +subscriptions _ = + Sub.none + + + +-- VIEW + + +view : Model -> Document Msg +view model = + { title = "About" + , body = + [ column (style model) + [ el [ Region.heading 1, centerX, Font.bold ] (text "What is this project?") + , paragraph [ width fill, height fill, spacing 5, Font.color Styles.blue ] + [ text "This is example project of the game Quarto, built using the Elm programming language." ] + , el [ Region.heading 1, centerX, Font.bold ] (text "What is Quarto") + , paragraph [ width fill, height fill, spacing 5, Font.color Styles.blue ] + [ text "Quarto is a board game for two players invented by Swiss mathematician Blaise Müller. It is published and copyrighted by Gigamic. " + , text "The game is played on a 4×4 board. " + , text "There are 16 unique pieces to play with, each of which is either; " + , text "tall or short; " + , text "red or blue (or a different pair of colors, e.g. light- or dark-stained wood); " + , text "square or circular; " + , text "and hollow-top or solid-top. " + ] + , el [ Region.heading 1, centerX, Font.bold ] (text "How to Play") + , paragraph [ width fill, spacing 5, height fill, Font.color Styles.blue ] + [ text "Players take turns choosing a piece which the other player must then place on the board." + , text "A player wins by placing a piece on the board which forms a horizontal, vertical, or diagonal row of four pieces, all of which have a common attribute (all short, all circular, etc.)." + ] + ] + ] + } + + +style : Dimensions -> List (Attribute msg) +style dimensions = + let + device = + Element.classifyDevice dimensions + in + case device.class of + Phone -> + [ Font.center, Font.justify, width fill, height fill, padding 15, spacing 15 ] + + _ -> + [ Font.center, Font.justify, width (px 580), height fill, centerX, padding 20, spacing 20 ] diff --git a/src/Pages/Top.elm b/src/Pages/Top.elm index f9480a4..af7fc73 100644 --- a/src/Pages/Top.elm +++ b/src/Pages/Top.elm @@ -9,15 +9,22 @@ module Pages.Top exposing import Element exposing - ( Element + ( Attribute + , Element , centerX + , centerY , column , el , fill + , height + , padding + , paragraph + , px , row , spacing , text , width + , wrappedRow ) import Element.Background as Background import Element.Border as Border @@ -41,8 +48,10 @@ import Game.Core , Shape(..) , Size(..) ) +import Helpers exposing (noCmds) import List.Extra as Liste import Pages.NotFound exposing (Msg) +import Shared exposing (Dimensions) import Spa.Document exposing (Document) import Spa.Page as Page exposing (Page) import Spa.Url as Url @@ -53,34 +62,45 @@ import Svg.Attributes as Attr page : Page Params Model Msg page = - Page.element + Page.application { init = init , update = update , view = view , subscriptions = subscriptions + , save = save + , load = load } -type alias Model = - { game : Game.Model } +load : Shared.Model -> Model -> ( Model, Cmd Msg ) +load shared model = + { model | dimensions = shared.dimensions } + |> noCmds +save : Model -> Shared.Model -> Shared.Model +save _ shared = + shared + + +type alias Model = + { game : Game.Model + , dimensions : Shared.Flags + } --- INIT -initModel : Model -initModel = - { game = Game.init } +-- INIT type alias Params = () -init : Url.Url Params -> ( Model, Cmd Msg ) -init _ = - ( initModel, Cmd.none ) +init : Shared.Model -> Url.Url Params -> ( Model, Cmd Msg ) +init shared _ = + { game = Game.init, dimensions = shared.dimensions } + |> noCmds @@ -127,10 +147,13 @@ view : Model -> Document Msg view model = { title = "Quarto - Play" , body = - [ column [ spacing 10, centerX ] - [ viewRemainingPieces (Game.remainingPieces model.game) - , viewGamestatus (Game.currentStatus model.game) - , viewBoard (Game.gameboard model.game) + [ column [ padding 20, spacing 20, centerX ] + [ rowOrCol model.dimensions + [ centerX ] + [ viewBoard (Game.gameboard model.game) + , viewRemainingPieces (Game.remainingPieces model.game) + ] + , viewGamestatus (Game.currentStatus model.game) model.dimensions ] ] } @@ -138,46 +161,65 @@ view model = viewRemainingPieces : List Gamepiece -> Element Msg viewRemainingPieces remainingPieces = - column [ spacing 10, centerX ] - [ el [ Font.center, width fill ] (text "Remaining Pieces") - , column [ centerX ] <| - List.map (row [ centerX ]) <| + column [ padding 10, centerX ] + [ column [] <| + List.map (row []) <| Liste.greedyGroupsOf 4 <| List.map viewRemainingPiecesButton remainingPieces ] -viewGamestatus : GameStatus -> Element Msg -viewGamestatus gamestatus = +viewBoard : (Cellname -> Cell) -> Element Msg +viewBoard cellDict = + column [ Region.announce, centerX ] + [ row [] <| List.map (viewCellButton << cellDict) [ A1, B1, C1, D1 ] + , row [] <| List.map (viewCellButton << cellDict) [ A2, B2, C2, D2 ] + , row [] <| List.map (viewCellButton << cellDict) [ A3, B3, C3, D3 ] + , row [] <| List.map (viewCellButton << cellDict) [ A4, B4, C4, D4 ] + ] + + +viewGamestatus : GameStatus -> Dimensions -> Element Msg +viewGamestatus gamestatus dimensions = let - containerize : Element Msg -> Element Msg - containerize elem = - column [] [ el [ Font.center, width fill ] (text "Game Status"), elem ] + containerize : List (Element Msg) -> Element Msg + containerize elements = + el [ Font.center, centerX ] (column [ width fill, Font.center, centerX ] elements) in case gamestatus of Won winner -> - row [] [ viewSvgbox [ Svg.text <| "Winner: " ++ Game.playerToString winner ], viewRestartButton ] - |> containerize + containerize [ text <| "The Winner is : " ++ Game.playerToString winner, viewRestartButton ] Draw -> - row [] [ viewSvgbox [ Svg.text "It's a Draw" ], viewRestartButton ] - |> containerize + containerize [ text "It's a Draw!", viewRestartButton ] InPlay player (ChoosingCellToPlay gamepiece) -> - row [] - [ text "Piece Selected: " - , viewGamepiece gamepiece - , text <| "Active Player: " ++ Game.playerToString player + let + script = + case player of + Human -> + paragraph [] [ text "Click an empty cell to play the piece the computer chose for you. " ] + + Computer -> + paragraph [] [ text "Computer is thinking of where to play selected gamepiece. " ] + in + containerize + [ script + , row [ centerX, Font.center ] [ text "Selected gamepiece: ", viewGamepiece gamepiece ] ] - |> containerize InPlay player ChoosingPiece -> - row [] - [ viewSvgbox - [ Svg.rect [ Attr.width "60", Attr.height "60", Attr.fill "none" ] [] ] - , text <| "Active Player: " ++ Game.playerToString player - ] - |> containerize + let + script = + case player of + Human -> + text "Choose a piece for the computer to play." + + Computer -> + text "Computer is choosing a piece for you to play." + in + containerize + [ script ] viewCell : Cell -> Element Msg @@ -205,17 +247,6 @@ viewRestartButton = { onPress = Just (GameMessage RestartWanted), label = text "Restart" } -viewBoard : (Cellname -> Cell) -> Element Msg -viewBoard cellDict = - column [ centerX, Region.announce ] - [ el [ Font.center, width fill ] (text "GameBoard") - , row [] <| List.map (viewCellButton << cellDict) [ A1, B1, C1, D1 ] - , row [] <| List.map (viewCellButton << cellDict) [ A2, B2, C2, D2 ] - , row [] <| List.map (viewCellButton << cellDict) [ A3, B3, C3, D3 ] - , row [] <| List.map (viewCellButton << cellDict) [ A4, B4, C4, D4 ] - ] - - viewRemainingPiecesButton : Gamepiece -> Element Msg viewRemainingPiecesButton gamepiece = let @@ -323,3 +354,12 @@ makeGamepieceSvg { shape, colour, pattern, size } = patternToSvgAttrs pattern in shapefunc (List.concat [ patternAttributes, colourAttributes, sizeAttributes ]) [] + + +rowOrCol : Dimensions -> (List (Attribute msg) -> List (Element msg) -> Element msg) +rowOrCol dims = + if dims.width < 800 then + column + + else + row diff --git a/src/Shared.elm b/src/Shared.elm index f226664..610da8b 100644 --- a/src/Shared.elm +++ b/src/Shared.elm @@ -1,5 +1,6 @@ module Shared exposing - ( Flags + ( Dimensions + , Flags , Model , Msg , init @@ -8,11 +9,32 @@ module Shared exposing , view ) +import Browser.Events import Browser.Navigation exposing (Key) -import Element exposing (Element, centerX, column, fill, height, link, newTabLink, padding, row, spacing, text, width) +import Element + exposing + ( Attribute + , DeviceClass(..) + , Element + , Orientation(..) + , alignLeft + , alignRight + , column + , fill + , height + , link + , newTabLink + , padding + , paragraph + , row + , spacing + , text + , width + ) import Element.Background as Background import Element.Font as Font import Element.Region as Region +import Helpers exposing (noCmds) import Spa.Document exposing (Document) import Spa.Generated.Route as Route import Styles @@ -24,20 +46,32 @@ import Url exposing (Url) type alias Flags = - () + { width : Int + , height : Int + } -type alias Model = - { url : Url - , key : Key +type alias Dimensions = + { width : Int + , height : Int } init : Flags -> Url -> Key -> ( Model, Cmd Msg ) -init _ url key = - ( Model url key - , Cmd.none - ) +init flags url key = + Model url key flags + |> noCmds + + + +-- MODEL + + +type alias Model = + { url : Url + , key : Key + , dimensions : Dimensions + } @@ -45,19 +79,20 @@ init _ url key = type Msg - = NoOp + = WindowResized Int Int update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case msg of - NoOp -> - ( model, Cmd.none ) + WindowResized width height -> + { model | dimensions = Dimensions width height } + |> noCmds subscriptions : Model -> Sub Msg subscriptions _ = - Sub.none + Browser.Events.onResize WindowResized @@ -68,10 +103,10 @@ view : { page : Document msg, toMsg : Msg -> msg } -> Model -> Document msg -view { page } _ = +view { page } model = { title = page.title , body = - [ column [ spacing 20, height fill, width fill, Region.mainContent ] + [ column (style model.dimensions) [ header , body page.body , footer @@ -83,13 +118,14 @@ view { page } _ = header : Element msg header = row [ width fill, spacing 20, padding 20, Background.color Styles.blue, Region.navigation ] - [--link [ Font.color Styles.white ] { url = Route.toString Route.Top, label = text "Home" } + [ link [ Font.color Styles.white, alignLeft ] { url = Route.toString Route.Top, label = text "Home" } + , link [ Font.color Styles.white, alignRight ] { url = Route.toString Route.About, label = text "About" } ] body : List (Element msg) -> Element msg body listy = - column [ height fill, centerX ] listy + column [ width fill, height fill, Region.mainContent ] listy @@ -98,5 +134,23 @@ body listy = footer : Element msg footer = - row [ width fill, spacing 20, padding 20, Background.color Styles.black ] - [ newTabLink [ Font.color Styles.white, centerX ] { url = "https://github.com/tkshill/Quarto", label = text "Checkout the GitHub Repository!" } ] + row [ width fill, spacing 20, padding 20, Font.color Styles.white, Background.color Styles.black ] + [ paragraph [ Font.center ] + [ text "Check out our " + , newTabLink [ Font.color Styles.red ] { url = "https://github.com/tkshill/Quarto", label = text "Repository" } + ] + ] + + +style : Dimensions -> List (Attribute msg) +style dimensions = + let + device = + Element.classifyDevice dimensions + in + case device.class of + Phone -> + [ height fill, width fill, Font.size 18 ] + + _ -> + [ height fill, width fill, Font.size 20 ]