-- |
-- Module      : HSlippyMap
-- Copyright   : (c) Jean-Alexandre Peyroux 2013
--
-- License     : BSD3
-- Maintainer  : m@j4.pe
-- Stability   : experimental
-- Portability : GHC
--
-- Exemple :
--
-- import HSlippyMap
-- main = do
--  putStrLn $ show $ tileFromLatLong lat long z
--  putStrLn $ show $ tileFromGPS x y z
--  where
--      lat = 48.8152
--      long = 2.2712
--      x = 66362
--      y = 45115
--      z = 19
--
-- -- http://tile.openstreetmap.org/19/265451/180461.png
-- -- http://tile.openstreetmap.org/19/66362/45115.png


module HSlippyMap (
    -- * HSlippyMap
    Tile,
    tileFromLatLong,
    tileFromGPS
) where

type Lat = Float
type Long = Float
type GpsX = Integer
type GpsY = Integer
type ZLevel = Integer

data Tile = Tile {
  lat :: Lat,
  long :: Long,
  x :: GpsX,
  y :: GpsY,
  z :: ZLevel }

instance Show Tile where
  show (Tile lat long x y z) = "http://tile.openstreetmap.org/" ++ show z ++ "/" ++ show x ++ "/" ++ show y ++ ".png"

-- | Create Tile from Lat Long
tileFromLatLong :: Lat -> Long -> ZLevel -> Tile
tileFromLatLong lat lon z = Tile lat lon x y z
    where
        x = long2tilex lon z
        y = lat2tiley lat z

-- | Create Tile from GPS X Y
tileFromGPS :: GpsX -> GpsY -> ZLevel -> Tile
tileFromGPS x y z = Tile lat lon x y z
    where
        lat = tilex2long x z
        lon = tiley2lat y z

long2tilex lon z = floor((lon + 180) / 360 * (2** fromInteger(z)::Long))

lat2tiley lat z = floor((1.0 - log( tan(lat * pi/180.0) + 1.0 / cos(lat * pi/180.0)) / pi) / 2.0 * (2 ** fromInteger(z)::Long))

tilex2long x z = (fromInteger(x)::Long) / (2.0 ** fromInteger(z)::Long) * 360.0 - 180

tiley2lat y z = 180.0 / pi * atan(0.5 * (exp(n) - exp(-n)))
    where
        n = pi - 2.0 * pi * (fromInteger(y)::Long) / (2.0 ** fromInteger(z)::Long)