module Data.Tile
(
Z(..)
, X(..)
, Y(..)
, Tile(..)
, Lng(..)
, Lat(..)
, LngLat(..)
, Px(..)
, Py(..)
, Pixel(..)
, BoxOrigin(..)
, TileBounds(..)
, maxTileIndex
, maxTilesInDimension
, maxPixelsInDimension
, flipY
, subTiles
, parentTile
, mkTile
, tileToPixel
, lngLatToPixel
, pixelToTile
, lngLatToTile
, pixelToLngLat
, tileToLngLat
, tileToBounds
) where
import Data.Bifunctor
import Data.Bits
newtype Z = Z Int
deriving (Show, Eq, Ord)
newtype X = X Int
deriving (Show, Eq, Ord)
newtype Y = Y Int
deriving (Show, Eq, Ord)
newtype Tile = Tile (Z, X, Y)
deriving (Show, Eq, Ord)
newtype Lng = Lng Double
deriving (Show, Eq, Ord)
instance Bounded Lng where
minBound = Lng (180.0)
maxBound = Lng 180.0
newtype Lat = Lat Double
deriving (Show, Eq, Ord)
instance Bounded Lat where
minBound = Lat (90.0)
maxBound = Lat 90.0
newtype LngLat = LngLat (Lng, Lat)
deriving (Show, Eq, Ord)
newtype Px = Px Int
deriving (Show, Eq, Ord)
newtype Py = Py Int
deriving (Show, Eq, Ord)
newtype Pixel = Pixel (Px, Py)
deriving (Show, Eq, Ord)
data BoxOrigin = SW
| NW
deriving (Show, Eq)
data TileBounds = TileBounds BoxOrigin LngLat LngLat
deriving (Show, Eq)
maxTileIndex :: Z -> Int
maxTileIndex z = maxTilesInDimension z 1
maxTilesInDimension :: Z -> Int
maxTilesInDimension (Z z) = 1 `shift` z
maxPixelsInDimension :: Z -> Int
maxPixelsInDimension = (256 *) . maxTilesInDimension
mkTile :: Z -> X -> Y -> Maybe Tile
mkTile zv@(Z z) xv@(X x) yv@(Y y)
| 0 <= x && x <= tileMax &&
0 <= y && y <= tileMax = Just $ Tile (zv, xv, yv)
| otherwise = Nothing
where tileMax = maxTileIndex zv
tileToPixel :: Tile -> Pixel
tileToPixel (Tile (Z z, X x, Y y)) = Pixel (Px $ 256 * x, Py $ 256 * y)
lngLatToPixel :: Z -> LngLat -> Pixel
lngLatToPixel z (LngLat (lng, lat)) =
let (Lng lng') = clipBounded lng
(Lat lat') = clipBounded lat
x = (lng' + 180.0) / 360.0
sinlat = sin (lat' * pi / 180.0)
y = 0.5 log ((1 + sinlat) / (1 sinlat)) / (4 * pi)
px = floor $ min (maxPixels 1) $ max 0 (x * maxPixels + 0.5)
py = floor $ min (maxPixels 1) $ max 0 (y * maxPixels + 0.5)
in Pixel (Px px, Py py)
where maxPixels = fromIntegral $ maxPixelsInDimension z
pixelToTile :: Z -> Pixel -> Tile
pixelToTile z (Pixel (Px px, Py py)) = Tile (z, X $ px `div` 256, Y $ py `div` 256)
lngLatToTile :: Z -> LngLat -> Tile
lngLatToTile z = pixelToTile z . lngLatToPixel z
pixelToLngLat :: Z -> Pixel -> LngLat
pixelToLngLat z p =
let x' = fromIntegral x / fromIntegral maxPx 0.5
y' = 0.5 fromIntegral y / fromIntegral maxPx
lng = 360 * x'
lat = 90 360 * atan (exp ((y') * 2 * pi)) / pi
in LngLat (Lng lng, Lat lat)
where (Pixel (Px x, Py y)) = clip z p
maxPx = maxPixelsInDimension z
tileToLngLat :: Tile -> LngLat
tileToLngLat t@(Tile (z, _, _)) = pixelToLngLat z $ tileToPixel t
tileToBounds :: BoxOrigin -> Tile -> TileBounds
tileToBounds SW t@(Tile (z, X x, Y y)) = TileBounds SW (tileToLngLat (Tile (z, X x, Y $ y + 1)))
(tileToLngLat (Tile (z, X $ x + 1, Y y)))
tileToBounds NW t@(Tile (z, X x, Y y)) = TileBounds NW (tileToLngLat (Tile (z, X x, Y y)))
(tileToLngLat (Tile (z, X $ x + 1, Y $ y + 1)))
subTiles :: Tile -> [Tile]
subTiles (Tile (Z z, X x, Y y)) = [Tile (Z $ z + 1, X $ 2 * x + i, Y $ 2 * y + j) | i <- [0..1], j <- [0..1]]
parentTile :: Tile -> Maybe Tile
parentTile (Tile (Z z, X x, Y y))
| z == 0 = Nothing
| otherwise = Just $ Tile (Z $ z 1, X $ x `div` 2, Y $ y `div` 2)
flipY :: Tile -> Tile
flipY (Tile (z, x, Y y)) = Tile (z, x, Y $ maxTileIndex z y)
clip :: Z -> Pixel -> Pixel
clip z (Pixel (Px x, Py y)) = Pixel $ bimap (Px . clip' pixels) (Py . clip' pixels) (x, y)
where clip' mx = min mx . max 0
pixels = maxPixelsInDimension z
clipBounded :: (Bounded a, Ord a) => a -> a
clipBounded = max minBound . min maxBound