souplesse

commit baf3046149610555eee371a0b9200fad5d97aeba
parent 9cfbb78e536de5f40139ddfe7354c48c9a54c3e0
Author: Daniel Barlow <dan@telent.net>
Date:   Fri, 15 Nov 2024 22:17:07 +0000

add scroll mouse for graphs to zoom in/out

Diffstat:
M
frontend/src/Main.elm
 | 
34
+++++++++++++++++++++++++---------

1 file changed, 25 insertions(+), 9 deletions(-)
diff --git a/frontend/src/Main.elm b/frontend/src/Main.elm
@@ -184,6 +184,7 @@ type Msg
   | PointerDown (Int, Int)
   | PointerMove (Int, Int)
   | PointerUp (Int, Int)
+  | TimeScale (Float)
   | Loaded (Result Http.Error (List Point))
   | NewUrlRequest
   | UrlChanged
@@ -217,6 +218,15 @@ newModel msg model =
             { model | drag = None,
                   centre = translatePixels model.centre (toZoom model.zoom) (dragDelta model.drag) }
 
+        TimeScale factor ->
+            let fudge = factor
+                len = model.duration - floor(fudge)
+            in { model |
+                     startTime = model.startTime + floor(fudge / 2)
+               ,     duration = len
+               }
+
+
         Loaded result ->
             case result of
                 Ok trk -> { model | track = Present trk }
@@ -365,15 +375,18 @@ tiles xs ys zoom =
              (List.map (\ x -> tileImg zoom (TileNumber x y)) xs))
         ys
 
-ifTrack track content =
-    case track of
-        Present t -> content t
+ifTrack : Model -> (List Point ->  Html msg) ->  Html msg
+ifTrack model content =
+    case model.track of
+        Present t ->
+            let points = Point.subseq t (toFloat model.startTime) (toFloat model.duration)
+            in  content points
         Failure f -> Debug.log f (div [] [ Html.text "failure", Html.text f])
         Loading -> div [] [Html.text "loading"]
         Empty -> div [] [Html.text "no points"]
 
 
-canvas centre zoom width height track =
+canvas centre zoom width height model =
     let (mintile, maxtile) = boundingTiles centre zoom width height
         -- offset is pixel difference between centre (which *should*
         -- be the middle of the image) and actual middle of the canvas
@@ -387,7 +400,7 @@ canvas centre zoom width height track =
         xs = List.range mintile.x maxtile.x
         ys = List.range mintile.y maxtile.y
         epos e = Tuple.mapBoth floor floor e.pointer.clientPos
-        tv = ifTrack track (trackView leftedge topedge zoom)
+        tv = ifTrack model (trackView leftedge topedge zoom)
     in  div [style "position" "absolute"
             ,style "width" (px pixWidth)
             ,style "height" (px pixHeight)
@@ -412,11 +425,13 @@ withSwallowing m =
 mapWheelDecoder =
     D.map (withSwallowing << MapScale) (D.field "deltaY" D.float)
 
+timeWheelDecoder =
+    D.map (withSwallowing << TimeScale) (D.field "deltaY" D.float)
 
 viewDiv : Model -> Html Msg
 viewDiv model =
     let coord = translate model.centre (pixelsToCoord (toZoom model.zoom) (dragDelta model.drag))
-        canvasV = canvas coord (toZoom model.zoom) portalWidth portalHeight model.track
+        canvasV = canvas coord (toZoom model.zoom) portalWidth portalHeight model
     in div [ style "display" "flex"
            , style "column-gap" "15px"
            ]
@@ -440,12 +455,13 @@ viewDiv model =
                   ]
               ]
         , div [ style "display" "flex"
+              , Html.Events.custom "wheel" timeWheelDecoder
               , style "flex-direction" "column"
               , style "row-gap" "10px"
               ]
-            [ div [] [ ifTrack model.track cadenceView ]
-            , div [] [ ifTrack model.track powerView ]
-            , div [] [ ifTrack model.track eleView ]
+            [ div [] [ ifTrack model cadenceView ]
+            , div [] [ ifTrack model powerView ]
+            , div [] [ ifTrack model eleView ]
             ]
         ]