thyphoon/PBMap
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Big Update (Bugs / Cluster

Browse Source
This commit is contained in:
Yann Lebrun
2026-01-12 18:31:37 +01:00
parent a32fd4d093
commit 9387a58080
4 changed files with 1046 additions and 105 deletions
Download Patch File Download Diff File Expand all files Collapse all files

50
Demo.pb
View File

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

524
PBMap.pb
View File

@@ -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)
@@ -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
@@ -293,6 +296,30 @@ Module PBMap
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
BoundingBox.Box
@@ -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
@@ -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
@@ -464,6 +508,40 @@ Module PBMap
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))
; "Loading" image
@@ -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"
@@ -869,6 +1135,12 @@ Module PBMap
ProcedureReturn GetBoolString(\ShowMarkersNb)
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,19 +2079,39 @@ 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)
Protected XmlDoc.i = LoadXML(#PB_Any, FileName.s)
If XmlDoc = 0
Error(MapGadget, "Cannot load XML file: " + FileName)
ProcedureReturn 0
EndIf
Protected *MainNode,*subNode,*child,child.l
*MainNode = MainXMLNode(0)
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
@@ -1818,16 +2130,23 @@ Module PBMap
EndIf
Next
SetZoomToTracks(MapGadget, LastElement(*PBMap\TracksList())) ; <-To center the view, and zoom on the tracks
FreeXML(XmlDoc)
ProcedureReturn *NewTrack
EndIf
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,6 +2321,22 @@ Module PBMap
Procedure DrawMarkers(MapGadget.i, *Drawing.DrawingParameters)
Protected *PBMap.PBMap = PBMaps(Str(MapGadget))
Protected Pixel.PixelCoordinates
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
Next
Else
ForEach *PBMap\Markers()
If IsInDrawingPixelBoundaries(MapGadget, *Drawing, @*PBMap\Markers()\GeographicCoordinates)
LatLon2PixelRel(MapGadget, @*PBMap\Markers()\GeographicCoordinates, @Pixel, *PBMap\Zoom)
@@ -2003,6 +2347,7 @@ Module PBMap
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,6 +2922,9 @@ Module PBMap
Touch = #False
; Check if the mouse touch a marker
ForEach *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
@@ -2556,6 +2937,7 @@ Module PBMap
EndIf
Break
EndIf
EndIf
Next
If Not Touch
GotoPixel(MapGadget, MouseX, MouseY)
@@ -2657,7 +3039,40 @@ 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
; 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
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
@@ -2669,6 +3084,7 @@ Module PBMap
*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

461
PBMap_doc_fr.md Normal file
View File

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

10
README.md
View File

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