{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-| Module : Graphics.Vega.VegaLite.Geometry Copyright : (c) Douglas Burke, 2018-2020 License : BSD3 Maintainer : dburke.gw@gmail.com Stability : unstable Portability : CPP, OverloadedStrings Geometric shapes and projections. -} module Graphics.Vega.VegaLite.Geometry ( geometry , geoFeatureCollection , geometryCollection , Geometry(..) , sphere , graticule , GraticuleProperty(..) , projection , ProjectionProperty(..) , Projection(..) , ClipRect(..) -- not for external export , projectionProperty ) where import qualified Data.Aeson as A import qualified Data.Text as T import Control.Arrow (second) import Data.Aeson ((.=), object, toJSON) #if !(MIN_VERSION_base(4, 12, 0)) import Data.Monoid ((<>)) #endif import Graphics.Vega.VegaLite.Data ( DataValue , dataValueSpec ) import Graphics.Vega.VegaLite.Foundation (fromT) import Graphics.Vega.VegaLite.Specification ( VLProperty(VLData, VLProjection) , VLSpec , LabelledSpec , PropertySpec ) import Graphics.Vega.VegaLite.Input ( Data ) type_ :: T.Text -> LabelledSpec type_ t = "type" .= t {-| Specifies a list of geo features to be used in a geoShape specification. Each feature object in this collection can be created with the 'geometry' function. @ 'geoFeatureCollection' [ 'geometry' ('GeoPolygon' [ [ ( -3, 59 ), ( -3, 52 ), ( 4, 52 ), ( -3, 59 ) ] ]) [ ( "myRegionName", 'Graphics.Vega.VegaLite.Str' "Northern region" ) ] , 'geometry' ('GeoPolygon' [ [ ( -3, 52 ), ( 4, 52 ), ( 4, 45 ), ( -3, 52 ) ] ]) [ ( "myRegionName", 'Graphics.Vega.VegaLite.Str' "Southern region" ) ] ] @ -} geoFeatureCollection :: [VLSpec] -> VLSpec geoFeatureCollection geoms = object [ type_ "FeatureCollection" , "features" .= geoms ] {-| Specifies a list of geometry objects to be used in a geoShape specification. Each geometry object in this collection can be created with the 'geometry' function. @ 'geometryCollection' [ 'geometry' ('GeoPolygon' [ [ ( -3, 59 ), ( 4, 59 ), ( 4, 52 ), ( -3, 59 ) ] ]) [] , 'geometry' ('GeoPoint' -3.5 55.5) [] ] @ -} geometryCollection :: [VLSpec] -> VLSpec geometryCollection geoms = object [ type_ "GeometryCollection" , "geometries" .= geoms ] {-| Types of geographic map projection. These are based on a subset of those provided by the . For details of available projections see the . -} -- based on schema 3.3.0 #/definitions/ProjectionType data Projection = Albers -- ^ An Albers equal-area conic map projection. | AlbersUsa -- ^ An Albers USA map projection that combines continental USA with -- Alaska and Hawaii. Unlike other projection types, this remains -- unaffected by 'PrRotate'. | AzimuthalEqualArea -- ^ An azimuthal equal area map projection. | AzimuthalEquidistant -- ^ An azimuthal equidistant map projection. | ConicConformal -- ^ A conformal conic map projection. | ConicEqualArea -- ^ An equal area conic map projection. | ConicEquidistant -- ^ An equidistant conic map projection. | Custom T.Text -- ^ Specify the name of the custom D3 prohection to use. See the -- -- for more information. -- -- An example: @Custom "winkle3"@ | EqualEarth -- ^ An -- that provides a reasonable shape approximation while retaining relative areas. -- -- @since 0.5.0.0 | Equirectangular -- ^ An equirectangular map projection that maps longitude to x and latitude to y. -- While showing less area distortion towards the poles than the default 'Mercator' -- projection, it is neither equal-area nor conformal. | Gnomonic -- ^ A gnomonic map projection. | Identity -- ^ The identiy projection. This can be combined with 'PrReflectX' and -- 'PrReflectY' in the list of projection properties. -- -- @since 0.4.0.0 | Mercator -- ^ A Mercator map projection. This is the default projection of longitude, latitude -- values if no projection is set explicitly. It preserves shape (local angle) and -- lines of equal angular bearing remain parallel straight lines. The area is -- /significantly/ enlarged towards the poles. | NaturalEarth1 -- ^ The -- is neither conformal nor equal-area, but is designed to be \"appealing to the -- eye\" for small-scale maps of the whole world. -- -- @since 0.5.0.0 | Orthographic -- ^ An orthographic map projection. | Stereographic -- ^ A stereographic map projection. | TransverseMercator -- ^ A transverse Mercator map projection. projectionLabel :: Projection -> T.Text projectionLabel Albers = "albers" projectionLabel AlbersUsa = "albersUsa" projectionLabel AzimuthalEqualArea = "azimuthalEqualArea" projectionLabel AzimuthalEquidistant = "azimuthalEquidistant" projectionLabel ConicConformal = "conicConformal" projectionLabel ConicEqualArea = "conicEqualarea" projectionLabel ConicEquidistant = "conicEquidistant" projectionLabel (Custom pName) = pName projectionLabel EqualEarth = "equalEarth" projectionLabel Equirectangular = "equirectangular" projectionLabel Gnomonic = "gnomonic" projectionLabel Identity = "identity" projectionLabel Mercator = "mercator" projectionLabel NaturalEarth1 = "naturalEarth1" projectionLabel Orthographic = "orthographic" projectionLabel Stereographic = "stereographic" projectionLabel TransverseMercator = "transverseMercator" -- | Specifies a clipping rectangle for defining -- the clip extent of a map projection. data ClipRect = NoClip -- ^ No clipping it to be applied. | LTRB Double Double Double Double -- ^ The left, top, right, and bottom extents, in pixels, -- of a rectangular clip. {-| Properties for customising a geospatial projection that converts longitude,latitude pairs into planar @(x,y)@ coordinate pairs for rendering and query. For details see the . This type has been changed in the @0.4.0.0@ release so that all constructors start with @Pr@ rather than @P@ (and so provide some differentiation to the 'Graphics.Vega.VegaLite.PositionChannel' constructors). -} -- based on schema 3.3.0 #/definitions/Projection data ProjectionProperty = PrType Projection -- ^ The type of the map projection. | PrClipAngle (Maybe Double) -- ^ The clipping circle angle in degrees. A value of @Nothing@ will switch to -- antimeridian cutting rather than small-circle clipping. | PrClipExtent ClipRect -- ^ Projection’s viewport clip extent to the specified bounds in pixels. | PrCenter Double Double -- ^ Projection’s center as longitude and latitude in degrees. | PrScale Double -- ^ The projection's zoom scale, which if set, overrides automatic scaling of a -- geo feature to fit within the viewing area. -- -- @since 0.4.0.0 | PrTranslate Double Double -- ^ A projection’s panning translation, which if set, overrides automatic positioning -- of a geo feature to fit within the viewing area -- -- Note that the prefix is @Pr@ and not @P@, to match the Elm API. -- -- @since 0.4.0.0 | PrRotate Double Double Double -- ^ A projection’s three-axis rotation angle. The order is @lambda@ @phi@ @gamma@, -- and specifies the rotation angles in degrees about each spherical axis. | PrPrecision Double -- ^ Threshold for the projection’s adaptive resampling in pixels, and corresponds to the -- Douglas–Peucker distance. If precision is not specified, the projection’s current -- resampling precision of 0.707 is used. -- -- Version 3.3.0 of the Vega-Lite spec claims this should be output as a string, -- but it is written out as a number since the -- [spec is in error](https://github.com/vega/vega-lite/issues/5190). | PrReflectX Bool -- ^ Reflect the x-coordinates after performing an identity projection. This -- creates a left-right mirror image of the geoshape marks when subject to an -- identity projection with 'Identity'. -- -- @since 0.4.0.0 | PrReflectY Bool -- ^ Reflect the y-coordinates after performing an identity projection. This -- creates a left-right mirror image of the geoshape marks when subject to an -- identity projection with 'Identity'. -- -- @since 0.4.0.0 | PrCoefficient Double -- ^ The @Hammer@ map projection coefficient. | PrDistance Double -- ^ The @Satellite@ map projection distance. | PrFraction Double -- ^ The @Bottomley@ map projection fraction. | PrLobes Int -- ^ Number of lobes in lobed map projections such as the @Berghaus star@. | PrParallel Double -- ^ Parallel for map projections such as the @Armadillo@. | PrRadius Double -- ^ Radius value for map projections such as the @Gingery@. | PrRatio Double -- ^ Ratio value for map projections such as the @Hill@. | PrSpacing Double -- ^ Spacing value for map projections such as the @Lagrange@. | PrTilt Double -- ^ @Satellite@ map projection tilt. projectionProperty :: ProjectionProperty -> LabelledSpec projectionProperty (PrType proj) = "type" .= projectionLabel proj projectionProperty (PrClipAngle numOrNull) = "clipAngle" .= maybe A.Null toJSON numOrNull projectionProperty (PrClipExtent rClip) = ("clipExtent", case rClip of NoClip -> A.Null LTRB l t r b -> toJSON (map toJSON [l, t, r, b]) ) projectionProperty (PrCenter lon lat) = "center" .= [lon, lat] projectionProperty (PrScale sc) = "scale" .= sc projectionProperty (PrTranslate tx ty) = "translate" .= [tx, ty] projectionProperty (PrRotate lambda phi gamma) = "rotate" .= [lambda, phi, gamma] projectionProperty (PrPrecision pr) = "precision" .= pr -- the 3.3.0 spec says this is a string, but that's wrong, See https://github.com/vega/vega-lite/issues/5190 projectionProperty (PrReflectX b) = "reflectX" .= b projectionProperty (PrReflectY b) = "reflectY" .= b projectionProperty (PrCoefficient x) = "coefficient" .= x projectionProperty (PrDistance x) = "distance" .= x projectionProperty (PrFraction x) = "fraction" .= x projectionProperty (PrLobes n) = "lobes" .= n projectionProperty (PrParallel x) = "parallel" .= x projectionProperty (PrRadius x) = "radius" .= x projectionProperty (PrRatio x) = "ratio" .= x projectionProperty (PrSpacing x) = "spacing" .= x projectionProperty (PrTilt x) = "tilt" .= x {-| Sets the cartographic projection used for geospatial coordinates. A projection defines the mapping from @(longitude,latitude)@ to an @(x,y)@ plane used for rendering. This is useful when using the 'Graphics.Vega.VegaLite.Geoshape' mark. For further details see the . @ 'projection' [ 'PrType' 'Orthographic', 'PrRotate' (-40) 0 0 ] @ -} projection :: [ProjectionProperty] -> PropertySpec projection pProps = (VLProjection, object (map projectionProperty pProps)) {-| Specifies the type and content of geometry specifications for programatically creating GeoShapes. These can be mapped to the where the pluralised type names refer to their @Multi@ prefixed equivalent in the GeoJSON specification. -} data Geometry = GeoPoint Double Double -- ^ The GeoJson geometry @point@ type. | GeoPoints [(Double, Double)] -- ^ The GeoJson geometry @multi-point@ type. | GeoLine [(Double, Double)] -- ^ The GeoJson geometry @line@ type. | GeoLines [[(Double, Double)]] -- ^ The GeoJson geometry @multi-line@ type. | GeoPolygon [[(Double, Double)]] -- ^ The GeoJson geometry @polygon@ type. | GeoPolygons [[[(Double, Double)]]] -- ^ The GeoJson geometry @multi-polygon@ type. {-| Specifies a geometric object to be used in a geoShape specification. The first parameter is the geometric type, the second an optional list of properties to be associated with the object. @ 'geometry' ('GeoPolygon' [ [ ( -3, 59 ), ( 4, 59 ), ( 4, 52 ), ( -3, 59 ) ] ]) [] @ -} geometry :: Geometry -> [(T.Text, DataValue)] -> VLSpec geometry gType properties = object ([ ("type", fromT "Feature") , ("geometry", geometryTypeSpec gType) ] <> if null properties then [] else [("properties", object (map (second dataValueSpec) properties))] ) geometryTypeSpec :: Geometry -> VLSpec geometryTypeSpec gType = let toCoords :: [(Double, Double)] -> VLSpec toCoords = toJSON -- rely on Aeson converting a pair to a 2-element list toCoordList :: [[(Double, Double)]] -> VLSpec toCoordList = toJSON . map toCoords -- this is just toJSON isn't it? -- can we replace this infinite tower of toJSON calls with one toJSON call? (ptype, cs) = case gType of GeoPoint x y -> ("Point", toJSON [x, y]) GeoPoints coords -> ("MultiPoint", toCoords coords) GeoLine coords -> ("LineString", toCoords coords) GeoLines coords -> ("MultiLineString", toCoordList coords) GeoPolygon coords -> ("Polygon", toCoordList coords) GeoPolygons ccoords -> ("MultiPolygon", toJSON (map toCoordList ccoords)) in object [("type", ptype), ("coordinates", cs)] {-| Generate a data source that is a sphere for bounding global geographic data. The sphere will be subject to whatever projection is specified for the view. @ 'Graphics.Vega.VegaLite.toVegaLite' [ 'sphere' , 'projection' [ 'PrType' 'Orthographic' ] , 'Graphics.Vega.VegaLite.mark' 'Graphics.Vega.VegaLite.Geoshape' [ 'Graphics.Vega.VegaLite.MFill' "aliceblue" ] ] @ @since 0.4.0.0 -} sphere :: Data sphere = (VLData, object ["sphere" .= True]) {-| Generate a grid of lines of longitude (meridians) and latitude (parallels). @ let proj = 'projection' [ 'PrType' 'Orthographic' ] sphereSpec = 'Graphics.Vega.VegaLite.asSpec' [ 'sphere' , 'Graphics.Vega.VegaLite.mark' 'Graphics.Vega.VegaLite.Geoshape' [ 'Graphics.Vega.VegaLite.MFill' "aliceblue" ] ] gratSpec = 'Graphics.Vega.VegaLite.asSpec' [ 'graticule' [ 'GrStep' (5, 5) ] , 'Graphics.Vega.VegaLite.mark' 'Graphics.Vega.VegaLite.Geoshape' [ 'Graphics.Vega.VegaLite.MFilled' False, 'Graphics.Vega.VegaLite.MStrokeWidth' 0.3 ] ] in 'Graphics.Vega.VegaLite.toVegaLite' [ proj, 'Graphics.Vega.VegaLite.layer' [ sphereSpec, gratSpec ] ] @ @since 0.4.0.0 -} graticule :: [GraticuleProperty] -- ^ An empty list uses the default parameters -> Data graticule [] = (VLData, object ["graticule" .= True]) graticule grProps = (VLData, object ["graticule" .= object (map graticuleProperty grProps)]) {-| Determine the properties of graticules. See the for details. @since 0.4.0.0 -} data GraticuleProperty = GrExtent (Double, Double) (Double, Double) -- ^ Define the extent of both the major and minor graticules. -- The range is given as longitude, latitude pairs of the -- minimum and then maximum extent. The units are degrees. | GrExtentMajor (Double, Double) (Double, Double) -- ^ As @GrExtent@ but for the major graticule lines only. | GrExtentMinor (Double, Double) (Double, Double) -- ^ As @GrExtent@ but for the minor graticule lines only. | GrStep (Double, Double) -- ^ The step angles for the graticule lines, given as a longitude, -- latitude pair defining the EW and NS intervals respectively. -- The units are degrees. -- -- By default major graticule lines extend to both poles but the -- minor lines stop at ±80 degrees latitude. | GrStepMajor (Double, Double) -- ^ As @GrStep@ but for the major graticule lines only. -- -- The default is @(90, 360)@. | GrStepMinor (Double, Double) -- ^ As @GrStep@ but for the minor graticule lines only. -- -- The default is @(10, 10)@. | GrPrecision Double -- ^ The precision of the graticule. The units are degrees. -- A smaller value reduces visual artifacts (steps) but takes longer -- to render. -- -- The default is @2.5@. graticuleProperty :: GraticuleProperty -> LabelledSpec graticuleProperty (GrExtent (lng1, lat1) (lng2, lat2)) = "extent" .= [[lng1, lat1], [lng2, lat2]] graticuleProperty (GrExtentMajor (lng1, lat1) (lng2, lat2)) = "extentMajor" .= [[lng1, lat1], [lng2, lat2]] graticuleProperty (GrExtentMinor (lng1, lat1) (lng2, lat2)) = "extentMinor" .= [[lng1, lat1], [lng2, lat2]] graticuleProperty (GrStep (lng, lat)) = "step" .= [lng, lat] graticuleProperty (GrStepMajor (lng, lat)) = "stepMajor" .= [lng, lat] graticuleProperty (GrStepMinor (lng, lat)) = "stepMinor" .= [lng, lat] graticuleProperty (GrPrecision x) = "precision" .= x