dan/souplesse
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

drag time graphs left/right

Browse Source
This commit is contained in:
Daniel Barlow 2024-11-16 00:22:29 +00:00
parent 5f02b5b992
commit 12a547c7aa
1 changed files with 25 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
frontend/src/Main.elm
View File

@ -144,6 +144,7 @@ type alias Model =
{ centre: Coord { centre: Coord
, zoom: FineZoomLevel , zoom: FineZoomLevel
, drag: Drag , drag: Drag
, timeDrag: Drag
, startTime : Int , startTime : Int
, duration : Int , duration : Int
, track: TrackState } , track: TrackState }
@ -155,7 +156,7 @@ init _ url navKey =
Just (Timeline (Just s) (Just d)) -> (s, d) Just (Timeline (Just s) (Just d)) -> (s, d)
_ -> (10,10) _ -> (10,10)
in 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)) (fetchTrack start duration))
-- SUBSCRIPTIONS -- SUBSCRIPTIONS
@ -182,6 +183,9 @@ type Msg
| MapDrag (Int, Int) | MapDrag (Int, Int)
| MapDragFinish (Int, Int) | MapDragFinish (Int, Int)
| TimeScale (Float) | TimeScale (Float)
| TimeDragStart (Int, Int)
| TimeDrag (Int, Int)
| TimeDragFinish (Int, Int)
| Loaded (Result Http.Error (List Point)) | Loaded (Result Http.Error (List Point))
| NewUrlRequest | NewUrlRequest
| UrlChanged | UrlChanged
@ -214,6 +218,18 @@ newModel msg model =
, duration = len , 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 -> Loaded result ->
case result of case result of
Ok trk -> { model | track = Present trk } Ok trk -> { model | track = Present trk }
@ -366,7 +382,10 @@ ifTrack : Model -> (List Point -> Html msg) -> Html msg
ifTrack model content = ifTrack model content =
case model.track of case model.track of
Present t -> 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 in content points
Failure f -> Debug.log f (div [] [ Html.text "failure", Html.text f]) Failure f -> Debug.log f (div [] [ Html.text "failure", Html.text f])
Loading -> div [] [Html.text "loading"] Loading -> div [] [Html.text "loading"]
@ -420,6 +439,7 @@ viewDiv : Model -> Html Msg
viewDiv model = viewDiv model =
let coord = translate model.centre (pixelsToCoord (toZoom model.zoom) (dragDelta model.drag)) let coord = translate model.centre (pixelsToCoord (toZoom model.zoom) (dragDelta model.drag))
canvasV = canvas coord (toZoom model.zoom) portalWidth portalHeight model canvasV = canvas coord (toZoom model.zoom) portalWidth portalHeight model
epos e = Tuple.mapBoth floor floor e.pointer.clientPos
in div [ style "display" "flex" in div [ style "display" "flex"
, style "column-gap" "15px" , style "column-gap" "15px"
] ]
@ -440,6 +460,9 @@ viewDiv model =
] ]
, div [ style "display" "flex" , div [ style "display" "flex"
, Html.Events.custom "wheel" timeWheelDecoder , 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 "flex-direction" "column"
, style "row-gap" "10px" , style "row-gap" "10px"
] ]