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

First version

Browse Source
This commit is contained in:
djes
2016-08-26 09:41:26 +02:00
parent 648231a5b2
commit bb00a6b039
1 changed files with 169 additions and 86 deletions
Download Patch File Download Diff File Expand all files Collapse all files

255
PBMap.pb
View File

@@ -26,6 +26,7 @@ UsePNGImageEncoder()
DeclareModule PBMap DeclareModule PBMap
;-Show debug infos ;-Show debug infos
Global Verbose = #False Global Verbose = #False
Global MyDebugLevel = 3
Global Proxy = #False Global Proxy = #False
Declare InitPBMap() Declare InitPBMap()
Declare SetMapServer(ServerURL.s="http://tile.openstreetmap.org/",TileSize.l=256,ZoomMin.l=0,ZoomMax.l=18) Declare SetMapServer(ServerURL.s="http://tile.openstreetmap.org/",TileSize.l=256,ZoomMin.l=0,ZoomMax.l=18)
@@ -73,6 +74,7 @@ Module PBMap
PBMapTileY.i PBMapTileY.i
PBMapZoom.i PBMapZoom.i
nImage.i nImage.i
key.s
GetImageThread.i GetImageThread.i
EndStructure EndStructure
@@ -95,13 +97,14 @@ Module PBMap
EndStructure EndStructure
Structure TileThread Structure TileThread
*Tile.Tile
GetImageThread.i GetImageThread.i
*Tile.Tile
EndStructure EndStructure
Structure ImgMemCach Structure ImgMemCach
nImage.i nImage.i
Usage.i ;Location.Location
;Mutex.i
EndStructure EndStructure
Structure TileMemCach Structure TileMemCach
@@ -153,7 +156,9 @@ Module PBMap
Options.option ; Options.option ;
EndStructure EndStructure
;-Global variables
Global PBMap.PBMap, Null.i Global PBMap.PBMap, Null.i
Global LoadMutexTest = CreateMutex()
;Shows an error msg and terminates the program ;Shows an error msg and terminates the program
Procedure Error(msg.s) Procedure Error(msg.s)
@@ -161,10 +166,11 @@ Module PBMap
End End
EndProcedure EndProcedure
;Send debug infos to stdout ;Send debug infos to stdout (allowing mixed debug infos with curl or other libs)
Procedure MyDebug(msg.s) Procedure MyDebug(msg.s, DbgLevel = 0)
If Verbose If Verbose And MyDebugLevel >= DbgLevel
PrintN(msg) PrintN(msg)
;Debug msg
EndIf EndIf
EndProcedure EndProcedure
@@ -181,8 +187,8 @@ Module PBMap
Procedure.i CurlReceiveHTTPToFile(URL$, DestFileName$, ProxyURL$="", ProxyPort$="", ProxyUser$="", ProxyPassword$="") Procedure.i CurlReceiveHTTPToFile(URL$, DestFileName$, ProxyURL$="", ProxyPort$="", ProxyUser$="", ProxyPassword$="")
Protected *Buffer, curl.i, Timeout.i, res.i Protected *Buffer, curl.i, Timeout.i, res.i
Protected FileHandle.i Protected FileHandle.i
MyDebug("ReceiveHTTPToFile from " + URL$ + " " + ProxyURL$ + ProxyPort$ + ProxyUser$) MyDebug("ReceiveHTTPToFile from " + URL$ + " " + ProxyURL$ + ProxyPort$ + ProxyUser$, 3)
MyDebug(" to file : " + DestFileName$) MyDebug(" to file : " + DestFileName$, 3)
FileHandle = CreateFile(#PB_Any, DestFileName$) FileHandle = CreateFile(#PB_Any, DestFileName$)
If FileHandle And Len(URL$) If FileHandle And Len(URL$)
curl = curl_easy_init() curl = curl_easy_init()
@@ -215,11 +221,11 @@ Module PBMap
curl_easy_setopt(curl, #CURLOPT_WRITEFUNCTION, @ReceiveHTTPWriteToFileFunction()) curl_easy_setopt(curl, #CURLOPT_WRITEFUNCTION, @ReceiveHTTPWriteToFileFunction())
res = curl_easy_perform(curl) res = curl_easy_perform(curl)
If res <> #CURLE_OK If res <> #CURLE_OK
MyDebug("CURL problem") MyDebug("CURL problem", 3)
EndIf EndIf
curl_easy_cleanup(curl) curl_easy_cleanup(curl)
Else Else
MyDebug("Can't init CURL") MyDebug("Can't init CURL", 3)
EndIf EndIf
CloseFile(FileHandle) CloseFile(FileHandle)
ProcedureReturn FileSize(DestFileName$) ProcedureReturn FileSize(DestFileName$)
@@ -242,7 +248,7 @@ Module PBMap
PBMap\Dirty = #False PBMap\Dirty = #False
PBMap\Drawing\Mutex = CreateMutex() PBMap\Drawing\Mutex = CreateMutex()
PBMap\Drawing\Semaphore = CreateSemaphore() PBMap\Drawing\Semaphore = CreateSemaphore()
PBMap\EditMarkerIndex = -1 ;<- You must initialize with No Marker selected PBMap\EditMarkerIndex = -1 ;Initialised with "no marker selected"
PBMap\Font = LoadFont(#PB_Any, "Arial", 20, #PB_Font_Bold) PBMap\Font = LoadFont(#PB_Any, "Arial", 20, #PB_Font_Bold)
;-Options ;-Options
PBMap\Options\WheelMouseRelative = #True PBMap\Options\WheelMouseRelative = #True
@@ -286,20 +292,35 @@ Module PBMap
EndProcedure EndProcedure
Procedure Quit() Procedure Quit()
;kill main drawing thread (nicer than KillThread(PBMap\MainDrawingThread)) Protected TimeCounter.q
;Ask main drawing thread to stop and wait for it for 2 seconds
LockMutex(PBMap\Drawing\Mutex) LockMutex(PBMap\Drawing\Mutex)
PBMap\Drawing\End = #True PBMap\Drawing\End = #True
UnlockMutex(PBMap\Drawing\Mutex) UnlockMutex(PBMap\Drawing\Mutex)
;wait for loading threads to finish nicely TimeCounter = ElapsedMilliseconds()
ResetList(PBMap\TilesThreads()) Repeat
While NextElement(PBMap\TilesThreads()) Delay(100)
If IsThread(PBMap\TilesThreads()\GetImageThread) = 0 If ElapsedMilliseconds() - TimeCounter > 2000
FreeMemory(PBMap\TilesThreads()\Tile) ;Should not occur
DeleteElement(PBMap\TilesThreads()) KillThread(PBMap\MainDrawingThread)
ResetList( PBMap\TilesThreads())
EndIf EndIf
Wend Until Not IsThread(PBMap\MainDrawingThread)
curl_global_cleanup() ;Wait for loading threads to finish nicely. Passed 2 seconds, kills them.
TimeCounter = ElapsedMilliseconds()
Repeat
ResetList(PBMap\TilesThreads())
While NextElement(PBMap\TilesThreads())
If IsThread(PBMap\TilesThreads()\GetImageThread) = 0
FreeMemory(PBMap\TilesThreads()\Tile)
DeleteElement(PBMap\TilesThreads())
ElseIf ElapsedMilliseconds() - TimeCounter > 2000
;Should not occur
KillThread(PBMap\TilesThreads()\GetImageThread)
EndIf
Wend
Delay(10)
Until ListSize(PBMap\TilesThreads()) = 0
curl_global_cleanup()
EndProcedure EndProcedure
Macro Min(a,b) Macro Min(a,b)
@@ -416,28 +437,34 @@ Module PBMap
EndIf EndIf
EndProcedure EndProcedure
Procedure.i GetTileFromMem(Zoom.i, XTile.i, YTile.i) Procedure.i GetTileFromMem(key.s)
Protected key.s = "Z" + RSet(Str(Zoom), 4, "0") + "X" + RSet(Str(XTile), 8, "0") + "Y" + RSet(Str(YTile), 8, "0") MyDebug("Check if we have this image in memory", 3)
MyDebug("Check if we have this image in memory")
If FindMapElement(PBMap\MemCache\Images(), key) If FindMapElement(PBMap\MemCache\Images(), key)
MyDebug("Key : " + key + " found !") MyDebug("Key : " + key + " found !", 3)
ProcedureReturn PBMap\MemCache\Images()\nImage ProcedureReturn PBMap\MemCache\Images()\nImage
Else Else
MyDebug("Key : " + key + " not found !") MyDebug("Key : " + key + " not found !", 3)
ProcedureReturn -1 ProcedureReturn -1
EndIf EndIf
EndProcedure EndProcedure
Procedure.i GetTileFromHDD(CacheFile.s) Procedure.i GetTileFromHDD(CacheFile.s)
Protected nImage.i Protected nImage.i
Debug "Loading image " + CacheFile + " ; Size : " + Str(FileSize(CacheFile))
If FileSize(CacheFile) > 0 If FileSize(CacheFile) > 0
nImage = LoadImage(#PB_Any, CacheFile) nImage = LoadImage(#PB_Any, CacheFile)
If IsImage(nImage) If IsImage(nImage)
MyDebug("Loadimage " + CacheFile + " -> Success !") Debug "Success loading " + CacheFile + " as nImage " + Str(nImage)
MyDebug("Success loading " + CacheFile + " as nImage " + Str(nImage), 3)
ProcedureReturn nImage ProcedureReturn nImage
Else
Debug "Failed loading " + CacheFile + " as nImage " + Str(nImage) + " -> not an image !"
MyDebug("Failed loading " + CacheFile + " as nImage " + Str(nImage) + " -> not an image !", 3)
EndIf EndIf
Else
Debug "Failed loading " + CacheFile + " -> Size = 0"
MyDebug("Failed loading " + CacheFile + " -> Size = 0", 3)
EndIf EndIf
MyDebug("Loadimage " + CacheFile + " -> Failed !")
ProcedureReturn -1 ProcedureReturn -1
EndProcedure EndProcedure
@@ -446,29 +473,29 @@ Module PBMap
Protected nImage.i = -1 Protected nImage.i = -1
Protected FileHandle.i Protected FileHandle.i
Protected TileURL.s = PBMap\ServerURL + Str(Zoom) + "/" + Str(XTile) + "/" + Str(YTile) + ".png" Protected TileURL.s = PBMap\ServerURL + Str(Zoom) + "/" + Str(XTile) + "/" + Str(YTile) + ".png"
MyDebug("Check if we have this image on Web") MyDebug("Check if we have this image on Web", 3)
If Proxy If Proxy
FileHandle = CurlReceiveHTTPToFile(TileURL, CacheFile, ProxyURL$, ProxyPort$, ProxyUser$, ProxyPassword$) FileHandle = CurlReceiveHTTPToFile(TileURL, CacheFile, ProxyURL$, ProxyPort$, ProxyUser$, ProxyPassword$)
If FileHandle If FileHandle
nImage = GetTileFromHDD(CacheFile) nImage = GetTileFromHDD(CacheFile)
Else Else
MyDebug("File " + TileURL + " not correctly received with Curl and proxy") MyDebug("File " + TileURL + " not correctly received with Curl and proxy", 3)
EndIf EndIf
Else Else
*Buffer = ReceiveHTTPMemory(TileURL) ;TODO to thread by using #PB_HTTP_Asynchronous *Buffer = ReceiveHTTPMemory(TileURL) ;TODO to thread by using #PB_HTTP_Asynchronous
If *Buffer If *Buffer
nImage = CatchImage(#PB_Any, *Buffer, MemorySize(*Buffer)) nImage = CatchImage(#PB_Any, *Buffer, MemorySize(*Buffer))
If IsImage(nImage) If IsImage(nImage)
MyDebug("Load from web " + TileURL + " as Tile nb " + nImage) MyDebug("Load from web " + TileURL + " as Tile nb " + nImage, 3)
SaveImage(nImage, CacheFile, #PB_ImagePlugin_PNG) SaveImage(nImage, CacheFile, #PB_ImagePlugin_PNG)
FreeMemory(*Buffer) FreeMemory(*Buffer)
Else Else
MyDebug("Can't catch image " + TileURL) MyDebug("Can't catch image " + TileURL, 3)
nImage = -1 nImage = -1
;ShowMemoryViewer(*Buffer, MemorySize(*Buffer)) ;ShowMemoryViewer(*Buffer, MemorySize(*Buffer))
EndIf EndIf
Else Else
MyDebug("ReceiveHTTPMemory's buffer is empty") MyDebug("ReceiveHTTPMemory's buffer is empty", 3)
EndIf EndIf
EndIf EndIf
ProcedureReturn nImage ProcedureReturn nImage
@@ -476,31 +503,37 @@ Module PBMap
Procedure GetImageThread(*Tile.Tile) Procedure GetImageThread(*Tile.Tile)
Protected nImage.i = -1 Protected nImage.i = -1
Protected key.s = "Z" + RSet(Str(*Tile\PBMapZoom), 4, "0") + "X" + RSet(Str(*Tile\PBMapTileX), 8, "0") + "Y" + RSet(Str(*Tile\PBMapTileY), 8, "0")
Protected CacheFile.s = PBMap\HDDCachePath + "PBMap_" + Str(*Tile\PBMapZoom) + "_" + Str(*Tile\PBMapTileX) + "_" + Str(*Tile\PBMapTileY) + ".png" Protected CacheFile.s = PBMap\HDDCachePath + "PBMap_" + Str(*Tile\PBMapZoom) + "_" + Str(*Tile\PBMapTileX) + "_" + Str(*Tile\PBMapTileY) + ".png"
;Adding the image to the cache if possible Protected Tile.position
AddMapElement(PBMap\MemCache\Images(), key) ; PBMap\MemCache\Images(*Tile\key)\Mutex = CreateMutex()
; LockMutex(PBMap\MemCache\Images(*Tile\key)\Mutex)
; LockMutex(LoadMutexTest)
nImage = GetTileFromHDD(CacheFile) nImage = GetTileFromHDD(CacheFile)
; UnlockMutex(LoadMutexTest)
If nImage = -1 If nImage = -1
nImage = GetTileFromWeb(*Tile\PBMapZoom, *Tile\PBMapTileX, *Tile\PBMapTileY, CacheFile) nImage = GetTileFromWeb(*Tile\PBMapZoom, *Tile\PBMapTileX, *Tile\PBMapTileY, CacheFile)
If nImage = -1
MyDebug("Error GetImageThread procedure, image not loaded - " + *Tile\key, 3)
*Tile\nImage = -1
ProcedureReturn
EndIf
EndIf EndIf
If nImage <> -1 PBMap\MemCache\Images(*Tile\key)\nImage = nImage
PBMap\MemCache\Images(key)\nImage = nImage ; Tile\x=*Tile\PBMapTileX
MyDebug("Image nb " + Str(nImage) + " successfully added to mem cache") ; Tile\y=*Tile\PBMapTiley
MyDebug("With the following key : " + key) ; XY2LatLon(@Tile,@PBMap\MemCache\Images(*Tile\key)\Location)
Else MyDebug("Image nb " + Str(nImage) + " successfully added to mem cache", 3)
MyDebug("Error GetImageThread procedure, image not loaded - " + key) MyDebug("With the following key : " + *Tile\key, 3)
nImage = -1
EndIf
;Define this tile image nb ;Define this tile image nb
*Tile\nImage = nImage *Tile\nImage = nImage
; UnlockMutex(PBMap\MemCache\Images(key)\Mutex)
EndProcedure EndProcedure
Procedure DrawTile(*Tile.Tile) Procedure DrawTile(*Tile.Tile)
Protected x = *Tile\Position\x Protected x = *Tile\Position\x
Protected y = *Tile\Position\y Protected y = *Tile\Position\y
MyDebug(" Drawing tile nb " + " X : " + Str(*Tile\PBMapTileX) + " Y : " + Str(*Tile\PBMapTileX)) MyDebug(" Drawing tile nb " + " X : " + Str(*Tile\PBMapTileX) + " Y : " + Str(*Tile\PBMapTileX), 2)
MyDebug(" at coords " + Str(x) + "," + Str(y)) MyDebug(" at coords " + Str(x) + "," + Str(y), 2)
MovePathCursor(x, y) MovePathCursor(x, y)
DrawVectorImage(ImageID(*Tile\nImage)) DrawVectorImage(ImageID(*Tile\nImage))
EndProcedure EndProcedure
@@ -509,8 +542,8 @@ Module PBMap
Protected x = *Tile\Position\x Protected x = *Tile\Position\x
Protected y = *Tile\Position\y Protected y = *Tile\Position\y
Protected Text$ = "Loading" Protected Text$ = "Loading"
MyDebug(" Drawing tile nb " + " X : " + Str(*Tile\PBMapTileX) + " Y : " + Str(*Tile\PBMapTileX)) MyDebug(" Drawing tile nb " + " X : " + Str(*Tile\PBMapTileX) + " Y : " + Str(*Tile\PBMapTileX), 2)
MyDebug(" at coords " + Str(x) + "," + Str(y)) MyDebug(" at coords " + Str(x) + "," + Str(y), 2)
BeginVectorLayer() BeginVectorLayer()
;MovePathCursor(x, y) ;MovePathCursor(x, y)
VectorSourceColor(RGBA(255, 255, 255, 128)) VectorSourceColor(RGBA(255, 255, 255, 128))
@@ -530,17 +563,18 @@ Module PBMap
Protected ty = Int(*Drawing\Position\y) Protected ty = Int(*Drawing\Position\y)
Protected nx = *Drawing\CenterX / PBMap\TileSize ;How many tiles around the point Protected nx = *Drawing\CenterX / PBMap\TileSize ;How many tiles around the point
Protected ny = *Drawing\CenterY / PBMap\TileSize Protected ny = *Drawing\CenterY / PBMap\TileSize
MyDebug("Drawing tiles") MyDebug("Drawing tiles", 2)
For y = - ny - 1 To ny + 1 For y = - ny - 1 To ny + 1
For x = - nx - 1 To nx + 1 For x = - nx - 1 To nx + 1
;Was quiting the loop if a move occured, giving maybe smoother movement ;Was quiting the loop if a move occured, giving maybe smoother movement
;If PBMap\Moving ;If PBMap\Moving
; Break 2 ; Break 2
;EndIf ;EndIf
;Store parameters in only one memory place, and give it to the thread if needed
Protected *NewTile.Tile = AllocateMemory(SizeOf(Tile)) Protected *NewTile.Tile = AllocateMemory(SizeOf(Tile))
If *NewTile If *NewTile
With *NewTile With *NewTile
;Keep a track of tiles (especially to free memory) ;Keep a track of tiles, and eventually associated threads, to free memory
AddElement(PBMap\TilesThreads()) AddElement(PBMap\TilesThreads())
PBMap\TilesThreads()\Tile = *NewTile PBMap\TilesThreads()\Tile = *NewTile
;New tile parameters ;New tile parameters
@@ -549,52 +583,99 @@ Module PBMap
\PBMapTileX = tx + x \PBMapTileX = tx + x
\PBMapTileY = ty + y \PBMapTileY = ty + y
\PBMapZoom = PBMap\Zoom \PBMapZoom = PBMap\Zoom
\key = "Z" + RSet(Str(\PBMapZoom), 4, "0") + "X" + RSet(Str(\PBMapTileX), 8, "0") + "Y" + RSet(Str(\PBMapTileY), 8, "0") ;Unique identifier
;Check if the image exists ;Check if the image exists
\nImage = GetTileFromMem(\PBMapZoom, \PBMapTileX, \PBMapTileY) \nImage = GetTileFromMem(\key)
If \nImage = -1 If \nImage = -1
;If not, load it in the background ;If not, load it in the background
\GetImageThread = CreateThread(@GetImageThread(), *NewTile) If AddMapElement(PBMap\MemCache\Images(), \key) ;Add the image to the cache, once in this loop
PBMap\TilesThreads()\GetImageThread = \GetImageThread \GetImageThread = CreateThread(@GetImageThread(), *NewTile)
MyDebug(" Creating get image thread nb " + Str(\GetImageThread)) PBMap\TilesThreads()\GetImageThread = \GetImageThread
MyDebug(" Creating get image thread nb " + Str(\GetImageThread), 2)
Else
MyDebug(" Can't add a new image to the map list", 2)
CallDebugger
EndIf
EndIf EndIf
If IsImage(\nImage) If IsImage(\nImage)
DrawTile(*NewTile) DrawTile(*NewTile)
Else Else
MyDebug("Image missing") MyDebug("Image missing", 2)
DrawLoading(*NewTile) DrawLoading(*NewTile)
*Drawing\Dirty = #True ;Signals that this image is missing so we should have to redraw *Drawing\Dirty = #True ;Signals that this image is missing so we should have to redraw
EndIf EndIf
EndWith EndWith
Else Else
MyDebug(" Error, can't create a new tile") MyDebug(" Error, can't create a new tile", 2)
Break 2 Break 2
EndIf EndIf
Next Next
Next Next
;Free tile memory when the loading thread has finished ;Free tile memory
;TODO : get out this proc from drawtiles in a special "free ressources" task ;TODO : get out this proc from drawtiles in a special "free ressources" task
ForEach PBMap\TilesThreads() ForEach PBMap\TilesThreads()
;Check if there's no more loading thread
If IsThread(PBMap\TilesThreads()\GetImageThread) = 0 If IsThread(PBMap\TilesThreads()\GetImageThread) = 0
FreeMemory(PBMap\TilesThreads()\Tile) FreeMemory(PBMap\TilesThreads()\Tile)
DeleteElement(PBMap\TilesThreads()) DeleteElement(PBMap\TilesThreads())
EndIf EndIf
Next Next
; ;-**** Clean Mem Cache
; ;TODO in development, by now there's many cache problem as the loading thread could be perturbed
; ;GadgetWidth(PBMap\Gadget)/PBMap\TileSize
; Protected MaxNbTile.l
; If GadgetWidth(PBMap\Gadget)>GadgetHeight(PBMap\Gadget)
; MaxNbTile=GadgetWidth(PBMap\Gadget)/PBMap\TileSize
; Else
; MaxNbTile=GadgetHeight(PBMap\Gadget)/PBMap\TileSize
; EndIf
; Protected Scale.d= 40075*Cos(Radian(PBMap\TargetLocation\Latitude))/Pow(2,PBMap\Zoom)
; Protected Limit.d=Scale*(MaxNbTile)*1.5
; Debug "Cache cleaning"
; ForEach PBMap\MemCache\Images()
; Protected Distance.d = HaversineInKM(@PBMap\MemCache\Images()\Location, @PBMap\TargetLocation)
; Debug "Limit:"+StrD(Limit)+" Distance:"+StrD(Distance)
; If Distance>Limit And IsImage(PBMap\MemCache\Images()\nImage)
; LockMutex(PBMap\MemCache\Images()\Mutex)
; Debug "delete"
; Debug PBMap\MemCache\Images()
; FreeImage(PBMap\MemCache\Images()\nImage)
; UnlockMutex(PBMap\MemCache\Images()\Mutex)
; FreeMutex(PBMap\MemCache\Images()\Mutex)
; DeleteMapElement(PBMap\MemCache\Images())
; EndIf
; Next
EndProcedure EndProcedure
Procedure Pointer(x.i, y.i, color.l = 0) Procedure DrawPointer(*Drawing.DrawingParameters)
VectorSourceColor(color) If PBMap\CallBackMainPointer > 0
MovePathCursor(x, y) ; @Procedure(X.i, Y.i) to DrawPointer (you must use VectorDrawing lib)
AddPathLine(-8, -16, #PB_Path_Relative) CallFunctionFast(PBMap\CallBackMainPointer, *Drawing\CenterX, *Drawing\CenterY)
AddPathCircle(8, 0, 8, 180, 0, #PB_Path_Relative) Else
AddPathLine(-8, 16, #PB_Path_Relative) VectorSourceColor(RGBA($FF, 0, 0, $FF))
;FillPath(#PB_Path_Preserve) MovePathCursor(*Drawing\CenterX, *Drawing\CenterY)
;ClipPath(#PB_Path_Preserve) AddPathLine(-8, -16, #PB_Path_Relative)
AddPathCircle(0, -16, 5, 0, 360, #PB_Path_Relative) AddPathCircle(8, 0, 8, 180, 0, #PB_Path_Relative)
VectorSourceColor(color) AddPathLine(-8, 16, #PB_Path_Relative)
FillPath(#PB_Path_Preserve):VectorSourceColor(color);RGBA(0, 0, 0, 255)) ;FillPath(#PB_Path_Preserve)
StrokePath(1) ;ClipPath(#PB_Path_Preserve)
AddPathCircle(0, -16, 5, 0, 360, #PB_Path_Relative)
VectorSourceColor(RGBA($FF, 0, 0, $FF))
FillPath(#PB_Path_Preserve):VectorSourceColor(RGBA($FF, 0, 0, $FF));RGBA(0, 0, 0, 255))
StrokePath(1)
EndIf
EndProcedure EndProcedure
Procedure DrawScale(*Drawing.DrawingParameters)
;TODO Add Option and function to display Scale on Map
Protected Scale.d= 40075*Cos(Radian(PBMap\TargetLocation\Latitude))/Pow(2,PBMap\Zoom)
VectorFont(FontID(PBMap\Font), 30)
VectorSourceColor(RGBA(0, 0, 0, 80))
MovePathCursor(50,50)
DrawVectorText(StrD(Scale))
EndProcedure
Procedure TrackPointer(x.i, y.i,dist.l) Procedure TrackPointer(x.i, y.i,dist.l)
Protected color.l Protected color.l
color=RGBA(0, 0, 0, 255) color=RGBA(0, 0, 0, 255)
@@ -677,7 +758,7 @@ Module PBMap
If PBMap\Marker()\CallBackPointer > 0 If PBMap\Marker()\CallBackPointer > 0
CallFunctionFast(PBMap\Marker()\CallBackPointer, Pixel\X, Pixel\Y) CallFunctionFast(PBMap\Marker()\CallBackPointer, Pixel\X, Pixel\Y)
Else Else
Pointer(Pixel\X, Pixel\Y, PBMap\Marker()\color) DrawPointer(*Drawing)
EndIf EndIf
EndIf EndIf
EndIf EndIf
@@ -711,13 +792,16 @@ Module PBMap
DrawTiles(@Drawing) DrawTiles(@Drawing)
DrawTrack(@Drawing) DrawTrack(@Drawing)
DrawMarker(@Drawing) DrawMarker(@Drawing)
; @Procedure(X.i, Y.i) to DrawPointer (you must use VectorDrawing lib) DrawPointer(@Drawing)
If PBMap\CallBackMainPointer > 0 ;DrawScale(@Drawing)
CallFunctionFast(PBMap\CallBackMainPointer, Drawing\CenterX, Drawing\CenterY) ;- Display how many images in cache
Else VectorFont(FontID(PBMap\Font), 30)
Pointer(Drawing\CenterX, Drawing\CenterY, RGBA($FF, 0, 0, $FF)) VectorSourceColor(RGBA(0, 0, 0, 80))
EndIf MovePathCursor(50,50)
StopVectorDrawing() DrawVectorText(Str(MapSize(PBMap\MemCache\Images())))
MovePathCursor(50,80)
DrawVectorText(Str(ListSize(PBMap\TilesThreads())))
StopVectorDrawing()
;Redraw ;Redraw
; If something was not correctly drawn, redraw after a while ; If something was not correctly drawn, redraw after a while
LockMutex(*SharedDrawing\Mutex) ;Be sure that we're not modifying variables while moving (seems not useful, but it is, especially to clean the semaphore) LockMutex(*SharedDrawing\Mutex) ;Be sure that we're not modifying variables while moving (seems not useful, but it is, especially to clean the semaphore)
@@ -730,7 +814,7 @@ Module PBMap
Repeat : Until TrySemaphore(*SharedDrawing\Semaphore) = 0 Repeat : Until TrySemaphore(*SharedDrawing\Semaphore) = 0
EndIf EndIf
UnlockMutex(*SharedDrawing\Mutex) UnlockMutex(*SharedDrawing\Mutex)
Until Drawing\End Until Drawing\End
EndProcedure EndProcedure
Procedure Refresh() Procedure Refresh()
@@ -949,7 +1033,7 @@ Module PBMap
;New move values ;New move values
PBMap\Position\x - MouseX PBMap\Position\x - MouseX
PBMap\Position\y - MouseY PBMap\Position\y - MouseY
;Fill parameters and signal the drawing thread ;Fill parameters and send a signal to the drawing thread
LockMutex(PBMap\Drawing\Mutex) LockMutex(PBMap\Drawing\Mutex)
;PBMap tile position in tile.decimal ;PBMap tile position in tile.decimal
PBMap\Drawing\Position\x = PBMap\Position\x / PBMap\TileSize PBMap\Drawing\Position\x = PBMap\Position\x / PBMap\TileSize
@@ -957,9 +1041,9 @@ Module PBMap
PBMap\Drawing\PassNb = 1 PBMap\Drawing\PassNb = 1
XY2LatLon(@PBMap\Drawing, @PBMap\TargetLocation) XY2LatLon(@PBMap\Drawing, @PBMap\TargetLocation)
UnlockMutex(PBMap\Drawing\Mutex) UnlockMutex(PBMap\Drawing\Mutex)
;Start drawing
SignalSemaphore(PBMap\Drawing\Semaphore)
EndIf EndIf
;Start drawing
SignalSemaphore(PBMap\Drawing\Semaphore)
;If CallBackLocation send Location to function ;If CallBackLocation send Location to function
If PBMap\CallBackLocation > 0 If PBMap\CallBackLocation > 0
CallFunctionFast(PBMap\CallBackLocation, @PBMap\TargetLocation) CallFunctionFast(PBMap\CallBackLocation, @PBMap\TargetLocation)
@@ -1131,10 +1215,9 @@ CompilerIf #PB_Compiler_IsMainFile
PBMap::Quit() PBMap::Quit()
EndIf EndIf
CompilerEndIf CompilerEndIf
; IDE Options = PureBasic 5.42 LTS (Windows - x86) ; IDE Options = PureBasic 5.42 LTS (Windows - x86)
; CursorPosition = 1120 ; CursorPosition = 478
; FirstLine = 1077 ; FirstLine = 468
; Folding = --------- ; Folding = ---------
; EnableUnicode ; EnableUnicode
; EnableThread ; EnableThread