From 12a547c7aafa413cedf673a05d7d66b102084cf3 Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Sat, 16 Nov 2024 00:22:29 +0000 Subject: [PATCH] drag time graphs left/right --- frontend/src/Main.elm | 27 +++++++++++++++++++++++++-- 1 file changed, 25 insertions(+), 2 deletions(-) diff --git a/frontend/src/Main.elm b/frontend/src/Main.elm index 8d0056a..49a9661 100644 --- a/frontend/src/Main.elm +++ b/frontend/src/Main.elm @@ -144,6 +144,7 @@ type alias Model = { centre: Coord , zoom: FineZoomLevel , drag: Drag + , timeDrag: Drag , startTime : Int , duration : Int , track: TrackState } @@ -155,7 +156,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 start duration Empty), + ((Model (toCoord 51.60 -0.01) (FineZoomLevel (13*8)) None None start duration Empty), (fetchTrack start duration)) -- SUBSCRIPTIONS @@ -182,6 +183,9 @@ type Msg | MapDrag (Int, Int) | MapDragFinish (Int, Int) | TimeScale (Float) + | TimeDragStart (Int, Int) + | TimeDrag (Int, Int) + | TimeDragFinish (Int, Int) | Loaded (Result Http.Error (List Point)) | NewUrlRequest | UrlChanged @@ -214,6 +218,18 @@ newModel 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 -> { model | track = Present trk } @@ -366,7 +382,10 @@ 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) + let (dt, _) = dragDelta model.timeDrag + dpix = dt * model.duration // portalWidth + start = toFloat (model.startTime + dpix) + points = Point.subseq t start (toFloat model.duration) in content points Failure f -> Debug.log f (div [] [ Html.text "failure", Html.text f]) Loading -> div [] [Html.text "loading"] @@ -420,6 +439,7 @@ 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 + epos e = Tuple.mapBoth floor floor e.pointer.clientPos in div [ style "display" "flex" , style "column-gap" "15px" ] @@ -440,6 +460,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)) , style "flex-direction" "column" , style "row-gap" "10px" ]