souplesse/frontend/src/TileMap.elm

module TileMap exposing (tiles
                        , FineZoomLevel(..)
                        , ZoomLevel
                        , Coord
                        , TileMap(..)
                        , toCoord
                        , toZoom
                        , translate
                        , translatePixels
                        , incZoom
                        , bounds
                        , 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


type TileMap = TileMap Coord FineZoomLevel Int 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 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
reflect c = Coord -c.x -c.y

-- used for Coords and for TileNumbers
translate base offset =
    { x = (base.x + offset.x), y = (base.y + offset.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 -> 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 z1 width height) =
    -- find the tiles needed to cover the area (`width` x `height`)
    -- about the point at `centre`
    let z = toZoom z1
        delta = pixelsToCoord z1 ((width // 2), (height // 2))
        minCoord = translate centre (reflect delta)
        maxCoord = translate centre delta
    in ((tileCovering minCoord z),
        (translate (tileCovering maxCoord z) (TileNumber 1 1)))

bounds : TileMap -> { left : Int, top : Int, width: Int, height: Int }
bounds tmap =
    let (mintile, maxtile) = boundingTiles tmap
    in {
        left = mintile.x * 256,
        top = mintile.y * 256,
        width = (1 + maxtile.x - mintile.x) * 256,
        height = (1 + maxtile.y - mintile.y) * 256
    }


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 tmap =
    let (TileMap centre zoom width height) = 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))
        ys