diff --git a/Demo.pb b/Demo.pb index bd14ea6..b3630fb 100644 --- a/Demo.pb +++ b/Demo.pb @@ -33,8 +33,6 @@ XIncludeFile "PBMap.pb" -InitNetwork() - CompilerIf #PB_Compiler_Thread = #False MessageRequester("Warning !", "You must enable 'Create ThreadSafe Executable' in compiler options", #PB_MessageRequester_Ok ) End @@ -70,6 +68,7 @@ Enumeration #Gdt_Degrees #Gdt_EditMode #Gdt_ClearDiskCache + #Gdt_TestClusters #TextGeoLocationQuery #StringGeoLocationQuery EndEnumeration @@ -85,6 +84,40 @@ Structure Location Latitude.d EndStructure +; ============================================================================= +; SECTION : Constantes de demo clustering +; OBJECTIF : Centraliser les coordonnees d'Eragny pour le test +; POURQUOI : Faciliter le reglage et la maintenance +; ============================================================================= +#ERAGNY_LAT = 49.0176 +#ERAGNY_LON = 2.0979 + +; ============================================================================= +; SECTION : Test clustering +; OBJECTIF : Generer un nuage de marqueurs autour d'Eragny +; POURQUOI : Visualiser et valider le clustering +; COMMENT : Distribution simple autour du centre +; ============================================================================= +Procedure AddClusterTestMarkers(MapGadget.i) + Protected i.i + Protected Lat.d, Lon.d + + PBMap::ClearMarkers(MapGadget) + PBMap::SetOption(MapGadget, "EnableClusters", "1") + PBMap::SetOption(MapGadget, "ClusterPixelSize", "60") + PBMap::SetOption(MapGadget, "ClusterMinCount", "2") + + PBMap::SetLocation(MapGadget, #ERAGNY_LAT, #ERAGNY_LON, 13) + + For i = 0 To 49 + Lat = #ERAGNY_LAT + (Random(100) - 50) / 10000.0 + Lon = #ERAGNY_LON + (Random(100) - 50) / 10000.0 + PBMap::AddMarker(MapGadget, Lat, Lon, "", "Cluster", RGBA(Random(255), Random(255), Random(255), 255)) + Next + + PBMap::Refresh(MapGadget) +EndProcedure + Procedure UpdateLocation(*Location.Location) SetGadgetText(#StringLatitude, StrD(*Location\Latitude)) SetGadgetText(#StringLongitude, StrD(*Location\Longitude)) @@ -169,6 +202,7 @@ Procedure ResizeAll() ResizeGadget(#Gdt_Degrees, WindowWidth(#Window_0)-170, #PB_Ignore, #PB_Ignore, #PB_Ignore) ResizeGadget(#Gdt_EditMode, WindowWidth(#Window_0)-170, #PB_Ignore, #PB_Ignore, #PB_Ignore) ResizeGadget(#Gdt_ClearDiskCache, WindowWidth(#Window_0)-170, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ResizeGadget(#Gdt_TestClusters, WindowWidth(#Window_0)-170, #PB_Ignore, #PB_Ignore, #PB_Ignore) ResizeGadget(#TextGeoLocationQuery, WindowWidth(#Window_0)-170, #PB_Ignore, #PB_Ignore, #PB_Ignore) ResizeGadget(#StringGeoLocationQuery, WindowWidth(#Window_0)-170, #PB_Ignore, #PB_Ignore, #PB_Ignore) PBMap::Refresh(#Map) @@ -205,8 +239,9 @@ If OpenWindow(#Window_0, 260, 225, 700, 571, "PBMap", #PB_Window_SystemMenu | #P ButtonGadget(#Gdt_Degrees, 530, 420, 150, 30, "Show/Hide Degrees", #PB_Button_Toggle) ButtonGadget(#Gdt_EditMode, 530, 450, 150, 30, "Edit mode ON/OFF", #PB_Button_Toggle) ButtonGadget(#Gdt_ClearDiskCache, 530, 480, 150, 30, "Clear disk cache", #PB_Button_Toggle) - TextGadget(#TextGeoLocationQuery, 530, 515, 150, 15, "Enter an address") - StringGadget(#StringGeoLocationQuery, 530, 530, 150, 20, "") + ButtonGadget(#Gdt_TestClusters, 530, 510, 150, 30, "Test clusters Eragny") + TextGadget(#TextGeoLocationQuery, 530, 545, 150, 15, "Enter an address") + StringGadget(#StringGeoLocationQuery, 530, 560, 150, 20, "") SetActiveGadget(#StringGeoLocationQuery) AddKeyboardShortcut(#Window_0, #PB_Shortcut_Return, #MenuEventGeoLocationStringEnter) ; *** TODO : code to remove when the SetActiveGadget(-1) will be fixed @@ -341,6 +376,8 @@ If OpenWindow(#Window_0, 260, 225, 700, 571, "PBMap", #PB_Window_SystemMenu | #P EndIf Case #Gdt_ClearDiskCache PBMap::ClearDiskCache(#Map) + Case #Gdt_TestClusters + AddClusterTestMarkers(#Map) Case #StringGeoLocationQuery Select EventType() Case #PB_EventType_Focus @@ -373,8 +410,9 @@ If OpenWindow(#Window_0, 260, 225, 700, 571, "PBMap", #PB_Window_SystemMenu | #P EndIf -; IDE Options = PureBasic 5.73 LTS (Windows - x64) -; CursorPosition = 7 +; IDE Options = PureBasic 6.21 (Windows - x64) +; CursorPosition = 35 +; FirstLine = 31 ; Folding = -- ; EnableThread -; EnableXP \ No newline at end of file +; EnableXP diff --git a/PBMap.pb b/PBMap.pb index 38e4767..a75b11c 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -41,7 +41,6 @@ CompilerEndIf EnableExplicit -InitNetwork() UsePNGImageDecoder() UseJPEGImageDecoder() UsePNGImageEncoder() @@ -52,7 +51,7 @@ UseJPEGImageEncoder() DeclareModule PBMap #PBMAPNAME = "PBMap" - #PBMAPVERSION = "0.91" + #PBMAPVERSION = "0.98" #USERAGENT = #PBMAPNAME + "/" + #PBMAPVERSION + " (https://github.com/djes/PBMap)" CompilerIf #PB_Compiler_OS = #PB_OS_Linux @@ -97,7 +96,7 @@ DeclareModule PBMap Declare.s GetOption(MapGadget.i, Option.s) Declare LoadOptions(MapGadget.i, PreferencesFile.s = "PBMap.prefs") Declare SaveOptions(MapGadget.i, PreferencesFile.s = "PBMap.prefs") - Declare.i AddOSMServerLayer(MapGadget.i, LayerName.s, Order.i, ServerURL.s = "http://tile.openstreetmap.org/") + Declare.i AddOSMServerLayer(MapGadget.i, LayerName.s, Order.i, ServerURL.s = "https://tile.openstreetmap.org/") Declare.i AddHereServerLayer(MapGadget.i, LayerName.s, Order.i, APP_ID.s = "", APP_CODE.s = "", ServerURL.s = "aerial.maps.api.here.com", path.s = "/maptile/2.1/", ressource.s = "maptile", id.s = "newest", scheme.s = "satellite.day", format.s = "jpg", lg.s = "eng", lg2.s = "eng", param.s = "") Declare.i AddGeoServerLayer(MapGadget.i, LayerName.s, Order.i, ServerLayerName.s, ServerURL.s = "http://localhost:8080/", path.s = "geowebcache/service/gmaps", format.s = "image/png") Declare IsLayer(MapGadget.i, Name.s) @@ -156,7 +155,7 @@ Module PBMap Prototype.i ProtoDrawTile(x.i, y.i, image.i, alpha.d = 1) Prototype.s ProtoModifyTileFile(Filename.s, OriginalURL.s) - + ;-*** Internal Structures Structure PixelCoordinates @@ -180,6 +179,7 @@ Module PBMap Size.i Window.i ; Parent Window Gadget.i + *PBMap.PBMap ; Back-reference for cooperative shutdown EndStructure Structure BoundingBox @@ -251,6 +251,9 @@ Module PBMap ShowMarkersNb.i ShowMarkersLegend.i ShowTrackSelection.i ; YA to show or not track selection + EnableClusters.i ; Enable marker clustering + ClusterPixelSize.i ; Cluster size in pixels (screen grid) + ClusterMinCount.i ; Min markers to display a cluster ; Drawing stuff StrokeWidthTrackDefault.i ; Colours @@ -292,6 +295,30 @@ Module PBMap x2.i y2.i EndStructure + + ; --------------------------------------------------------------------------- + ; SECTION : Clustering des marqueurs + ; OBJECTIF : Regrouper les marqueurs proches pour la lisibilite + ; POURQUOI : Eviter la surcharge visuelle a faible zoom + ; COMMENT : Regroupement par grille en pixels ecran + ; --------------------------------------------------------------------------- + Structure Cluster + CenterX.d + CenterY.d + CenterLat.d + CenterLon.d + SumX.d + SumY.d + SumLat.d + SumLon.d + Count.i + CellX.i + CellY.i + MarkerX.d + MarkerY.d + *Marker.Marker + Focus.i + EndStructure Structure Tracks List Track.GeographicCoordinates() ; To display a GPX track @@ -347,15 +374,26 @@ Module PBMap List TracksList.Tracks() ; To display a GPX track List Markers.Marker() ; To diplay marker + List Clusters.Cluster() ; Marker clusters (computed each draw) EditMarker.l ImgLoading.i ; Image Loading Tile ImgNothing.i ; Image Nothing Tile Options.option ; Options + StopDownloads.b ; Stop flag for cooperative thread shutdown EndStructure + + ; --------------------------------------------------------------------------- + ; SECTION : Declarations internes + ; OBJECTIF : Permettre l'appel de procedures definies plus bas + ; POURQUOI : Eviter les erreurs de compilation sur l'ordre des procedures + ; --------------------------------------------------------------------------- + + + ;-*** Module's global variables ;-Show debug infos @@ -396,7 +434,7 @@ Module PBMap EndIf End EndProcedure - + ; Shows an error msg Procedure Error(MapGadget, msg.s) Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) @@ -443,6 +481,12 @@ Module PBMap EndMacro CompilerEndSelect + ; --------------------------------------------------------------------------- + ; SECTION : Creation de dossiers en cascade + ; OBJECTIF : Creer un chemin complet sans echec sur les sous-dossiers + ; POURQUOI : Le cache doit toujours disposer d'un chemin valide + ; COMMENT : Creation progressive + verification de chaque niveau + ; --------------------------------------------------------------------------- Procedure CreateDirectoryEx(DirectoryName.s, FileAttribute = #PB_Default) Protected i, c, tmp.s If Right(DirectoryName, 1) = slash @@ -463,6 +507,40 @@ Module PBMap ProcedureReturn #True EndIf EndProcedure + + ; --------------------------------------------------------------------------- + ; SECTION : Validation de chemin de cache + ; OBJECTIF : Eviter la suppression de dossiers critiques (racine) + ; POURQUOI : ClearDiskCache() utilise une suppression recursive dangereuse + ; COMMENT : Rejeter les chemins vides ou de type racine + ; --------------------------------------------------------------------------- + Procedure.b IsSafeCachePath(Path.s) + Protected Normalized.s = Trim(Path) + + If Normalized = "" + ProcedureReturn #False + EndIf + + While Right(Normalized, 1) = slash + Normalized = Left(Normalized, Len(Normalized) - 1) + Wend + + If Normalized = "" + ProcedureReturn #False + EndIf + + CompilerIf #PB_Compiler_OS = #PB_OS_Windows + If Len(Normalized) <= 3 And Mid(Normalized, 2, 1) = ":" + ProcedureReturn #False + EndIf + CompilerElse + If Normalized = "/" + ProcedureReturn #False + EndIf + CompilerEndIf + + ProcedureReturn #True + EndProcedure Procedure TechnicalImagesCreation(MapGadget.i) Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) @@ -714,6 +792,188 @@ Module PBMap ProcedureReturn "$" + StrU(Red(Value), #PB_Byte) + StrU(Green(Value), #PB_Byte) + StrU(Blue(Value), #PB_Byte) EndProcedure + ;-*** Cluster + ; --------------------------------------------------------------------------- + ; SECTION : Dessin d'un cluster + ; OBJECTIF : Afficher un regroupement de marqueurs + ; POURQUOI : Representer visuellement plusieurs points proches + ; COMMENT : Cercle avec degrade continu + compteur + ; --------------------------------------------------------------------------- + Procedure DrawCluster(MapGadget.i, *Cluster.Cluster) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) + Protected Radius.i + Protected Text.s = Str(*Cluster\Count) + Protected Width.d + Protected Height.d + Protected t.d + Protected r.i, g.i, b.i + Protected MaxCount.i = 50 + + ; Degrade continu (petit -> grand) avec compression logarithmique + t = Log(*Cluster\Count + 1) / Log(MaxCount + 1) + If t > 1.0 + t = 1.0 + EndIf + If t < 0.0 + t = 0.0 + EndIf + + ; Rayon max 22 => diametre max 44 px + Radius = 8 + Int(14 * t) + + ; Couleur du bleu vers le rouge + r = Int(40 + 200 * t) + g = Int(160 - 120 * t) + b = Int(220 - 200 * t) + VectorSourceColor(RGBA(r, g, b, 220)) + AddPathCircle(*Cluster\CenterX, *Cluster\CenterY, Radius) + FillPath() + + If *Cluster\Focus + VectorSourceColor(RGBA(255, 255, 255, 200)) + AddPathCircle(*Cluster\CenterX, *Cluster\CenterY, Radius + 2) + StrokePath(2) + EndIf + + VectorFont(FontID(*PBMap\StandardFont), 14) + VectorSourceColor(RGBA(255, 255, 255, 255)) + Width = VectorTextWidth(Text) + Height = VectorTextHeight(Text) + MovePathCursor(*Cluster\CenterX - Width / 2, *Cluster\CenterY - Height / 2) + DrawVectorText(Text) + EndProcedure + + ; --------------------------------------------------------------------------- + ; SECTION : Construction des clusters + ; OBJECTIF : Regrouper les marqueurs selon une grille en pixels ecran + ; POURQUOI : Minimiser le chevauchement des marqueurs + ; COMMENT : Map de cellules -> pointeur de cluster + ; --------------------------------------------------------------------------- + Procedure BuildClusters(MapGadget.i, *Drawing.DrawingParameters) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) + Protected Pixel.PixelCoordinates + Protected cellX.i, cellY.i, key.s + Protected *Cluster.Cluster + Protected NewMap ClusterIndex.i() + + ClearList(*PBMap\Clusters()) + + If *PBMap\Options\EnableClusters = #False + ProcedureReturn + EndIf + If *PBMap\Options\ClusterPixelSize <= 0 + ProcedureReturn + EndIf + + ForEach *PBMap\Markers() + If IsInDrawingPixelBoundaries(MapGadget, *Drawing, @*PBMap\Markers()\GeographicCoordinates) + LatLon2PixelRel(MapGadget, @*PBMap\Markers()\GeographicCoordinates, @Pixel, *PBMap\Zoom) + cellX = Int(Pixel\x / *PBMap\Options\ClusterPixelSize) + cellY = Int(Pixel\y / *PBMap\Options\ClusterPixelSize) + key = Str(cellX) + ":" + Str(cellY) + If FindMapElement(ClusterIndex(), key) + *Cluster = ClusterIndex() + Else + AddElement(*PBMap\Clusters()) + *Cluster = @*PBMap\Clusters() + *Cluster\Count = 0 + *Cluster\Focus = #False + *Cluster\CellX = cellX + *Cluster\CellY = cellY + ClusterIndex() = *Cluster + EndIf + + *Cluster\Count + 1 + *Cluster\SumX + Pixel\x + *Cluster\SumY + Pixel\y + *Cluster\SumLat + *PBMap\Markers()\GeographicCoordinates\Latitude + *Cluster\SumLon + *PBMap\Markers()\GeographicCoordinates\Longitude + + If *Cluster\Count = 1 + *Cluster\Marker = @*PBMap\Markers() + *Cluster\MarkerX = Pixel\x + *Cluster\MarkerY = Pixel\y + Else + *Cluster\Marker = 0 + EndIf + EndIf + Next + + ForEach *PBMap\Clusters() + If *PBMap\Clusters()\Count > 0 + *PBMap\Clusters()\CenterX = *PBMap\Clusters()\SumX / *PBMap\Clusters()\Count + *PBMap\Clusters()\CenterY = *PBMap\Clusters()\SumY / *PBMap\Clusters()\Count + *PBMap\Clusters()\CenterLat = *PBMap\Clusters()\SumLat / *PBMap\Clusters()\Count + *PBMap\Clusters()\CenterLon = *PBMap\Clusters()\SumLon / *PBMap\Clusters()\Count + EndIf + Next + EndProcedure + + ; --------------------------------------------------------------------------- + ; SECTION : Detection de cluster sous la souris + ; OBJECTIF : Identifier un cluster dans les coordonnees ecran + ; POURQUOI : Synchroniser le survol et les clics avec le rendu + ; COMMENT : Test de distance sur le centre de cluster + ; --------------------------------------------------------------------------- + Procedure.i FindClusterAt(MapGadget.i, MouseX.d, MouseY.d) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) + Protected Radius.i + Protected cellX.i + Protected cellY.i + + If *PBMap\Options\ClusterPixelSize <= 0 + ProcedureReturn 0 + EndIf + + cellX = Int(MouseX / *PBMap\Options\ClusterPixelSize) + cellY = Int(MouseY / *PBMap\Options\ClusterPixelSize) + + ForEach *PBMap\Clusters() + If *PBMap\Clusters()\CellX = cellX And *PBMap\Clusters()\CellY = cellY + Radius = 10 + Min(20, *PBMap\Clusters()\Count) + If Distance(*PBMap\Clusters()\CenterX, *PBMap\Clusters()\CenterY, MouseX, MouseY) <= Radius + ProcedureReturn @*PBMap\Clusters() + EndIf + EndIf + Next + + ProcedureReturn 0 + EndProcedure + + ; --------------------------------------------------------------------------- + ; SECTION : Test d'appartenance a un cluster + ; OBJECTIF : Savoir si un marqueur est masqué par un cluster + ; POURQUOI : Eviter la selection d'un marqueur non visible + ; COMMENT : Recalcule la cellule du marqueur et compare aux clusters + ; --------------------------------------------------------------------------- + Procedure.b IsMarkerClustered(MapGadget.i, *Marker.Marker) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) + Protected Pixel.PixelCoordinates + Protected cellX.i, cellY.i + + If *PBMap\Options\EnableClusters = #False + ProcedureReturn #False + EndIf + If *PBMap\Options\ClusterPixelSize <= 0 + ProcedureReturn #False + EndIf + + LatLon2PixelRel(MapGadget, @*Marker\GeographicCoordinates, @Pixel, *PBMap\Zoom) + cellX = Int(Pixel\x / *PBMap\Options\ClusterPixelSize) + cellY = Int(Pixel\y / *PBMap\Options\ClusterPixelSize) + + ForEach *PBMap\Clusters() + If *PBMap\Clusters()\CellX = cellX And *PBMap\Clusters()\CellY = cellY + If *PBMap\Clusters()\Count >= *PBMap\Options\ClusterMinCount + ProcedureReturn #True + EndIf + Break + EndIf + Next + + ProcedureReturn #False + EndProcedure + ;-*** Options Procedure SetOptions(MapGadget.i) @@ -793,6 +1053,12 @@ Module PBMap SelBool(ShowMarkersNb) Case "showmarkerslegend" SelBool(ShowMarkersLegend) + Case "enableclusters" + SelBool(EnableClusters) + Case "clusterpixelsize" + *PBMap\Options\ClusterPixelSize = Val(Value) + Case "clustermincount" + *PBMap\Options\ClusterMinCount = Val(Value) Case "showtrackkms" SelBool(ShowTrackKms) Case "strokewidthtrackdefault" @@ -867,8 +1133,14 @@ Module PBMap ProcedureReturn GetBoolString(\ShowTrackSelection) Case "showmarkersnb" ProcedureReturn GetBoolString(\ShowMarkersNb) - Case "showmarkerslegend" - ProcedureReturn GetBoolString(\ShowMarkersLegend) + Case "showmarkerslegend" + ProcedureReturn GetBoolString(\ShowMarkersLegend) + Case "enableclusters" + ProcedureReturn GetBoolString(\EnableClusters) + Case "clusterpixelsize" + ProcedureReturn StrU(\ClusterPixelSize) + Case "clustermincount" + ProcedureReturn StrU(\ClusterMinCount) Case "showtrackkms" ProcedureReturn GetBoolString(\ShowTrackKms) Case "strokewidthtrackdefault" @@ -923,6 +1195,9 @@ Module PBMap WritePreferenceInteger("ShowTrackKms", \ShowTrackKms) WritePreferenceInteger("ShowMarkersNb", \ShowMarkersNb) WritePreferenceInteger("ShowMarkersLegend", \ShowMarkersLegend) + WritePreferenceInteger("EnableClusters", \EnableClusters) + WritePreferenceInteger("ClusterPixelSize", \ClusterPixelSize) + WritePreferenceInteger("ClusterMinCount", \ClusterMinCount) PreferenceGroup("DRAWING") WritePreferenceInteger("StrokeWidthTrackDefault", \StrokeWidthTrackDefault) ; Colours; @@ -969,7 +1244,7 @@ Module PBMap \appid = ReadPreferenceString("APP_ID", "") ; = InputRequester("Here App ID", "Do you use HERE ? Enter app ID", "") ; TODO \appcode = ReadPreferenceString("APP_CODE", "") ; = InputRequester("Here App Code", "Do you use HERE ? Enter app Code", "") ; TODO PreferenceGroup("URL") - \DefaultOSMServer = ReadPreferenceString("DefaultOSMServer", "http://tile.openstreetmap.org/") + \DefaultOSMServer = ReadPreferenceString("DefaultOSMServer", "https://tile.openstreetmap.org/") PreferenceGroup("PATHS") \HDDCachePath = ReadPreferenceString("TilesCachePath", GetTemporaryDirectory() + "PBMap" + slash) @@ -992,6 +1267,9 @@ Module PBMap \ShowTrackKms = ReadPreferenceInteger("ShowTrackKms", #False) \ShowMarkersNb = ReadPreferenceInteger("ShowMarkersNb", #True) \ShowMarkersLegend = ReadPreferenceInteger("ShowMarkersLegend", #False) + \EnableClusters = ReadPreferenceInteger("EnableClusters", #False) + \ClusterPixelSize = ReadPreferenceInteger("ClusterPixelSize", 60) + \ClusterMinCount = ReadPreferenceInteger("ClusterMinCount", 2) PreferenceGroup("DRAWING") \StrokeWidthTrackDefault = ReadPreferenceInteger("StrokeWidthTrackDefault", 10) PreferenceGroup("COLOURS") @@ -1026,7 +1304,7 @@ Module PBMap EndProcedure ; "OpenStreetMap" layer - Procedure.i AddOSMServerLayer(MapGadget.i, LayerName.s, Order.i, ServerURL.s = "http://tile.openstreetmap.org/") + Procedure.i AddOSMServerLayer(MapGadget.i, LayerName.s, Order.i, ServerURL.s = "https://tile.openstreetmap.org/") Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) Protected *Ptr.Layer = AddLayer(MapGadget, LayerName, Order, 1) If *Ptr @@ -1248,6 +1526,12 @@ Module PBMap Threaded Progress = 0, Quit = #False + ; --------------------------------------------------------------------------- + ; SECTION : Thread de telechargement de tuiles + ; OBJECTIF : Telecharger une tuile en asynchrone avec arret propre + ; POURQUOI : Eviter KillThread() et permettre une fermeture cooperative + ; COMMENT : Verification du flag StopDownloads + AbortHTTP() si besoin + ; --------------------------------------------------------------------------- Procedure GetImageThread(*Tile.Tile) ;LockMutex(*PBMap\MemoryCacheAccessMutex) ;MyDebug(*PBMap, "Thread nb " + Str(*Tile\GetImageThread) + " " + *Tile\key + " starting for image " + *Tile\CacheFile, 5) @@ -1262,6 +1546,10 @@ Module PBMap ; We're accessing MemoryCache ;UnlockMutex(*PBMap\MemoryCacheAccessMutex) *Tile\Size = 0 + If *Tile\PBMap And *Tile\PBMap\StopDownloads + PostEvent(#PB_Event_Gadget, *Tile\Window, *Tile\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) + ProcedureReturn + EndIf *Tile\Download = ReceiveHTTPFile(*Tile\URL, *Tile\CacheFile, #PB_HTTP_Asynchronous, #USERAGENT) ;TODO : obtain original file size to compare and eventually delete truncated file If *Tile\Download @@ -1288,6 +1576,9 @@ Module PBMap ;MyDebug(*PBMap, " Thread nb " + Str(*Tile\GetImageThread) + " " + *Tile\key + " for image " + *Tile\CacheFile + " canceled after 10 seconds.", 5) AbortHTTP(*Tile\Download) EndIf + If *Tile\PBMap And *Tile\PBMap\StopDownloads + AbortHTTP(*Tile\Download) + EndIf EndSelect Delay(200) ; Frees CPU Until Quit @@ -1392,6 +1683,7 @@ Module PBMap \Time = ElapsedMilliseconds() \Window = *PBMap\Window \Gadget = *PBMap\Gadget + \PBMap = *PBMap \GetImageThread = CreateThread(@GetImageThread(), *NewTile) If \GetImageThread MyDebug(*PBMap, " Creating get image thread nb " + Str(\GetImageThread) + " to get " + CacheFile + " (key = " + key, 3) @@ -1787,47 +2079,74 @@ Module PBMap EndWith EndProcedure + ; --------------------------------------------------------------------------- + ; SECTION : Chargement GPX securise + ; OBJECTIF : Charger un fichier GPX en verifiant la structure XML + ; POURQUOI : Eviter les acces nuls sur des fichiers invalides + ; COMMENT : Verification des noeuds + liberation XML systematique + ; --------------------------------------------------------------------------- Procedure.i LoadGpxFile(MapGadget.i, FileName.s) Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) - If LoadXML(0, FileName.s) - Protected Message.s - If XMLStatus(0) <> #PB_XML_Success - Message = "Error in the XML file:" + Chr(13) - Message + "Message: " + XMLError(0) + Chr(13) - Message + "Line: " + Str(XMLErrorLine(0)) + " Character: " + Str(XMLErrorPosition(0)) - Error(MapGadget, Message) - EndIf - Protected *MainNode,*subNode,*child,child.l - *MainNode = MainXMLNode(0) - *MainNode = XMLNodeFromPath(*MainNode, "/gpx/trk/trkseg") - Protected *NewTrack.Tracks = AddElement(*PBMap\TracksList()) - *PBMap\TracksList()\StrokeWidth = *PBMap\Options\StrokeWidthTrackDefault - *PBMap\TracksList()\Colour = *PBMap\Options\ColourTrackDefault - For child = 1 To XMLChildCount(*MainNode) - *child = ChildXMLNode(*MainNode, child) - AddElement(*NewTrack\Track()) - If ExamineXMLAttributes(*child) - While NextXMLAttribute(*child) - Select XMLAttributeName(*child) - Case "lat" - *NewTrack\Track()\Latitude = ValD(XMLAttributeValue(*child)) - Case "lon" - *NewTrack\Track()\Longitude = ValD(XMLAttributeValue(*child)) - EndSelect - Wend - EndIf - Next - SetZoomToTracks(MapGadget, LastElement(*PBMap\TracksList())) ; <-To center the view, and zoom on the tracks - ProcedureReturn *NewTrack + Protected XmlDoc.i = LoadXML(#PB_Any, FileName.s) + If XmlDoc = 0 + Error(MapGadget, "Cannot load XML file: " + FileName) + ProcedureReturn 0 EndIf + + Protected Message.s + If XMLStatus(XmlDoc) <> #PB_XML_Success + Message = "Error in the XML file:" + Chr(13) + Message + "Message: " + XMLError(XmlDoc) + Chr(13) + Message + "Line: " + Str(XMLErrorLine(XmlDoc)) + " Character: " + Str(XMLErrorPosition(XmlDoc)) + Error(MapGadget, Message) + FreeXML(XmlDoc) + ProcedureReturn 0 + EndIf + + Protected *MainNode, *child, child.l + *MainNode = MainXMLNode(XmlDoc) + *MainNode = XMLNodeFromPath(*MainNode, "/gpx/trk/trkseg") + If *MainNode = 0 + Error(MapGadget, "Invalid GPX structure: missing /gpx/trk/trkseg") + FreeXML(XmlDoc) + ProcedureReturn 0 + EndIf + + Protected *NewTrack.Tracks = AddElement(*PBMap\TracksList()) + *PBMap\TracksList()\StrokeWidth = *PBMap\Options\StrokeWidthTrackDefault + *PBMap\TracksList()\Colour = *PBMap\Options\ColourTrackDefault + For child = 1 To XMLChildCount(*MainNode) + *child = ChildXMLNode(*MainNode, child) + AddElement(*NewTrack\Track()) + If ExamineXMLAttributes(*child) + While NextXMLAttribute(*child) + Select XMLAttributeName(*child) + Case "lat" + *NewTrack\Track()\Latitude = ValD(XMLAttributeValue(*child)) + Case "lon" + *NewTrack\Track()\Longitude = ValD(XMLAttributeValue(*child)) + EndSelect + Wend + EndIf + Next + SetZoomToTracks(MapGadget, LastElement(*PBMap\TracksList())) ; <-To center the view, and zoom on the tracks + FreeXML(XmlDoc) + ProcedureReturn *NewTrack EndProcedure + ; --------------------------------------------------------------------------- + ; SECTION : Sauvegarde GPX securisee + ; OBJECTIF : Exporter un track avec verification du resultat XML + ; POURQUOI : Eviter un fichier corrompu non detecte + ; COMMENT : Creation XML avec identifiant et liberation systematique + ; --------------------------------------------------------------------------- Procedure.i SaveGpxFile(MapGadget.i, FileName.s, *Track.Tracks) Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) Protected Message.s - If CreateXML(0) + Protected XmlDoc.i = CreateXML(#PB_Any) + If XmlDoc Protected *MainNode, *subNode, *child - *MainNode = CreateXMLNode(RootXMLNode(0), "gpx") + *MainNode = CreateXMLNode(RootXMLNode(XmlDoc), "gpx") *subNode = CreateXMLNode(*MainNode, "trk") *subNode = CreateXMLNode(*subNode, "trkseg") ForEach *Track\Track() @@ -1835,14 +2154,23 @@ Module PBMap SetXMLAttribute(*child, "lat", StrD(*Track\Track()\Latitude)) SetXMLAttribute(*child, "lon", StrD(*Track\Track()\Longitude)) Next - SaveXML(0, FileName) - If XMLStatus(0) <> #PB_XML_Success + If SaveXML(XmlDoc, FileName) = 0 Message = "Error in the XML file:" + Chr(13) - Message + "Message: " + XMLError(0) + Chr(13) - Message + "Line: " + Str(XMLErrorLine(0)) + " Character: " + Str(XMLErrorPosition(0)) + Message + "Message: " + XMLError(XmlDoc) + Chr(13) + Message + "Line: " + Str(XMLErrorLine(XmlDoc)) + " Character: " + Str(XMLErrorPosition(XmlDoc)) Error(MapGadget, Message) + FreeXML(XmlDoc) ProcedureReturn #False EndIf + If XMLStatus(XmlDoc) <> #PB_XML_Success + Message = "Error in the XML file:" + Chr(13) + Message + "Message: " + XMLError(XmlDoc) + Chr(13) + Message + "Line: " + Str(XMLErrorLine(XmlDoc)) + " Character: " + Str(XMLErrorPosition(XmlDoc)) + Error(MapGadget, Message) + FreeXML(XmlDoc) + ProcedureReturn #False + EndIf + FreeXML(XmlDoc) ProcedureReturn #True Else ProcedureReturn #False @@ -1993,16 +2321,33 @@ Module PBMap Procedure DrawMarkers(MapGadget.i, *Drawing.DrawingParameters) Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) Protected Pixel.PixelCoordinates - ForEach *PBMap\Markers() - If IsInDrawingPixelBoundaries(MapGadget, *Drawing, @*PBMap\Markers()\GeographicCoordinates) - LatLon2PixelRel(MapGadget, @*PBMap\Markers()\GeographicCoordinates, @Pixel, *PBMap\Zoom) - If *PBMap\Markers()\CallBackPointer > 0 - CallFunctionFast(*PBMap\Markers()\CallBackPointer, Pixel\x, Pixel\y, *PBMap\Markers()\Focus, *PBMap\Markers()\Selected) - Else - DrawMarker(MapGadget, Pixel\x, Pixel\y, ListIndex(*PBMap\Markers()), @*PBMap\Markers()) + + If *PBMap\Options\EnableClusters + BuildClusters(MapGadget, *Drawing) + ForEach *PBMap\Clusters() + If *PBMap\Clusters()\Count >= *PBMap\Options\ClusterMinCount + DrawCluster(MapGadget, @*PBMap\Clusters()) + ElseIf *PBMap\Clusters()\Marker + ChangeCurrentElement(*PBMap\Markers(), *PBMap\Clusters()\Marker) + If *PBMap\Markers()\CallBackPointer > 0 + CallFunctionFast(*PBMap\Markers()\CallBackPointer, *PBMap\Clusters()\MarkerX, *PBMap\Clusters()\MarkerY, *PBMap\Markers()\Focus, *PBMap\Markers()\Selected) + Else + DrawMarker(MapGadget, *PBMap\Clusters()\MarkerX, *PBMap\Clusters()\MarkerY, ListIndex(*PBMap\Markers()), @*PBMap\Markers()) + EndIf EndIf - EndIf - Next + Next + Else + ForEach *PBMap\Markers() + If IsInDrawingPixelBoundaries(MapGadget, *Drawing, @*PBMap\Markers()\GeographicCoordinates) + LatLon2PixelRel(MapGadget, @*PBMap\Markers()\GeographicCoordinates, @Pixel, *PBMap\Zoom) + If *PBMap\Markers()\CallBackPointer > 0 + CallFunctionFast(*PBMap\Markers()\CallBackPointer, Pixel\x, Pixel\y, *PBMap\Markers()\Focus, *PBMap\Markers()\Selected) + Else + DrawMarker(MapGadget, Pixel\x, Pixel\y, ListIndex(*PBMap\Markers()), @*PBMap\Markers()) + EndIf + EndIf + Next + EndIf EndProcedure ;-*** Main drawing stuff @@ -2407,28 +2752,37 @@ Module PBMap ProcedureReturn *PBMap\Angle EndProcedure + ; --------------------------------------------------------------------------- + ; SECTION : Requete Nominatim securisee + ; OBJECTIF : Geocoder une adresse sans ecriture disque + ; POURQUOI : Eviter les fichiers temporaires et traiter les erreurs reseau + ; COMMENT : ReceiveHTTPMemory() + ParseJSON() + FreeMemory() + ; --------------------------------------------------------------------------- Procedure NominatimGeoLocationQuery(MapGadget.i, Address.s, *ReturnPosition.GeographicCoordinates = 0) Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) - Protected Size.i - Protected Query.s = "http://nominatim.openstreetmap.org/search/" + - URLEncoder(Address) + - "?format=json&addressdetails=0&polygon=0&limit=1" - Protected JSONFileName.s = *PBMap\Options\HDDCachePath + "nominatimresponse.json" - ; Protected *Buffer = CurlReceiveHTTPToMemory("http://nominatim.openstreetmap.org/search/Unter%20den%20Linden%201%20Berlin?format=json&addressdetails=1&limit=1&polygon_svg=1", *PBMap\Options\ProxyURL, *PBMap\Options\ProxyPort, *PBMap\Options\ProxyUser, *PBMap\Options\ProxyPassword) - ; Debug *Buffer - ; Debug MemorySize(*Buffer) - ; Protected JSon.s = PeekS(*Buffer, MemorySize(*Buffer), #PB_UTF8) + Protected Query.s = "https://nominatim.openstreetmap.org/search" + + "?q=" + URLEncoder(Address) + + "&format=json&addressdetails=0&polygon=0&limit=1" If *PBMap\Options\Proxy HTTPProxy(*PBMap\Options\ProxyURL + ":" + *PBMap\Options\ProxyPort, *PBMap\Options\ProxyUser, *PBMap\Options\ProxyPassword) EndIf - Size = ReceiveHTTPFile(Query, JSONFileName) - If LoadJSON(0, JSONFileName) = 0 + Protected *Buffer = ReceiveHTTPMemory(Query, 0, #USERAGENT) + If *Buffer = 0 + MyDebug(*PBMap, "Nominatim query failed: empty response", 1) + ProcedureReturn + EndIf + + Protected JsonText.s = PeekS(*Buffer, MemorySize(*Buffer), #PB_UTF8 | #PB_ByteLength) + FreeMemory(*Buffer) + Protected JsonId.i = ParseJSON(#PB_Any, JsonText) + If JsonId = 0 ; Demivec's code MyDebug(*PBMap, JSONErrorMessage() + " at position " + JSONErrorPosition() + " in line " + JSONErrorLine() + " of JSON web Data", 1) - ElseIf JSONArraySize(JSONValue(0)) > 0 - Protected object_val = GetJSONElement(JSONValue(0), 0) + ProcedureReturn + ElseIf JSONArraySize(JSONValue(JsonId)) > 0 + Protected object_val = GetJSONElement(JSONValue(JsonId), 0) Protected object_box = GetJSONMember(object_val, "boundingbox") Protected bbox.BoundingBox bbox\SouthEast\Latitude = ValD(GetJSONString(GetJSONElement(object_box, 0))) @@ -2446,10 +2800,21 @@ Module PBMap ; SetLocation(Position\Latitude, Position\Longitude) EndIf EndIf + FreeJSON(JsonId) EndProcedure + ; --------------------------------------------------------------------------- + ; SECTION : Nettoyage de cache securise + ; OBJECTIF : Supprimer le cache sans risque de supprimer une racine + ; POURQUOI : DeleteDirectory() est destructif + ; COMMENT : Validation du chemin avant suppression recursive + ; --------------------------------------------------------------------------- Procedure.i ClearDiskCache(MapGadget.i) Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) + If IsSafeCachePath(*PBMap\Options\HDDCachePath) = #False + Error(MapGadget, "Unsafe cache path, aborting: " + *PBMap\Options\HDDCachePath) + ProcedureReturn #False + EndIf If *PBMap\Options\Warning Protected Result.i = MessageRequester("Warning", "You will clear all cache content in " + *PBMap\Options\HDDCachePath + ". Are you sure ?",#PB_MessageRequester_YesNo) If Result = #PB_MessageRequester_No ; Quit if "no" selected @@ -2474,6 +2839,10 @@ Module PBMap Protected key.s, Touch.i Protected Pixel.PixelCoordinates Protected ImgNB.i, TileNewFilename.s + Protected *Cluster.Cluster + Protected MouseScreenX.d, MouseScreenY.d + Protected FocusChanged.b + Protected NewZoom.i Static CtrlKey Protected Location.GeographicCoordinates Protected MapGadget.i = EventGadget() @@ -2536,6 +2905,15 @@ Module PBMap CtrlKey = #True EndIf Case #PB_EventType_LeftDoubleClick + If *PBMap\Options\EnableClusters + *Cluster = FindClusterAt(MapGadget, CanvasMouseX + *PBMap\Drawing\RadiusX, CanvasMouseY + *PBMap\Drawing\RadiusY) + If *Cluster And *Cluster\Count >= *PBMap\Options\ClusterMinCount + NewZoom = Min(*PBMap\Zoom + 1, *PBMap\ZoomMax) + SetLocation(MapGadget, *Cluster\CenterLat, *Cluster\CenterLon, NewZoom) + *PBMap\Redraw = #True + ProcedureReturn + EndIf + EndIf LatLon2Pixel(MapGadget, @*PBMap\GeographicCoordinates, @*PBMap\PixelCoordinates, *PBMap\Zoom) MouseX = *PBMap\PixelCoordinates\x + CanvasMouseX MouseY = *PBMap\PixelCoordinates\y + CanvasMouseY @@ -2544,17 +2922,21 @@ Module PBMap Touch = #False ; Check if the mouse touch a marker ForEach *PBMap\Markers() - LatLon2Pixel(MapGadget, @*PBMap\Markers()\GeographicCoordinates, @MarkerCoords, *PBMap\Zoom) - If Distance(MarkerCoords\x, MarkerCoords\y, MouseX, MouseY) < 8 - If *PBMap\Mode = #MODE_DEFAULT Or *PBMap\Mode = #MODE_SELECT - ; Jump to the marker - Touch = #True - SetLocation(MapGadget, *PBMap\Markers()\GeographicCoordinates\Latitude, *PBMap\Markers()\GeographicCoordinates\Longitude) - ElseIf *PBMap\Mode = #MODE_EDIT - ; Edit the legend - MarkerEdit(MapGadget, @*PBMap\Markers()) + If *PBMap\Options\EnableClusters And IsMarkerClustered(MapGadget, @*PBMap\Markers()) + ; Skip markers hidden by a cluster + Else + LatLon2Pixel(MapGadget, @*PBMap\Markers()\GeographicCoordinates, @MarkerCoords, *PBMap\Zoom) + If Distance(MarkerCoords\x, MarkerCoords\y, MouseX, MouseY) < 8 + If *PBMap\Mode = #MODE_DEFAULT Or *PBMap\Mode = #MODE_SELECT + ; Jump to the marker + Touch = #True + SetLocation(MapGadget, *PBMap\Markers()\GeographicCoordinates\Latitude, *PBMap\Markers()\GeographicCoordinates\Longitude) + ElseIf *PBMap\Mode = #MODE_EDIT + ; Edit the legend + MarkerEdit(MapGadget, @*PBMap\Markers()) + EndIf + Break EndIf - Break EndIf Next If Not Touch @@ -2657,18 +3039,52 @@ Module PBMap ; Clip MouseX to the map range (in X, the map is infinite) MouseX = Mod(Mod(MouseX, MapWidth) + MapWidth, MapWidth) If *PBMap\Mode = #MODE_DEFAULT Or *PBMap\Mode = #MODE_SELECT Or *PBMap\Mode = #MODE_EDIT - ; Check if mouse touch markers - ForEach *PBMap\Markers() - LatLon2Pixel(MapGadget, @*PBMap\Markers()\GeographicCoordinates, @MarkerCoords, *PBMap\Zoom) - If Distance(MarkerCoords\x, MarkerCoords\y, MouseX, MouseY) < 8 - *PBMap\Markers()\Focus = #True - *PBMap\Redraw = #True - ElseIf *PBMap\Markers()\Focus - ; If CtrlKey = #False - *PBMap\Markers()\Focus = #False + ; Check if mouse touch markers or clusters + If *PBMap\Options\EnableClusters + MouseScreenX = CanvasMouseX + *PBMap\Drawing\RadiusX + MouseScreenY = CanvasMouseY + *PBMap\Drawing\RadiusY + *Cluster = FindClusterAt(MapGadget, MouseScreenX, MouseScreenY) + FocusChanged = #False + + ForEach *PBMap\Markers() + If *PBMap\Markers()\Focus + *PBMap\Markers()\Focus = #False + FocusChanged = #True + EndIf + Next + ForEach *PBMap\Clusters() + If *PBMap\Clusters()\Focus + *PBMap\Clusters()\Focus = #False + FocusChanged = #True + EndIf + Next + If FocusChanged *PBMap\Redraw = #True EndIf - Next + + If *Cluster + If *Cluster\Count >= *PBMap\Options\ClusterMinCount + *Cluster\Focus = #True + *PBMap\Redraw = #True + ElseIf *Cluster\Marker + ChangeCurrentElement(*PBMap\Markers(), *Cluster\Marker) + *PBMap\Markers()\Focus = #True + *PBMap\Redraw = #True + EndIf + EndIf + Else + ForEach *PBMap\Markers() + LatLon2Pixel(MapGadget, @*PBMap\Markers()\GeographicCoordinates, @MarkerCoords, *PBMap\Zoom) + If Distance(MarkerCoords\x, MarkerCoords\y, MouseX, MouseY) < 8 + *PBMap\Markers()\Focus = #True + *PBMap\Redraw = #True + ElseIf *PBMap\Markers()\Focus + ; If CtrlKey = #False + *PBMap\Markers()\Focus = #False + *PBMap\Redraw = #True + EndIf + Next + EndIf ; Check if mouse touch tracks If *PBMap\Options\ShowTrackSelection ; YA to avoid selecting track With *PBMap\TracksList() @@ -2772,6 +3188,12 @@ Module PBMap EndProcedure ; Could be called directly to attach our map to an existing canvas + ; --------------------------------------------------------------------------- + ; SECTION : Initialisation du gadget + ; OBJECTIF : Initialiser un PBMap et ses ressources critiques + ; POURQUOI : Garantir des valeurs par defaut coherentes + ; COMMENT : Mutex, options, images techniques et timers + ; --------------------------------------------------------------------------- Procedure BindMapGadget(MapGadget.i, TimerNB = 1, Window = -1) Protected *PBMap.PBMap *PBMap.PBMap = AllocateStructure(PBMap) @@ -2800,6 +3222,7 @@ Module PBMap MyDebug(*PBMap, "Cannot create a mutex", 0) End EndIf + \StopDownloads = #False EndWith LoadOptions(MapGadget) TechnicalImagesCreation(MapGadget) @@ -2831,17 +3254,28 @@ Module PBMap EndIf EndProcedure + ; --------------------------------------------------------------------------- + ; SECTION : Arret propre des threads + ; OBJECTIF : Fermer proprement sans KillThread() + ; POURQUOI : Eviter les corruptions et fuites de ressources + ; COMMENT : Stop flag + AbortHTTP() + attente des threads + ; --------------------------------------------------------------------------- Procedure Quit(*PBMap.PBMap) *PBMap\Drawing\End = #True - ; Wait for loading threads to finish nicely. Passed 2 seconds, kills them. + *PBMap\StopDownloads = #True + ; Wait for loading threads to finish nicely. AbortHTTP is used to stop downloads. Protected TimeCounter = ElapsedMilliseconds() + Protected Warned.b = #False Repeat ForEach *PBMap\MemCache\Images() If *PBMap\MemCache\Images()\Tile > 0 If IsThread(*PBMap\MemCache\Images()\Tile\GetImageThread) - If ElapsedMilliseconds() - TimeCounter > 2000 - ; Should not occur - KillThread(*PBMap\MemCache\Images()\Tile\GetImageThread) + If *PBMap\MemCache\Images()\Tile\Download + AbortHTTP(*PBMap\MemCache\Images()\Tile\Download) + EndIf + If ElapsedMilliseconds() - TimeCounter > 20000 And Warned = #False + MyDebug(*PBMap, "Waiting for download threads to finish...", 1) + Warned = #True EndIf Else FreeMemory(*PBMap\MemCache\Images()\Tile) @@ -2855,6 +3289,10 @@ Module PBMap Until MapSize(*PBMap\MemCache\Images()) = 0 RemoveWindowTimer(*PBMap\Window, *PBMap\Timer) UnbindGadgetEvent(*PBMap\Gadget, @CanvasEvents()) + If *PBMap\MemoryCacheAccessMutex + FreeMutex(*PBMap\MemoryCacheAccessMutex) + *PBMap\MemoryCacheAccessMutex = 0 + EndIf FreeStructure(*PBMap) EndProcedure @@ -2874,9 +3312,9 @@ EndModule -; IDE Options = PureBasic 6.00 Alpha 3 (Windows - x64) -; CursorPosition = 2657 -; FirstLine = 766 -; Folding = -------------------- +; IDE Options = PureBasic 6.21 (Windows - x64) +; CursorPosition = 53 +; FirstLine = 40 +; Folding = --------------------- ; EnableThread ; EnableXP \ No newline at end of file diff --git a/PBMap_doc_fr.md b/PBMap_doc_fr.md new file mode 100644 index 0000000..94fe243 --- /dev/null +++ b/PBMap_doc_fr.md @@ -0,0 +1,461 @@ +# PBMap - Documentation FR (usage simple et complet) + +Ce document explique comment utiliser `pbmap/PBMap.pb` facilement, avec un demarrage rapide, des exemples et le detail de chaque procedure publique. + +## Demarrage rapide + +Objectif: afficher une carte, ajouter un marqueur et deplacer la vue. + +```purebasic +IncludeFile "pbmap/PBMap.pb" + +EnableExplicit +InitNetwork() + +UseModule PBMap + +Enumeration + #Win + #Map +EndEnumeration + +If OpenWindow(#Win, 100, 100, 900, 600, "PBMap demo", #PB_Window_SystemMenu) + #Map = MapGadget(#PB_Any, 0, 0, 900, 600, 1, #Win) + + ; Options utiles + SetOption(#Map, "ShowScale", "1") + SetOption(#Map, "ShowZoom", "1") + SetOption(#Map, "ShowMarkersLegend", "1") + + ; Position de depart + SetLocation(#Map, 48.8566, 2.3522, 12) + + ; Ajout d'un marqueur + AddMarker(#Map, 48.8566, 2.3522, "1", "Paris", RGBA(255, 80, 80, 255)) + + Repeat + Select WaitWindowEvent() + Case #PB_Event_CloseWindow + Break + EndSelect + ForEver +EndIf +``` + +Notes importantes: +- Activez "Create ThreadSafe Executable" dans les options du compilateur. +- Appelez `InitNetwork()` avant les telechargements HTTP. +- Les tuiles sont telechargees automatiquement via HTTP/HTTPS. + +## Ce que PBMap permet de faire + +- Afficher une carte (tuiles OSM/HERE/GeoServer). +- Gerer des marqueurs (ajout, selection, edition). +- Gerer des traces GPX (chargement, affichage, suppression). +- Changer la vue (zoom, angle, centrage). +- Configurer le cache disque et memoire. +- Ajouter des callbacks pour reagir aux mouvements et aux clics. +- Utiliser un clustering de marqueurs pour une meilleure lisibilite. + +## Configuration rapide des options utiles + +```purebasic +PBMap::SetOption(#Map, "Verbose", "1") +PBMap::SetOption(#Map, "ShowMarkersLegend", "1") +PBMap::SetOption(#Map, "TileLifetime", "1209600") ; 2 semaines +PBMap::SetOption(#Map, "EnableClusters", "1") +PBMap::SetOption(#Map, "ClusterPixelSize", "60") +PBMap::SetOption(#Map, "ClusterMinCount", "2") +``` + +## API publique - procedures et exemples + +Les exemples supposent l'existence d'une carte `#Map`. + +### SetDebugLevel(Level.i) +Definit le niveau de debug (0..5). +```purebasic +PBMap::SetDebugLevel(3) +``` + +### SetOption(MapGadget.i, Option.s, Value.s) +Change une option via une cle texte. +```purebasic +PBMap::SetOption(#Map, "ShowZoom", "1") +``` + +### GetOption(MapGadget.i, Option.s) +Lit une option sous forme de chaine. +```purebasic +Debug PBMap::GetOption(#Map, "ShowZoom") +``` + +### LoadOptions(MapGadget.i, PreferencesFile.s = "PBMap.prefs") +Charge les options depuis un fichier. +```purebasic +PBMap::LoadOptions(#Map, "PBMap.prefs") +``` + +### SaveOptions(MapGadget.i, PreferencesFile.s = "PBMap.prefs") +Sauvegarde les options. +```purebasic +PBMap::SaveOptions(#Map, "PBMap.prefs") +``` + +### AddOSMServerLayer(MapGadget.i, LayerName.s, Order.i, ServerURL.s) +Ajoute une couche OSM. +```purebasic +PBMap::AddOSMServerLayer(#Map, "OSM", 1, "https://tile.openstreetmap.org/") +``` + +### AddHereServerLayer(...) +Ajoute une couche HERE (necessite AppId/AppCode). +```purebasic +PBMap::AddHereServerLayer(#Map, "HERE", 2, "APP_ID", "APP_CODE") +``` + +### AddGeoServerLayer(...) +Ajoute une couche GeoServer. +```purebasic +PBMap::AddGeoServerLayer(#Map, "WMS", 3, "layer-name", "http://localhost:8080/") +``` + +### IsLayer(MapGadget.i, Name.s) +Teste si une couche existe. +```purebasic +If PBMap::IsLayer(#Map, "OSM") + Debug "Layer OSM ok" +EndIf +``` + +### DeleteLayer(MapGadget.i, Name.s) +Supprime une couche. +```purebasic +PBMap::DeleteLayer(#Map, "WMS") +``` + +### EnableLayer(MapGadget.i, Name.s) +Active une couche. +```purebasic +PBMap::EnableLayer(#Map, "OSM") +``` + +### DisableLayer(MapGadget.i, Name.s) +Desactive une couche. +```purebasic +PBMap::DisableLayer(#Map, "HERE") +``` + +### SetLayerAlpha(MapGadget.i, Name.s, Alpha.d) +Change la transparence d'une couche (0..1). +```purebasic +PBMap::SetLayerAlpha(#Map, "WMS", 0.5) +``` + +### GetLayerAlpha(MapGadget.i, Name.s) +Lit la transparence d'une couche. +```purebasic +Debug PBMap::GetLayerAlpha(#Map, "WMS") +``` + +### BindMapGadget(MapGadget.i, TimerNB = 1, Window = -1) +Attache PBMap a un Canvas existant. +```purebasic +PBMap::BindMapGadget(#MyCanvas, 1, #Win) +``` + +### SetCallBackLocation(MapGadget.i, *CallBackLocation) +Callback: appel lors d'un changement de position (lat/lon). +```purebasic +Procedure OnMove(*Pos.PBMap::GeographicCoordinates) + Debug StrD(*Pos\Latitude) + ", " + StrD(*Pos\Longitude) +EndProcedure +PBMap::SetCallBackLocation(#Map, @OnMove()) +``` + +### SetCallBackMainPointer(MapGadget.i, CallBackMainPointer.i) +Callback pour dessiner le pointeur principal. +```purebasic +Procedure DrawPointer(x.i, y.i) + ; custom drawing +EndProcedure +PBMap::SetCallBackMainPointer(#Map, @DrawPointer()) +``` + +### SetCallBackDrawTile(MapGadget.i, *CallBackLocation) +Callback pour personnaliser le dessin d'une tuile. +```purebasic +Procedure DrawTile(x.i, y.i, image.i, alpha.d) + ; custom drawing +EndProcedure +PBMap::SetCallBackDrawTile(#Map, @DrawTile()) +``` + +### SetCallBackMarker(MapGadget.i, *CallBackLocation) +Callback appele quand un marqueur a ete deplace (selection). +```purebasic +Procedure OnMarkerChange(*Marker.PBMap::Marker) + Debug *Marker\Identifier +EndProcedure +PBMap::SetCallBackMarker(#Map, @OnMarkerChange()) +``` + +### SetCallBackLeftClic(MapGadget.i, *CallBackLocation) +Callback lors d'un clic gauche sur la carte. +```purebasic +Procedure OnLeftClick(*Pos.PBMap::GeographicCoordinates) + Debug StrD(*Pos\Latitude) +EndProcedure +PBMap::SetCallBackLeftClic(#Map, @OnLeftClick()) +``` + +### SetCallBackModifyTileFile(MapGadget.i, *CallBackLocation) +Callback pour modifier un fichier de tuile apres telechargement. +```purebasic +Procedure.s OnTileFile(FileName.s, Url.s) + ProcedureReturn FileName +EndProcedure +PBMap::SetCallBackModifyTileFile(#Map, @OnTileFile()) +``` + +### MapGadget(MapGadget.i, X.i, Y.i, Width.i, Height.i, TimerNB = 1, Window = -1) +Cree un canvas + PBMap. +```purebasic +#Map = PBMap::MapGadget(#PB_Any, 0, 0, 800, 600, 1, #Win) +``` + +### FreeMapGadget(MapGadget.i) +Libere une carte. +```purebasic +PBMap::FreeMapGadget(#Map) +``` + +### GetLatitude(MapGadget.i) +Latitude courante. +```purebasic +Debug StrD(PBMap::GetLatitude(#Map)) +``` + +### GetLongitude(MapGadget.i) +Longitude courante. +```purebasic +Debug StrD(PBMap::GetLongitude(#Map)) +``` + +### GetMouseLatitude(MapGadget.i) +Latitude sous la souris. +```purebasic +Debug StrD(PBMap::GetMouseLatitude(#Map)) +``` + +### GetMouseLongitude(MapGadget.i) +Longitude sous la souris. +```purebasic +Debug StrD(PBMap::GetMouseLongitude(#Map)) +``` + +### GetAngle(MapGadget.i) +Angle actuel. +```purebasic +Debug StrD(PBMap::GetAngle(#Map)) +``` + +### GetZoom(MapGadget.i) +Zoom actuel. +```purebasic +Debug PBMap::GetZoom(#Map) +``` + +### GetMode(MapGadget.i) +Mode utilisateur courant. +```purebasic +Debug PBMap::GetMode(#Map) +``` + +### SetMode(MapGadget.i, Mode.i = #MODE_DEFAULT) +Definit le mode. +```purebasic +PBMap::SetMode(#Map, PBMap::#MODE_HAND) +``` + +### SetMapScaleUnit(MapGadget.i, ScaleUnit = PBMap::#SCALE_KM) +Definit l'unite d'echelle. +```purebasic +PBMap::SetMapScaleUnit(#Map, PBMap::#SCALE_NAUTICAL) +``` + +### SetLocation(MapGadget.i, Latitude.d, Longitude.d, Zoom = -1, Mode.i = #PB_Absolute) +Centre la carte. +```purebasic +PBMap::SetLocation(#Map, 48.8566, 2.3522, 12) +``` + +### SetAngle(MapGadget.i, Angle.d, Mode = #PB_Absolute) +Change l'angle. +```purebasic +PBMap::SetAngle(#Map, 15.0, #PB_Absolute) +``` + +### SetZoom(MapGadget.i, Zoom.i, Mode.i = #PB_Relative) +Change le zoom. +```purebasic +PBMap::SetZoom(#Map, 1, #PB_Relative) +``` + +### SetZoomToArea(MapGadget.i, MinY.d, MaxY.d, MinX.d, MaxX.d) +Zoom sur une zone. +```purebasic +PBMap::SetZoomToArea(#Map, 48.80, 48.90, 2.30, 2.40) +``` + +### SetZoomToTracks(MapGadget.i, *Tracks) +Zoom automatique sur une trace. +```purebasic +PBMap::SetZoomToTracks(#Map, *Track) +``` + +### NominatimGeoLocationQuery(MapGadget.i, Address.s, *ReturnPosition = 0) +Geocodage d'une adresse via Nominatim. +```purebasic +Define Pos.PBMap::GeographicCoordinates +PBMap::NominatimGeoLocationQuery(#Map, "Paris", @Pos) +``` + +### LoadGpxFile(MapGadget.i, FileName.s) +Charge un fichier GPX. +```purebasic +Define *Track = PBMap::LoadGpxFile(#Map, "track.gpx") +``` + +### SaveGpxFile(MapGadget.i, FileName.s, *Track) +Sauvegarde une trace GPX. +```purebasic +PBMap::SaveGpxFile(#Map, "export.gpx", *Track) +``` + +### ClearTracks(MapGadget.i) +Supprime toutes les traces. +```purebasic +PBMap::ClearTracks(#Map) +``` + +### DeleteTrack(MapGadget.i, *Ptr) +Supprime une trace. +```purebasic +PBMap::DeleteTrack(#Map, *Track) +``` + +### DeleteSelectedTracks(MapGadget.i) +Supprime les traces selectionnees. +```purebasic +PBMap::DeleteSelectedTracks(#Map) +``` + +### SetTrackColour(MapGadget.i, *Ptr, Colour.i) +Change la couleur d'une trace. +```purebasic +PBMap::SetTrackColour(#Map, *Track, RGBA(0, 200, 0, 200)) +``` + +### AddMarker(MapGadget.i, Latitude.d, Longitude.d, Identifier.s = "", Legend.s = "", Color.l = -1, CallBackPointer.i = -1) +Ajoute un marqueur. +```purebasic +PBMap::AddMarker(#Map, 48.86, 2.35, "A", "Point A", RGBA(255, 80, 80, 255)) +``` + +### ClearMarkers(MapGadget.i) +Supprime tous les marqueurs. +```purebasic +PBMap::ClearMarkers(#Map) +``` + +### DeleteMarker(MapGadget.i, *Ptr) +Supprime un marqueur. +```purebasic +PBMap::DeleteMarker(#Map, *Marker) +``` + +### DeleteSelectedMarkers(MapGadget.i) +Supprime les marqueurs selectionnes. +```purebasic +PBMap::DeleteSelectedMarkers(#Map) +``` + +### Drawing(MapGadget.i) +Force un rendu immediat. +```purebasic +PBMap::Drawing(#Map) +``` + +### FatalError(MapGadget.i, msg.s) +Affiche une erreur et termine. +```purebasic +PBMap::FatalError(#Map, "Erreur critique") +``` + +### Error(MapGadget.i, msg.s) +Affiche une erreur simple. +```purebasic +PBMap::Error(#Map, "Erreur") +``` + +### Refresh(MapGadget.i) +Demande un rafraichissement. +```purebasic +PBMap::Refresh(#Map) +``` + +### ClearDiskCache(MapGadget.i) +Vide le cache disque. +```purebasic +PBMap::ClearDiskCache(#Map) +``` + +## Clustering des marqueurs (explication) + +Le clustering regroupe les marqueurs proches en un seul cercle. +- `EnableClusters`: active ou non. +- `ClusterPixelSize`: taille de la grille (en pixels). +- `ClusterMinCount`: nombre minimum pour afficher un cluster. + +Double-clic sur un cluster: zoom sur le centre du cluster. + +## Astuces pratiques + +- Activez `Verbose` pour diagnostiquer les chargements de tuiles. +- Utilisez `TileLifetime` pour gerer l'expiration du cache. +- Si vous avez beaucoup de marqueurs, activez le clustering. +- Pour des couches multiples, ajustez `SetLayerAlpha`. +- Si l'interface devient lente, reduisez `MaxThreads` ou `MaxDownloadSlots`. + +## Exemple complet (avec clustering) + +```purebasic +IncludeFile "pbmap/PBMap.pb" +InitNetwork() +UseModule PBMap + +Enumeration + #Win +EndEnumeration + +OpenWindow(#Win, 0, 0, 1000, 700, "PBMap clustering", #PB_Window_SystemMenu) +Define MapId = MapGadget(#PB_Any, 0, 0, 1000, 700, 1, #Win) + +SetOption(MapId, "EnableClusters", "1") +SetOption(MapId, "ClusterPixelSize", "60") +SetOption(MapId, "ClusterMinCount", "2") + +SetLocation(MapId, 48.8566, 2.3522, 10) + +AddMarker(MapId, 48.85, 2.34, "1", "A", RGBA(255, 80, 80, 255)) +AddMarker(MapId, 48.86, 2.35, "2", "B", RGBA(255, 80, 80, 255)) +AddMarker(MapId, 48.87, 2.36, "3", "C", RGBA(255, 80, 80, 255)) + +Repeat + Select WaitWindowEvent() + Case #PB_Event_CloseWindow + Break + EndSelect +ForEver +``` diff --git a/README.md b/README.md index 4d3b905..8d4ae85 100644 --- a/README.md +++ b/README.md @@ -1,19 +1,22 @@ -# PBMap 0.91 +# PBMap 0.98 + Open source tiled map software. Module to develop tiled map applications in PureBasic, like like OpenStreetMap(c), Google Maps(c), Here(c), ... + Functional example based on OpenStreetMap(c) services OSM copyright : http://www.openstreetmap.org/copyright + This code is free, but any user should mention the origin of this code. Official forums topics : -http://www.purebasic.fr/english/viewtopic.php?f=27&t=66320 (english) -http://www.purebasic.fr/french/viewtopic.php?f=3&t=16160 (french) +http://www.purebasic.fr/english/viewtopic.php?f=27\&t=66320 (english) +http://www.purebasic.fr/french/viewtopic.php?f=3\&t=16160 (french) Contributors : Thyphoon @@ -27,3 +30,4 @@ André falsam Special thanks to Fred and Fantaisie Software's team +