compile Drg messages/model into a single concept

we can only drag one thing at a time anyway

frontend/src/Main.elm

@@ -126,27 +126,35 @@ boundingTiles centre z width height =
 
 -- MODEL
 
+type DragTarget = Map | Graph | StartMark | EndMark
+
 type Drag
     = None
-    | Dragging  (Int, Int)  (Int, Int)
+    | Dragging DragTarget (Int, Int)  (Int, Int)
+
 
 dragTo : Drag ->  (Int, Int) -> Drag
 dragTo d dest =
     case d of
         None -> None
-        Dragging from to -> Dragging from dest
+        Dragging target from to -> Dragging target from dest
 
-dragDelta d =
+dragDelta target d =
     case d of
-        None -> (0,0)
+        Dragging target_ (fx,fy) (tx,ty) ->
-        Dragging (fx,fy) (tx,ty) -> (fx-tx, fy-ty)
+            if target == target_
+            then (fx-tx, fy-ty)
+            else (0, 0)
+        _ -> (0, 0)
+
+subTuple (fx,fy) (tx,ty) = (fx-tx, fy-ty)
+
 
 type TrackState = Empty | Loading | Failure String | Present (List Point)
 type alias Model =
     { centre: Coord
     , zoom: FineZoomLevel
     , drag: Drag
-    , timeDrag: Drag
     , startTime : Int
     , duration : Int
     , track: TrackState }
@@ -158,7 +166,7 @@ init _ url navKey =
                 Just (Timeline (Just s) (Just d)) -> (s, d)
                 _ -> (10,10)
     in
-        ((Model (toCoord 51.60 -0.01) (FineZoomLevel (13*8)) None None 0 0 Empty),
+        ((Model (toCoord 51.60 -0.01) (FineZoomLevel (13*8)) None 0 0 Empty),
              (fetchTrack start duration))
 
 -- SUBSCRIPTIONS
@@ -181,13 +189,10 @@ fetchTrack start duration = Http.get
 
 type Msg
   = MapScale Int
-  | MapDragStart (Int, Int)
+  | DragStart DragTarget (Int, Int)
-  | MapDrag (Int, Int)
+  | Drag (Int, Int)
-  | MapDragFinish (Int, Int)
+  | DragFinish (Int, Int)
   | TimeScale (Float)
-  | TimeDragStart (Int, Int)
-  | TimeDrag (Int, Int)
-  | TimeDragFinish (Int, Int)
   | Loaded (Result Http.Error (List Point))
   | NewUrlRequest
   | UrlChanged
@@ -202,16 +207,26 @@ updateModel msg model =
         MapScale y ->
             { model | zoom = incZoom model.zoom y }
 
-        MapDragStart (x,y) ->
+        DragStart target (x,y) ->
-            { model | drag = Dragging (x,y) (x,y) }
+            { model | drag = Dragging target (x,y) (x,y) }
 
-        MapDrag (x,y) ->
+        Drag (x,y) ->
             { model | drag = dragTo model.drag (x,y) }
 
-        MapDragFinish (x,y) ->
+        DragFinish (x,y) ->
-            { model | drag = None,
+            case model.drag of
-                  centre = translatePixels model.centre (toZoom model.zoom) (dragDelta model.drag) }
+                Dragging Map start end ->
-
+                    { model |
+                          drag = None,
+                          centre = translatePixels model.centre (toZoom model.zoom) (subTuple start end) }
+                Dragging Graph start end ->
+                    { model |
+                          drag = None,
+                          startTime =
+                          let (delta, _) = subTuple start end
+                          in model.startTime + delta * model.duration // portalWidth
+                    }
+                _ -> model
         TimeScale factor ->
             let fudge = factor
                 len = model.duration - floor(fudge)
@@ -220,18 +235,6 @@ updateModel msg model =
                ,     duration = len
                }
 
-        TimeDragStart (x,y) ->
-            { model | timeDrag = Dragging (x,y) (x,y) }
-
-        TimeDrag (x,y) ->
-            { model | timeDrag = dragTo model.timeDrag (x,y) }
-
-        TimeDragFinish (x,y) ->
-            { model | timeDrag = None,
-                  startTime =
-                  let (delta, _) = dragDelta model.timeDrag
-                  in model.startTime + delta * model.duration // portalWidth
-            }
         Loaded result ->
             case result of
                 Ok trk ->
@@ -526,7 +529,7 @@ ifTrack : Model -> (List Point ->  Html msg) ->  Html msg
 ifTrack model content =
     case model.track of
         Present t ->
-            let (dt, _) = dragDelta model.timeDrag
+            let (dt, _) = dragDelta Graph model.drag
                 dpix = dt * model.duration // portalWidth
                 start = toFloat (model.startTime + dpix)
                 points = Point.subseq t start (toFloat model.duration)
@@ -557,11 +560,12 @@ canvas centre zoom width height model =
             ,style "left" (px -offsetX)
             ,style "top" (px -offsetY)
             ,style "lineHeight" (px 0)
-            ,Pointer.onUp (\e -> MapDragFinish (epos e))
+            ,Pointer.onUp (\e -> DragFinish (epos e))
-            ,Pointer.onMove (\e -> MapDrag (epos e))
+            ,Pointer.onMove (\e -> Drag (epos e))
-            ,Pointer.onDown (\e -> MapDragStart (epos e)) ]
+            ,Pointer.onDown (\e -> DragStart Map (epos e)) ]
         (tv :: tiles xs ys zoom)
 
+
 portalWidth = 600
 portalHeight = 600
 
@@ -581,7 +585,7 @@ timeWheelDecoder =
 
 viewDiv : Model -> Html Msg
 viewDiv model =
-    let coord = translate model.centre (pixelsToCoord (toZoom model.zoom) (dragDelta model.drag))
+    let coord = translate model.centre (pixelsToCoord (toZoom model.zoom) (dragDelta Map model.drag))
         canvasV = canvas coord (toZoom model.zoom) portalWidth portalHeight model
         epos e = Tuple.mapBoth floor floor e.pointer.clientPos
     in div [ style "display" "flex"
@@ -604,9 +608,9 @@ viewDiv model =
               ]
         , div [ style "display" "flex"
               , Html.Events.custom "wheel" timeWheelDecoder
-              , Pointer.onUp (\e -> TimeDragFinish (epos e))
+              , Pointer.onUp (\e -> DragFinish (epos e))
-              , Pointer.onMove (\e -> TimeDrag (epos e))
+              , Pointer.onMove (\e -> Drag (epos e))
-              , Pointer.onDown (\e -> TimeDragStart (epos e))
+              , Pointer.onDown (\e -> DragStart Graph (epos e))
               , style "flex-direction" "column"
               , style "row-gap" "10px"
               ]