souplesse

commit 2c49318823670c9392e123d3698eeea15c2807c1
parent 70a654c4722b9c96b628d25621811ffc06846d31
Author: Daniel Barlow <dan@telent.net>
Date:   Thu, 21 Nov 2024 23:03:15 +0000

allow dragging the selection markers (no live update)

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

1 file changed, 70 insertions(+), 11 deletions(-)
diff --git a/frontend/src/Main.elm b/frontend/src/Main.elm
@@ -117,7 +117,7 @@ boundingTiles centre z width height =
 
 -- MODEL
 
-type DragTarget = Map | Graph | StartMark | EndMark
+type DragTarget = Map | Graph | StartMark | EndMark | NoTarget
 
 type Drag
     = None
@@ -148,6 +148,7 @@ type alias Model =
     , drag: Drag
     , startTime : Float
     , duration : Float
+    , markedTime : (Float, Float)
     , track: TrackState }
 
 init : () -> Url -> Nav.Key -> (Model, Cmd Msg)
@@ -159,7 +160,7 @@ init _ url navKey =
     in
         ((Model
               (toCoord (Pos 0 0 Nothing))
-              (FineZoomLevel (1*8)) None 0 0 Nothing Loading),
+              (FineZoomLevel (1*8)) None 0 0 (0,0) Loading),
              (fetchTrack start duration))
 
 -- SUBSCRIPTIONS
@@ -220,6 +221,25 @@ updateModel msg model =
                           let (delta, _) = subTuple start end
                           in model.startTime + toFloat delta * model.duration / portalWidth
                     }
+                Dragging StartMark start end ->
+                    { model |
+                          drag = None,
+                          markedTime =
+                          let delta = Tuple.first (subTuple start end)
+                              deltat = toFloat delta * model.duration / portalWidth
+                              (s, d) = model.markedTime
+                          in (s - deltat, d + deltat)
+                    }
+                Dragging EndMark start end ->
+                    { model |
+                          drag = None,
+                          markedTime =
+                          let delta = Tuple.first (subTuple start end)
+                              deltat = toFloat delta * model.duration / portalWidth
+                              (s, d) = model.markedTime
+                          in (s, d - deltat)
+                    }
+
                 _ -> model
         TimeScale factor ->
             let fudge = factor
@@ -238,10 +258,10 @@ updateModel msg model =
                     { model
                         | track = Present trk
                         , centre = toCoord (Point.centre trk)
-                        , zoom = FineZoomLevel ( 13  * 8)
+                        , zoom = FineZoomLevel (13  * 8)
                         , startTime = start
                         , duration = duration
---                        , markedTime = Just (start + 300, duration - 600)
+                        , markedTime = (start + 300, duration - 900)
                     }
                 Err (Http.BadBody e) -> { model | track = Debug.log e (Failure "e") }
                 Err e -> { model | track = Debug.log "unknown error" (Failure "e") }
@@ -400,10 +420,41 @@ measureView title colour fn points =
         , xtick 5
         ]
 
-timeClickDecoder  =
-    D.map Dribble  (D.at ["target", "id"] D.string)
+type alias TargetedPointerEvent =
+    { pointerEvent : Pointer.Event
+    , targetId : String
+    }
+
+targetedEventDecoder =
+    D.map2 TargetedPointerEvent
+        Pointer.eventDecoder
+        (D.at ["target", "id"] D.string)
 
-timeAxis points =
+targetFor : String ->  DragTarget
+targetFor s =
+    case s of
+        "left-marker" -> StartMark
+        "right-marker" -> EndMark
+        _ -> NoTarget
+
+onDownWithTarget tag =
+    let
+        decoder =
+            targetedEventDecoder
+                |> D.map tag
+                |> D.map options
+
+        options message =
+            { message = message
+            , stopPropagation = True
+            , preventDefault = True
+            }
+        in
+        Html.Events.custom "pointerdown" decoder
+
+
+
+timeAxis model points =
     let graphHeight = 30
         startTime = Maybe.withDefault 0 (Point.startTime points)
         maxX = Point.duration points
@@ -459,15 +510,23 @@ timeAxis points =
                 , H.id "right-marker"
                 , strokeWidth "3"
                 ] []
+        markStartPix = case model.markedTime of
+                           (s, d) ->
+                               floor ((s - startTime) * portalWidth/maxX)
+        markEndPix = case model.markedTime of
+                           (s, d) ->
+                               ceiling ((s - startTime + d) * portalWidth/maxX)
+        epos e = Tuple.mapBoth floor floor e.pointer.clientPos
+
     in
         svg
         [ width portalWidth
         , height (graphHeight + 20)
-        , on "pointerdown" timeClickDecoder
+        , onDownWithTarget (\e -> DragStart (targetFor e.targetId) (epos e.pointerEvent))
         , viewBox ("0 -10 " ++ (String.fromInt portalWidth) ++
                        "  " ++ (String.fromInt (graphHeight + 10)))
         ]
-        (bg::(markStart 22)::(markEnd 422)::xticks)
+        (bg::(markStart markStartPix)::(markEnd markEndPix)::xticks)
 
 
 cadenceView : List Point -> Svg Msg
@@ -609,10 +668,10 @@ viewDiv model =
             [ div [] [ ifTrack model cadenceView ]
             , div [] [ ifTrack model powerView ]
             , div [] [ ifTrack model eleView ]
-            , div [] [ ifTrack model timeAxis ]
+            , div [] [ ifTrack model (timeAxis model) ]
             ]
         ]
 
 view : Model -> Browser.Document Msg
 view model =
-    Browser.Document  "Souplesse elm" [  (viewDiv model) ]
+    Browser.Document  "Souplesse" [  (viewDiv model) ]