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

Grid of degrees

Browse Source
This commit is contained in:
djes
2016-08-30 12:20:31 +02:00
parent eca7a01c84
commit 19ce16e8d0
1 changed files with 391 additions and 310 deletions
Download Patch File Download Diff File Expand all files Collapse all files

421
PBMap.pb
View File

@@ -1,4 +1,4 @@
;**************************************************************
;;**************************************************************
; Program: PBMap
; Description: Permits the use of tiled maps like
; OpenStreetMap in a handy PureBASIC module
@@ -39,7 +39,6 @@ DeclareModule PBMap
Declare InitPBMap(window)
Declare SetMapServer(ServerURL.s = "http://tile.openstreetmap.org/", TileSize = 256, ZoomMin = 0, ZoomMax = 18)
Declare MapGadget(Gadget.i, X.i, Y.i, Width.i, Height.i)
Declare Event(Event.l)
Declare SetLocation(latitude.d, longitude.d, zoom = 15, mode.i = #PB_Absolute)
Declare Drawing()
Declare SetZoom(Zoom.i, mode.i = #PB_Relative)
@@ -55,7 +54,6 @@ DeclareModule PBMap
Declare.d GetLatitude()
Declare.d GetLongitude()
Declare.i GetZoom()
EndDeclareModule
Module PBMap
@@ -87,11 +85,18 @@ Module PBMap
key.s
CacheFile.s
GetImageThread.i
layer.i
RetryNb.i
Layer.i
EndStructure
Structure TileBounds
NorthWest.Position
SouthEast.Position
EndStructure
Structure DrawingParameters
Position.Position
Bounds.TileBounds
Canvas.i
PBMapTileX.i
PBMapTileY.i
@@ -113,6 +118,7 @@ Module PBMap
Structure ImgMemCach
nImage.i
*Tile.Tile
;Location.Location
;Mutex.i
EndStructure
@@ -137,6 +143,7 @@ Module PBMap
Window.i ; Parent Window
Gadget.i ; Canvas Gadget Id
Font.i ; Font to uses when write on the map
Timer.i
TargetLocation.Location ; Latitude and Longitude from focus point
Drawing.DrawingParameters ; Drawing parameters based on focus point
;
@@ -157,11 +164,13 @@ Module PBMap
HDDCachePath.S ; Path where to load and save tiles downloaded from server
MemCache.TileMemCach ; Images in memory cache
;
OnStage.i
Redraw.i
Moving.i
Dirty.i ; To signal that drawing need a refresh
;
MainDrawingThread.i
List TilesThreads.TileThread()
;List TilesThreads.TileThread()
TileThreadMutex.i; ;Mutex to protect resources
List track.Location() ; To display a GPX track
List Marker.Marker() ; To diplay marker
@@ -173,6 +182,7 @@ Module PBMap
EndStructure
#PB_MAP_REDRAW = #PB_EventType_FirstCustomValue + 1
#PB_MAP_RETRY = #PB_EventType_FirstCustomValue + 2
;-Global variables
Global PBMap.PBMap, Null.i
@@ -204,8 +214,8 @@ Module PBMap
Procedure.i CurlReceiveHTTPToFile(URL$, DestFileName$, ProxyURL$="", ProxyPort$="", ProxyUser$="", ProxyPassword$="")
Protected *Buffer, curl.i, Timeout.i, res.i
Protected FileHandle.i
MyDebug("ReceiveHTTPToFile from " + URL$ + " " + ProxyURL$ + ProxyPort$ + ProxyUser$, 3)
MyDebug(" to file : " + DestFileName$, 3)
MyDebug("CurlReceiveHTTPToFile from " + URL$ + " " + ProxyURL$ + " " + ProxyPort$ + " " + ProxyUser$, 4)
MyDebug(" to file : " + DestFileName$, 4)
FileHandle = CreateFile(#PB_Any, DestFileName$)
If FileHandle And Len(URL$)
curl = curl_easy_init()
@@ -238,11 +248,11 @@ Module PBMap
curl_easy_setopt(curl, #CURLOPT_WRITEFUNCTION, @ReceiveHTTPWriteToFileFunction())
res = curl_easy_perform(curl)
If res <> #CURLE_OK
MyDebug("CURL problem", 3)
MyDebug("CURL problem", 4)
EndIf
curl_easy_cleanup(curl)
Else
MyDebug("Can't init CURL", 3)
MyDebug("Can't init CURL", 4)
EndIf
CloseFile(FileHandle)
ProcedureReturn FileSize(DestFileName$)
@@ -270,7 +280,7 @@ Module PBMap
EndIf
EndProcedure
Procedure InitPBMap(window)
Procedure InitPBMap(Window)
Protected Result.i
If Verbose
OpenConsole()
@@ -284,7 +294,8 @@ Module PBMap
PBMap\TileThreadMutex = CreateMutex()
PBMap\EditMarkerIndex = -1 ;Initialised with "no marker selected"
PBMap\Font = LoadFont(#PB_Any, "Arial", 20, #PB_Font_Bold)
PBMap\Window = window
PBMap\Window = Window
PBMap\Timer = 1
PBMap\Options\WheelMouseRelative = #True
SetMapServer("http://tile.openstreetmap.org/")
@@ -325,24 +336,26 @@ Module PBMap
PBMap\TileSize = TileSize
EndProcedure
Procedure Quit()
PBMap\Drawing\End = #True
;Wait for loading threads to finish nicely. Passed 2 seconds, kills them.
Protected 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
ForEach PBMap\MemCache\Images()
If PBMap\MemCache\Images()\Tile <> 0
If IsThread(PBMap\MemCache\Images()\Tile\GetImageThread)
PBMap\MemCache\Images()\Tile\RetryNb = 0
If ElapsedMilliseconds() - TimeCounter > 2000
;Should not occur
KillThread(PBMap\TilesThreads()\GetImageThread)
KillThread(PBMap\MemCache\Images()\Tile\GetImageThread)
EndIf
Wend
EndIf
Else
DeleteMapElement(PBMap\MemCache\Images())
EndIf
Next
Delay(10)
Until ListSize(PBMap\TilesThreads()) = 0
Until MapSize(PBMap\MemCache\Images()) = 0
curl_global_cleanup()
EndProcedure
@@ -360,15 +373,6 @@ Module PBMap
ProcedureReturn Result
EndProcedure
Procedure MapGadget(Gadget.i, X.i, Y.i, Width.i, Height.i)
If Gadget = #PB_Any
PBMap\Gadget = CanvasGadget(PBMap\Gadget, X, Y, Width, Height, #PB_Canvas_Keyboard) ;#PB_Canvas_Keyboard has to be set for mousewheel to work on windows
Else
PBMap\Gadget = Gadget
CanvasGadget(PBMap\Gadget, X, Y, Width, Height, #PB_Canvas_Keyboard)
EndIf
EndProcedure
;*** Converts coords to tile.decimal
;Warning, structures used in parameters are not tested
Procedure LatLon2XY(*Location.Location, *Coords.Position)
@@ -460,62 +464,47 @@ Module PBMap
EndIf
EndProcedure
; Procedure LoadErrorHandler()
; MessageRequester("Error", "")
; EndProcedure
Procedure.i GetTileFromHDD(CacheFile.s)
Protected nImage.i
; Debug "Loading image " + CacheFile + " ; Size : " + Str(FileSize(CacheFile))
If FileSize(CacheFile) > 0
; OnErrorCall(@LoadErrorHandler())
nImage = LoadImage(#PB_Any, CacheFile)
; OnErrorDefault()
If IsImage(nImage)
;Debug "Success loading " + CacheFile + " as nImage " + Str(nImage)
MyDebug("Success loading " + CacheFile + " as nImage " + Str(nImage), 3)
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)
MyDebug("Failed loading " + CacheFile + " as nImage " + Str(nImage) + " -> not an image !", 3)
EndIf
Else
; Debug "Failed loading " + CacheFile + " -> Size <= 0"
MyDebug("Failed loading " + CacheFile + " -> Size <= 0", 3)
EndIf
ProcedureReturn -1
EndProcedure
Procedure.i GetLocalTile(key.s, CacheFile.s)
Protected timg
MyDebug("Check if we have this image in memory", 3)
If FindMapElement(PBMap\MemCache\Images(), key)
MyDebug("Key : " + key + " found !", 3)
ProcedureReturn PBMap\MemCache\Images()\nImage
Else
MyDebug("Key : " + key + " Try HDD!")
timg = GetTileFromHDD(CacheFile.s)
If timg <> -1
AddMapElement(PBMap\MemCache\Images(),key)
PBMap\MemCache\Images()\nImage = timg
EndIf
ProcedureReturn timg
EndIf
EndProcedure
Procedure.i GetTileFromWeb(Zoom.i, XTile.i, YTile.i, CacheFile.s,layer.i)
Procedure.i GetTileFromWeb(Zoom.i, XTile.i, YTile.i, CacheFile.s, Layer.i)
Protected *Buffer
Protected nImage.i = -1
Protected FileHandle.i,timg
Protected TileURL.s = PBMap\ServerURL(layer) + Str(Zoom) + "/" + Str(XTile) + "/" + Str(YTile) + ".png"
MyDebug("Check if we have this image on Web", 3)
Protected FileSize.i, timg
Protected TileURL.s = PBMap\ServerURL(Layer) + Str(Zoom) + "/" + Str(XTile) + "/" + Str(YTile) + ".png"
If Proxy
FileHandle = CurlReceiveHTTPToFile(TileURL, CacheFile, ProxyURL$, ProxyPort$, ProxyUser$, ProxyPassword$)
If FileHandle
FileSize = CurlReceiveHTTPToFile(TileURL, CacheFile, ProxyURL$, ProxyPort$, ProxyUser$, ProxyPassword$)
If FileSize > 0
MyDebug("Loaded from web " + TileURL + " as CacheFile " + CacheFile, 3)
nImage = GetTileFromHDD(CacheFile)
Else
MyDebug("File " + TileURL + " not correctly received with Curl and proxy", 3)
MyDebug("Problem loading from web " + TileURL, 3)
EndIf
Else
*Buffer = ReceiveHTTPMemory(TileURL) ;TODO to thread by using #PB_HTTP_Asynchronous
If *Buffer
nImage = CatchImage(#PB_Any, *Buffer, MemorySize(*Buffer))
If IsImage(nImage)
MyDebug("Load from web " + TileURL + " as Tile nb " + nImage, 3)
; Debug "url: " + TileURL
; Debug "cache file: " + CacheFile
; timg = LoadImage(#PB_Any,CacheFile)
@@ -526,17 +515,20 @@ Module PBMap
; SaveImage(timg, CacheFile, #PB_ImagePlugin_PNG)
; FreeImage(timg)
; Else
SaveImage(nImage, CacheFile, #PB_ImagePlugin_PNG)
If SaveImage(nImage, CacheFile, #PB_ImagePlugin_PNG,0,32)
MyDebug("Loaded from web " + TileURL + " as CacheFile " + CacheFile, 3)
Else
MyDebug("Loaded from web " + TileURL + " but cannot save to CacheFile " + CacheFile, 3)
EndIf
FreeMemory(*Buffer)
; EndIf
Else
MyDebug("Can't catch image " + TileURL, 3)
MyDebug("Can't catch image loaded from web " + TileURL, 3)
nImage = -1
;ShowMemoryViewer(*Buffer, MemorySize(*Buffer))
EndIf
Else
; Debug("ReceiveHTTPMemory's buffer is empty")
MyDebug("ReceiveHTTPMemory's buffer is empty", 3)
MyDebug(" Problem loading from web " + TileURL, 3)
EndIf
EndIf
ProcedureReturn nImage
@@ -544,76 +536,59 @@ Module PBMap
Procedure GetImageThread(*Tile.Tile)
Protected nImage.i = -1
nImage = GetTileFromWeb(*Tile\PBMapZoom, *Tile\PBMapTileX, *Tile\PBMapTileY, *Tile\CacheFile,*tile\layer)
Repeat
nImage = GetTileFromWeb(*Tile\PBMapZoom, *Tile\PBMapTileX, *Tile\PBMapTileY, *Tile\CacheFile, *Tile\Layer)
If nImage <> -1
LockMutex(PBMap\TileThreadMutex)
PBMap\MemCache\Images(*Tile\key)\nImage = nImage
UnlockMutex(PBMap\TileThreadMutex)
MyDebug("Image nb " + Str(nImage) + " successfully added to mem cache")
MyDebug("With the following key : " + *Tile\key)
*Tile\nImage = nImage
PostEvent(#PB_Event_Gadget, PBMap\window,PBmap\Gadget, #PB_MAP_REDRAW, *Tile)
MyDebug("Image key : " + *Tile\key + " web image loaded", 3)
PBMap\Dirty = #True
*Tile\RetryNb = 0
; PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_REDRAW, *Tile) ;If image is loaded from web, redraw
Else
MyDebug("Error GetImageThread procedure, image not loaded - " + *Tile\key)
;nImage = -1
MyDebug("Image key : " + *Tile\key + " web image not correctly loaded", 3)
Delay(5000)
*Tile\RetryNb - 1
; PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_RETRY, *Tile) ;If image is not loaded, retry
EndIf
Until *Tile\RetryNb <= 0
;End of the thread
LockMutex(PBMap\TileThreadMutex)
FreeMemory(PBMap\MemCache\Images(*Tile\key)\Tile)
PBMap\MemCache\Images(*Tile\key)\Tile = 0
UnlockMutex(PBMap\TileThreadMutex)
EndProcedure
Procedure DrawTile(*Tile.Tile)
Protected x = *Tile\Position\x
Protected y = *Tile\Position\y
MyDebug(" Drawing tile nb " + " X : " + Str(*Tile\PBMapTileX) + " Y : " + Str(*Tile\PBMapTileX), 2)
MyDebug(" at coords " + Str(x) + "," + Str(y), 2)
MovePathCursor(x, y)
DrawVectorImage(ImageID(*Tile\nImage))
EndProcedure
Procedure DrawLoading(*Tile.Tile)
Protected x = *Tile\Position\x
Protected y = *Tile\Position\y
Protected Text$ = "Loading"
MyDebug(" Drawing tile nb " + " X : " + Str(*Tile\PBMapTileX) + " Y : " + Str(*Tile\PBMapTileX), 2)
MyDebug(" at coords " + Str(x) + "," + Str(y))
EndProcedure
Procedure DrawTiles(*Drawing.DrawingParameters,layer.i,alpha.i=255)
;DisableDebugger
Protected x.i, y.i,kq.q
Protected tx = Int(*Drawing\Position\x) ;Don't forget the Int() !
Protected ty = Int(*Drawing\Position\y)
Protected nx = *Drawing\CenterX / PBMap\TileSize ;How many tiles around the point
Protected ny = *Drawing\CenterY / PBMap\TileSize
Protected px, py, img, tilex,tiley, key.s, CacheFile.s
MyDebug("Drawing tiles")
For y = - ny - 1 To ny + 1
For x = - nx - 1 To nx + 1
px = *Drawing\CenterX + x * PBMap\TileSize - *Drawing\DeltaX
py = *Drawing\CenterY + y * PBMap\TileSize - *Drawing\DeltaY
tilex = ((tx+x) % (1<< PBMap\Zoom))
tiley = ty+y
kq = layer | (pbmap\zoom << 8) | (tilex << 16) | (tiley << 36)
key = Str(kq)
CacheFile = PBMap\HDDCachePath + key + ".png"
img = GetLocalTile(key, CacheFile)
If img <> -1
MovePathCursor(px, py)
DrawVectorImage(ImageID(img),alpha)
Procedure.i GetTile(key.s, CacheFile.s, px.i, py.i, tilex.i, tiley.i, Layer.i)
Protected timg = -1
If FindMapElement(PBMap\MemCache\Images(), key)
MyDebug("Key : " + key + " found in memory cache!", 3)
timg = PBMap\MemCache\Images()\nImage
If timg <> -1
MyDebug("Image : " + timg + " found in memory cache!", 3)
ProcedureReturn timg
EndIf
Else
MovePathCursor(px, py)
DrawVectorImage(ImageID(PBMap\ImgLoading),alpha)
AddMapElement(PBMap\MemCache\Images(), key)
MyDebug("Key : " + key + " added in memory cache!", 3)
PBMap\MemCache\Images()\nImage = -1
;UnlockMutex(PBMap\TileThreadMutex)
EndIf
If PBMap\MemCache\Images()\Tile = 0 ;Check if a loading thread is not running
MyDebug("Trying to load from HDD " + CacheFile)
timg = GetTileFromHDD(CacheFile.s)
If timg <> -1
MyDebug("Key : " + key + " found on HDD")
PBMap\MemCache\Images()\nImage = timg
ProcedureReturn timg
EndIf
MyDebug("Key : " + key + " not found on HDD")
;Launch a new thread
Protected *NewTile.Tile = AllocateMemory(SizeOf(Tile))
If *NewTile
With *NewTile
;Keep a track of tiles (especially to free memory)
;TODO : not sure if it really needs a mutex here, i'm still trying to find where the white tile issue is coming from
;a tile download is either getting clobbered or timing out or getting kicked and it results in a corrupted png file on linux
LockMutex(PBMap\TileThreadMutex)
AddElement(PBMap\TilesThreads())
PBMap\TilesThreads()\Tile = *NewTile
UnlockMutex(PBMap\TileThreadMutex)
PBMap\MemCache\Images()\Tile = *NewTile
;New tile parameters
\Position\x = px
\Position\y = py
@@ -622,36 +597,84 @@ Module PBMap
\PBMapZoom = PBMap\Zoom
\key = key
\CacheFile = CacheFile
\layer = layer
LockMutex(PBMap\TileThreadMutex)
AddMapElement(PBMap\MemCache\Images(), \key) ;Add the image to the cache, once in this loop
PBMap\MemCache\Images()\nImage = PBMap\ImgLoading
UnlockMutex(PBMap\TileThreadMutex)
\Layer = Layer
\RetryNb = 5
\GetImageThread = CreateThread(@GetImageThread(), *NewTile)
PBMap\TilesThreads()\GetImageThread = \GetImageThread
myDebug(" Creating get image thread nb " + Str(\GetImageThread))
EndWith
Else
MyDebug(" Error, can't create a new tile")
Break 2
MyDebug(" Error, can't create a new tile loading thread")
EndIf
EndIf
ProcedureReturn timg
EndProcedure
Next
; Procedure DrawTile(*Tile.Tile)
; Protected x = *Tile\Position\x
; Protected y = *Tile\Position\y
; MyDebug(" Drawing tile nb " + " X : " + Str(*Tile\PBMapTileX) + " Y : " + Str(*Tile\PBMapTileX), 2)
; MyDebug(" at coords " + Str(x) + "," + Str(y), 2)
; MovePathCursor(x, y)
; DrawVectorImage(ImageID(*Tile\nImage))
; EndProcedure
;
; Procedure DrawLoading(*Tile.Tile)
; Protected x = *Tile\Position\x
; Protected y = *Tile\Position\y
; Protected Text$ = "Loading"
; MyDebug(" Drawing tile nb " + " X : " + Str(*Tile\PBMapTileX) + " Y : " + Str(*Tile\PBMapTileX), 2)
; MyDebug(" at coords " + Str(x) + "," + Str(y))
; EndProcedure
Next
Procedure DrawTiles(*Drawing.DrawingParameters, Layer.i, alpha.i=255)
;DisableDebugger
Protected x.i, y.i,kq.q
Protected tx = Int(*Drawing\Position\x) ;Don't forget the Int() !
Protected ty = Int(*Drawing\Position\y)
Protected nx = *Drawing\CenterX / PBMap\TileSize ;How many tiles around the point
Protected ny = *Drawing\CenterY / PBMap\TileSize
Protected px, py, img, tilex,tiley, key.s, CacheFile.s
MyDebug("Drawing tiles")
*Drawing\Bounds\NorthWest\x = tx-nx-1
*Drawing\Bounds\NorthWest\y = ty-ny-1
*Drawing\Bounds\SouthEast\x = tx+nx+1
*Drawing\Bounds\SouthEast\y = ty+ny+1
;Free tile memory
;TODO : maybe get out this proc from drawtiles in a special "free ressources" task
ForEach PBMap\TilesThreads()
;Check if there's no more loading thread
If IsThread(PBMap\TilesThreads()\GetImageThread) = 0
FreeMemory(PBMap\TilesThreads()\Tile)
DeleteElement(PBMap\TilesThreads())
For y = - ny - 1 To ny + 1
For x = - nx - 1 To nx + 1
; If PBMap\Moving ;If drawing was threaded, this would exit the loop when the user is moving
; Break 2
; EndIf
px = *Drawing\CenterX + x * PBMap\TileSize - *Drawing\DeltaX
py = *Drawing\CenterY + y * PBMap\TileSize - *Drawing\DeltaY
tilex = ((tx+x) % (1<< PBMap\Zoom))
tiley = ty+y
kq = Layer | (pbmap\zoom << 8) | (tilex << 16) | (tiley << 36)
key = Str(kq)
CacheFile = PBMap\HDDCachePath + key + ".png"
img = GetTile(key, CacheFile, px, py, tilex, tiley, Layer)
If img <> -1
MovePathCursor(px, py)
DrawVectorImage(ImageID(img), alpha)
Else
MovePathCursor(px, py)
DrawVectorImage(ImageID(PBMap\ImgLoading), alpha)
EndIf
Next
;EnableDebugger
Next
; ;Free tile memory
; ;TODO : maybe get out this proc from drawtiles in a special "free ressources" task
; ForEach PBMap\TilesThreads()
; ;Check if there's no more loading thread
; If IsThread(PBMap\TilesThreads()\GetImageThread) = 0
; FreeMemory(PBMap\TilesThreads()\Tile)
; DeleteElement(PBMap\TilesThreads())
; EndIf
; Next
EndProcedure
; ;-**** Clean Mem Cache
@@ -719,9 +742,43 @@ Module PBMap
MovePathCursor(x,y+12)
AddPathLine(x+128,y+10)
StrokePath(1)
EndProcedure
Procedure DrawDegrees(*Drawing.DrawingParameters,alpha=192)
Protected nx,ny,nx1,ny1,x,y,n,cx,dperpixel.d
Protected pos1.PixelPosition,pos2.PixelPosition,Degrees1.Location,degrees2.Location
;VectorFont(FontID(PBMap\Font), 10)
VectorSourceColor(RGBA(0, 0, 0,Alpha))
;GetMapRegionDegrees(@Degrees1,@degrees2)
XY2LatLon(*Drawing\Bounds\NorthWest,@Degrees1)
XY2LatLon(*Drawing\Bounds\SouthEast,@Degrees2)
ny = Round(Degrees1\Latitude,#PB_Round_Up)+1
ny1 = Round(degrees2\Latitude,#PB_Round_Down)-1
nx = Round(Degrees1\Longitude,#PB_Round_Down)-1
nx1 = Round(degrees2\Longitude,#PB_Round_Up) +1
For y = ny1 To ny
Degrees1\Latitude = y
degrees2\Latitude = y + 1
For x = nx To nx1
Degrees1\Longitude =x
Degrees2\Longitude =x+ 1
GetPixelCoordFromLocation(@Degrees1,@pos1)
MovePathCursor(pos1\x,pos1\y)
AddPathLine(pos2\x,pos1\y)
MovePathCursor(pos1\x,pos1\y)
AddPathLine(pos1\x,pos2\y)
Next
Next
StrokePath(1)
EndProcedure
Procedure TrackPointer(x.i, y.i,dist.l)
Protected color.l
color=RGBA(0, 0, 0, 255)
@@ -813,6 +870,9 @@ Module PBMap
Procedure Drawing()
Protected *Drawing.DrawingParameters = @PBMap\Drawing
Protected Px.d, Py.d,a
PBMap\OnStage = #True
PBMap\Dirty = #False
PBMap\Redraw = #False
;Precalc some values
*Drawing\CenterX = GadgetWidth(PBMap\Gadget) / 2
*Drawing\CenterY = GadgetHeight(PBMap\Gadget) / 2
@@ -838,12 +898,26 @@ Module PBMap
MovePathCursor(50,50)
DrawVectorText(Str(MapSize(PBMap\MemCache\Images())))
MovePathCursor(50,80)
DrawVectorText(Str(ListSize(PBMap\TilesThreads())))
Protected ThreadCounter = 0
ForEach PBMap\MemCache\Images()
If PBMap\MemCache\Images()\Tile <> 0
If PBMap\MemCache\Images()\Tile\GetImageThread <> 0
ThreadCounter + 1
EndIf
EndIf
Next
DrawVectorText(Str(ThreadCounter))
;If PBMap\Options\ShowScale
DrawScale(*Drawing,10,GadgetHeight(PBMAP\Gadget)-20,192)
DrawDegrees(*Drawing,192)
;EndIf
StopVectorDrawing()
;If there was a problem while drawing, redraw
; If PBMap\Dirty
; PBMap\Redraw = #True
; ;PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_REDRAW)
; EndIf
PBMap\OnStage = #False
EndProcedure
Procedure Refresh()
@@ -1001,17 +1075,10 @@ Module PBMap
ProcedureReturn Value
EndProcedure
Procedure Event(Event.l)
Protected Gadget.i
Procedure CanvasEvents()
Protected MouseX.i, MouseY.i
Protected Marker.Position
Protected *Drawing.DrawingParameters
If IsGadget(PBMap\Gadget) And GadgetType(PBMap\Gadget) = #PB_GadgetType_Canvas
Select Event
Case #PB_Event_Gadget ;{
Gadget = EventGadget()
Select Gadget
Case PBMap\Gadget
PBMap\Moving = #False
Select EventType()
Case #PB_EventType_MouseWheel
If PBMap\Options\WheelMouseRelative
@@ -1038,10 +1105,10 @@ Module PBMap
PBMap\MoveStartingPoint\x = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX)
PBMap\MoveStartingPoint\y = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY)
Case #PB_EventType_MouseMove
PBMap\Moving = #True
If PBMap\MoveStartingPoint\x <> - 1
MouseX = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) - PBMap\MoveStartingPoint\x
MouseY = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY) - PBMap\MoveStartingPoint\y
PBMap\Moving = #True
;Move marker
If PBMap\EditMarkerIndex > -1
SelectElement(PBMap\Marker(), PBMap\EditMarkerIndex)
@@ -1063,12 +1130,11 @@ Module PBMap
CallFunctionFast(PBMap\CallBackLocation, @PBMap\TargetLocation)
EndIf
EndIf
Drawing()
PBMap\Redraw = #True
PBMap\MoveStartingPoint\x = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX)
PBMap\MoveStartingPoint\y = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY)
EndIf
Case #PB_EventType_LeftButtonUp
PBMap\Moving = #False
PBMap\MoveStartingPoint\x = - 1
If PBMap\EditMarkerIndex > -1
PBMap\EditMarkerIndex = -1
@@ -1077,19 +1143,35 @@ Module PBMap
PBMap\Drawing\Position\y = PBMap\Position\y / PBMap\TileSize
MyDebug("PBMap\Drawing\Position\x " + Str(PBMap\Drawing\Position\x) + " ; PBMap\Drawing\Position\y " + Str(PBMap\Drawing\Position\y) )
XY2LatLon(@PBMap\Drawing, @PBMap\TargetLocation)
Drawing()
PBMap\Redraw = #True
EndIf
Case #PB_MAP_REDRAW
Drawing()
Debug "Redraw"
PBMap\Redraw = #True
Case #PB_MAP_RETRY
Debug "Reload"
PBMap\Redraw = #True
EndSelect
EndSelect
EndSelect
Else
MessageRequester("Module PBMap", "You must use PBMapGadget before", #PB_MessageRequester_Ok )
End
EndIf
EndProcedure
Procedure TimerEvents()
If EventTimer() = PBMap\Timer And (PBMap\Redraw Or PBMap\Dirty) And PBMap\OnStage = #False
Drawing()
EndIf
EndProcedure
Procedure MapGadget(Gadget.i, X.i, Y.i, Width.i, Height.i)
If Gadget = #PB_Any
PBMap\Gadget = CanvasGadget(PBMap\Gadget, X, Y, Width, Height, #PB_Canvas_Keyboard) ;#PB_Canvas_Keyboard has to be set for mousewheel to work on windows
Else
PBMap\Gadget = Gadget
CanvasGadget(PBMap\Gadget, X, Y, Width, Height, #PB_Canvas_Keyboard)
EndIf
BindGadgetEvent(PBMap\Gadget, @CanvasEvents())
AddWindowTimer(PBMap\Window, PBMap\Timer, 20)
BindEvent(#PB_Event_Timer, @TimerEvents())
EndProcedure
EndModule
;-Exemple
@@ -1172,10 +1254,10 @@ CompilerIf #PB_Compiler_IsMainFile
LoadFont(1, "Arial", 12, #PB_Font_Bold)
TextGadget(#Text_1, 530, 50, 60, 15, "Movements")
ButtonGadget(#Gdt_Left, 550, 100, 30, 30, Chr($E7)) : SetGadgetFont(#Gdt_Left, FontID(0))
ButtonGadget(#Gdt_Right, 610, 100, 30, 30, Chr($E8)) : SetGadgetFont(#Gdt_Right, FontID(0))
ButtonGadget(#Gdt_Up, 580, 070, 30, 30, Chr($E9)) : SetGadgetFont(#Gdt_Up, FontID(0))
ButtonGadget(#Gdt_Down, 580, 130, 30, 30, Chr($EA)) : SetGadgetFont(#Gdt_Down, FontID(0))
ButtonGadget(#Gdt_Left, 550, 100, 30, 30, Chr($25C4)) : SetGadgetFont(#Gdt_Left, FontID(0))
ButtonGadget(#Gdt_Right, 610, 100, 30, 30, Chr($25BA)) : SetGadgetFont(#Gdt_Right, FontID(0))
ButtonGadget(#Gdt_Up, 580, 070, 30, 30, Chr($25B2)) : SetGadgetFont(#Gdt_Up, FontID(0))
ButtonGadget(#Gdt_Down, 580, 130, 30, 30, Chr($25BC)) : SetGadgetFont(#Gdt_Down, FontID(0))
TextGadget(#Text_2, 530, 160, 60, 15, "Zoom")
ButtonGadget(#Button_4, 550, 180, 50, 30, " + ") : SetGadgetFont(#Button_4, FontID(1))
ButtonGadget(#Button_5, 600, 180, 50, 30, " - ") : SetGadgetFont(#Button_5, FontID(1))
@@ -1201,7 +1283,6 @@ CompilerIf #PB_Compiler_IsMainFile
Repeat
Event = WaitWindowEvent()
PBMap::Event(Event)
Select Event
Case #PB_Event_CloseWindow : Quit = 1
Case #PB_Event_Gadget ;{
@@ -1237,9 +1318,9 @@ CompilerIf #PB_Compiler_IsMainFile
CompilerEndIf
; IDE Options = PureBasic 5.50 (Windows - x64)
; CursorPosition = 1219
; FirstLine = 1193
; Folding = ----------
; CursorPosition = 1290
; FirstLine = 1275
; Folding = ---------
; EnableThread
; EnableXP
; DisableDebugger