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

zoom map on mouse wheel events

Browse Source
This commit is contained in:
Daniel Barlow 2024-11-14 15:05:31 +00:00
parent 7d9273190e
commit 7f58809741
1 changed files with 23 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
frontend/src/Main.elm
View File

@ -166,6 +166,7 @@ fetchTrack start duration = Http.get
type Msg
= MapZoomIn
| MapZoomOut
| MapZoomWheel Float Float Int
| Scroll Int Int
| PointerDown (Int, Int)
| PointerMove (Int, Int)
@ -179,14 +180,26 @@ update : Msg -> Model -> (Model, Cmd Msg)
update msg model = (newModel msg model, Cmd.none)
clamp min max val =
if val < min
then min
else if val > max
then max
else val
newModel msg model =
case msg of
MapZoomIn ->
{ model | zoom = model.zoom + 1 }
{ model | zoom = clamp 0 20 (model.zoom + 1) }
MapZoomOut ->
{ model | zoom = model.zoom - 1 }
{ model | zoom = clamp 0 20 (model.zoom - 1) }
MapZoomWheel x y delta ->
let dir = if y > 0
then -1
else 1
in { model | zoom = clamp 0 20 (model.zoom + dir) }
Scroll x y ->
{ model | centre = translatePixels model.centre model.zoom (x,y) }
@ -351,12 +364,20 @@ canvas centre zoom width height track =
portalWidth = 600
portalHeight = 600
wheelDecoder : D.Decoder Msg
wheelDecoder =
D.map3 MapZoomWheel
(D.field "deltaX" D.float)
(D.field "deltaY" D.float)
(D.field "deltaMode" D.int)
viewDiv : Model -> Html Msg
viewDiv model =
let coord = translate model.centre (pixelsToCoord model.zoom (dragDelta model.drag))
canvasV = canvas coord model.zoom portalWidth portalHeight model.track
in div [ style "display" "flex" ]
[ div [ style "display" "flex"
, on "wheel" wheelDecoder
, style "flex-direction" "column"]
[ div [ style "width" (px portalWidth)
, style "height" (px portalHeight)