implementation module GoogleMaps
import HTML, StdEnv, JSON, GenUpdate, GenVisualize, GenVerify
derive JSONEncode TUIGoogleMap, TUIGoogleMapOptions
derive JSONDecode MVCUpdate, ClickUpdate, ClickSource, ClickEvent, MarkerDragUpdate
derive gVisualizeText GoogleMapSettings, GoogleMapPerspective, GoogleMapPosition, GoogleMapMarker, GoogleMapInfoWindow, GoogleMapType
derive gVisualizeEditor GoogleMapSettings, GoogleMapPerspective, GoogleMapPosition, GoogleMapMarker, GoogleMapInfoWindow, GoogleMapType
derive gHeaders GoogleMap, GoogleMapSettings, GoogleMapPerspective, GoogleMapPosition, GoogleMapMarker, GoogleMapInfoWindow, GoogleMapType
derive gGridRows GoogleMap, GoogleMapSettings, GoogleMapPerspective, GoogleMapPosition, GoogleMapMarker, GoogleMapInfoWindow, GoogleMapType
derive gUpdate GoogleMapSettings, GoogleMapPerspective, GoogleMapPosition, GoogleMapMarker, GoogleMapInfoWindow, GoogleMapType
derive gDefaultMask GoogleMapSettings, GoogleMapPerspective, GoogleMapPosition, GoogleMapMarker, GoogleMapInfoWindow, GoogleMapType
derive gVerify GoogleMapSettings, GoogleMapPerspective, GoogleMapPosition, GoogleMapMarker, GoogleMapInfoWindow, GoogleMapType
derive JSONEncode GoogleMap, GoogleMapPerspective, GoogleMapSettings, GoogleMapMarker, GoogleMapInfoWindow, GoogleMapType
derive JSONDecode GoogleMap, GoogleMapPerspective, GoogleMapSettings, GoogleMapMarker, GoogleMapInfoWindow, GoogleMapType
derive gEq GoogleMap, GoogleMapPerspective, GoogleMapSettings, GoogleMapPosition, GoogleMapMarker, GoogleMapInfoWindow, GoogleMapType
JSONEncode{|GoogleMapPosition|} {lat,lng} = [JSONArray [JSONReal lat,JSONReal lng]]
JSONDecode{|GoogleMapPosition|} [JSONArray [JSONReal lat,JSONReal lng]:rest] = (Just {lat=lat,lng=lng},rest)
JSONDecode{|GoogleMapPosition|} [JSONArray [JSONInt lat,JSONReal lng]:rest] = (Just {lat=toReal lat,lng=lng},rest)
JSONDecode{|GoogleMapPosition|} [JSONArray [JSONReal lat,JSONInt lng]:rest] = (Just {lat=lat,lng=toReal lng},rest)
JSONDecode{|GoogleMapPosition|} [JSONArray [JSONInt lat,JSONInt lng]:rest] = (Just {lat=toReal lat,lng=toReal lng},rest)
JSONDecode{|GoogleMapPosition|} rest = (Nothing,rest)
:: MVCUpdate =
{ center :: !GoogleMapPosition
, zoom :: !Int
, type :: !GoogleMapType
}
:: ClickUpdate =
{ event :: !ClickEvent
, source :: !ClickSource
, point :: !GoogleMapPosition
}
:: ClickEvent = LEFTCLICK | RIGHTCLICK | DBLCLICK
:: ClickSource = MAP | MARKER GoogleMapPosition
:: MarkerDragUpdate =
{ index :: !Int
, point :: !GoogleMapPosition
}
:: TUIGoogleMap =
{ center :: GoogleMapPosition
, mapType :: GoogleMapType
, markers :: [GoogleMapMarker]
, xtype :: String
, taskId :: Maybe String
, name :: String
, editor :: Bool
, options :: TUIGoogleMapOptions
}
:: TUIGoogleMapOptions =
{ mapTypeControl :: Bool
, panControl :: Bool
, streetViewControl :: Bool
, zoomControl :: Bool
, scaleControl :: Bool
, scrollwheel :: Bool
, draggable :: Bool
, zoom :: Int
}
instance toString GoogleMapType
where
toString ROADMAP = "ROADMAP"
toString SATELLITE = "SATELLITE"
toString HYBRID = "HYBRID"
toString TERRAIN = "TERRAIN"
gVisualizeText{|GoogleMap|} _ _ = [""]
gVisualizeEditor{|GoogleMap|} mbMap vst = visualizeCustom mkControl vst
where
mkControl name _ _ _ vst=:{VSt|taskId}
= ([defaultDef (TUICustom ((mapPanel mbMap name True)))], vst)
where
mapPanel Nothing name ed = toJSON (tuidef defaultMap name ed)
mapPanel (Just map) name ed = toJSON (tuidef map name ed)
tuidef map name ed =
{ TUIGoogleMap
| center = map.perspective.GoogleMapPerspective.center
, mapType = map.perspective.GoogleMapPerspective.type
, markers = map.GoogleMap.markers
, xtype = "itasks-googlemap"
, name = name
, taskId = fmap toString taskId
, editor = ed
, options =
{ TUIGoogleMapOptions
| mapTypeControl = map.settings.GoogleMapSettings.mapTypeControl
, panControl = map.settings.GoogleMapSettings.panControl
, streetViewControl = map.settings.GoogleMapSettings.streetViewControl
, zoomControl = map.settings.GoogleMapSettings.zoomControl
, scaleControl = map.settings.GoogleMapSettings.scaleControl
, scrollwheel = map.settings.GoogleMapSettings.scrollwheel
, draggable = map.settings.GoogleMapSettings.draggable
, zoom = map.perspective.GoogleMapPerspective.zoom
}
}
gUpdate{|GoogleMap|} mode ust = basicUpdate mode parseUpdate defaultMap ust
where
parseUpdate json orig
# mbMVC = fromJSON json
| isJust mbMVC
# mvc = fromJust mbMVC
= {GoogleMap | orig & perspective = {GoogleMapPerspective|orig.perspective & center = mvc.MVCUpdate.center, zoom = mvc.MVCUpdate.zoom, type = mvc.MVCUpdate.type}}
# mbClick = fromJSON json
| isJust mbClick
# click = fromJust mbClick
# marker = {GoogleMapMarker | position = click.ClickUpdate.point, title = Nothing, icon = Nothing, infoWindow = Nothing, draggable = True, selected = False}
= {GoogleMap | orig & markers = orig.GoogleMap.markers ++ [marker]}
# mbMarkerDrag = fromJSON json
| isJust mbMarkerDrag
# {MarkerDragUpdate|index,point} = fromJust mbMarkerDrag
= {GoogleMap | orig & markers = [if (i == index) {GoogleMapMarker|m & position = point} m \\ m <- orig.GoogleMap.markers & i <- [0..]]}
| otherwise = orig
gDefaultMask{|GoogleMap|} _ = [Touched []]
gVerify{|GoogleMap|} _ vst = alwaysValid vst //Maps are always valid
// -- Utility Functions --
defaultMapPerspective :: GoogleMapPerspective
defaultMapPerspective =
{ GoogleMapPerspective
| type = ROADMAP
, center = {GoogleMapPosition|lat = 51.82, lng = 5.86}
, zoom = 10
}
defaultMapSettings :: GoogleMapSettings
defaultMapSettings =
{ GoogleMapSettings
| mapTypeControl = True
, panControl = True
, streetViewControl = True
, zoomControl = True
, scaleControl = True
, scrollwheel = True
, draggable = True
}
defaultMap :: GoogleMap
defaultMap = {GoogleMap|perspective = defaultMapPerspective, settings = defaultMapSettings, markers = []}
minimalMapSettings :: GoogleMapSettings
minimalMapSettings =
{ GoogleMapSettings
| mapTypeControl = False
, panControl = False
, streetViewControl = False
, zoomControl = False
, scaleControl = False
, scrollwheel = False
, draggable = False
}
minimalMap :: GoogleMap
minimalMap = {GoogleMap|perspective = defaultMapPerspective, settings = minimalMapSettings, markers = []}