module OpenLayers.Func where
import Prelude hiding (void)
import JQuery
import Fay.Text hiding (head, tail, map)
import OpenLayers.Html
import OpenLayers.Internal
import OpenLayers.Types
import Fay.FFI
newLayerMqt :: String
-> Object
newLayerMqt = ffi "new ol.layer.Tile({source: new ol.source.MapQuest({layer: %1})})"
newLayerOSM :: Object
newLayerOSM = ffi "new ol.layer.Tile({source: new ol.source.OSM()})"
newVector :: Object
-> Opacity
-> Fay Object
newVector = ffi "new ol.layer.Vector({source: %1, opacity: %2.slot1*0.01})"
newFeature :: GeoFeature -> Fay Object
newFeature f = case f of
GeoPoint p id s -> newFeaturePoint $ transformPoint p
GeoLine pts id s -> newFeatureLine $ transformPoints pts
_ -> error "newStyledFeature: the GeoFeature is not implemented yet"
newFeatureLine :: [(Double, Double)]
-> Fay Object
newFeatureLine = ffi "new ol.source.GeoJSON({object:{'type':'Feature','geometry':{'type':'LineString','coordinates': %1}}})"
newFeaturePoint :: (Double, Double)
-> Fay Object
newFeaturePoint = ffi "new ol.source.GeoJSON({object:{'type':'Feature','geometry':{'type':'Point','coordinates': %1}}})"
newLineStyle :: GeoLineStyle -> Object
newLineStyle = ffi "[new ol.style.Style({stroke: new ol.style.Stroke({color: %1.color, width: %1.width})})]"
newPointStyle :: GeoPointStyle -> Object
newPointStyle = ffi "[new ol.style.Style({image: new ol.style.Circle({radius: %1.radius, fill: new ol.style.Fill({color:(%1.fillcolor == 'null' ? 'rgba(0,0,0,0)' : %1.fillcolor)}), stroke: %1.outcolor == 'null' ? null : new ol.style.Stroke({color: %1.outcolor, width: %1.outwidth})})})]"
newOlInput :: JQuery
-> String
-> Object
-> String
-> Fay ()
newOlInput = ffi "(new ol.dom.Input(%1[0])).bindTo(%2, %3, %4)"
addSingleClickEventAlertCoo :: String
-> Fay ()
addSingleClickEventAlertCoo = ffi "olc.on('singleclick', function (evt) {alert(%1 + ': ' + ol.proj.transform([evt.coordinate[0], evt.coordinate[1]], 'EPSG:3857', %1) + '\\nEPSG:3857: ' + evt.coordinate)})"
addBaseLayer :: MapSource -> Fay ()
addBaseLayer s = void $ do
removeLayers
addMapLayer s
addMapLayer :: MapSource -> Fay ()
addMapLayer s
| s == OSM = addLayer newLayerOSM
| Prelude.any(s==)mapQuests = addLayer ( newLayerMqt $ showMapSource s)
| otherwise = error ("wrong MapSource allowed is OSM and " ++ show mapQuests)
addLayer :: Object -> Fay ()
addLayer = ffi "olc.addLayer(%1)"
addStyledFeature :: GeoFeature
-> Opacity
-> Fay ()
addStyledFeature f o = do
feature <- newFeature f
styleFeature feature f
setFeatureId feature f
vector <- newVector feature o
addLayer vector
addStyledFeatures :: [GeoFeature]
-> Opacity
-> Fay ()
addStyledFeatures f o = do
features <- mapS newFeature f
zipWithS styleFeature features f
zipWithS setFeatureId features f
vectors <- zipWithS newVector features [ o | x <- [0..(Prelude.length features)1]]
addLayer (head vectors)
sources <- return $ zipWith getVectorFeatureAt ( vectors) [ 0 | x <- [0..(Prelude.length features)1]]
addFeatures (head vectors) (tail sources)
addFeatures :: Object
-> [Object]
-> Fay ()
addFeatures = ffi "%1.getSource().addFeatures(%2)"
addPointFromLabels :: String
-> String
-> String
-> String
-> GeoPointStyle
-> Fay ()
addPointFromLabels xId yId oId idId s = void $ do
xinput <- selectId xId
xcoor <- getVal xinput
yinput <- selectId yId
ycoor <- getVal yinput
o <- getInputInt oId
i <- getInputInt idId
addStyledFeature (GeoPoint (Coordinate (toDouble xcoor) (toDouble ycoor) (Projection "EPSG:3857")) i s) (Opacity o)
addMapWindowEvent :: String
-> Fay JQuery
-> Fay ()
addMapWindowEvent = ffi "olc.on(%1, %2)"
addOlDomInput :: String
-> String
-> String
-> Object
-> Fay ()
addOlDomInput id typehtml value method = void $ do
element <- selectId id
newOlInput element typehtml method value
removeLayers :: Fay ()
removeLayers = void $ do
layers <- getLayers
mapM removeLayer layers
removeLayer :: a
-> Fay ()
removeLayer = ffi "olc.removeLayer(%1)"
zoomIn :: Integer
-> Fay ()
zoomIn = ffi "olc.getView().setZoom(olc.getView().getZoom()+%1)"
zoomOut :: Integer
-> Fay ()
zoomOut = ffi "olc.getView().setZoom(olc.getView().getZoom()-%1)"
styleFeature :: Object
-> GeoFeature
-> Fay ()
styleFeature object feature = case feature of
GeoPoint p id s -> styleFeature' object $ newPointStyle s
GeoLine pts id s -> styleFeature' object $ newLineStyle s
_ -> error "styleFeature: the GeoFeature is not implemented"
styleFeature' :: Object -> Object -> Fay ()
styleFeature' = ffi "%1.getFeatures()[0].setStyle(%2)"
changeBaseLayer :: MapSource
-> Fay ()
changeBaseLayer s = void $ do
layers <- getLayers
addBaseLayer s
mapS addLayer $ tail layers
setId :: Object
-> Integer
-> Integer
-> Fay ()
setId = ffi "(%2 < 1 || %3 < 0) ? '' : %1.getSource().getFeatures()[%3].setId(%2)"
setFeatureId :: Object
-> GeoFeature
-> Fay ()
setFeatureId = ffi "%1.getFeatures()[0].setId(%2.id)"
setCenter :: Coordinate -> Fay ()
setCenter c = setCenter' $ transformPoint c
setCenter' :: (Double, Double) -> Fay ()
setCenter' = ffi "olc.getView().setCenter(%1)"
setCenterZoom :: Coordinate
-> Integer
-> Fay ()
setCenterZoom c z = void $ do
setCenter c
setZoom z
setZoom :: Integer -> Fay ()
setZoom = ffi "olc.getView().setZoom(%1)"
getCenter :: Projectionlike
-> Integer
-> Fay Text
getCenter proj fixed = do
c <- getCenter'
coordFixed (transformPointTo proj c) fixed
getCenter' :: Fay (Double, Double)
getCenter' = ffi "olc.getView().getCenter()"
getZoom :: Fay Text
getZoom = ffi "olc.getView().getZoom()"
getLayers :: Fay [Object]
getLayers = ffi "olc.getLayers().getArray()"
getLayerByIndex :: Integer -> Object
getLayerByIndex = ffi "olc.getLayers().item(%1)"
getLayerByIndex' :: Integer -> Fay Object
getLayerByIndex' = ffi "olc.getLayers().item(%1)"
getFeatureId :: Object
-> Integer
getFeatureId = ffi "%1.getId()"
getVectorFeatureAt :: Object
-> Integer
-> Object
getVectorFeatureAt = ffi "%1.getSource().getFeatures()[%2]"
getVectorFeatureLength :: Object
-> Integer
getVectorFeatureLength = ffi "%1.getSource().getFeatures().length"
transformPointTo :: Projectionlike
-> (Double, Double)
-> (Double, Double)
transformPointTo = ffi "ol.proj.transform(%2, 'EPSG:3857', %1.slot1)"
transformPoint :: Coordinate
-> (Double, Double)
transformPoint = ffi "ol.proj.transform([%1.x, %1.y], %1.from.slot1, 'EPSG:3857')"
transformPoints :: [Coordinate] -> [(Double, Double)]
transformPoints c = [transformPoint x | x <- c]
coordFixed :: (Double, Double) -> Integer -> Fay Text
coordFixed = ffi "%1[0].toFixed(%2) + ',' + %1[1].toFixed(%2)"
toDouble :: Text -> Double
toDouble = ffi "%1"
mapS :: (a -> Fay b) -> [a] -> Fay [b]
mapS f x = sequence (map f x)
zipWithS :: (a -> b -> Fay c) -> [a] -> [b] -> Fay [c]
zipWithS f x y = sequence $ zipWith f x y