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

Leaflet maps: remove explicit bounds from FitToBounds; compute based on objects

parent 0c55e12b
......@@ -47,7 +47,7 @@ customLeafletEditor :: !MapOptions !(LeafletEventHandlers s) s -> Editor (Leafle
*/
:: LeafletPerspective
= CenterAndZoom !LeafletLatLng !Int
| FitToBounds !LeafletBounds
| FitToBounds
:: TileLayer = {url :: !String, attribution :: !Maybe HtmlTag}
......@@ -77,6 +77,8 @@ customLeafletEditor :: !MapOptions !(LeafletEventHandlers s) s -> Editor (Leafle
| Window !LeafletWindow
leafletObjectIdOf :: !LeafletObject -> LeafletObjectID
leafletPointsOf :: !LeafletObject -> [LeafletLatLng]
leafletBoundingRectangleOf :: ![LeafletObject] -> LeafletBounds
:: LeafletObjectID =: LeafletObjectID String
:: LeafletMarker =
......
......@@ -2,7 +2,7 @@ implementation module iTasks.Extensions.GIS.Leaflet
import iTasks
import iTasks.UI.Definition, iTasks.UI.Editor
import StdMisc, Data.Tuple, Data.Error, Data.Func, Text, Data.Functor
import StdMisc, Data.Tuple, Data.Error, Data.Func, Data.List, Text, Data.Functor
import qualified Data.Map as DM
//from Text.HTML import instance toString HtmlTag, instance toString SVGElt
import Text.HTML
......@@ -35,6 +35,26 @@ leafletObjectIdOf (Circle c) = c.circleId
leafletObjectIdOf (Rectangle r) = r.rectangleId
leafletObjectIdOf (Window w) = w.windowId
leafletPointsOf :: !LeafletObject -> [LeafletLatLng]
leafletPointsOf (Marker m) = [m.position]
leafletPointsOf (Polyline l) = l.LeafletPolyline.points
leafletPointsOf (Polygon p) = p.LeafletPolygon.points
leafletPointsOf (Circle c) = [c.LeafletCircle.center]
leafletPointsOf (Rectangle {LeafletRectangle | bounds=b}) = [b.southWest, b.northEast]
leafletPointsOf (Window w) = []
leafletBoundingRectangleOf :: ![LeafletObject] -> LeafletBounds
leafletBoundingRectangleOf objects
| isEmpty points = defaultValue
| otherwise =
{ southWest = {lat=minList lats, lng=minList lngs}
, northEast = {lat=maxList lats, lng=maxList lngs}
}
where
points = concatMap leafletPointsOf objects
lats = [p.lat \\ p <- points]
lngs = [p.lng \\ p <- points]
:: LeafletEdit
= LDSetManualPerspective
//Current state
......@@ -86,6 +106,7 @@ where
fromMaybe gDefault{|*|} $ editModeValue mode
# mapAttr = 'DM'.fromList
[("perspective", encodePerspective perspective)
,("fitbounds", encodeBounds (leafletBoundingRectangleOf objects))
,("tilesUrls"
, JSONArray $
(\tile ->
......@@ -113,12 +134,12 @@ where
, JSONArray [JSONReal center.lat, JSONReal center.lng]
, JSONInt zoom
]
encodePerspective (FitToBounds bounds=:{southWest=sw,northEast=ne}) = JSONArray
[ JSONString "FitToBounds"
, JSONArray
[ JSONArray [JSONReal sw.lat, JSONReal sw.lng]
, JSONArray [JSONReal ne.lat, JSONReal ne.lng]
]
encodePerspective FitToBounds = JSONArray [JSONString "FitToBounds"]
encodeBounds :: !LeafletBounds -> JSONNode
encodeBounds {southWest=sw,northEast=ne} = JSONArray
[ JSONArray [JSONReal sw.lat, JSONReal sw.lng]
, JSONArray [JSONReal ne.lat, JSONReal ne.lng]
]
encodeUI (Marker o) = let (JSONObject attr) = toJSON o
......@@ -291,6 +312,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
_ -> jsTrace "unknown attribute change" world
onHtmlEvent me args world
......@@ -387,7 +409,7 @@ where
-> syncCurrentState me world
"FitToBounds"
# world = (me .# "attributes.ignorezoomend" .= True) world
# world = (me .# "map.fitBounds" .$! (attr .# 1)) world
# world = (me .# "map.fitBounds" .$! (me .# "attributes.fitbounds")) world
-> syncCurrentState me world
_
-> jsTraceVal attr (jsTrace "failed to set perspective" world)
......@@ -711,6 +733,9 @@ where
# attrChanges = diffAttributes oldMap newMap
//Determine object changes
# childChanges = diffChildren oldMap.LeafletMap.objects newMap.LeafletMap.objects updateFromOldToNew encodeUI
# attrChanges = if (isEmpty childChanges)
attrChanges
[SetAttribute "fitbounds" (encodeBounds (leafletBoundingRectangleOf newMap.objects)):attrChanges]
= (Ok (ChangeUI attrChanges childChanges, newMap),vst)
where
//Only center and zoom are synced to the client, bounds are only synced from client to server
......@@ -758,6 +783,11 @@ where
gDefault{|LeafletPerspective|} = CenterAndZoom {LeafletLatLng|lat = 51.82, lng = 5.86} 7
gDefault{|LeafletBounds|} =
{ southWest = {lat=50.82, lng=4.86}
, northEast = {lat=52.82, lng=6.86}
}
//Comparing reals may have unexpected results, especially when comparing constants to previously stored ones
gEq{|LeafletLatLng|} x y = (toString x.lat == toString y.lat) && (toString x.lng == toString y.lng)
......
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