Commit e463865a authored by Steffen Michels's avatar Steffen Michels

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
......@@ -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)
......
......@@ -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)
......
......@@ -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}
......@@ -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", [])]
}
......
......@@ -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
This diff is collapsed.
//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);
}
}
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