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

make the wheel zoom less sensitive

Browse Source
This commit is contained in:
Daniel Barlow 2024-11-14 16:03:32 +00:00
parent 86e9919825
commit 3a3dce91b1
1 changed files with 27 additions and 17 deletions

44
frontend/src/Main.elm
View File

@ -54,6 +54,23 @@ type alias Coord = { x: Float, y: Float }
-- zoom level
type alias ZoomLevel = Int
type FineZoomLevel = FineZoomLevel Int
zoomStep = 8
toZoom : FineZoomLevel -> ZoomLevel
toZoom (FineZoomLevel f) = f // zoomStep
clamp min max val =
if val < min
then min
else if val > max
then max
else val
incZoom : FineZoomLevel -> Int -> FineZoomLevel
incZoom (FineZoomLevel z) delta =
FineZoomLevel (clamp 0 (20 * zoomStep) (z + delta))
type alias TileNumber = { x: Int, y: Int }
@ -129,7 +146,7 @@ dragDelta d =
type TrackState = Empty | Loading | Failure String | Present (List Point)
type alias Model =
{ centre: Coord
, zoom: ZoomLevel
, zoom: FineZoomLevel
, drag: Drag
, startTime : Int
, duration : Int
@ -142,7 +159,7 @@ init _ url navKey =
Just (Timeline (Just s) (Just d)) -> (s, d)
_ -> (10,10)
in
((Model (toCoord 51.60 -0.01) 13 None start duration Empty),
((Model (toCoord 51.60 -0.01) (FineZoomLevel (13*8)) None start duration Empty),
(fetchTrack start duration))
-- SUBSCRIPTIONS
@ -180,28 +197,21 @@ 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 = clamp 0 20 (model.zoom + 1) }
{ model | zoom = incZoom model.zoom zoomStep }
MapZoomOut ->
{ model | zoom = clamp 0 20 (model.zoom - 1) }
{ model | zoom = incZoom model.zoom -zoomStep }
MapZoomWheel x y delta ->
let dir = if y > 0
then -1
else 1
in { model | zoom = clamp 0 20 (model.zoom + dir) }
in { model | zoom = incZoom model.zoom dir }
Scroll x y ->
{ model | centre = translatePixels model.centre model.zoom (x,y) }
{ model | centre = translatePixels model.centre (toZoom model.zoom) (x,y) }
PointerDown (x,y) ->
{ model | drag = Dragging (x,y) (x,y) }
@ -211,7 +221,7 @@ newModel msg model =
PointerUp (x,y) ->
{ model | drag = None,
centre = translatePixels model.centre model.zoom (dragDelta model.drag) }
centre = translatePixels model.centre (toZoom model.zoom) (dragDelta model.drag) }
Loaded result ->
case result of
@ -373,8 +383,8 @@ wheelDecoder =
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
let coord = translate model.centre (pixelsToCoord (toZoom model.zoom) (dragDelta model.drag))
canvasV = canvas coord (toZoom model.zoom) portalWidth portalHeight model.track
in div [ style "display" "flex" ]
[ div [ style "display" "flex"
, on "wheel" wheelDecoder
@ -385,7 +395,7 @@ viewDiv model =
, style "position" "relative"
, style "overflow" "hidden"]
[canvasV]
, text ("Zoom level " ++ (String.fromInt model.zoom))
, text ("Zoom level " ++ (String.fromInt (toZoom model.zoom)))
, span []
[ button [ onClick MapZoomOut ] [ text "-" ]
, button [ onClick MapZoomIn ] [ text "+" ]