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

Make LeafletPerspective an ADT with CenterAndZoom and FitToBounds options; add...

Make LeafletPerspective an ADT with CenterAndZoom and FitToBounds options; add bounds/center/zoom informational fields to LeafletMap
parent ef729b48
......@@ -26,9 +26,30 @@ managePerspective :: (Shared sds (LeafletMap,LeafletSimpleState)) -> Task () | R
managePerspective m = Title "Perspective" @>> updateSharedInformation []
(mapReadWrite (\(x,s) -> x.LeafletMap.perspective, \p (x,s) -> Just ({x & perspective = p},s)) Nothing m) @! ()
:: ReadOnlyState =
{ bounds :: !Maybe LeafletBounds
, center :: !Maybe LeafletLatLng
, zoom :: !Maybe Int
}
derive class iTask ReadOnlyState
manageState :: (Shared sds (LeafletMap,LeafletSimpleState)) -> Task () | RWShared sds
manageState m = Title "State" @>> updateSharedInformation []
(mapReadWrite (\(x,s) -> s, \sn (x,s) -> Just (x,sn)) Nothing m) @! ()
manageState m = Title "State" @>>
(
viewSharedInformation []
(mapRead (readOnlyState o fst) m)
-&&-
updateSharedInformation []
(mapReadWrite (\(x,s) -> s, \sn (x,s) -> Just (x,sn)) Nothing m)
) @! ()
where
readOnlyState m =
{ ReadOnlyState
| bounds = m.LeafletMap.bounds
, center = m.LeafletMap.center
, zoom = m.LeafletMap.zoom
}
// objects can currently only be viewed, as the editor for `HtmlTag` only works in view mode
manageMapObjects :: (Shared sds (LeafletMap,LeafletSimpleState)) -> Task () | RWShared sds
......@@ -100,7 +121,7 @@ where
withCircleFromCursor (Just position) objects = objects ++ [Circle {circleId = LeafletObjectID "CIRCLE_CURSOR", center = position, radius = 100000.0, editable = True, style = []}]
addRectangleAroundCurrentPerspective m
= upd (\(l=:{LeafletMap|perspective={LeafletPerspective|bounds},objects},s) -> ({LeafletMap|l & objects = withRectangleAroundCurrentPerspective bounds objects},s)) m
= upd (\(l=:{LeafletMap|bounds,objects},s) -> ({LeafletMap|l & objects = withRectangleAroundCurrentPerspective bounds objects},s)) m
where
withRectangleAroundCurrentPerspective Nothing objects = objects
withRectangleAroundCurrentPerspective (Just bounds) objects = objects ++ [Rectangle {rectangleId = LeafletObjectID "RECT_PERSPECTIVE", bounds = bounds, editable = True, style = []}]
......
......@@ -23,17 +23,31 @@ customLeafletEditor :: !MapOptions !(LeafletEventHandlers s) s -> Editor (Leafle
}
:: LeafletMap =
{ perspective :: !LeafletPerspective
, tilesUrls :: ![TileLayer]
, objects :: ![LeafletObject] //Markers, lines and polygon
, icons :: ![LeafletIcon] //Custom icons used by markers. They are referenced using their 'iconId' string.
}
{ perspective :: !LeafletPerspective //* How the map should decide what should be in view
, bounds :: !Maybe LeafletBounds //* The actual bounds of the map (updated by the client; writes are ignored)
, center :: !Maybe LeafletLatLng //* The actual center of the map (updated by the client; writes are ignored)
, zoom :: !Maybe Int //* The actual zoom level of the map (updated by the client; writes are ignored)
, tilesUrls :: ![TileLayer]
, objects :: ![LeafletObject] //* Markers, lines and polygon
, icons :: ![LeafletIcon] //* Custom icons used by markers. They are referenced using their 'iconId' string.
}
:: LeafletPerspective =
{ center :: !LeafletLatLng
, zoom :: !Int
, bounds :: !Maybe LeafletBounds
}
/**
* This type describes how the application prefers the map to be drawn.
*
* When the perspective is `FitToBounds`, a view is automatically computed such
* that all objects are visible.
*
* `CenterAndZoom` simply sets the center coordinate and zoom level.
*
* When the user drags or zooms the map, the perspective of a `LeafletMap` is
* reset to `CenterAndZoom`. This prevents applications from automatically
* moving the view after the user has changed it. It is of course possible to
* programmatically change it back to `FitToBounds`.
*/
:: LeafletPerspective
= CenterAndZoom !LeafletLatLng !Int
| FitToBounds !LeafletBounds
:: TileLayer = {url :: !String, attribution :: !Maybe HtmlTag}
......@@ -161,7 +175,7 @@ instance == LeafletIconID
derive JSONEncode LeafletMap, LeafletPerspective, LeafletLatLng
derive JSONDecode LeafletMap, LeafletPerspective, LeafletLatLng
derive gDefault LeafletMap, LeafletPerspective, LeafletLatLng
derive gEq LeafletMap, LeafletPerspective
derive gEq LeafletMap, LeafletPerspective, LeafletLatLng
derive gText LeafletMap, LeafletPerspective, LeafletLatLng
derive gEditor LeafletMap, LeafletPerspective, LeafletLatLng
derive class iTask LeafletIcon, LeafletBounds, LeafletObject, LeafletMarker, LeafletPolyline, LeafletPolygon, LeafletWindow, LeafletWindowPos, LeafletLineStyle, LeafletStyleDef, LeafletAreaStyle, LeafletObjectID, LeafletSimpleState
This diff is collapsed.
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