From 19ce16e8d0ba2622b0c8ab7f393a133fa1275692 Mon Sep 17 00:00:00 2001 From: djes Date: Tue, 30 Aug 2016 12:20:31 +0200 Subject: [PATCH] Grid of degrees --- PBMap.pb | 701 +++++++++++++++++++++++++++++++------------------------ 1 file changed, 391 insertions(+), 310 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index a3e75e3..d7f6348 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -1,4 +1,4 @@ -;************************************************************** +;;************************************************************** ; Program: PBMap ; Description: Permits the use of tiled maps like ; OpenStreetMap in a handy PureBASIC module @@ -30,7 +30,7 @@ DeclareModule PBMap ;-Show debug infos Global Verbose = 1 Global MyDebugLevel = 3 - ;-Proxy ON/OFF + ;-Proxy ON/OFF Global Proxy = #False #SCALE_NAUTICAL = 1 @@ -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,15 +143,16 @@ 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 - ; + ; CallBackLocation.i ; @Procedure(latitude.d,lontitude.d) CallBackMainPointer.i ; @Procedure(X.i, Y.i) to DrawPointer (you must use VectorDrawing lib) - ; + ; Position.PixelPosition ; Actual focus point coords in pixels (global) MoveStartingPoint.PixelPosition ; Start mouse position coords when dragging the map - ; + ; Array ServerURL.s(0) ; Web URL ex: http://tile.openstreetmap.org/ NumberOfMapLayers.i ; The number of map tile layers; @@ -153,15 +160,17 @@ Module PBMap ZoomMax.i ; Max Zoom supported by server Zoom.i ; Current zoom TileSize.i ; Tile size downloaded on the server ex : 256 - ; + ; 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,10 +294,11 @@ 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/") - + ;-Preferences ;Use this to create and customize your preferences file for the first time ; CreatePreferences(GetHomeDirectory() + "PBMap.prefs") @@ -324,25 +335,27 @@ Module PBMap PBMap\ZoomMax = ZoomMax 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 - ;Should not occur - KillThread(PBMap\TilesThreads()\GetImageThread) + 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\MemCache\Images()\Tile\GetImageThread) + EndIf + EndIf + Else + DeleteMapElement(PBMap\MemCache\Images()) EndIf - Wend + 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) @@ -423,7 +427,7 @@ Module PBMap x2 = (PBMap\TargetLocation\Longitude+180)*(mapWidth/360) ; convert from degrees To radians latRad = PBMap\TargetLocation\Latitude*#PI/180; - ; get y value + ; get y value mercN = Log(Tan((#PI/4)+(latRad/2))) y2 = (mapHeight/2)-(mapWidth*mercN/(2*#PI)); *Pixel\x=GadgetWidth(PBMap\Gadget)/2 - (x2-x1) @@ -460,83 +464,71 @@ 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) - ; If timg - ; StartDrawing(ImageOutput(timg)) - ; DrawImage(ImageID(nimage)) - ; StopDrawing() - ; SaveImage(timg, CacheFile, #PB_ImagePlugin_PNG) - ; FreeImage(timg) - ; Else - SaveImage(nImage, CacheFile, #PB_ImagePlugin_PNG) - FreeMemory(*Buffer) - ; EndIf + ; Debug "url: " + TileURL + ; Debug "cache file: " + CacheFile + ; timg = LoadImage(#PB_Any,CacheFile) + ; If timg + ; StartDrawing(ImageOutput(timg)) + ; DrawImage(ImageID(nimage)) + ; StopDrawing() + ; SaveImage(timg, CacheFile, #PB_ImagePlugin_PNG) + ; FreeImage(timg) + ; Else + 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,141 +536,172 @@ Module PBMap Procedure GetImageThread(*Tile.Tile) Protected nImage.i = -1 - 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) - Else - MyDebug("Error GetImageThread procedure, image not loaded - " + *Tile\key) - ;nImage = -1 - EndIf - + 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 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("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)) + 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 + 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 + PBMap\MemCache\Images()\Tile = *NewTile + ;New tile parameters + \Position\x = px + \Position\y = py + \PBMapTileX = tilex + \PBMapTileY = tiley + \PBMapZoom = PBMap\Zoom + \key = key + \CacheFile = CacheFile + \Layer = Layer + \RetryNb = 5 + \GetImageThread = CreateThread(@GetImageThread(), *NewTile) + myDebug(" Creating get image thread nb " + Str(\GetImageThread)) + EndWith + Else + MyDebug(" Error, can't create a new tile loading thread") + EndIf + EndIf + ProcedureReturn timg 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 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) + 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 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 + 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) - Else - MovePathCursor(px, py) - DrawVectorImage(ImageID(PBMap\ImgLoading),alpha) - 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) - ;New tile parameters - \Position\x = px - \Position\y = py - \PBMapTileX = tilex - \PBMapTileY = tiley - \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) - \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 - EndIf - EndIf - - Next - - 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 - ;EnableDebugger + ; 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 + 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 -; ;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 + ; ;-**** 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 Procedure DrawPointer(*Drawing.DrawingParameters) If PBMap\CallBackMainPointer > 0 @@ -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 @@ -826,8 +886,8 @@ Module PBMap StartVectorDrawing(CanvasVectorOutput(PBMap\Gadget)) ;TODO add in layers of tiles ;this way we can cache them as 0 base 1.n layers ;such as for openseamap tiles which are overlaid. not that efficent from here though. - For a = 0 To PBMap\NumberOfMapLayers-1 - DrawTiles(*Drawing,a) + For a = 0 To PBMap\NumberOfMapLayers - 1 + DrawTiles(*Drawing, a) Next DrawTrack(*Drawing) DrawMarker(*Drawing) @@ -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) + DrawScale(*Drawing,10,GadgetHeight(PBMAP\Gadget)-20,192) + DrawDegrees(*Drawing,192) ;EndIf - StopVectorDrawing() + 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() @@ -948,8 +1022,8 @@ Module PBMap PBMap\Options\ScaleUnit = ScaleUnit Drawing() EndProcedure - - ;Zoom on x, y position relative to the canvas gadget + + ;Zoom on x, y position relative to the canvas gadget Procedure SetZoomOnPosition(x, y, zoom) Protected MouseX.d, MouseY.d Protected OldPx.d, OldPy.d, OldMx.d, OldMy.d @@ -1001,95 +1075,103 @@ 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 - Select EventType() - Case #PB_EventType_MouseWheel - If PBMap\Options\WheelMouseRelative - ;Relative zoom (centered on the mouse) - SetZoomOnPosition(GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX), GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY), GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_WheelDelta)) - Else - ;Absolute zoom (centered on the center of the map) - SetZoom(GetGadgetAttribute(PBMap\Gadget,#PB_Canvas_WheelDelta), #PB_Relative) - EndIf - Case #PB_EventType_LeftButtonDown - ;Check if we select a marker - MouseX = PBMap\Position\x - GadgetWidth(PBMap\Gadget) / 2 + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) - MouseY = PBMap\Position\y - GadgetHeight(PBMap\Gadget) / 2 + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY) - ForEach PBMap\Marker() - LatLon2XY(@PBMap\Marker()\Location, @Marker) - Marker\x * PBMap\TileSize - Marker\y * PBMap\TileSize - If Distance(Marker\x, Marker\y, MouseX, MouseY) < 8 - PBMap\EditMarkerIndex = ListIndex(PBMap\Marker()) - Break - EndIf - Next - ;Mem cursor Coord - PBMap\MoveStartingPoint\x = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) - PBMap\MoveStartingPoint\y = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY) - Case #PB_EventType_MouseMove - 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) - LatLon2XY(@PBMap\Marker()\Location, @Marker) - Marker\x + MouseX / PBMap\TileSize - Marker\y + MouseY / PBMap\TileSize - XY2LatLon(@Marker, @PBMap\Marker()\Location) - Else - ;New move values - PBMap\Position\x - MouseX - PBMap\Position\y - MouseY - ;PBMap tile position in tile.decimal - PBMap\Drawing\Position\x = PBMap\Position\x / PBMap\TileSize - PBMap\Drawing\Position\y = PBMap\Position\y / PBMap\TileSize - PBMap\Drawing\PassNb = 1 - XY2LatLon(@PBMap\Drawing, @PBMap\TargetLocation) - ;If CallBackLocation send Location to function - If PBMap\CallBackLocation > 0 - CallFunctionFast(PBMap\CallBackLocation, @PBMap\TargetLocation) - EndIf - EndIf - Drawing() - 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 - Else ;Move Map - PBMap\Drawing\Position\x = PBMap\Position\x / PBMap\TileSize - 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() - EndIf - Case #PB_MAP_REDRAW - Drawing() - EndSelect - EndSelect - EndSelect - Else - MessageRequester("Module PBMap", "You must use PBMapGadget before", #PB_MessageRequester_Ok ) - End - EndIf - + PBMap\Moving = #False + Select EventType() + Case #PB_EventType_MouseWheel + If PBMap\Options\WheelMouseRelative + ;Relative zoom (centered on the mouse) + SetZoomOnPosition(GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX), GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY), GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_WheelDelta)) + Else + ;Absolute zoom (centered on the center of the map) + SetZoom(GetGadgetAttribute(PBMap\Gadget,#PB_Canvas_WheelDelta), #PB_Relative) + EndIf + Case #PB_EventType_LeftButtonDown + ;Check if we select a marker + MouseX = PBMap\Position\x - GadgetWidth(PBMap\Gadget) / 2 + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) + MouseY = PBMap\Position\y - GadgetHeight(PBMap\Gadget) / 2 + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY) + ForEach PBMap\Marker() + LatLon2XY(@PBMap\Marker()\Location, @Marker) + Marker\x * PBMap\TileSize + Marker\y * PBMap\TileSize + If Distance(Marker\x, Marker\y, MouseX, MouseY) < 8 + PBMap\EditMarkerIndex = ListIndex(PBMap\Marker()) + Break + EndIf + Next + ;Mem cursor Coord + 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 + ;Move marker + If PBMap\EditMarkerIndex > -1 + SelectElement(PBMap\Marker(), PBMap\EditMarkerIndex) + LatLon2XY(@PBMap\Marker()\Location, @Marker) + Marker\x + MouseX / PBMap\TileSize + Marker\y + MouseY / PBMap\TileSize + XY2LatLon(@Marker, @PBMap\Marker()\Location) + Else + ;New move values + PBMap\Position\x - MouseX + PBMap\Position\y - MouseY + ;PBMap tile position in tile.decimal + PBMap\Drawing\Position\x = PBMap\Position\x / PBMap\TileSize + PBMap\Drawing\Position\y = PBMap\Position\y / PBMap\TileSize + PBMap\Drawing\PassNb = 1 + XY2LatLon(@PBMap\Drawing, @PBMap\TargetLocation) + ;If CallBackLocation send Location to function + If PBMap\CallBackLocation > 0 + CallFunctionFast(PBMap\CallBackLocation, @PBMap\TargetLocation) + EndIf + EndIf + 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\MoveStartingPoint\x = - 1 + If PBMap\EditMarkerIndex > -1 + PBMap\EditMarkerIndex = -1 + Else ;Move Map + PBMap\Drawing\Position\x = PBMap\Position\x / PBMap\TileSize + 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) + PBMap\Redraw = #True + EndIf + Case #PB_MAP_REDRAW + Debug "Redraw" + PBMap\Redraw = #True + Case #PB_MAP_RETRY + Debug "Reload" + PBMap\Redraw = #True + EndSelect 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 @@ -1170,12 +1252,12 @@ CompilerIf #PB_Compiler_IsMainFile LoadFont(0, "Arial", 12) 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 ;{ @@ -1232,14 +1313,14 @@ CompilerIf #PB_Compiler_IsMainFile PBMap::Quit() EndIf - + CloseConsole() CompilerEndIf ; IDE Options = PureBasic 5.50 (Windows - x64) -; CursorPosition = 1219 -; FirstLine = 1193 -; Folding = ---------- +; CursorPosition = 1290 +; FirstLine = 1275 +; Folding = --------- ; EnableThread ; EnableXP ; DisableDebugger