diff --git a/frontend/src/Main.elm b/frontend/src/Main.elm index edaef83..80cf358 100644 --- a/frontend/src/Main.elm +++ b/frontend/src/Main.elm @@ -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 "+" ]