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

add scroll mouse for graphs to zoom in/out

Browse Source
This commit is contained in:
Daniel Barlow 2024-11-15 22:17:07 +00:00
parent 9cfbb78e53
commit baf3046149
1 changed files with 25 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
frontend/src/Main.elm
View File

@ -184,6 +184,7 @@ type Msg
| PointerDown (Int, Int)
| PointerMove (Int, Int)
| PointerUp (Int, Int)
| TimeScale (Float)
| Loaded (Result Http.Error (List Point))
| NewUrlRequest
| UrlChanged
@ -217,6 +218,15 @@ newModel msg model =
{ model | drag = None,
centre = translatePixels model.centre (toZoom model.zoom) (dragDelta model.drag) }
TimeScale factor ->
let fudge = factor
len = model.duration - floor(fudge)
in { model |
startTime = model.startTime + floor(fudge / 2)
, duration = len
}
Loaded result ->
case result of
Ok trk -> { model | track = Present trk }
@ -365,15 +375,18 @@ tiles xs ys zoom =
(List.map (\ x -> tileImg zoom (TileNumber x y)) xs))
ys
ifTrack track content =
case track of
Present t -> content t
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)
in content points
Failure f -> Debug.log f (div [] [ Html.text "failure", Html.text f])
Loading -> div [] [Html.text "loading"]
Empty -> div [] [Html.text "no points"]
canvas centre zoom width height track =
canvas centre zoom width height model =
let (mintile, maxtile) = boundingTiles centre zoom width height
-- offset is pixel difference between centre (which *should*
-- be the middle of the image) and actual middle of the canvas
@ -387,7 +400,7 @@ canvas centre zoom width height track =
xs = List.range mintile.x maxtile.x
ys = List.range mintile.y maxtile.y
epos e = Tuple.mapBoth floor floor e.pointer.clientPos
tv = ifTrack track (trackView leftedge topedge zoom)
tv = ifTrack model (trackView leftedge topedge zoom)
in div [style "position" "absolute"
,style "width" (px pixWidth)
,style "height" (px pixHeight)
@ -412,11 +425,13 @@ withSwallowing m =
mapWheelDecoder =
D.map (withSwallowing << MapScale) (D.field "deltaY" D.float)
timeWheelDecoder =
D.map (withSwallowing << TimeScale) (D.field "deltaY" D.float)
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.track
canvasV = canvas coord (toZoom model.zoom) portalWidth portalHeight model
in div [ style "display" "flex"
, style "column-gap" "15px"
]
@ -440,12 +455,13 @@ viewDiv model =
]
]
, div [ style "display" "flex"
, Html.Events.custom "wheel" timeWheelDecoder
, style "flex-direction" "column"
, style "row-gap" "10px"
]
[ div [] [ ifTrack model.track cadenceView ]
, div [] [ ifTrack model.track powerView ]
, div [] [ ifTrack model.track eleView ]
[ div [] [ ifTrack model cadenceView ]
, div [] [ ifTrack model powerView ]
, div [] [ ifTrack model eleView ]
]
]