From 21b4b9b37b02dac97f1d6e11106441bf7c1066fd Mon Sep 17 00:00:00 2001 From: ccamel Date: Wed, 10 Jul 2024 09:23:09 +0200 Subject: [PATCH 1/4] :heavy_plus_sign: Add elm-community/html-extra dependency --- elm.json | 109 ++++++++++++++++++++++++++++--------------------------- 1 file changed, 56 insertions(+), 53 deletions(-) diff --git a/elm.json b/elm.json index 968c4356..d741538b 100644 --- a/elm.json +++ b/elm.json @@ -1,57 +1,60 @@ { - "type": "application", - "source-directories": ["src"], - "elm-version": "0.19.1", - "dependencies": { - "direct": { - "BrianHicks/elm-particle": "1.5.0", - "Chadtech/elm-vector": "3.0.2", - "MacCASOutreach/graphicsvg": "8.1.0", - "andre-dietrich/elm-conditional": "1.0.0", - "avh4/elm-color": "1.0.0", - "cuducos/elm-format-number": "9.0.1", - "elm/browser": "1.0.2", - "elm/core": "1.0.5", - "elm/file": "1.0.5", - "elm/html": "1.0.0", - "elm/json": "1.1.3", - "elm/random": "1.0.0", - "elm/svg": "1.0.1", - "elm/time": "1.0.0", - "elm/url": "1.0.0", - "elm-community/basics-extra": "4.1.0", - "elm-community/list-extra": "8.7.0", - "elm-community/random-extra": "3.2.0", - "elm-explorations/markdown": "1.0.0", - "fapian/elm-html-aria": "1.4.0", - "harmboschloo/elm-ecs": "2.0.0", - "ianmackenzie/elm-geometry": "3.9.1", - "ianmackenzie/elm-units": "2.10.0", - "joakin/elm-canvas": "5.0.0", - "lukewestby/elm-string-interpolate": "1.0.4", - "mpizenberg/elm-pointer-events": "5.0.0", - "myrho/elm-round": "1.0.5", - "noahzgordon/elm-color-extra": "1.0.2", - "ohanhi/keyboard": "2.0.1", - "simonh1000/elm-colorpicker": "2.0.3", - "wsowens/term": "2.0.6" + "type": "application", + "source-directories": [ + "src" + ], + "elm-version": "0.19.1", + "dependencies": { + "direct": { + "BrianHicks/elm-particle": "1.5.0", + "Chadtech/elm-vector": "3.0.2", + "MacCASOutreach/graphicsvg": "8.1.0", + "andre-dietrich/elm-conditional": "1.0.0", + "avh4/elm-color": "1.0.0", + "cuducos/elm-format-number": "9.0.1", + "elm/browser": "1.0.2", + "elm/core": "1.0.5", + "elm/file": "1.0.5", + "elm/html": "1.0.0", + "elm/json": "1.1.3", + "elm/random": "1.0.0", + "elm/svg": "1.0.1", + "elm/time": "1.0.0", + "elm/url": "1.0.0", + "elm-community/basics-extra": "4.1.0", + "elm-community/html-extra": "3.4.0", + "elm-community/list-extra": "8.7.0", + "elm-community/random-extra": "3.2.0", + "elm-explorations/markdown": "1.0.0", + "fapian/elm-html-aria": "1.4.0", + "harmboschloo/elm-ecs": "2.0.0", + "ianmackenzie/elm-geometry": "3.9.1", + "ianmackenzie/elm-units": "2.10.0", + "joakin/elm-canvas": "5.0.0", + "lukewestby/elm-string-interpolate": "1.0.4", + "mpizenberg/elm-pointer-events": "5.0.0", + "myrho/elm-round": "1.0.5", + "noahzgordon/elm-color-extra": "1.0.2", + "ohanhi/keyboard": "2.0.1", + "simonh1000/elm-colorpicker": "2.0.3", + "wsowens/term": "2.0.6" + }, + "indirect": { + "elm/bytes": "1.0.8", + "elm/parser": "1.1.0", + "elm/regex": "1.0.0", + "elm/virtual-dom": "1.0.2", + "fredcy/elm-parseint": "2.0.1", + "harmboschloo/elm-dict-intersect": "1.0.0", + "ianmackenzie/elm-1d-parameter": "1.0.1", + "ianmackenzie/elm-float-extra": "1.1.0", + "ianmackenzie/elm-interval": "2.0.0", + "ianmackenzie/elm-triangular-mesh": "1.1.0", + "ianmackenzie/elm-units-interval": "2.3.0" + } }, - "indirect": { - "elm/bytes": "1.0.8", - "elm/parser": "1.1.0", - "elm/regex": "1.0.0", - "elm/virtual-dom": "1.0.2", - "fredcy/elm-parseint": "2.0.1", - "harmboschloo/elm-dict-intersect": "1.0.0", - "ianmackenzie/elm-1d-parameter": "1.0.1", - "ianmackenzie/elm-float-extra": "1.1.0", - "ianmackenzie/elm-interval": "2.0.0", - "ianmackenzie/elm-triangular-mesh": "1.1.0", - "ianmackenzie/elm-units-interval": "2.3.0" + "test-dependencies": { + "direct": {}, + "indirect": {} } - }, - "test-dependencies": { - "direct": {}, - "indirect": {} - } } From 61030597914ccf8b95eac8f205738fc2ce230138 Mon Sep 17 00:00:00 2001 From: ccamel Date: Tue, 9 Jul 2024 10:58:19 +0200 Subject: [PATCH 2/4] :technologist: Canonicalize navigation (LinkClicked, UrlChanged) --- src/App/Messages.elm | 2 - src/App/Update.elm | 122 +++++++++++++++++--------------------- src/App/View.elm | 12 ++-- src/Lib/ColorSelector.elm | 5 +- src/Lib/Html.elm | 15 +---- src/Main.elm | 14 +---- src/Page/Lissajous.elm | 10 ++-- src/Page/Maze.elm | 19 +++--- src/Page/Physics.elm | 7 +-- 9 files changed, 80 insertions(+), 126 deletions(-) diff --git a/src/App/Messages.elm b/src/App/Messages.elm index 7b2681ff..90b06aa3 100644 --- a/src/App/Messages.elm +++ b/src/App/Messages.elm @@ -26,8 +26,6 @@ type Page type Msg = UrlChanged Url | LinkClicked Browser.UrlRequest - | GoToHome - | GoToPage Page -- messages for pages | AboutPageMsg Page.About.Msg | CalcPageMsg Page.Calc.Msg diff --git a/src/App/Update.elm b/src/App/Update.elm index d196ba54..564f0d1d 100644 --- a/src/App/Update.elm +++ b/src/App/Update.elm @@ -1,9 +1,8 @@ -module App.Update exposing (initialModel, update) +module App.Update exposing (init, update) import App.Flags exposing (Flags) import App.Messages exposing (Msg(..), Page(..)) import App.Models exposing (Model, PagesModel, emptyPagesModel) -import App.Pages exposing (pageHash) import App.Routing exposing (Route(..), toRoute) import Browser import Browser.Navigation as Nav @@ -16,8 +15,8 @@ import Page.Lissajous import Page.Maze import Page.Physics import Page.Term -import String exposing (cons) import Tuple exposing (first, second) +import Url update : Msg -> Model -> ( Model, Cmd Msg ) @@ -29,84 +28,79 @@ update msg model = case msg of LinkClicked urlRequest -> case urlRequest of + Browser.Internal location -> + ( model, Nav.pushUrl model.navKey (Url.toString location) ) + Browser.External href -> ( model, Nav.load href ) - _ -> - ( model, Cmd.none ) - UrlChanged location -> let newRoute = toRoute model.flags.basePath location + in + if model.route == newRoute then + ( model, Cmd.none ) - clearedModel = - { model | pages = emptyPagesModel } + else + let + clearedModel = + { model | pages = emptyPagesModel } - ( aboutModel, aboutCmd ) = - Page.About.init model.flags + ( aboutModel, aboutCmd ) = + Page.About.init model.flags - ( calcModel, calcCmd ) = - Page.Calc.init + ( calcModel, calcCmd ) = + Page.Calc.init - ( lissajousModel, lissajousCmd ) = - Page.Lissajous.init + ( lissajousModel, lissajousCmd ) = + Page.Lissajous.init - ( digitalClockModel, digitalClockCmd ) = - Page.DigitalClock.init + ( digitalClockModel, digitalClockCmd ) = + Page.DigitalClock.init - ( mazeModel, mazeCmd ) = - Page.Maze.init + ( mazeModel, mazeCmd ) = + Page.Maze.init - ( physicsModel, physicsCmd ) = - Page.Physics.init + ( physicsModel, physicsCmd ) = + Page.Physics.init - ( termModel, termCmd ) = - Page.Term.init + ( termModel, termCmd ) = + Page.Term.init - ( asteroidsModel, asteroidsCmd ) = - Page.Asteroids.init - in - case newRoute of - NotFoundRoute -> - ( { clearedModel | route = newRoute }, Cmd.none ) + ( asteroidsModel, asteroidsCmd ) = + Page.Asteroids.init + in + case newRoute of + NotFoundRoute -> + ( { clearedModel | route = newRoute }, Cmd.none ) - Home -> - ( { clearedModel | route = newRoute }, Cmd.none ) + Home -> + ( { clearedModel | route = newRoute }, Cmd.none ) - Page About -> - ( { clearedModel | route = newRoute, pages = { emptyPagesModel | aboutPage = Just aboutModel } }, Cmd.map AboutPageMsg aboutCmd ) + Page About -> + ( { clearedModel | route = newRoute, pages = { emptyPagesModel | aboutPage = Just aboutModel } }, Cmd.map AboutPageMsg aboutCmd ) - Page Calc -> - ( { clearedModel | route = newRoute, pages = { emptyPagesModel | calcPage = Just calcModel } }, Cmd.map CalcPageMsg calcCmd ) + Page Calc -> + ( { clearedModel | route = newRoute, pages = { emptyPagesModel | calcPage = Just calcModel } }, Cmd.map CalcPageMsg calcCmd ) - Page Lissajous -> - ( { clearedModel | route = newRoute, pages = { emptyPagesModel | lissajousPage = Just lissajousModel } }, Cmd.map LissajousPageMsg lissajousCmd ) + Page Lissajous -> + ( { clearedModel | route = newRoute, pages = { emptyPagesModel | lissajousPage = Just lissajousModel } }, Cmd.map LissajousPageMsg lissajousCmd ) - Page DigitalClock -> - ( { clearedModel | route = newRoute, pages = { emptyPagesModel | digitalClockPage = Just digitalClockModel } }, Cmd.map DigitalClockPageMsg digitalClockCmd ) + Page DigitalClock -> + ( { clearedModel | route = newRoute, pages = { emptyPagesModel | digitalClockPage = Just digitalClockModel } }, Cmd.map DigitalClockPageMsg digitalClockCmd ) - Page Maze -> - ( { clearedModel | route = newRoute, pages = { emptyPagesModel | mazePage = Just mazeModel } }, Cmd.map MazePageMsg mazeCmd ) + Page Maze -> + ( { clearedModel | route = newRoute, pages = { emptyPagesModel | mazePage = Just mazeModel } }, Cmd.map MazePageMsg mazeCmd ) - Page Physics -> - ( { clearedModel | route = newRoute, pages = { emptyPagesModel | physicsPage = Just physicsModel } }, Cmd.map PhysicsPageMsg physicsCmd ) + Page Physics -> + ( { clearedModel | route = newRoute, pages = { emptyPagesModel | physicsPage = Just physicsModel } }, Cmd.map PhysicsPageMsg physicsCmd ) - Page Term -> - ( { clearedModel | route = newRoute, pages = { emptyPagesModel | termPage = Just termModel } }, Cmd.map TermPageMsg termCmd ) + Page Term -> + ( { clearedModel | route = newRoute, pages = { emptyPagesModel | termPage = Just termModel } }, Cmd.map TermPageMsg termCmd ) - Page Asteroids -> - ( { clearedModel | route = newRoute, pages = { emptyPagesModel | asteroidsPage = Just asteroidsModel } }, Cmd.map AsteroidsPageMsg asteroidsCmd ) - - GoToPage p -> - ( model - , pageHash p - |> cons '#' - |> Nav.pushUrl model.navKey - ) - - GoToHome -> - ( model, Nav.replaceUrl model.navKey "#" ) + Page Asteroids -> + ( { clearedModel | route = newRoute, pages = { emptyPagesModel | asteroidsPage = Just asteroidsModel } }, Cmd.map AsteroidsPageMsg asteroidsCmd ) -- messages from pages AboutPageMsg m -> @@ -134,27 +128,19 @@ update msg model = convert model m .asteroidsPage Page.Asteroids.update (\mdl -> { model | pages = { pages | asteroidsPage = Just mdl } }) AsteroidsPageMsg -initialModel : Flags -> Nav.Key -> Route -> ( Model, Cmd App.Messages.Msg ) -initialModel flags navKey route = +init : Flags -> Url.Url -> Nav.Key -> ( Model, Cmd App.Messages.Msg ) +init flags url navKey = let model = { flags = flags - , route = route + , route = Home , navKey = navKey -- models for pages , pages = emptyPagesModel } in - case route of - NotFoundRoute -> - update GoToHome model - - Home -> - update GoToHome model - - Page p -> - update (GoToPage p) model + update (UrlChanged url) model convert : Model -> b -> (PagesModel -> Maybe.Maybe a) -> (b -> a -> ( m, Cmd c )) -> (m -> Model) -> (c -> Msg) -> ( Model, Cmd Msg ) diff --git a/src/App/View.elm b/src/App/View.elm index b6832ec6..63171618 100644 --- a/src/App/View.elm +++ b/src/App/View.elm @@ -1,14 +1,13 @@ module App.View exposing (view) -import App.Messages exposing (Msg(..), Page) +import App.Messages exposing (Msg, Page) import App.Models exposing (Model) import App.Pages exposing (pageDate, pageDescription, pageGithubLink, pageHash, pageName, pageView, pages) import App.Routing exposing (Route(..)) -import Browser exposing (UrlRequest(..)) +import Browser import Html exposing (Html, a, article, br, div, footer, h1, h2, h3, hr, i, img, p, section, span, strong, text) import Html.Attributes exposing (attribute, class, href, src, title, width) -import Html.Events exposing (onClick) -import Lib.Html exposing (classList, onClickNotPropagate) +import Lib.Html exposing (classList) import List exposing (intersperse) import String.Interpolate exposing (interpolate) @@ -34,7 +33,7 @@ view model = [ h1 [ class "title pb-5" ] [ i [ class "quote-left fa fa-quote-left text-muted pr-4" ] [] , span [ class "break" ] [] - , a [ href "#", onClickNotPropagate GoToHome ] [ text "playground" ] + , a [ href "#" ] [ text "playground" ] , span [ class "elm-pipe pl-1" ] [ text "|" ] , span [ class "elm-gt pr-1" ] [ text ">" ] , a [ href "http://elm-lang.org/" ] [ text "elm" ] @@ -199,13 +198,11 @@ showcase { flags } num page = , a [ href ("#" ++ pageHash page) , class "button is-primary mr-4" - , onClick (GoToPage page) ] [ text "View demo" ] , a [ href (pageGithubLink page) , class "button is-secondary" - , onClickNotPropagate (LinkClicked (External (pageGithubLink page))) ] [ i [ class "fa fa-github mr-2" ] [] , text "Source" @@ -252,7 +249,6 @@ notFound = , a [ href "#" , class "button" - , onClickNotPropagate GoToHome ] [ text "Go Home" ] ] diff --git a/src/Lib/ColorSelector.elm b/src/Lib/ColorSelector.elm index f3e45e96..9e7127c0 100644 --- a/src/Lib/ColorSelector.elm +++ b/src/Lib/ColorSelector.elm @@ -5,7 +5,8 @@ import ColorPicker import Html exposing (Html, button, div, i, span) import Html.Attributes exposing (attribute, class, id, style) import Html.Attributes.Aria exposing (ariaControls, ariaHasPopup, role) -import Lib.Html exposing (classList, onClickNotPropagate) +import Html.Events exposing (onClick) +import Lib.Html exposing (classList) {-| A color selector that opens a color picker when clicked. @@ -18,7 +19,7 @@ view { elementId, visible, color, onVisibilityChange, state, toMsg } = , class "dropdown" ] [ div [ class "dropdown-trigger" ] - [ button [ class "button py-1", ariaHasPopup "true", ariaControls "dropdown-menu", onClickNotPropagate (onVisibilityChange (not visible)) ] + [ button [ class "button py-1", ariaHasPopup "true", ariaControls "dropdown-menu", onClick (onVisibilityChange (not visible)) ] [ span [ class "p-2 m-0", style "background-color" (toCssString color) ] [] , span [ class "icon is-small" ] [ i diff --git a/src/Lib/Html.elm b/src/Lib/Html.elm index 67d66283..acc5409b 100644 --- a/src/Lib/Html.elm +++ b/src/Lib/Html.elm @@ -1,4 +1,4 @@ -module Lib.Html exposing (classList, onClickNotPropagate, svgClassList) +module Lib.Html exposing (classList, svgClassList) {-| This function makes it easier to build a space-separated class attribute with SVG TODO: To replace with equivalent function in core modules when available @@ -6,8 +6,6 @@ TODO: To replace with equivalent function in core modules when available import Html import Html.Attributes as HtmlAtt -import Html.Events exposing (custom) -import Json.Decode as Decode import Svg import Svg.Attributes as SvgAtt @@ -26,14 +24,3 @@ svgClassList = >> List.map Tuple.first >> String.join " " >> SvgAtt.class - - -onClickNotPropagate : a -> Html.Attribute a -onClickNotPropagate msg = - custom "click" - (Decode.succeed - { message = msg - , stopPropagation = True - , preventDefault = True - } - ) diff --git a/src/Main.elm b/src/Main.elm index d8a4e61a..0803401e 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -3,22 +3,10 @@ module Main exposing (main) import App.Flags exposing (Flags) import App.Messages exposing (Msg(..)) import App.Models exposing (Model) -import App.Routing import App.Subscriptions exposing (subscriptions) -import App.Update exposing (initialModel, update) +import App.Update exposing (init, update) import App.View exposing (view) import Browser -import Browser.Navigation as Nav -import Url exposing (Url) - - -init : Flags -> Url -> Nav.Key -> ( Model, Cmd Msg ) -init flags url navKey = - let - currentRoute = - App.Routing.toRoute flags.basePath url - in - initialModel flags navKey currentRoute diff --git a/src/Page/Lissajous.elm b/src/Page/Lissajous.elm index 6c3f9981..0f541009 100644 --- a/src/Page/Lissajous.elm +++ b/src/Page/Lissajous.elm @@ -9,11 +9,11 @@ import GraphicSVG.Widget as Widget import Html exposing (Html, a, div, input, p, text) import Html.Attributes exposing (class, href, id, name, size, step, style, type_, value) import Html.Events exposing (onInput) +import Html.Events.Extra exposing (onClickPreventDefaultAndStopPropagation) import Lib.Array exposing (BoundedArray, appendToBoundedArray, createBoundedArray, resizeBoundedArray) import Lib.ColorSelector as ColorSelector import Lib.Decoder exposing (outsideTarget) import Lib.Frame exposing (Frames, addFrame, createFrames, fpsText, resetFrames) -import Lib.Html exposing (onClickNotPropagate) import Lib.Page import Lib.String exposing (strToFloatWithMinMax, strToIntWithMinMax) import List exposing (concat, concatMap, filterMap, indexedMap, map, range) @@ -326,12 +326,12 @@ view model = [ p [] [ text "You can " , if not model.started then - a [ class "action", href "", onClickNotPropagate Start ] [ text "start" ] + a [ class "action", href "#lissajous", onClickPreventDefaultAndStopPropagation Start ] [ text "start" ] else - a [ class "action", href "", onClickNotPropagate Stop ] [ text "stop" ] + a [ class "action", href "#lissajous", onClickPreventDefaultAndStopPropagation Stop ] [ text "stop" ] , text " the animation. You can also " - , a [ class "action", href "", onClickNotPropagate Reset ] [ text "reset" ] + , a [ class "action", href "#lissajous", onClickPreventDefaultAndStopPropagation Reset ] [ text "reset" ] , text " the values to default." ] , p [] [ text "The equations are:" ] @@ -391,7 +391,7 @@ view model = clazz = "action" ++ selected in - [ a [ class clazz, href "", onClickNotPropagate (Batch [ SetAParemeter (fromInt pa), SetBParameter (fromInt pb) ]) ] + [ a [ class clazz, href "#lissajous", onClickPreventDefaultAndStopPropagation (Batch [ SetAParemeter (fromInt pa), SetBParameter (fromInt pb) ]) ] [ text (interpolate "({0},{1})" ([ pa, pb ] |> map fromInt)) ] , text " " diff --git a/src/Page/Maze.elm b/src/Page/Maze.elm index ed8f924d..269cc44d 100644 --- a/src/Page/Maze.elm +++ b/src/Page/Maze.elm @@ -7,9 +7,8 @@ import FormatNumber exposing (format) import FormatNumber.Locales exposing (Decimals(..), Locale, usLocale) import Html exposing (Html, button, div, i, label, option, p, select, span, text) import Html.Attributes exposing (attribute, class, classList, disabled, selected, title, type_, value) -import Html.Events exposing (onInput) +import Html.Events exposing (onClick, onInput) import Json.Encode exposing (Value, encode, int, list, object, string) -import Lib.Html exposing (onClickNotPropagate) import Lib.Page import List exposing (map, range, repeat) import List.Extra exposing (last, splitAt) @@ -455,7 +454,7 @@ controlView model = [ class "button is-danger" , type_ "button" , title "reset the maze" - , onClickNotPropagate Reset + , onClick Reset ] [ span [ class "icon is-small" ] [ i [ class "fa fa-repeat" ] [] ] ] , button @@ -463,7 +462,7 @@ controlView model = , disabled (model.auto || List.isEmpty model.memento) , type_ "button" , title "make 5 steps backward" - , onClickNotPropagate (Steps -5) + , onClick (Steps -5) ] [ span [ class "icon is-small" ] [ i [ class "fa fa-fast-backward" ] [] ] ] , button @@ -471,7 +470,7 @@ controlView model = , disabled (model.auto || List.isEmpty model.memento) , type_ "button" , title "make one step backward" - , onClickNotPropagate (Steps -1) + , onClick (Steps -1) ] [ span [ class "icon is-small" ] [ i [ class "fa fa-step-backward" ] [] ] ] , button @@ -479,7 +478,7 @@ controlView model = , disabled (model.auto || (model.maze.state == Ready)) , type_ "button" , title "generate the maze" - , onClickNotPropagate StartAutoGeneration + , onClick StartAutoGeneration ] [ span [ class "icon is-small" ] [ i [ class "fa fa-play" ] [] ] ] , button @@ -487,7 +486,7 @@ controlView model = , disabled (not model.auto || (model.maze.state == Ready)) , type_ "button" , title "stop the generation" - , onClickNotPropagate StopAutoGeneration + , onClick StopAutoGeneration ] [ span [ class "icon is-small" ] [ i [ class "fa fa-pause" ] [] ] ] , button @@ -495,7 +494,7 @@ controlView model = , disabled (model.auto || (model.maze.state == Ready)) , type_ "button" , title "make one step" - , onClickNotPropagate (Steps 1) + , onClick (Steps 1) ] [ span [ class "icon is-small" ] [ i [ class "fa fa-step-forward" ] [] ] ] , button @@ -503,14 +502,14 @@ controlView model = , disabled (model.auto || (model.maze.state == Ready)) , type_ "button" , title "make one step" - , onClickNotPropagate (Steps 5) + , onClick (Steps 5) ] [ span [ class "icon is-small" ] [ i [ class "fa fa-fast-forward" ] [] ] ] , button [ class "button is-info ml-4" , type_ "button" , title "export the maze state to JSON" - , onClickNotPropagate Download + , onClick Download ] [ span [ class "icon is-small" ] [ i [ class "fa fa-download" ] [] ] ] , div [ class "select is-info is-small ml-4" ] diff --git a/src/Page/Physics.elm b/src/Page/Physics.elm index 6bd577ce..5bde7c2c 100644 --- a/src/Page/Physics.elm +++ b/src/Page/Physics.elm @@ -17,7 +17,6 @@ import Html.Events exposing (onClick, onInput) import Html.Events.Extra.Mouse as Mouse exposing (Button(..)) import Lib.Frame exposing (Frames, addFrame, createFrames, fpsText) import Lib.Gfx exposing (withAlpha) -import Lib.Html exposing (onClickNotPropagate) import Lib.Page import List exposing (length) import Markdown @@ -1036,7 +1035,7 @@ controlView model = [ class "button is-danger ml-2" , type_ "button" , title "reset the simulation" - , onClickNotPropagate Reset + , onClick Reset ] [ span [ class "icon is-small" ] [ i [ class "fa fa-repeat" ] [] ] ] , button @@ -1044,7 +1043,7 @@ controlView model = , disabled model.started , type_ "button" , title "start the simulation" - , onClickNotPropagate Start + , onClick Start ] [ span [ class "icon is-small" ] [ i [ class "fa fa-play" ] [] ] ] , button @@ -1052,7 +1051,7 @@ controlView model = , disabled (not model.started) , type_ "button" , title "pause the simulation" - , onClickNotPropagate Stop + , onClick Stop ] [ span [ class "icon is-small" ] [ i [ class "fa fa-pause" ] [] ] ] , div [ class "select is-info is-small ml-4" ] From 4758fe7175e34fb768dd20bd61c4aaa9e36ebb24 Mon Sep 17 00:00:00 2001 From: ccamel Date: Wed, 10 Jul 2024 12:03:58 +0200 Subject: [PATCH 3/4] :art: Use always function where relevant --- src/Lib/Frame.elm | 2 +- src/Page/Calc.elm | 2 +- src/Page/Lissajous.elm | 2 +- src/Page/Maze.elm | 2 +- src/Page/Physics.elm | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Lib/Frame.elm b/src/Lib/Frame.elm index 733ed5a9..926cb81e 100644 --- a/src/Lib/Frame.elm +++ b/src/Lib/Frame.elm @@ -19,7 +19,7 @@ type alias Frames = createFrames : Int -> Frames createFrames = - flip createBoundedArray (\_ -> 0.0) + flip createBoundedArray (always 0.0) addFrame : Frames -> Float -> Frames diff --git a/src/Page/Calc.elm b/src/Page/Calc.elm index 12766a4f..c097218b 100644 --- a/src/Page/Calc.elm +++ b/src/Page/Calc.elm @@ -529,7 +529,7 @@ renderMemoryTag : Model -> Html Msg renderMemoryTag model = text (model.memory - |> Maybe.map (\_ -> "M") + |> Maybe.map (always "M") |> withDefault " " ) diff --git a/src/Page/Lissajous.elm b/src/Page/Lissajous.elm index 0f541009..4fdcc965 100644 --- a/src/Page/Lissajous.elm +++ b/src/Page/Lissajous.elm @@ -114,7 +114,7 @@ init = , curveStyle = { color = Color.rgb255 31 122 31, lineType = solid 2 } , resolution = 400 , afterglow = initialAfterGlow - , lissajousStencils = createBoundedArray (initialAfterGlow + 1) (\_ -> Nothing) + , lissajousStencils = createBoundedArray (initialAfterGlow + 1) (always Nothing) , ticks = createFrames 20 -- initial capacity , foregroundColorPicker = ColorPicker.empty , foregroundColorPickerVisible = False diff --git a/src/Page/Maze.elm b/src/Page/Maze.elm index 269cc44d..255708b2 100644 --- a/src/Page/Maze.elm +++ b/src/Page/Maze.elm @@ -162,7 +162,7 @@ emptyMaze : Int -> Int -> Maze emptyMaze width height = { width = width , height = height - , cells = initialize width (\_ -> initialize height (\_ -> [])) + , cells = initialize width (\_ -> initialize height (always [])) , state = Created } diff --git a/src/Page/Physics.elm b/src/Page/Physics.elm index 5bde7c2c..095a1642 100644 --- a/src/Page/Physics.elm +++ b/src/Page/Physics.elm @@ -977,7 +977,7 @@ simulationView ({ entity } as model) = ( constants.width, constants.height ) [ Mouse.onDown (\e -> MouseDown e.button (makeVector2D e.offsetPos)) , Mouse.onMove (.offsetPos >> makeVector2D >> MouseMove) - , Mouse.onUp (\_ -> MouseUp) + , Mouse.onUp (always MouseUp) ] (List.concat [ [ shapes [ fill constants.backgroundColor ] [ rect ( 0, 0 ) constants.width constants.height ] From 280b72742893175b76584f9f0c14113964d93360 Mon Sep 17 00:00:00 2001 From: ccamel Date: Wed, 10 Jul 2024 12:22:13 +0200 Subject: [PATCH 4/4] :adhesive_bandage: Reset viewport when changing page --- src/App/Messages.elm | 3 ++- src/App/Update.elm | 12 +++++++++++- 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/src/App/Messages.elm b/src/App/Messages.elm index 90b06aa3..f051ea58 100644 --- a/src/App/Messages.elm +++ b/src/App/Messages.elm @@ -24,7 +24,8 @@ type Page type Msg - = UrlChanged Url + = NoOp + | UrlChanged Url | LinkClicked Browser.UrlRequest -- messages for pages | AboutPageMsg Page.About.Msg diff --git a/src/App/Update.elm b/src/App/Update.elm index 564f0d1d..e2e59ee0 100644 --- a/src/App/Update.elm +++ b/src/App/Update.elm @@ -5,6 +5,7 @@ import App.Messages exposing (Msg(..), Page(..)) import App.Models exposing (Model, PagesModel, emptyPagesModel) import App.Routing exposing (Route(..), toRoute) import Browser +import Browser.Dom as Dom import Browser.Navigation as Nav import Maybe exposing (withDefault) import Page.About @@ -15,6 +16,7 @@ import Page.Lissajous import Page.Maze import Page.Physics import Page.Term +import Task import Tuple exposing (first, second) import Url @@ -26,10 +28,18 @@ update msg model = model.pages in case msg of + NoOp -> + ( model, Cmd.none ) + LinkClicked urlRequest -> case urlRequest of Browser.Internal location -> - ( model, Nav.pushUrl model.navKey (Url.toString location) ) + ( model + , Cmd.batch + [ Nav.pushUrl model.navKey (Url.toString location) + , Task.perform (always NoOp) (Dom.setViewport 0 0) + ] + ) Browser.External href -> ( model, Nav.load href )