commit 9fd3620d9b57b218ef2160b7a5bb6b91ffc92c3b
parent f4a9314033d587225dc701515bce8c50ed4bf9b0
Author: Daniel Barlow <dan@telent.net>
Date: Thu, 21 Nov 2024 12:37:48 +0000
compile Drg messages/model into a single concept
we can only drag one thing at a time anyway
Diffstat:
| M | frontend/src/Main.elm | | | 84 | +++++++++++++++++++++++++++++++++++++++++-------------------------------------- |
1 file changed, 44 insertions(+), 40 deletions(-)
diff --git a/frontend/src/Main.elm b/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 (fx,fy) (tx,ty) -> (fx-tx, fy-ty)
+ Dragging target_ (fx,fy) (tx,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)
- | MapDrag (Int, Int)
- | MapDragFinish (Int, Int)
+ | DragStart DragTarget (Int, Int)
+ | Drag (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) ->
- { model | drag = Dragging (x,y) (x,y) }
+ DragStart target (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) ->
- { model | drag = None,
- centre = translatePixels model.centre (toZoom model.zoom) (dragDelta model.drag) }
-
+ DragFinish (x,y) ->
+ case model.drag of
+ 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.onMove (\e -> MapDrag (epos e))
- ,Pointer.onDown (\e -> MapDragStart (epos e)) ]
+ ,Pointer.onUp (\e -> DragFinish (epos e))
+ ,Pointer.onMove (\e -> Drag (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.onMove (\e -> TimeDrag (epos e))
- , Pointer.onDown (\e -> TimeDragStart (epos e))
+ , Pointer.onUp (\e -> DragFinish (epos e))
+ , Pointer.onMove (\e -> Drag (epos e))
+ , Pointer.onDown (\e -> DragStart Graph (epos e))
, style "flex-direction" "column"
, style "row-gap" "10px"
]
