Commit 246fd3ba authored by Camil Staps's avatar Camil Staps 🙂 Committed by Steffen Michels

Leaflet maps: add FitToBoundsOptions

parent bec7d9c4
......@@ -47,7 +47,12 @@ customLeafletEditor :: !MapOptions !(LeafletEventHandlers s) s -> Editor (Leafle
*/
:: LeafletPerspective
= CenterAndZoom !LeafletLatLng !Int
| FitToBounds
| FitToBounds !FitToBoundsOptions
:: FitToBoundsOptions =
{ padding :: !(!Int, !Int) //* The horizontal and vertical padding in pixels
, maxZoom :: !Int //* The maximum zoom level
}
:: TileLayer = {url :: !String, attribution :: !Maybe HtmlTag}
......@@ -174,10 +179,10 @@ openStreetMapTiles :: TileLayer
instance == LeafletObjectID
instance == LeafletIconID
derive JSONEncode LeafletMap, LeafletPerspective, LeafletLatLng
derive JSONDecode LeafletMap, LeafletPerspective, LeafletLatLng
derive gDefault LeafletMap, LeafletPerspective, LeafletLatLng
derive gEq LeafletMap, LeafletPerspective, LeafletLatLng
derive gText LeafletMap, LeafletPerspective, LeafletLatLng
derive gEditor LeafletMap, LeafletPerspective, LeafletLatLng
derive JSONEncode LeafletMap, LeafletPerspective, LeafletLatLng, FitToBoundsOptions
derive JSONDecode LeafletMap, LeafletPerspective, LeafletLatLng, FitToBoundsOptions
derive gDefault LeafletMap, LeafletPerspective, LeafletLatLng, FitToBoundsOptions
derive gEq LeafletMap, LeafletPerspective, LeafletLatLng, FitToBoundsOptions
derive gText LeafletMap, LeafletPerspective, LeafletLatLng, FitToBoundsOptions
derive gEditor LeafletMap, LeafletPerspective, LeafletLatLng, FitToBoundsOptions
derive class iTask LeafletIcon, LeafletBounds, LeafletObject, LeafletMarker, LeafletPolyline, LeafletPolygon, LeafletWindow, LeafletWindowPos, LeafletLineStyle, LeafletStyleDef, LeafletAreaStyle, LeafletObjectID, LeafletSimpleState
......@@ -134,7 +134,10 @@ where
, JSONArray [JSONReal center.lat, JSONReal center.lng]
, JSONInt zoom
]
encodePerspective FitToBounds = JSONArray [JSONString "FitToBounds"]
encodePerspective (FitToBounds options) = JSONArray
[ JSONString "FitToBounds"
, toJSON options
]
encodeBounds :: !LeafletBounds -> JSONNode
encodeBounds {southWest=sw,northEast=ne} = JSONArray
......@@ -312,7 +315,7 @@ where
onAttributeChange me args world = case jsValToString` "" args.[0] of
"perspective" -> setMapPerspective me args.[1] world
"icons" -> setMapIcons me (me .# "map") args.[1] world
"fitbounds" -> (me .# "map.fitBounds" .$! args.[1]) world
"fitbounds" -> fitBounds me args.[1] (me .# "attributes.perspective" .# 1) world
_ -> jsTrace "unknown attribute change" world
onHtmlEvent me args world
......@@ -408,12 +411,15 @@ where
# world = (me .# "map.setView" .$! (attr .# 1, attr .# 2)) world
-> syncCurrentState me world
"FitToBounds"
# world = (me .# "attributes.ignorezoomend" .= True) world
# world = (me .# "map.fitBounds" .$! (me .# "attributes.fitbounds")) world
# world = fitBounds me (me .# "attributes.fitbounds") (attr .# 1) world
-> syncCurrentState me world
_
-> jsTraceVal attr (jsTrace "failed to set perspective" world)
fitBounds me bounds options world
# world = (me .# "attributes.ignorezoomend" .= True) world
= (me .# "map.fitBounds" .$! (bounds, options)) world
addMapTilesLayer me mapObj _ tiles world
# (tilesUrl, world) = tiles .# "url" .? world
| jsIsNull tilesUrl = world
......@@ -871,10 +877,15 @@ where
instance == LeafletObjectID where (==) (LeafletObjectID x) (LeafletObjectID y) = x == y
instance == LeafletIconID where (==) (LeafletIconID x) (LeafletIconID y) = x == y
derive JSONEncode LeafletMap, LeafletPerspective, LeafletLatLng, TileLayer
derive JSONDecode LeafletMap, LeafletPerspective, LeafletLatLng, TileLayer
gDefault{|FitToBoundsOptions|} =
{ padding = (100, 100)
, maxZoom = 10
}
derive JSONEncode LeafletMap, LeafletPerspective, LeafletLatLng, TileLayer, FitToBoundsOptions
derive JSONDecode LeafletMap, LeafletPerspective, LeafletLatLng, TileLayer, FitToBoundsOptions
derive gDefault LeafletLatLng
derive gEq LeafletMap, LeafletPerspective, TileLayer
derive gText LeafletMap, LeafletPerspective, LeafletLatLng, TileLayer
derive gEditor LeafletPerspective, LeafletLatLng
derive gEq LeafletMap, LeafletPerspective, TileLayer, FitToBoundsOptions
derive gText LeafletMap, LeafletPerspective, LeafletLatLng, TileLayer, FitToBoundsOptions
derive gEditor LeafletPerspective, LeafletLatLng, FitToBoundsOptions
derive class iTask LeafletIcon, LeafletBounds, LeafletObject, LeafletMarker, LeafletPolyline, LeafletPolygon, LeafletEdit, LeafletWindow, LeafletWindowPos, LeafletLineStyle, LeafletStyleDef, LeafletAreaStyle, LeafletObjectID, CSSClass, LeafletIconID, LeafletCircle, LeafletObjectUpdate, LeafletRectangle, LeafletSimpleState
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment