souplesse

commit 02a30a7a106813283df431dd27490dacbb7cfca3
parent 33d59e16963400c4f940c0c24366c70c4c58ee19
Author: Daniel Barlow <dan@telent.net>
Date:   Sat, 23 Nov 2024 17:19:33 +0000

prefer FineZoomLevel to ZoomLevel almost everywhere

we only use the coarse zoom internally in TileMap

Diffstat:
M
frontend/src/Main.elm
 | 
11
+++++------
M
frontend/src/TileMap.elm
 | 
29
+++++++++++++++++------------

2 files changed, 22 insertions(+), 18 deletions(-)
diff --git a/frontend/src/Main.elm b/frontend/src/Main.elm
@@ -124,7 +124,7 @@ handleDragFinish model target (x, y) =
     case target of
         Map ->
             { model |
-                  centre = translatePixels model.centre (toZoom model.zoom) (x, y)
+                  centre = translatePixels model.centre model.zoom (x, y)
             }
         Graph ->
             { model |
@@ -454,7 +454,7 @@ powerView = measureView "power" "#994444" (.power >> Maybe.map toFloat)
 
 eleView = measureView "elevation" "#4444ee" (.pos >> .ele)
 
-trackView : Int -> Int -> ZoomLevel -> List Point -> Svg Msg
+trackView : Int -> Int -> FineZoomLevel -> List Point -> Svg Msg
 trackView leftedge topedge zoom points =
     let plot p =
             let (x, y) = pixelFromCoord (toCoord p.pos) zoom
@@ -499,7 +499,7 @@ ifTrack model content =
         Loading -> div [] [Html.text "loading"]
         Empty -> div [] [Html.text "no points"]
 
-canvas : Coord -> ZoomLevel -> Int -> Int -> Model -> Html Msg
+canvas : Coord -> FineZoomLevel -> Int -> Int -> Model -> Html Msg
 canvas centre zoom width height model =
     let tm = TileMap centre zoom width height
         mapBounds = TileMap.bounds tm
@@ -539,8 +539,8 @@ timeWheelDecoder =
 
 viewDiv : Model -> Html Msg
 viewDiv model =
-    let coord = translate model.centre (pixelsToCoord (toZoom model.zoom) (dragDelta Map model.drag))
-        canvasV = canvas coord (toZoom model.zoom) portalWidth portalHeight model
+    let coord = translate model.centre (pixelsToCoord model.zoom (dragDelta Map model.drag))
+        canvasV = canvas coord model.zoom portalWidth portalHeight model
         epos e = Tuple.mapBoth floor floor e.pointer.clientPos
     in div [ style "display" "flex"
            , style "column-gap" "15px"
@@ -554,7 +554,6 @@ viewDiv model =
                     , style "position" "relative"
                     , style "overflow" "hidden"]
                     [canvasV]
-              , text ("Zoom level " ++ (String.fromInt (toZoom model.zoom)))
               , span []
                   [ button [ onClick (MapScale -zoomStep) ] [ text "-" ]
                   , button [ onClick (MapScale zoomStep) ] [ text "+" ]
diff --git a/frontend/src/TileMap.elm b/frontend/src/TileMap.elm
@@ -28,7 +28,7 @@ type alias ZoomLevel = Int
 type FineZoomLevel = FineZoomLevel Int
 
 
-type TileMap = TileMap Coord ZoomLevel Int Int
+type TileMap = TileMap Coord FineZoomLevel Int Int
 
 zoomStep = 8
 
@@ -55,9 +55,10 @@ toCoord pos =
     in
         Coord x y
 
-pixelsToCoord z (x,y) =
-    let x_float = toFloat x / toFloat ( 2 ^ (z + 8))
-        y_float = toFloat y / toFloat ( 2 ^ (z + 8))
+pixelsToCoord z_ (x,y) =
+    let scale = 8 + toZoom z_
+        x_float = toFloat x / toFloat ( 2 ^ scale)
+        y_float = toFloat y / toFloat ( 2 ^ scale)
     in Coord x_float y_float
 
 reflect : Coord -> Coord
@@ -67,23 +68,26 @@ reflect c = Coord -c.x -c.y
 translate base offset =
     { x = (base.x + offset.x), y = (base.y + offset.y) }
 
-translatePixels : Coord -> ZoomLevel -> (Int, Int) -> Coord
-translatePixels old z (x, y) = translate old (pixelsToCoord z (x, y))
+translatePixels : Coord -> FineZoomLevel -> (Int, Int) -> Coord
+translatePixels old z_ (x, y) =
+    translate old (pixelsToCoord z_ (x, y))
 
 tileCovering : Coord -> ZoomLevel -> TileNumber
 tileCovering c z =
     TileNumber (truncate (toFloat (2 ^ z) * c.x)) (truncate (toFloat (2 ^ z) * c.y))
 
-pixelFromCoord : Coord -> ZoomLevel -> (Int, Int)
-pixelFromCoord c z =
-    let {x,y} = tileCovering c (z + 8)
+pixelFromCoord : Coord -> FineZoomLevel -> (Int, Int)
+pixelFromCoord c z_ =
+    let z = toZoom z_
+        {x,y} = tileCovering c (z + 8)
     in (x,y)
 
 boundingTiles : TileMap -> (TileNumber, TileNumber)
-boundingTiles (TileMap centre z width height) =
+boundingTiles (TileMap centre z1 width height) =
     -- find the tiles needed to cover the area (`width` x `height`)
     -- about the point at `centre`
-    let delta = pixelsToCoord z ((width // 2), (height // 2))
+    let z = toZoom z1
+        delta = pixelsToCoord z1 ((width // 2), (height // 2))
         minCoord = translate centre (reflect delta)
         maxCoord = translate centre delta
     in ((tileCovering minCoord z),
@@ -117,8 +121,9 @@ tiles tmap =
         (mintile, maxtile) = boundingTiles tmap
         xs = List.range mintile.x maxtile.x
         ys = List.range mintile.y maxtile.y
+        zoom_ = toZoom zoom
     in
     List.map
         (\ y -> div []
-             (List.map (\ x -> tileImg zoom (TileNumber x y)) xs))
+             (List.map (\ x -> tileImg zoom_ (TileNumber x y)) xs))
         ys