souplesse

commit cbe8bf4d4dd29da871d025ee6a137e421d01f057
parent 3427f500b3e0b4727c09c1ac654b60c0c1d623b2
Author: Daniel Barlow <dan@telent.net>
Date:   Tue, 12 Nov 2024 00:15:19 +0000

frontend: get start/duration from query params

Diffstat:
M
elm.json
 | 
2
+-
M
frontend/src/Main.elm
 | 
54
++++++++++++++++++++++++++++++++++++++++++++----------

2 files changed, 45 insertions(+), 11 deletions(-)
diff --git 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
@@ -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) ]