Skip to content

GitLab

Commit e463865a authored by Steffen Michels's avatar Steffen Michels
Browse files
Options

Merge branch '285-leaflet-maps-extended-interaction-possibilities' into 'master' 

Resolve "Leaflet maps: extended interaction possibilities"

Closes #285

See merge request !281
parents 41d2eb6d 950eaf60
Pipeline #26038 passed with stage
    in 5 minutes and 12 seconds
    Hide whitespace changes
    Inline Side-by-side
    Showing with 222 additions and 106 deletions
    Examples/Applications/Incidone/Incidone/ContactPosition.icl
    View file @ e463865a
    ......@@ -94,7 +94,7 @@ where
    eqBounds _ _ = False
    gDefault{|ContactMapPerspective|}
    = {ContactMapPerspective|center = (52.948300, 4.776007), zoom = 7, cursor = Nothing, bounds = Nothing} //(Full coast centered on Den Helder)
    = {ContactMapPerspective|center = (52.948300, 4.776007), zoom = 7, bounds = Nothing, cursor = Nothing} //(Full coast centered on Den Helder)
    contactToMapMarker :: Bool Bool Contact -> ContactMapMarker
    ......@@ -142,8 +142,8 @@ where
    tilesUrls layers = [url \\ {ContactMapLayer|def=CMTileLayer url} <- layers]
    convMarkers markers = [conv m \\ m=:{ContactMapMarker|position} <- markers | hasLatLng position]
    conv {ContactMapMarker|markerId,title,position,heading,type,selected}
    = Marker {LeafletMarker|markerId = markerId, title = title, position = pos position, icon = Nothing /* fmap (\t -> iconIndex heading t selected) type */, selected = selected, popup = Nothing}
    conv {ContactMapMarker|markerId,title,position,heading,type}
    = Marker {LeafletMarker|markerId = markerId, title = title, position = pos position, icon = Nothing /* fmap (\t -> iconIndex heading t selected) type */, popup = Nothing}
    pos (PositionLatLng (lat,lng)) = {LeafletLatLng|lat=lat,lng=lng}
    pos (PositionDescription _ (Just(lat,lng))) = {LeafletLatLng|lat=lat,lng=lng}
    ......@@ -183,7 +183,7 @@ where
    toLeafletPerspective :: ContactMapPerspective -> LeafletPerspective
    toLeafletPerspective {ContactMapPerspective|center,zoom,cursor,bounds}
    = {LeafletPerspective|center=toLeafletLatLng center,zoom=zoom,cursor=fmap toLeafletLatLng cursor,bounds=fmap toLeafletBounds bounds}
    = {LeafletPerspective|center=toLeafletLatLng center,zoom=zoom,bounds=fmap toLeafletBounds bounds}
    toLeafletLatLng :: !(!Real,!Real) -> LeafletLatLng
    toLeafletLatLng (lat,lng) = {LeafletLatLng|lat=lat,lng=lng}
    ......@@ -199,8 +199,8 @@ fromLeafletMap contactMap leafletMap
    }
    fromLeafletPerspective :: LeafletPerspective -> ContactMapPerspective
    fromLeafletPerspective {LeafletPerspective|center,cursor,zoom,bounds}
    = {ContactMapPerspective|center=fromLeafletLatLng center,zoom=zoom,cursor=fmap fromLeafletLatLng cursor,bounds=fmap fromLeafletBounds bounds}
    fromLeafletPerspective {LeafletPerspective|center,zoom,bounds}
    = {ContactMapPerspective|center=fromLeafletLatLng center,zoom=zoom,cursor=Nothing,bounds=fmap fromLeafletBounds bounds}
    /*
    fromLeafletLayer :: ContactMapLayer LeafletLayer -> ContactMapLayer
    ......@@ -216,8 +216,8 @@ fromLeafletLayer cl ll = cl
    */
    selectionFromLeafletMap :: LeafletMap -> [LeafletObjectID]
    selectionFromLeafletMap {LeafletMap|objects} =
    [markerId \\ Marker {LeafletMarker|markerId,selected} <- objects | selected]
    selectionFromLeafletMap {LeafletMap|objects} = []
    //[markerId \\ Marker {LeafletMarker|markerId} <- objects | selected]
    fromLeafletLatLng :: !LeafletLatLng -> (!Real,!Real)
    fromLeafletLatLng {LeafletLatLng|lat,lng} = (lat,lng)
    ......
    Examples/Applications/ShipAdventure/C2/Framework/Common.icl
    View file @ e463865a
    ......@@ -96,9 +96,9 @@ mapView` currentUser es = (updateSharedInformation () [UpdateAs toMap fromMap] (
    # mid = toInt contactMarker.ContactMapMarker.markerId
    = case 'DIS'.get mid markers of
    Just m
    # st = if contactMarker.ContactMapMarker.selected
    {st & selection = mid}
    st
    //# st = if contactMarker.ContactMapMarker.selected
    // {st & selection = mid}
    // st
    //= ('DIS'.put mid {Entity | m & selected = contactMarker.ContactMapMarker.selected} markers, st) // TODO FIXME
    = (markers, st)
    _ = (markers, st)
    ......@@ -120,9 +120,9 @@ mapView sh radarWorks currentUser es = (updateSharedInformation () [UpdateAs toM
    # mid = toInt contactMarker.ContactMapMarker.markerId
    = case 'DIS'.get mid markers of
    Just m
    # st = if contactMarker.ContactMapMarker.selected
    {st & selection = mid}
    st
    //# st = if contactMarker.ContactMapMarker.selected
    // {st & selection = mid}
    // st
    //= ('DIS'.put mid {Entity | m & selected = contactMarker.ContactMapMarker.selected} markers, st) TODO FIXME
    = (markers, st)
    _ = (markers, st)
    ......
    Examples/Applications/ShipAdventure/C2/Framework/ContactPosition.icl
    View file @ e463865a
    ......@@ -116,15 +116,15 @@ toLeafletMap {ContactMap|perspective,markers}
    }
    where
    convMarkers markers = [conv m \\ m=:{ContactMapMarker|position} <- markers]
    conv {ContactMapMarker|markerId,title,position,heading,type,selected}
    = Marker {LeafletMarker|markerId = LeafletObjectID markerId, title = title, position = toLeafletLatLng position, icon = fmap (\t -> LeafletIconID (iconIndex heading t selected)) type, selected = selected, popup = Nothing}
    conv {ContactMapMarker|markerId,title,position,heading,type}
    = Marker {LeafletMarker|markerId = LeafletObjectID markerId, title = title, position = toLeafletLatLng position, icon = fmap (\t -> LeafletIconID (iconIndex heading t False)) type,popup = Nothing}
    icon i = {LeafletIcon|iconId=LeafletIconID (toString i),iconUrl ="/ship-icons/"+++toString i+++".png",iconSize=(24,24)}
    iconIndex heading type selected = toString (cat type + ( (maybe 24 (\d -> toInt d / 15) heading) + (if selected 25 0)) * 5)
    toLeafletPerspective :: ContactMapPerspective -> LeafletPerspective
    toLeafletPerspective {ContactMapPerspective|center,zoom,cursor}
    = {LeafletPerspective|center=toLeafletLatLng center,zoom=zoom,cursor=fmap toLeafletLatLng cursor,bounds=Nothing}
    = {LeafletPerspective|center=toLeafletLatLng center,zoom=zoom,bounds=Nothing}
    toLeafletLatLng :: !LatLng -> LeafletLatLng
    toLeafletLatLng (lat,lng) = {LeafletLatLng | lat = toDeg lat, lng = toDeg lng}
    ......@@ -138,11 +138,11 @@ fromLeafletMap {LeafletMap|perspective,objects}
    ,markers=toMarkers objects}
    where
    toMarkers objects
    = [{ContactMapMarker|markerId=markerId,title=Nothing,position = fromLeafletLatLng position, type=Nothing,heading=Nothing,selected=selected}
    \\ Marker {LeafletMarker|markerId = LeafletObjectID markerId,position,selected} <- objects]
    = [{ContactMapMarker|markerId=markerId,title=Nothing,position = fromLeafletLatLng position, type=Nothing,heading=Nothing,selected=False}
    \\ Marker {LeafletMarker|markerId = LeafletObjectID markerId,position} <- objects]
    fromLeafletPerspective :: LeafletPerspective -> ContactMapPerspective
    fromLeafletPerspective {LeafletPerspective|center,cursor,zoom}
    = {ContactMapPerspective|center=fromLeafletLatLng center,zoom=zoom,cursor=fmap fromLeafletLatLng cursor}
    fromLeafletPerspective {LeafletPerspective|center,zoom}
    = {ContactMapPerspective|center=fromLeafletLatLng center,zoom=zoom,cursor=Nothing}
    Examples/GIS/LeafletMapExample.icl
    View file @ e463865a
    ......@@ -3,29 +3,39 @@ import iTasks
    import iTasks.Extensions.GIS.Leaflet
    import iTasks.Extensions.GIS.LeafletNavalIcons
    import iTasks.UI.Definition
    import Data.List, Text.HTML
    import StdFunctions, Data.List, Text.HTML
    playWithMaps :: Task ()
    playWithMaps = withShared {defaultValue & icons = shipIcons} (\m ->
    (allTasks [managePerspective m, manageMapObjects m])
    playWithMaps = withShared ({defaultValue & icons = shipIcons, tilesUrls = ["/tiles/{z}/{x}/{y}.png"]},defaultValue) (\m ->
    ((allTasks [managePerspective m, manageState m, manageMapObjects m]) <<@ ScrollContent)
    -&&-
    manipulateMap m
    ) <<@ ArrangeWithSideBar 0 LeftSide True @! ()
    manipulateMap :: (Shared sds LeafletMap) -> Task () | RWShared sds
    manipulateMap m = updateSharedInformation () [] m
    manipulateMap :: (Shared sds (LeafletMap,LeafletSimpleState)) -> Task () | RWShared sds
    manipulateMap m = updateSharedInformation () [UpdateUsing id (flip const) (customLeafletEditor eventHandlers)] m
    <<@ ApplyLayout (layoutSubUIs (SelectByPath [1]) (setUIAttributes (sizeAttr FlexSize FlexSize))) @! ()
    where
    eventHandlers = {simpleStateEventHandlers & onHtmlEvent = onHtmlEvent}
    onHtmlEvent "closewindows" (l,s) = ({LeafletMap|l & objects = [o \\ o <- l.LeafletMap.objects | not (o =: (Window _))]},s)
    onHtmlEvent _ (l,s) = (l,s)
    managePerspective :: (Shared sds (LeafletMap,LeafletSimpleState)) -> Task () | RWShared sds
    managePerspective m = updateSharedInformation (Title "Perspective") []
    (mapReadWrite (\(x,s) -> x.LeafletMap.perspective, \p (x,s) -> Just ({x & perspective = p},s)) Nothing m) @! ()
    managePerspective :: (Shared sds LeafletMap) -> Task () | RWShared sds
    managePerspective m = updateSharedInformation (Title "Perspective") [] (mapReadWrite (\x -> x.LeafletMap.perspective,\p x -> Just {x & perspective = p}) Nothing m) @! ()
    manageState :: (Shared sds (LeafletMap,LeafletSimpleState)) -> Task () | RWShared sds
    manageState m = updateSharedInformation (Title "State") []
    (mapReadWrite (\(x,s) -> s, \sn (x,s) -> Just (x,sn)) Nothing m) @! ()
    // objects can currently only be viewed, as the editor for `HtmlTag` only works in view mode
    manageMapObjects :: (Shared sds LeafletMap) -> Task () | RWShared sds
    manageMapObjects :: (Shared sds (LeafletMap,LeafletSimpleState)) -> Task () | RWShared sds
    manageMapObjects m = viewSharedInformation (Title "View objects") [ViewAs toPrj] m
    -|| addDemoObjects m
    @! ()
    where
    toPrj m = m.LeafletMap.objects
    toPrj (m,_) = m.LeafletMap.objects
    addDemoObjects m
    = enterChoiceAs "Add objects:" [ChooseFromCheckGroup fst] options snd
    ......@@ -43,10 +53,10 @@ where
    addRandomMarker m
    = get randomInt -&&- get randomInt @ toRandomMarker
    >>- \marker -> upd (\l=:{LeafletMap|objects} -> {LeafletMap|l & objects = objects ++ [marker]}) m
    >>- \marker -> upd (\(l=:{LeafletMap|objects},s) -> ({LeafletMap|l & objects = objects ++ [marker]},s)) m
    toRandomMarker (rLat,rLng)
    = Marker {markerId = LeafletObjectID markerId, position= {LeafletLatLng|lat = lat, lng = lng}, title = Just markerId, icon = Just icon, selected = False, popup = Nothing}
    = Marker {markerId = LeafletObjectID markerId, position= {LeafletLatLng|lat = lat, lng = lng}, title = Just markerId, icon = Just icon, popup = Nothing}
    where
    lat = 52.0 + (toReal (500 + (rLat rem 1000)) / 1000.0)
    lng = 6.0 + (toReal (500 + (rLng rem 1000)) / 1000.0)
    ......@@ -54,7 +64,7 @@ where
    icon = shipIconId (Just (rLat rem 360)) OrangeShip False
    addMarkerConnectingLine m
    = upd (\l=:{LeafletMap|objects} -> {LeafletMap|l & objects = objects ++ [line objects]}) m
    = upd (\(l=:{LeafletMap|objects},s) -> ({LeafletMap|l & objects = objects ++ [line objects]},s)) m
    where
    line objects = Polyline { polylineId = LeafletObjectID "markerConnection"
    , style = [Style (LineStrokeColor "#f0f"), Style (LineStrokeWidth 4)]
    ......@@ -64,7 +74,7 @@ where
    points objects = [position \\ Marker {LeafletMarker|position} <- objects]
    addMarkerConnectingPolygon m
    = upd (\l=:{LeafletMap|objects} -> {LeafletMap|l & objects = objects ++ [polygon objects]}) m
    = upd (\(l=:{LeafletMap|objects},s) -> ({LeafletMap|l & objects = objects ++ [polygon objects]},s)) m
    where
    polygon objects = Polygon { polygonId = LeafletObjectID "markerConnection"
    , style = [ Style (AreaLineStrokeColor "#000")
    ......@@ -77,31 +87,34 @@ where
    points objects = [position \\ Marker {LeafletMarker|position} <- objects]
    addMarkerAtCursor m
    = upd (\l=:{LeafletMap|perspective={LeafletPerspective|cursor},objects} -> {LeafletMap|l & objects = withMarkerFromCursor cursor objects}) m
    = upd (\(l=:{LeafletMap|objects},s=:{LeafletSimpleState|cursor}) -> ({LeafletMap|l & objects = withMarkerFromCursor cursor objects},s)) m
    where
    withMarkerFromCursor Nothing objects = objects
    withMarkerFromCursor (Just position) objects = objects ++ [Marker {markerId = LeafletObjectID "CURSOR", position= position, title = Nothing, icon = Nothing, selected = False, popup = Nothing}]
    withMarkerFromCursor (Just position) objects = objects ++ [Marker {markerId = LeafletObjectID "CURSOR", position= position, title = Nothing, icon = Nothing, popup = Nothing}]
    addCircleAtCursor m
    = upd (\l=:{LeafletMap|perspective={LeafletPerspective|cursor},objects} -> {LeafletMap|l & objects = withCircleFromCursor cursor objects}) m
    = upd (\(l=:{LeafletMap|objects},s=:{LeafletSimpleState|cursor}) -> ({LeafletMap|l & objects = withCircleFromCursor cursor objects},s)) m
    where
    withCircleFromCursor Nothing objects = objects
    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} -> {LeafletMap|l & objects = withRectangleAroundCurrentPerspective bounds objects}) m
    = upd (\(l=:{LeafletMap|perspective={LeafletPerspective|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 = []}]
    addWindow m
    = upd (\l=:{LeafletMap|objects} -> {LeafletMap| l & objects = [Window window:objects]}) m
    = upd (\(l=:{LeafletMap|objects},s) -> ({LeafletMap| l & objects = [Window window:objects]},s)) m
    where
    window =
    { windowId = LeafletObjectID "WINDOW"
    , initPosition = {x = 100, y = 100}
    , title = "Test Window"
    , content = H1Tag [] [Text "This is test content!"]
    , content = DivTag []
    [H1Tag [] [Text "This is test content!"]
    ,ATag [HrefAttr "#",OnclickAttr "itasks.htmlEvent(event, 'closewindows')"] [Text "Close windows"]
    ]
    , relatedMarkers = [(LeafletObjectID "home", [])]
    }
    ......
    Libraries/iTasks/Extensions/GIS/Leaflet.dcl
    View file @ e463865a
    ......@@ -2,20 +2,24 @@ definition module iTasks.Extensions.GIS.Leaflet
    import iTasks
    from Text.HTML import :: SVGElt
    from Data.Set import :: Set
    leafletEditor :: Editor LeafletMap
    //Customization of editors
    customLeafletEditor :: (LeafletEventHandlers s) -> Editor (LeafletMap, s) | iTask s
    :: LeafletMap =
    { perspective :: !LeafletPerspective
    , tilesUrls :: ![String]
    , objects :: ![LeafletObject] //Markers, lines and polygon
    , icons :: ![LeafletIcon] //Custom icons used by markers. They are indexed by 'iconId' string and cannot be changed once the map is loaded
    , icons :: ![LeafletIcon] //Custom icons used by markers. They are referenced using their 'iconId' string.
    }
    :: LeafletPerspective =
    { center :: !LeafletLatLng
    , zoom :: !Int
    , cursor :: !Maybe LeafletLatLng
    , bounds :: !Maybe LeafletBounds
    }
    ......@@ -51,9 +55,8 @@ leafletObjectIdOf :: !LeafletObject -> LeafletObjectID
    { markerId :: !LeafletObjectID
    , position :: !LeafletLatLng
    , title :: !Maybe String
    , icon :: !Maybe LeafletIconID// Id of the list of icons defined for the map
    , icon :: !Maybe LeafletIconID //Reference to an icon defined for this map
    , popup :: !Maybe HtmlTag
    , selected :: !Bool
    }
    :: LeafletPolyline =
    ......@@ -90,7 +93,7 @@ leafletObjectIdOf :: !LeafletObject -> LeafletObjectID
    , initPosition :: !LeafletWindowPos
    , title :: !String
    , content :: !HtmlTag
    , relatedMarkers :: ![(!LeafletObjectID, ![LeafletStyleDef LeafletLineStyle])] // connecting lines are drawn between the window and the markers
    , relatedMarkers :: ![(LeafletObjectID, [LeafletStyleDef LeafletLineStyle])] // connecting lines are drawn between the window and the markers
    // to visualise the relation
    }
    ......@@ -114,16 +117,35 @@ leafletObjectIdOf :: !LeafletObject -> LeafletObjectID
    :: LeafletWindowPos = { x :: !Int, y :: !Int }
    //Event handlers allow the customization of the map editor behaviour
    :: LeafletEventHandlers s =
    { onMapClick :: LeafletLatLng (LeafletMap,s) -> (LeafletMap,s)
    , onMarkerClick :: LeafletObjectID (LeafletMap,s) -> (LeafletMap,s)
    , onHtmlEvent :: String (LeafletMap,s) -> (LeafletMap,s)
    }
    //A minimal state for tracking a set of selected markers
    //and the last place that the map was clicked
    :: LeafletSimpleState =
    { cursor :: Maybe LeafletLatLng
    , selection :: [LeafletObjectID]
    }
    simpleStateEventHandlers :: LeafletEventHandlers LeafletSimpleState
    //Inline SVG based icons can be encoded as 'data uri's' which can be used instead of a url to an external icon image
    svgIconURL :: !SVGElt !(!Int,!Int) -> String
    //Public tileserver of openstreetmaps
    openStreetMapTiles :: String
    instance == LeafletObjectID
    instance == LeafletIconID
    derive JSONEncode LeafletMap, LeafletPerspective, LeafletLatLng
    derive JSONDecode LeafletMap, LeafletPerspective, LeafletLatLng
    derive gDefault LeafletMap, LeafletPerspective, LeafletLatLng
    derive gEq LeafletMap, LeafletPerspective
    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
    derive class iTask LeafletIcon, LeafletBounds, LeafletObject, LeafletMarker, LeafletPolyline, LeafletPolygon, LeafletWindow, LeafletWindowPos, LeafletLineStyle, LeafletStyleDef, LeafletAreaStyle, LeafletObjectID, LeafletSimpleState
    Libraries/iTasks/Extensions/GIS/Leaflet.icl
    View file @ e463865a
    ......@@ -4,7 +4,8 @@ import iTasks
    import iTasks.UI.Definition, iTasks.UI.Editor, iTasks.UI.JavaScript
    import StdMisc, Data.Tuple, Data.Error, Data.Func, Text, Data.Functor
    import qualified Data.Map as DM
    from Text.HTML import instance toString HtmlTag, instance toString SVGElt
    //from Text.HTML import instance toString HtmlTag, instance toString SVGElt
    import Text.HTML
    from Text.Encodings.Base64 import base64Encode
    from iTasks.UI.Editor.Common import diffChildren, :: ChildUpdate (..)
    import StdArray
    ......@@ -25,17 +26,11 @@ LEAFLET_CSS_WINDOW :== "leaflet-window.css"
    , zoomControl :: !Bool
    , editable :: !Bool
    }
    :: CursorOptions =
    { color :: !String
    , opacity :: !Real
    , radius :: !Int
    }
    derive JSONEncode IconOptions
    derive gToJS CursorOptions, MapOptions, LeafletLatLng
    derive gToJS MapOptions, LeafletLatLng
    CURSOR_OPTIONS :== {color = "#00f", opacity = 1.0, radius = 3}
    MAP_OPTIONS :== {attributionControl = False, zoomControl = True, editable = True}
    leafletObjectIdOf :: !LeafletObject -> LeafletObjectID
    ......@@ -50,13 +45,14 @@ leafletObjectIdOf (Window w) = w.windowId
    //Perspective
    = LDSetZoom !Int
    | LDSetCenter !LeafletLatLng
    | LDSetCursor !LeafletLatLng
    | LDSetBounds !LeafletBounds
    //Updating markers
    | LDSelectMarker !LeafletObjectID
    //Updating windows
    | LDRemoveWindow !LeafletObjectID
    | LDUpdateObject !LeafletObjectID !LeafletObjectUpdate
    //Events
    | LDMapClick !LeafletLatLng
    | LDMarkerClick !LeafletObjectID
    | LDHtmlEvent !String
    :: LeafletObjectUpdate
    = UpdatePolyline ![LeafletLatLng]
    ......@@ -74,7 +70,10 @@ openStreetMapTiles :: String
    openStreetMapTiles = "http://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png"
    leafletEditor :: Editor LeafletMap
    leafletEditor = leafEditorToEditor
    leafletEditor = leafEditorToEditor leafletEditor`
    leafletEditor` :: LeafEditor [LeafletEdit] LeafletMap LeafletMap
    leafletEditor` =
    { LeafEditor
    | genUI = withClientSideInit initUI genUI
    , onEdit = onEdit
    ......@@ -83,12 +82,11 @@ leafletEditor = leafEditorToEditor
    }
    where
    genUI attr dp mode world
    # val=:{LeafletMap|perspective={center,zoom,cursor},tilesUrls,objects,icons} =
    # val=:{LeafletMap|perspective={center,zoom},tilesUrls,objects,icons} =
    fromMaybe gDefault{|*|} $ editModeValue mode
    # mapAttr = 'DM'.fromList
    [("zoom", JSONInt zoom)
    ,("center", JSONArray [JSONReal center.LeafletLatLng.lat, JSONReal center.LeafletLatLng.lng])
    ,("cursor", maybe JSONNull toJSON cursor)
    ,("tilesUrls", toJSON tilesUrls)
    ,("icons", JSONArray [toJSON (iconId,{IconOptions|iconUrl=iconUrl,iconSize=[w,h]}) \\ {iconId,iconUrl,iconSize=(w,h)} <- icons])
    ]
    ......@@ -145,10 +143,7 @@ where
    //Set perspective
    # (center,world) = me .# "attributes.center" .? world
    # (zoom,world) = me .# "attributes.zoom" .? world
    # (cursor,world) = me .# "attributes.cursor" .? world
    # world = (mapObj .# "setView" .$! (center,zoom)) world
    //Set initial cursor
    # world = setMapCursor me mapObj cursor world
    //Add icons
    # world = setMapIcons me mapObj (me .# "attributes.icons") world
    //Create tile layer
    ......@@ -185,6 +180,8 @@ where
    # world = (vp .# "addChangeListener" .$! me) world
    # (cb,world) = jsWrapFun (\a w -> beforeRemove me w) me world
    # world = (me .# "beforeRemove" .= cb) world
    # (cb,world) = jsWrapFun (\a w -> onHtmlEvent me a w) me world
    # world = (me .# "onHtmlEvent" .= cb) world
    # world = case viewMode of
    True
    = world
    ......@@ -233,17 +230,15 @@ where
    # (editorId,world) = me .# "attributes.editorId" .? world
    # (mapObj,world) = args.[0] .# "target" .? world
    # (clickPos,world) = args.[0] .# "latlng" .? world
    # (cursor,world) = toLatLng clickPos world
    # edit = toJSON [LDSetCursor cursor]
    # (position,world) = toLatLng clickPos world
    # edit = toJSON [LDMapClick position]
    # world = (me .# "doEditEvent" .$! (taskId,editorId,edit)) world
    //Update cursor position on the map
    # world = setMapCursor me mapObj (toJS cursor) world
    = world
    onMarkerClick me markerId args world
    # (taskId,world) = me .# "attributes.taskId" .? world
    # (editorId,world) = me .# "attributes.editorId" .? world
    # edit = toJSON [LDSelectMarker markerId]
    # edit = toJSON [LDMarkerClick markerId]
    # world = (me .# "doEditEvent" .$! (taskId,editorId,edit)) world
    = world
    ......@@ -252,9 +247,20 @@ where
    = case jsValToString args.[0] of
    Just "center" = setMapCenter mapObj args.[1] world
    Just "zoom" = setMapZoom mapObj args.[1] world
    Just "cursor" = setMapCursor me mapObj args.[1] world
    Just "icons" = setMapIcons me mapObj args.[1] world
    _ = world
    onHtmlEvent me args world
    # (taskId,world) = me .# "attributes.taskId" .? world
    # (editorId,world) = me .# "attributes.editorId" .? world
    = case (jsValToString args.[0]) of
    Just event
    # edit = toJSON [LDHtmlEvent event]
    # world = (me .# "doEditEvent" .$! (taskId,editorId,edit)) world
    = world
    _ = world
    onAfterChildInsert viewMode me args world
    # (l, world) = jsGlobal "L" .? world
    # (mapObj,world) = me .# "map" .? world
    ......@@ -338,28 +344,6 @@ where
    # world = (mapObj .# "panTo" .$! center) world
    = world
    setMapCursor me mapObj position world
    # (cursor,world) = me .# "cursor" .? world
    | jsIsUndefined cursor
    | jsIsNull position //Nothing to do
    = world
    | otherwise
    //Create the cursor
    # (l, world) = jsGlobal "L" .? world
    # (cursor,world) = (l .# "circleMarker" .$ (position, CURSOR_OPTIONS)) world
    # world = (cursor .# "addTo" .$! mapObj) world
    # world = (me .# "cursor" .= cursor) world
    = world
    | otherwise //Update the position
    | jsIsNull position
    //Destroy the cursor
    # world = (mapObj .# "removeLayer" .$! cursor) world
    # world = jsDelete (me .# "cursor") world
    = world
    | otherwise
    # world = (cursor .# "setLatLng" .$! position) world
    = world
    addMapTilesLayer me mapObj _ tilesUrl world
    | jsIsNull tilesUrl = world
    # (l, world) = jsGlobal "L" .? world
    ......@@ -645,12 +629,7 @@ where
    where
    app m (LDSetZoom zoom) = {LeafletMap|m & perspective = {m.perspective & zoom = zoom}}
    app m (LDSetCenter center) = {LeafletMap|m & perspective = {LeafletPerspective| m.perspective & center = center}}
    app m (LDSetCursor cursor) = {LeafletMap|m & perspective = {m.perspective & cursor = Just cursor}}
    app m (LDSetBounds bounds) = {LeafletMap|m & perspective = {LeafletPerspective| m.perspective & bounds = Just bounds}}
    app m (LDSelectMarker markerId) = {LeafletMap|m & objects = map (sel markerId) m.LeafletMap.objects}
    where
    sel x (Marker m=:{LeafletMarker|markerId}) = Marker {LeafletMarker|m & selected = markerId === x}
    sel x o = o
    app m (LDRemoveWindow idToRemove) = {LeafletMap|m & objects = filter notToRemove m.LeafletMap.objects}
    where
    notToRemove (Window {windowId}) = windowId =!= idToRemove
    ......@@ -679,15 +658,15 @@ where
    # childChanges = diffChildren oldMap.LeafletMap.objects newMap.LeafletMap.objects updateFromOldToNew encodeUI
    = (Ok (ChangeUI attrChanges childChanges, newMap),vst)
    where
    //Only center, zoom and cursor are synced to the client, bounds are only synced from client to server
    diffAttributes {LeafletMap|perspective=p1} {LeafletMap|perspective=p2}
    //Only center and zoom are synced to the client, bounds are only synced from client to server
    diffAttributes {LeafletMap|perspective=p1,icons=i1} {LeafletMap|perspective=p2,icons=i2}
    //Center
    # center = if (p2.LeafletPerspective.center === p1.LeafletPerspective.center) [] [SetAttribute "center" (toJSON p2.LeafletPerspective.center)]
    //Zoom
    # zoom = if (p2.LeafletPerspective.zoom === p1.LeafletPerspective.zoom) [] [SetAttribute "zoom" (toJSON p2.LeafletPerspective.zoom)]
    //Cursor
    # cursor = if (p2.LeafletPerspective.cursor === p1.LeafletPerspective.cursor) [] [SetAttribute "cursor" (maybe JSONNull toJSON p2.LeafletPerspective.cursor)]
    = center ++ zoom ++ cursor
    //Icons
    # icons = if (i2 === i1) [] [SetAttribute "icons" (JSONArray [toJSON (iconId,{IconOptions|iconUrl=iconUrl,iconSize=[w,h]}) \\ {iconId,iconUrl,iconSize=(w,h)} <- i2])]
    = center ++ zoom ++ icons
    updateFromOldToNew :: !LeafletObject !LeafletObject -> ChildUpdate
    updateFromOldToNew (Window old) (Window new) | old.windowId === new.windowId && not (isEmpty changes) =
    ......@@ -714,18 +693,93 @@ gEditor{|LeafletMap|} = leafletEditor
    gDefault{|LeafletMap|}
    = {LeafletMap|perspective=defaultValue, tilesUrls = [openStreetMapTiles], objects = [Marker homeMarker], icons = []}
    where
    homeMarker = {markerId = LeafletObjectID "home", position= {LeafletLatLng|lat = 51.82, lng = 5.86}, title = Just "HOME", icon = Nothing, popup = Nothing, selected = False}
    homeMarker = {markerId = LeafletObjectID "home", position= {LeafletLatLng|lat = 51.82, lng = 5.86}, title = Just "HOME", icon = Nothing, popup = Nothing}
    gDefault{|LeafletPerspective|}
    = {LeafletPerspective|center = {LeafletLatLng|lat = 51.82, lng = 5.86}, zoom = 7, cursor = Nothing, bounds = Nothing}
    = {LeafletPerspective|center = {LeafletLatLng|lat = 51.82, lng = 5.86}, zoom = 7, bounds = Nothing}
    //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)
    simpleStateEventHandlers :: LeafletEventHandlers LeafletSimpleState
    simpleStateEventHandlers =
    { onMapClick = \position (l,s) -> (addCursorMarker position l,{LeafletSimpleState|s & cursor = Just position})
    , onMarkerClick = \markerId (l,s) -> (l,{LeafletSimpleState|s & selection = toggle markerId s.LeafletSimpleState.selection})
    , onHtmlEvent = \msg (l,s) -> (l,s)
    }
    where