souplesse/frontend/src/TileMap.elm

module TileMap exposing (tiles
                        , FineZoomLevel(..)
                        , ZoomLevel
                        , Coord
                        , toCoord
                        , toZoom
                        , translate
                        , translatePixels
                        , incZoom
                        , boundingTiles
                        , pixelsToCoord
                        , pixelFromCoord
                        , zoomStep)

import Html exposing (img, div)
import Html.Attributes as H exposing (src, style, width, height)

import Pos exposing (Pos)

type alias TileNumber = { x: Int, y: Int }

-- Coordinates in a Mercator projection
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


incZoom : FineZoomLevel -> Int -> FineZoomLevel
incZoom (FineZoomLevel z) delta =
    FineZoomLevel (clamp 0 (20 * zoomStep) (z + delta))


-- project lat/long to co-ordinates based on pseudocode at
-- https://wiki.openstreetmap.org/wiki/Slippy_map_tilenames#Zoom_levels

sec x = 1 / (cos x)

toCoord : Pos -> Coord
toCoord pos =
    let
        lat_rad = pos.lat * pi / 180
        x = (pos.lon + 180) / 360
        y = (1 - (logBase e ((tan lat_rad) + (sec lat_rad))) / pi) / 2
    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))
    in Coord x_float y_float

reflect : Coord -> Coord
reflect c = Coord -c.x -c.y

-- translate : a -> a -> a
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))


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)
    in (x,y)

boundingTiles : Coord -> ZoomLevel -> Int -> Int -> (TileNumber, TileNumber)
boundingTiles centre z 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))
        minCoord = translate centre (reflect delta)
        maxCoord = translate centre delta
    in ((tileCovering minCoord z),
        (translate (tileCovering maxCoord z) (TileNumber 1 1)))

tileUrl : TileNumber -> ZoomLevel -> String
tileUrl {x,y} z =
    String.concat ["https://a.tile.openstreetmap.org",
                       "/", String.fromInt z,
                       "/", String.fromInt x,
                       "/", String.fromInt y,
                       ".png" ]

tileImg zoom tilenumber = img [ width 256,
                                height 256,
                                src (tileUrl tilenumber zoom) ] []

tiles centre zoom width height =
    let (mintile, maxtile) = boundingTiles centre zoom width height
        xs = List.range mintile.x maxtile.x
        ys = List.range mintile.y maxtile.y
    in
    List.map
        (\ y -> div []
             (List.map (\ x -> tileImg zoom (TileNumber x y)) xs))
        ys