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

52
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
; EnableXP

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

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