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

Resolve "Leaflet maps: extended interaction possibilities"

Closes #285

See merge request !281

Examples/Applications/Incidone/Incidone/ContactPosition.icl

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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/UI/WebPublic/js/itasks-core.js

-//Test script for new itasks embedding style
+//Global itasks namespace
 itasks = {};
 
-//auxiliary definitions for sending Maybe values to server
+//Auxiliary definitions for sending Maybe values to server
 const Nothing = ["Nothing"];
 function Just(x) { return["Just", x]; }
 
+//Global lookup table of itask components indexed by their dom element.
+//This makes it possible to find the managing itask component object for arbitrary dom elements.
+//Because it is a WeakMap, we can register components without having to unregister them.
+itasks.components = new WeakMap();
+
 //Core behavior
 itasks.Component = {
 
@@ -32,6 +37,7 @@ itasks.Component = {
 			.then(me.initComponent.bind(me))
 			.then(me.initChildren.bind(me))
 			.then(me.renderComponent.bind(me))
+			.then(me.registerComponent.bind(me))
 			.then(function(){ me.initialized=true; });
 	},
 	initUI: function() {
@@ -92,6 +98,11 @@ itasks.Component = {
 			}
 		});
 	},
+	registerComponent: function() {
+		if(this.domEl !== null) {
+			itasks.components.set(this.domEl,this);
+		}	
+	},
 	initDOMEl: function() {},
 
 	initDOMElSize: function() {
@@ -330,6 +341,8 @@ itasks.Component = {
 	onResize: function() {
 		this.children.forEach(function(child) { if(child.onResize) {child.onResize();}});
 	},
+	onHtmlEvent: function(msg) { //Abstract
+	},
 	getViewport: function() {
 		var me = this, vp = me.parentCmp;
 		while(vp) {
@@ -674,3 +687,17 @@ itasks.ConnectionPool = {
 	}
 };
 
+//Global functions that you can use to trigger edit events from pieces of html code displayed by components
+itasks.htmlEvent = function(event, msg) {
+	var domEl = event.target;
+	var component = null;
+
+	event.preventDefault();
+
+	while(domEl !== null && (component = itasks.components.get(domEl)) == null) {
+		domEl = domEl.parentElement;
+	}
+	if(component !== null) {
+		component.onHtmlEvent(msg);
+	}
+}