diff --git a/elm.json b/elm.json index 3235b80..9f8f574 100644 --- a/elm.json +++ b/elm.json @@ -13,6 +13,7 @@ "elm/json": "1.1.3", "elm/svg": "1.0.1", "elm/time": "1.0.0", + "elm/url": "1.0.0", "elm-explorations/test": "2.2.0", "mpizenberg/elm-pointer-events": "5.0.0", "rtfeldman/elm-iso8601-date-strings": "1.1.4", @@ -23,7 +24,6 @@ "elm/file": "1.0.5", "elm/parser": "1.1.0", "elm/random": "1.0.0", - "elm/url": "1.0.0", "elm/virtual-dom": "1.0.3", "miniBill/elm-xml-parser": "1.0.1", "rtfeldman/elm-hex": "1.0.0" diff --git a/frontend/src/Main.elm b/frontend/src/Main.elm index d7d8b2a..bb7774e 100644 --- a/frontend/src/Main.elm +++ b/frontend/src/Main.elm @@ -1,6 +1,7 @@ module Main exposing (view) import Browser +import Browser.Navigation as Nav import Html exposing (Html, button, div, span, text, img, pre) import Html.Attributes as H exposing (src, style, width, height) import Html.Events exposing (onClick) @@ -17,16 +18,29 @@ import Svg.Attributes as S exposing , fill , points , stroke, strokeWidth, strokeOpacity) +import Url.Parser exposing (Parser, (), (), int, map, oneOf, s, string) +import Url.Parser.Query as Query +import Url exposing (Url) + + +type Route = Timeline (Maybe Int) (Maybe Int) + +routeParser : Parser (Route -> a) a +routeParser = + map Timeline (s "timeline" Query.int "start" Query.int "duration") -- MAIN main = - Browser.element { init = init - , update = update - , subscriptions = subscriptions - , view = view } + Browser.application + { init = init + , update = update + , subscriptions = subscriptions + , onUrlRequest = (\ ur -> NewUrlRequest) + , onUrlChange = (\ u -> UrlChanged) + , view = view } @@ -114,10 +128,19 @@ type alias Model = { centre: Coord , zoom: Zoom , drag: Drag + , startTime : Int + , duration : Int , track: TrackState } -init : () -> (Model, Cmd Msg) -init _ = ((Model (toCoord 51.60 -0.01) 13 None Empty), fetchTrack) +init : () -> Url -> Nav.Key -> (Model, Cmd Msg) +init _ url navKey = + let (start, duration) = + case Url.Parser.parse routeParser url of + Just (Timeline (Just s) (Just d)) -> (s, d) + _ -> (10,10) + in + ((Model (toCoord 51.60 -0.01) 13 None start duration Empty), + (fetchTrack start duration)) -- SUBSCRIPTIONS @@ -125,8 +148,11 @@ subscriptions : Model -> Sub Msg subscriptions model = Sub.none -fetchTrack = Http.get - { url = "http://localhost:3000/points?start=1729668899&duration=2842" +fetchTrack start duration = Http.get + { url = ("http://localhost:3000/points?start=" ++ + String.fromInt start ++ + "&duration=" ++ + String.fromInt duration) , expect = Http.expectJson Loaded trackDecoder } @@ -175,6 +201,8 @@ type Msg | PointerMove (Int, Int) | PointerUp (Int, Int) | Loaded (Result Http.Error (List Point)) + | NewUrlRequest + | UrlChanged update : Msg -> Model -> (Model, Cmd Msg) @@ -207,6 +235,8 @@ newModel msg model = Ok trk -> { model | track = Present trk } Err (Http.BadBody e) -> { model | track = Debug.log e (Failure "e") } Err e -> { model | track = Debug.log "unknown error" (Failure "e") } + NewUrlRequest -> model + UrlChanged -> model -- VIEW @@ -293,8 +323,8 @@ canvas centre zoom width height track = portalWidth = 600 portalHeight = 600 -view : Model -> Html Msg -view model = +viewDiv : Model -> Html Msg +viewDiv model = let coord = translate model.centre (pixelsToCoord model.zoom (dragDelta model.drag)) canvasV = canvas coord model.zoom portalWidth portalHeight model.track in div [] @@ -317,3 +347,7 @@ view model = , button [ onClick (Scroll 10 0) ] [ text ">" ] -- , div [] [ text (Debug.toString (List.length model.track)) ] ] + +view : Model -> Browser.Document Msg +view model = + Browser.Document "Souplesse elm" [ (viewDiv model) ]