PBMap - Cartes OSM, Here, Geoserver dans un Canvas
Re: OpenStreetMap dans un Canvas
Alors moi je suis complètement largué. Désolé le gars j'aimerais vraiment vous aider.
Re: OpenStreetMap dans un Canvas
pas de souci. Attend qu'on est quelques choses de stable. On te demandera un coup de main pour tester le tout apresMetalOS a écrit :Alors moi je suis complètement largué. Désolé le gars j'aimerais vraiment vous aider.
Re: OpenStreetMap dans un Canvas
Ok en tout cas merci pour votre travail car je cherche ce genre de chose pour mon logiciel depuis plusieurs années.
Re: OpenStreetMap dans un Canvas
Bon voilà un premier jet, vous verrez que les nouvelles tuiles suivent le déplacement. C'est parce que les threads sont "lancés" et que je ne les arrête pas (encore). Le fait est que je me tâte pour dessiner dans une image et ensuite cette image sur le gadget, afin d'éviter le flickering, et peut-être faire du "scrolling" afin de fluidifier et éviter des chargements...
Choses importantes : voici le fichier curl.pbi, qui remplace le fichier ReceiveHTTPToMemory.pbi. C'est maintenant un module. Je pensais que ça permettrait de le threader, mais il semble que non (?)
curl.pbi
Ne pas oublier le fichier libcurl.pbi d'infratec qui contient les constantes, à prendre sur https://github.com/deseven/pbsamples/tr ... rm/libcurl
Voici le code
Choses importantes : voici le fichier curl.pbi, qui remplace le fichier ReceiveHTTPToMemory.pbi. C'est maintenant un module. Je pensais que ça permettrait de le threader, mais il semble que non (?)
curl.pbi
Code : Tout sélectionner
DeclareModule curl
Declare ReceiveHTTPToMemory(URL$, ProxyURL$="", ProxyPort$="", ProxyUser$="", ProxyPassword$="")
EndDeclareModule
Module curl
IncludeFile "libcurl.pbi" ; https://github.com/deseven/pbsamples/tree/master/crossplatform/libcurl
EnableExplicit
CompilerIf #PB_Compiler_IsMainFile
EnableExplicit
CompilerEndIf
Global *ReceiveHTTPToMemoryBuffer, ReceiveHTTPToMemoryBufferPtr.i
ProcedureC ReceiveHTTPWriteToMemoryFunction(*ptr, Size.i, NMemB.i, *Stream)
Protected SizeProper.i = Size & 255
Protected NMemBProper.i = NMemB
If *ReceiveHTTPToMemoryBuffer = 0
*ReceiveHTTPToMemoryBuffer = AllocateMemory(SizeProper * NMemBProper)
If *ReceiveHTTPToMemoryBuffer = 0
Debug "Problem allocating memory"
End
EndIf
Else
*ReceiveHTTPToMemoryBuffer = ReAllocateMemory(*ReceiveHTTPToMemoryBuffer, MemorySize(*ReceiveHTTPToMemoryBuffer) + SizeProper * NMemBProper)
If *ReceiveHTTPToMemoryBuffer = 0
Debug "Problem reallocating memory"
End
EndIf
EndIf
CopyMemory(*ptr, *ReceiveHTTPToMemoryBuffer + ReceiveHTTPToMemoryBufferPtr, SizeProper * NMemBProper)
ReceiveHTTPToMemoryBufferPtr + SizeProper * NMemBProper
ProcedureReturn SizeProper * NMemBProper
EndProcedure
Procedure.i ReceiveHTTPToMemory(URL$, ProxyURL$="", ProxyPort$="", ProxyUser$="", ProxyPassword$="")
Protected *Buffer, curl.i, Timeout.i, res.i
;Debug "ReceiveHTTPToMemory" + URL$ + ProxyURL$ + ProxyPort$ + ProxyUser$ + ProxyPassword$
If Len(URL$)
curl = curl_easy_init()
If curl
Timeout = 3
curl_easy_setopt(curl, #CURLOPT_URL, str2curl(URL$))
curl_easy_setopt(curl, #CURLOPT_SSL_VERIFYPEER, 0)
curl_easy_setopt(curl, #CURLOPT_SSL_VERIFYHOST, 0)
curl_easy_setopt(curl, #CURLOPT_HEADER, 0)
curl_easy_setopt(curl, #CURLOPT_TIMEOUT, Timeout)
If Len(ProxyURL$)
;curl_easy_setopt(curl, #CURLOPT_HTTPPROXYTUNNEL, #True)
If Len(ProxyPort$)
ProxyURL$ + ":" + ProxyPort$
EndIf
Debug ProxyURL$
curl_easy_setopt(curl, #CURLOPT_PROXY, str2curl(ProxyURL$))
If Len(ProxyUser$)
If Len(ProxyPassword$)
ProxyUser$ + ":" + ProxyPassword$
EndIf
;Debug ProxyUser$
curl_easy_setopt(curl, #CURLOPT_PROXYUSERPWD, str2curl(ProxyUser$))
EndIf
EndIf
curl_easy_setopt(curl, #CURLOPT_WRITEFUNCTION, @ReceiveHTTPWriteToMemoryFunction())
res = curl_easy_perform(curl)
If res = #CURLE_OK
*Buffer = AllocateMemory(ReceiveHTTPToMemoryBufferPtr)
If *Buffer
CopyMemory(*ReceiveHTTPToMemoryBuffer, *Buffer, ReceiveHTTPToMemoryBufferPtr)
FreeMemory(*ReceiveHTTPToMemoryBuffer)
*ReceiveHTTPToMemoryBuffer = #Null
ReceiveHTTPToMemoryBufferPtr = 0
Else
Debug "Problem allocating buffer"
EndIf
;curl_easy_cleanup(curl) ;Was its original place but moved below as it seems more logical to me.
Else
Debug "CURL NOT OK"
EndIf
curl_easy_cleanup(curl)
Else
Debug "Can't Init CURL"
EndIf
EndIf
Debug "Curl Buffer : " + Str(*Buffer)
ProcedureReturn *Buffer
EndProcedure
EndModule
CompilerIf #PB_Compiler_IsMainFile
Define *Buffer, ProxyURL$, ProxyPort$, ProxyUser$, ProxyPass$
InitNetwork()
ProxyURL$ = InputRequester("ProxyServer", "Do you use a Proxy Server? Then enter the full url:", "")
ProxyPort$ = InputRequester("ProxyPort" , "Do you use a specific port? Then enter it", "")
ProxyUser$ = InputRequester("ProxyUser" , "Do you use a user name? Then enter it", "")
ProxyPass$ = InputRequester("ProxyPass" , "Do you use a password? Then enter it:", "")
*Buffer = curl::ReceiveHTTPToMemory("http://www.purebasic.fr/english/index.php", ProxyURL$, ProxyPort$, ProxyUser$, ProxyPass$)
If *Buffer
ShowMemoryViewer(*Buffer, MemorySize(*Buffer))
FreeMemory(*Buffer)
Else
MessageRequester("Erreur", "Problem while loading", #PB_MessageRequester_Ok )
EndIf
CompilerEndIfVoici le code
Code : Tout sélectionner
;**************************************************************
; Program: OSM (OpenStreetMap Module)
; Author: Thyphoon And Djes
; Date: Mai 17, 2016
; License: Free, unrestricted, credit appreciated
; but not required.
; Note: Please share improvement !
; Thanks: Progi1984,
;**************************************************************
CompilerIf #PB_Compiler_Thread = #False
MessageRequester("Warning !!","You must enable ThreadSafe support in compiler options",#PB_MessageRequester_Ok )
End
CompilerEndIf
EnableExplicit
InitNetwork()
UsePNGImageDecoder()
UsePNGImageEncoder()
IncludeFile("curl.pbi")
DeclareModule OSM
Declare InitOSM()
Declare OSMGadget(Gadget.i, X.i, Y.i, Width.i, Height.i)
Declare Event(Event.l)
Declare SetLocation(latitude.d, longitude.d, zoom = 15)
Declare Draw()
Declare SetZoom(Zoom.i, mode.i = #PB_Relative)
Declare LoadGpxFile(file.s);
EndDeclareModule
Module OSM
EnableExplicit
Structure Location
Longitude.d
Latitude.d
EndStructure
;- Tile Structure
Structure Tile
x.d
y.d
OSMTileX.i
OSMTileY.i
OSMZoom.i
nImage.i
LoadingSemaphore.i
GetImageThread.i
DrawTileThread.i
Quit.i
EndStructure
Structure TileThread
LoadingSemaphore.i
GetImageThread.i
DrawTileThread.i
*Tile.Tile
EndStructure
Structure Pixel
x.i
y.i
EndStructure
Structure ImgMemCach
nImage.i
Zoom.i
XTile.i
YTile.i
EndStructure
Structure TileMemCach
List Image.ImgMemCach()
Mutex.i
Semaphore.i
EndStructure
;-OSM Structure
Structure OSM
Gadget.i ; Canvas Gadget Id
TargetLocation.Location ; Latitude and Longitude from focus point
TargetTile.Tile ; Focus Tile coord
Position.Pixel ; Actual focus Point coords in pixels
DeltaX.i
DeltaY.i
MoveStartingPoint.Pixel ; Start mouse position coords when dragging the map
ServerURL.s ; Web URL ex: http://tile.openstreetmap.org/
ZoomMin.i ; Min Zoom supported by server
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 ; Image in memory cache
List MapImageIndex.ImgMemCach() ; Index from MemCache\Image() to construct map
DrawingThread.i
DrawingMutex.i
CurlMutex.i ;seems that I can't thread curl ! :(((((
List TilesThreads.TileThread()
MapImageMutex.i ; Mutex to lock
List track.Location() ;to display a GPX track
EndStructure
Global OSM.OSM
Procedure InitOSM()
OSM\HDDCachePath = GetTemporaryDirectory()
OSM\ServerURL = "http://tile.openstreetmap.org/"
OSM\ZoomMin = 0
OSM\ZoomMax = 18
OSM\MoveStartingPoint\x = - 1
OSM\TileSize = 256
OSM\MemCache\Mutex = CreateMutex()
OSM\DrawingMutex = CreateMutex()
OSM\CurlMutex = CreateMutex()
Global Proxy = #True
If proxy
Global ProxyURL$ = InputRequester("ProxyServer", "Do you use a Proxy Server? Then enter the full url:", "")
Global ProxyPort$ = InputRequester("ProxyPort" , "Do you use a specific port? Then enter it", "")
Global ProxyUser$ = InputRequester("ProxyUser" , "Do you use a user name? Then enter it", "")
Global ProxyPassword$ = InputRequester("ProxyPass" , "Do you use a password? Then enter it:", "")
EndIf
EndProcedure
Procedure OSMGadget(Gadget.i, X.i, Y.i, Width.i, Height.i)
If Gadget = #PB_Any
OSM\Gadget = CanvasGadget(OSM\Gadget, X, Y, Width, Height)
Else
OSM\Gadget = Gadget
CanvasGadget(OSM\Gadget, X, Y, Width, Height)
EndIf
EndProcedure
Procedure LatLon2XY(*Location.Location, *Tile.Tile)
Protected n.d = Pow(2.0, OSM\Zoom)
Protected LatRad.d = Radian(*Location\Latitude)
*Tile\x = n * ( (*Location\Longitude + 180.0) / 360.0)
*Tile\y = n * ( 1.0 - Log(Tan(LatRad) + 1.0/Cos(LatRad)) / #PI ) / 2.0
Debug "Latitude : " + StrD(*Location\Latitude) + " ; Longitude : " + StrD(*Location\Longitude)
Debug "Tile X : " + Str(*Tile\x) + " ; Tile Y : " + Str(*Tile\y)
EndProcedure
Procedure XY2LatLon(*Tile.Tile, *Location.Location)
Protected n.d = Pow(2.0, OSM\Zoom)
Protected LatitudeRad.d
*Location\Longitude = *Tile\x / n * 360.0 - 180.0
LatitudeRad = ATan(SinH(#PI * (1.0 - 2.0 * *Tile\y / n)))
*Location\Latitude = Degree(LatitudeRad)
EndProcedure
Procedure getPixelCoorfromLocation(*Location.Location, *Pixel.Pixel) ; TODO to Optimize
Protected mapWidth.l = Pow(2,OSM\Zoom+8)
Protected mapHeight.l = Pow(2,OSM\Zoom+8)
Protected x1.l,y1.l
Protected deltaX = OSM\Position\x - Int(OSM\TargetTile\x) * OSM\TileSize ;Get the position into the tile
Protected deltaY = OSM\Position\y - Int(OSM\TargetTile\y) * OSM\TileSize
; get x value
x1 = (*Location\Longitude+180)*(mapWidth/360)
; convert from degrees To radians
Protected latRad.d = *Location\Latitude*#PI/180;
Protected mercN.d = Log(Tan((#PI/4)+(latRad/2)));
y1 = (mapHeight/2)-(mapWidth*mercN/(2*#PI)) ;
Protected x2.l, y2.l
; get x value
x2 = (OSM\TargetLocation\Longitude+180)*(mapWidth/360)
; convert from degrees To radians
latRad = OSM\TargetLocation\Latitude*#PI/180;
; get y value
mercN = Log(Tan((#PI/4)+(latRad/2))) ;
y2 = (mapHeight/2)-(mapWidth*mercN/(2*#PI));
*Pixel\x=GadgetWidth(OSM\Gadget)/2 - (x2-x1) + deltaX
*Pixel\y=GadgetHeight(OSM\Gadget)/2 - (y2-y1) + deltaY
EndProcedure
Procedure LoadGpxFile(file.s)
If LoadXML(0, file.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))
MessageRequester("Error", Message)
EndIf
Protected *MainNode,*subNode,*child,child.l
*MainNode=MainXMLNode(0)
*MainNode=XMLNodeFromPath(*MainNode,"/gpx/trk/trkseg")
ClearList(OSM\track())
For child = 1 To XMLChildCount(*MainNode)
*child = ChildXMLNode(*MainNode, child)
AddElement(OSM\track())
If ExamineXMLAttributes(*child)
While NextXMLAttribute(*child)
Select XMLAttributeName(*child)
Case "lat"
OSM\track()\Latitude=ValD(XMLAttributeValue(*child))
Case "lon"
OSM\track()\Longitude=ValD(XMLAttributeValue(*child))
EndSelect
Wend
EndIf
Next
EndIf
EndProcedure
Procedure AddTileToMemCache(Zoom.i, XTile.i, YTile.i, nImage.i)
Protected Index.i
If IsImage(nImage)
Debug "Adding tile " + Str(nImage) + " to mem cache"
LockMutex(OSM\MemCache\Mutex)
AddElement(OSM\MemCache\Image())
OSM\MemCache\Image()\xTile = XTile
OSM\MemCache\Image()\yTile = YTile
OSM\MemCache\Image()\Zoom = Zoom
OSM\MemCache\Image()\nImage = nImage
UnlockMutex(OSM\MemCache\Mutex)
Else
Debug "Tile not added to mem cache"
EndIf
EndProcedure
Procedure.i GetTileFromMem(Zoom.i, XTile.i, YTile.i)
Protected nImage.i
Debug "Check if we have this image in memory"
LockMutex(OSM\MemCache\Mutex)
ForEach OSM\MemCache\Image()
If Zoom = OSM\MemCache\Image()\Zoom And OSM\MemCache\Image()\xTile = XTile And OSM\MemCache\Image()\yTile = YTile
nImage = OSM\MemCache\Image()\nImage
Debug "Load from MEM Tile X : " + Str(XTile) + " ; Tile Y : " + Str(YTile) + " nImage:" + Str(nImage)
Break;
ElseIf Zoom<>OSM\MemCache\Image()\Zoom
; DeleteElement(OSM\MemCache\Image())
EndIf
Next
UnlockMutex(OSM\MemCache\Mutex)
ProcedureReturn nImage
EndProcedure
Procedure.i GetTileFromHDD(Zoom.i, XTile.i, YTile.i)
Protected nImage.i
Protected CacheFile.s = "OSM_" + Str(Zoom) + "_" + Str(XTile) + "_" + Str(YTile) + ".png"
Debug "Check if we have this image on HDD"
If FileSize(OSM\HDDCachePath + cacheFile) > 0
nImage = LoadImage(#PB_Any, OSM\HDDCachePath + CacheFile)
If IsImage(nImage)
Debug "Load from HDD Tile " + CacheFile
AddTileToMemCache(Zoom, XTile, YTile, nImage)
ProcedureReturn nImage
EndIf
EndIf
ProcedureReturn 0
EndProcedure
Procedure.i GetTileFromWeb(Zoom.i, XTile.i, YTile.i)
Protected *Buffer
Protected nImage.i
Protected TileURL.s = OSM\ServerURL + Str(Zoom) + "/" + Str(XTile) + "/" + Str(YTile) + ".png"
; Test if in cache else download it
Protected CacheFile.s = "OSM_" + Str(Zoom) + "_" + Str(XTile) + "_" + Str(YTile) + ".png"
Debug "Check if we have this image on Web"
If Proxy
LockMutex(OSM\CurlMutex)
*Buffer = curl::ReceiveHTTPToMemory(TileURL, ProxyURL$, ProxyPort$, ProxyUser$, ProxyPassword$)
UnlockMutex(OSM\CurlMutex)
Else
*Buffer = ReceiveHTTPMemory(TileURL) ;TODO to thread by using #PB_HTTP_Asynchronous
EndIf
Debug "Image buffer " + Str(*Buffer)
If *Buffer
nImage = CatchImage(#PB_Any, *Buffer, MemorySize(*Buffer))
If nImage > 0
Debug "Loaded from web " + TileURL + " as Tile nb " + nImage
AddTileToMemCache(Zoom, XTile, YTile, nImage)
SaveImage(nImage, OSM\HDDCachePath + CacheFile, #PB_ImagePlugin_PNG)
FreeMemory(*Buffer)
Else
Debug "Can't catch image " + TileURL
;ShowMemoryViewer(*Buffer, MemorySize(*Buffer))
EndIf
Else
Debug "Problem loading from web " + TileURL
EndIf
ProcedureReturn nImage
EndProcedure
Procedure.i ThreadGetImage(*Tile.Tile)
LockMutex(OSM\LoadingMutex)
Protected nImage = GetTileFromMem(*Tile\OSMZoom, *Tile\OSMTileX, *Tile\OSMTileY)
If nImage = 0 And *Tile\Quit = 0
nImage = GetTileFromHDD(*Tile\OSMZoom, *Tile\OSMTileX, *Tile\OSMTileY)
If nImage = 0 And *Tile\Quit = 0
nImage = GetTileFromWeb(*Tile\OSMZoom, *Tile\OSMTileX, *Tile\OSMTileY)
If nImage = 0
Debug "Error ThreadGetImage procedure : can't load this tile - Zoom:" + Str(*Tile\OSMZoom) + " X:" + Str(*Tile\OSMTileX) + " Y:" + Str(*Tile\OSMTileY)
nImage = -1
EndIf
EndIf
EndIf
UnlockMutex(OSM\LoadingMutex)
*Tile\nImage = nImage
;The loading is ended, draw can occur
SignalSemaphore(*Tile\LoadingSemaphore)
Debug " Signal semaphore " + Str(*Tile\LoadingSemaphore) + " loading image " + Str(nImage) + " ended"
EndProcedure
Procedure ThreadDrawTile(*Tile.Tile)
Protected x = *Tile\x - OSM\DeltaX
Protected y = *Tile\y - OSM\DeltaY
Debug " Thread drawing tile nb " + Str(*Tile\DrawTileThread) + " X : " + Str(x) + " Y : " + Str(y)
; If *Tile\nImage = 0
; LockMutex(OSM\DrawingMutex)
; ;Waiting image
; StartDrawing(CanvasOutput(OSM\Gadget))
; Box(x, y, OSM\TileSize, OSM\TileSize, RGB($EE, $EE, $EE))
; Line(x, y, OSM\TileSize, OSM\TileSize, RGB($AA, $AA, $AA))
; Line(x, y + OSM\TileSize, OSM\TileSize, -OSM\TileSize, RGB($AA, $AA, $AA))
; DrawText(x + OSM\TileSize / 2 - TextWidth("Loading")/2, y + OSM\TileSize / 2 - TextHeight("Loading") / 2, "Loading", RGB($AA, $AA, $AA), RGB($EE, $EE, $EE))
; UnlockMutex(OSM\DrawingMutex)
; StopDrawing()
; EndIf
;Wait for the loading thread
Debug " Waiting loading semaphore " + Str(*Tile\LoadingSemaphore)
WaitSemaphore(*Tile\LoadingSemaphore)
Debug " ---> Waiting nImage " + Str(*Tile\nImage) + " semaphore ended"
LockMutex(OSM\DrawingMutex)
If *Tile\Quit = 0 ;Quit the thread before drawing
StartDrawing(CanvasOutput(OSM\Gadget))
If IsImage(*Tile\nImage)
DrawImage(ImageID(*Tile\nImage), x, y)
DrawText( x, y, Str(x) + ", " + Str(y))
Else
Box(x, y, OSM\TileSize, OSM\TileSize, RGB($EE, $EE, $EE))
Line(x, y, OSM\TileSize, OSM\TileSize, RGB($AA, $AA, $AA))
Line(x, y + OSM\TileSize, OSM\TileSize, -OSM\TileSize, RGB($AA, $AA, $AA))
DrawText(x + OSM\TileSize / 2 - TextWidth("Error")/2, y + OSM\TileSize / 2 - TextHeight("Error") / 2, "Error", RGB($FF, $00, $00), RGB($EE, $EE, $EE))
EndIf
StopDrawing()
EndIf
UnlockMutex(OSM\DrawingMutex)
FreeSemaphore(*Tile\LoadingSemaphore)
FreeMemory(*Tile)
EndProcedure
Procedure StopDrawingRunningThreads()
;Stop all the drawing running threads
ForEach OSM\TilesThreads()
If IsThread(OSM\TilesThreads()\DrawTileThread)
Debug " Stopping drawing thread " + Str(OSM\TilesThreads()\DrawTileThread)
OSM\TilesThreads()\Tile\Quit = #True
EndIf
Next
ClearList(OSM\TilesThreads())
EndProcedure
Procedure DrawTiles()
Protected x.i, y.i
Protected tx = Int(OSM\TargetTile\x) ;Don't forget the Int() !
Protected ty = Int(OSM\TargetTile\y)
Protected CenterX = GadgetWidth(OSM\Gadget) / 2
Protected CenterY = GadgetHeight(OSM\Gadget) / 2
Protected nx = CenterX / OSM\TileSize ;How many tiles around the point
Protected ny = CenterY / OSM\TileSize
Debug "Drawing tiles"
For y = - ny To ny
For x = - nx To nx
Protected *NewTile.Tile = AllocateMemory(SizeOf(Tile))
If *NewTile
With *NewTile
\x = CenterX + x * OSM\TileSize
\y = CenterY + y * OSM\TileSize
\OSMTileX = tx + x
\OSMTileY = ty + y
\OSMZoom = OSM\Zoom
\nImage = 0
\Quit = 0
;This semaphore permits to the drawing thread to wait for an image
\LoadingSemaphore = CreateSemaphore()
If \LoadingSemaphore = 0
Debug "Can't create loading semaphore"
EndIf
;Check if the image exists, if not, load it in the background
\GetImageThread = CreateThread(@ThreadGetImage(), *NewTile)
Debug " Creating get image thread nb " + Str(\GetImageThread)
\DrawTileThread = CreateThread(@ThreadDrawTile(), *NewTile)
Debug " Creating tile drawing thread " + Str(\DrawTileThread)
AddElement(OSM\TilesThreads())
OSM\TilesThreads()\DrawTileThread = \DrawTileThread
OSM\TilesThreads()\LoadingSemaphore = \LoadingSemaphore
OSM\TilesThreads()\GetImageThread = \GetImageThread
OSM\TilesThreads()\Tile = *NewTile
EndWith
Else
Debug" Error, can't create a new tile."
Break 2
EndIf
Next
Next
EndProcedure
Procedure DrawTrack()
Protected Pixel.Pixel
Protected Location.Location
Protected n.i = 0, x.i, y.i
StartDrawing(CanvasOutput(OSM\Gadget))
ForEach OSM\track()
n=n+1
If @OSM\TargetLocation\Latitude<>0 And @OSM\TargetLocation\Longitude<>0
getPixelCoorfromLocation(@OSM\track(),@Pixel)
x=Pixel\x
y=Pixel\y
If x>0 And y>0 And x<GadgetWidth(OSM\Gadget) And y<GadgetHeight(OSM\Gadget)
Circle(x,y,2,#Green)
EndIf
EndIf
Next
StopDrawing()
EndProcedure
Procedure Draw()
Protected CenterX = GadgetWidth(OSM\Gadget) / 2
Protected CenterY = GadgetHeight(OSM\Gadget) / 2
LockMutex(OSM\DrawingMutex)
StartDrawing(CanvasOutput(OSM\Gadget))
;Box(0, 0, GadgetWidth(OSM\Gadget), GadgetHeight(OSM\Gadget), RGB(255, 255, 255))
StopDrawing()
UnlockMutex(OSM\DrawingMutex)
DrawTiles()
LockMutex(OSM\DrawingMutex)
StartDrawing(CanvasOutput(OSM\Gadget))
;DrawTrack()
Circle(CenterX, CenterY, 5, #Red)
StopDrawing()
UnlockMutex(OSM\DrawingMutex)
EndProcedure
Procedure SetLocation(latitude.d, longitude.d, zoom = 15)
If zoom > OSM\ZoomMax : zoom = OSM\ZoomMax : EndIf
If zoom < OSM\ZoomMin : zoom = OSM\ZoomMin : EndIf
OSM\Zoom = zoom
OSM\TargetLocation\Latitude = latitude
OSM\TargetLocation\Longitude = longitude
LatLon2XY(@OSM\TargetLocation, @OSM\TargetTile)
OSM\Position\x = OSM\TargetTile\x * OSM\TileSize ;Convert X, Y in tile.decimal into real pixels
OSM\Position\y = OSM\TargetTile\y * OSM\TileSize
OSM\DeltaX = OSM\Position\x - Int(OSM\Position\x / OSM\TileSize) * OSM\TileSize
OSM\DeltaY = OSM\Position\y - Int(OSM\Position\y / OSM\TileSize) * OSM\TileSize
EndProcedure
Procedure SetZoom(Zoom.i, mode.i = #PB_Relative)
Select mode
Case #PB_Relative
OSM\Zoom = OSM\Zoom + zoom
Case #PB_Absolute
OSM\Zoom = zoom
EndSelect
If OSM\Zoom > OSM\ZoomMax : OSM\Zoom = OSM\ZoomMax : EndIf
If OSM\Zoom < OSM\ZoomMin : OSM\Zoom = OSM\ZoomMin : EndIf
LatLon2XY(@OSM\TargetLocation, @OSM\TargetTile)
OSM\Position\x = OSM\TargetTile\x * OSM\TileSize ;Convert X, Y in tile.decimal into real pixels
OSM\Position\y = OSM\TargetTile\y * OSM\TileSize
OSM\DeltaX = OSM\Position\x - Int(OSM\Position\x / OSM\TileSize) * OSM\TileSize
OSM\DeltaY = OSM\Position\y - Int(OSM\Position\y / OSM\TileSize) * OSM\TileSize
Draw()
EndProcedure
Procedure Event(Event.l)
Protected Gadget.i
Protected MouseX.i, MouseY.i
Protected OldX.i, OldY.i
Protected TileX.d, TileY.d
If IsGadget(OSM\Gadget) And GadgetType(OSM\Gadget) = #PB_GadgetType_Canvas
Select Event
Case #PB_Event_Gadget ;{
Gadget = EventGadget()
Select Gadget
Case OSM\Gadget
Select EventType()
Case #PB_EventType_LeftButtonDown
;Mem cursor Coord
OSM\MoveStartingPoint\x = GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseX)
OSM\MoveStartingPoint\y = GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseY)
Case #PB_EventType_MouseMove
If OSM\MoveStartingPoint\x <> - 1
;Need a refresh
MouseX = GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseX) - OSM\MoveStartingPoint\x
MouseY = GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseY) - OSM\MoveStartingPoint\y
;Old move values
OldX = OSM\Position\x
OldY = OSM\Position\y
;New move values
OSM\Position\x - MouseX
OSM\Position\y - MouseY
;OSM tile position in tile.decimal
TileX = OSM\Position\x / OSM\TileSize
TileY = OSM\Position\y / OSM\TileSize
;Pixel shift
OSM\DeltaX = OSM\Position\x - Int(TileX) * OSM\TileSize
OSM\DeltaY = OSM\Position\y - Int(TileY) * OSM\TileSize
;Moved to a new tile ?
If (Int(OSM\Position\x / OSM\TileSize)) <> (Int(OldX / OSM\TileSize)) Or (Int(OSM\Position\y / OSM\TileSize)) <> (Int(OldY / OSM\TileSize))
Debug "--- New tile"
OSM\TargetTile\x = TileX
OSM\TargetTile\y = TileY
Debug "OSM\Position\x " + Str(OSM\Position\x) + " ; OSM\Position\y " + Str(OSM\Position\y)
XY2LatLon(@OSM\TargetTile, @OSM\TargetLocation)
Debug "OSM\TargetTile\x " + StrD(OSM\TargetTile\x) + " ; OSM\TargetTile\y " + StrD(OSM\TargetTile\y)
EndIf
StopDrawingRunningThreads()
Draw()
OSM\MoveStartingPoint\x = GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseX)
OSM\MoveStartingPoint\y = GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseY)
EndIf
Case #PB_EventType_LeftButtonUp
OSM\MoveStartingPoint\x = - 1
OSM\TargetTile\x = OSM\Position\x / OSM\TileSize
OSM\TargetTile\y = OSM\Position\y / OSM\TileSize
Debug "OSM\Position\x " + Str(OSM\Position\x) + " ; OSM\Position\y " + Str(OSM\Position\y)
XY2LatLon(@OSM\TargetTile, @OSM\TargetLocation)
;Draw()
Debug "OSM\TargetTile\x " + StrD(OSM\TargetTile\x) + " ; OSM\TargetTile\y " + StrD(OSM\TargetTile\y)
;SetGadgetText(#String_1, StrD(OSM\TargetLocation\Latitude))
;SetGadgetText(#String_0, StrD(OSM\TargetLocation\Longitude))
EndSelect
EndSelect
EndSelect
Else
MessageRequester("Module OSM", "You must use OSMGadget before", #PB_MessageRequester_Ok )
End
EndIf
EndProcedure
EndModule
Enumeration
#Window_0
#Map
#Button_0
#Button_1
#Button_2
#Button_3
#Button_4
#Button_5
#Combo_0
#Text_0
#Text_1
#Text_2
#Text_3
#Text_4
#String_0
#String_1
EndEnumeration
;- Main
If OpenWindow(#Window_0, 260, 225, 700, 571, "OpenStreetMap", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered )
OSM::InitOSM()
LoadFont(0, "Wingdings", 12)
LoadFont(1, "Arial", 12, #PB_Font_Bold)
OSM::OSMGadget(#Map, 10, 10, 512, 512)
TextGadget(#Text_1, 530, 50, 60, 15, "Movements : ")
ButtonGadget(#Button_0, 550, 100, 30, 30, Chr($E7)) : SetGadgetFont(#Button_0, FontID(0))
ButtonGadget(#Button_1, 610, 100, 30, 30, Chr($E8)) : SetGadgetFont(#Button_1, FontID(0))
ButtonGadget(#Button_2, 580, 070, 30, 30, Chr($E9)) : SetGadgetFont(#Button_2, FontID(0))
ButtonGadget(#Button_3, 580, 130, 30, 30, Chr($EA)) : SetGadgetFont(#Button_3, 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))
TextGadget(#Text_3, 530, 230, 60, 15, "Latitude : ")
StringGadget(#String_0, 600, 230, 90, 20, "")
TextGadget(#Text_4, 530, 250, 60, 15, "Longitude : ")
StringGadget(#String_1, 600, 250, 90, 20, "")
Define Event.i, Gadget.i, Quit.b = #False
Define pfValue.d
OSM::SetLocation(49.04599, 2.03347, 17)
OSM::Draw()
;OSM::SetLocation(49.0361165, 2.0456982)
Repeat
Event = WaitWindowEvent()
OSM::Event(Event)
Select Event
Case #PB_Event_CloseWindow : Quit = 1
Case #PB_Event_Gadget ;{
Gadget = EventGadget()
Select Gadget
Case #Button_4
OSM::SetZoom(1)
Case #Button_5
OSM::SetZoom( - 1)
EndSelect
EndSelect
Until Quit = #True
EndIf
Re: OpenStreetMap dans un Canvas
super bon boulot ! 
Effectivement peut être que dessiner sur une image a appliquer ensuite dans le canvas serait une bonne chose !
Par-contre je me pose la question ... si tu utilises la lib curl dans un module .. si tu veux l'utiliser dans un autre module il faut l'inclure aussi dans l'autre module.
J'ai eu aucune reponse a propos de la gestion du proxy pour les commandes natives ... très chiant .
J'avais trouvé un Hook mais ça ne marche pas dans un module pour remplacer la fonction d'origine ...
Effectivement peut être que dessiner sur une image a appliquer ensuite dans le canvas serait une bonne chose !
Par-contre je me pose la question ... si tu utilises la lib curl dans un module .. si tu veux l'utiliser dans un autre module il faut l'inclure aussi dans l'autre module.
J'ai eu aucune reponse a propos de la gestion du proxy pour les commandes natives ... très chiant .
J'avais trouvé un Hook mais ça ne marche pas dans un module pour remplacer la fonction d'origine ...
Re: OpenStreetMap dans un Canvas
Merci !Thyphoon a écrit :super bon boulot !
Effectivement peut être que dessiner sur une image a appliquer ensuite dans le canvas serait une bonne chose !
Par-contre je me pose la question ... si tu utilises la lib curl dans un module .. si tu veux l'utiliser dans un autre module il faut l'inclure aussi dans l'autre module.
J'ai eu aucune reponse a propos de la gestion du proxy pour les commandes natives ... très chiant .
J'avais trouvé un Hook mais ça ne marche pas dans un module pour remplacer la fonction d'origine ...
J'ai modifié le code ci-dessus, histoire d'éliminer un vilain bug. Oui, pour le module curl, je ne sais pas trop. Je l'avais mis dans un module pour qu'il soit réentrant (threadable), mais ça n'a pas l'air de fonctionner.
Il faudra aussi penser à la gestion du cache, mémoire et disque, peut-être en fonction de l'heure du dernier usage et de l'espace consommé...? Un thread à part, ça serait peut-être bien.
Re: OpenStreetMap dans un Canvas
Yop, voici la dernière version, à tester (j'ai commenté les lignes pour l'utilisation du proxy)
J'ai vu un petit bug de calcul entre deux tuiles ou lors d'un saut rapide, mais je ne l'ai pas encore repéré.
Edit: intégration de curl, et création d'un fichier de préférences pour faciliter les échanges.
J'ai vu un petit bug de calcul entre deux tuiles ou lors d'un saut rapide, mais je ne l'ai pas encore repéré.
Edit: intégration de curl, et création d'un fichier de préférences pour faciliter les échanges.
Code : Tout sélectionner
;**************************************************************
; Program: OSM (OpenStreetMap Module)
; Author: Thyphoon And Djes
; Date: Mai 17, 2016
; License: Free, unrestricted, credit appreciated
; but not required.
; Note: Please share improvement !
; Thanks: Progi1984,
;**************************************************************
CompilerIf #PB_Compiler_Thread = #False
MessageRequester("Warning !!","You must enable ThreadSafe support in compiler options",#PB_MessageRequester_Ok )
End
CompilerEndIf
EnableExplicit
InitNetwork()
UsePNGImageDecoder()
UsePNGImageEncoder()
DeclareModule OSM
Declare InitOSM()
Declare OSMGadget(Gadget.i, X.i, Y.i, Width.i, Height.i)
Declare Event(Event.l)
Declare SetLocation(latitude.d, longitude.d, zoom = 15)
Declare DrawingThread(Null)
Declare SetZoom(Zoom.i, mode.i = #PB_Relative)
Declare LoadGpxFile(file.s);
EndDeclareModule
Module OSM
EnableExplicit
Structure Location
Longitude.d
Latitude.d
EndStructure
;- Tile Structure
Structure Tile
x.d
y.d
OSMTileX.i
OSMTileY.i
OSMZoom.i
nImage.i
GetImageThread.i
EndStructure
Structure TileThread
GetImageThread.i
*Tile.Tile
EndStructure
Structure Pixel
x.i
y.i
EndStructure
Structure ImgMemCach
nImage.i
Zoom.i
XTile.i
YTile.i
Usage.i
EndStructure
Structure TileMemCach
List Image.ImgMemCach()
Mutex.i
Semaphore.i
EndStructure
;-OSM Structure
Structure OSM
Gadget.i ; Canvas Gadget Id
TargetLocation.Location ; Latitude and Longitude from focus point
TargetTile.Tile ; Focus Tile coord
Position.Pixel ; Actual focus Point coords in pixels
DeltaX.i
DeltaY.i
MoveStartingPoint.Pixel ; Start mouse position coords when dragging the map
ServerURL.s ; Web URL ex: http://tile.openstreetmap.org/
ZoomMin.i ; Min Zoom supported by server
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 ; Image in memory cache
List MapImageIndex.ImgMemCach() ; Index from MemCache\Image() to construct map
DrawingThreadMutex.i ;Only one main drawing thread
EmergencyQuit.i
Dirty.i ;To signal that drawing need a refresh
LoadingMutex.i
DrawingMutex.i
CurlMutex.i ;seems that I can't thread curl ! :(((((
List TilesThreads.TileThread()
MapImageMutex.i ; Mutex to lock
List track.Location() ;to display a GPX track
EndStructure
Global OSM.OSM, Null.i
Procedure InitOSM()
Protected Result.i
OSM\HDDCachePath = GetTemporaryDirectory()
OSM\ServerURL = "http://tile.openstreetmap.org/"
OSM\ZoomMin = 0
OSM\ZoomMax = 18
OSM\MoveStartingPoint\x = - 1
OSM\TileSize = 256
OSM\MemCache\Mutex = CreateMutex()
OSM\LoadingMutex = CreateMutex()
OSM\DrawingMutex = CreateMutex()
OSM\CurlMutex = CreateMutex()
OSM\DrawingThreadMutex = CreateMutex()
OSM\EmergencyQuit = #False
OSM\Dirty = #False
;-*** PROXY
Global Proxy = #True
;- => Use this to customise your preferences
; Result = CreatePreferences(GetCurrentDirectory() + "OSM.prefs")
; If Proxy
; PreferenceGroup("PROXY")
; WritePreferenceString("ProxyURL", "myproxy.fr")
; WritePreferenceString("ProxyPort", "myproxyport")
; WritePreferenceString("ProxyUser", "myproxyname")
; EndIf
; If Result
; ClosePreferences()
; EndIf
Result = OpenPreferences(GetCurrentDirectory() + "OSM.prefs")
If Proxy
PreferenceGroup("PROXY")
Global ProxyURL$ = ReadPreferenceString("ProxyURL", "") ;InputRequester("ProxyServer", "Do you use a Proxy Server? Then enter the full url:", "")
Global ProxyPort$ = ReadPreferenceString("ProxyPort", "") ;InputRequester("ProxyPort" , "Do you use a specific port? Then enter it", "")
Global ProxyUser$ = ReadPreferenceString("ProxyUser", "") ;InputRequester("ProxyUser" , "Do you use a user name? Then enter it", "")
Global ProxyPassword$ = InputRequester("ProxyPass" , "Do you use a password ? Then enter it", "")
EndIf
If Result
ClosePreferences()
EndIf
EndProcedure
;- **
Procedure OSMGadget(Gadget.i, X.i, Y.i, Width.i, Height.i)
If Gadget = #PB_Any
OSM\Gadget = CanvasGadget(OSM\Gadget, X, Y, Width, Height)
Else
OSM\Gadget = Gadget
CanvasGadget(OSM\Gadget, X, Y, Width, Height)
EndIf
EndProcedure
;- *** CURL specific ***
Global *ReceiveHTTPToMemoryBuffer, ReceiveHTTPToMemoryBufferPtr.i, ReceivedData.s
IncludeFile "libcurl.pbi" ; https://github.com/deseven/pbsamples/tree/master/crossplatform/libcurl
ProcedureC ReceiveHTTPWriteToMemoryFunction(*ptr, Size.i, NMemB.i, *Stream)
Protected SizeProper.i = Size & 255
Protected NMemBProper.i = NMemB
If *ReceiveHTTPToMemoryBuffer = 0
*ReceiveHTTPToMemoryBuffer = AllocateMemory(SizeProper * NMemBProper)
If *ReceiveHTTPToMemoryBuffer = 0
Debug "Problem allocating memory"
End
EndIf
Else
*ReceiveHTTPToMemoryBuffer = ReAllocateMemory(*ReceiveHTTPToMemoryBuffer, MemorySize(*ReceiveHTTPToMemoryBuffer) + SizeProper * NMemBProper)
If *ReceiveHTTPToMemoryBuffer = 0
Debug "Problem reallocating memory"
End
EndIf
EndIf
CopyMemory(*ptr, *ReceiveHTTPToMemoryBuffer + ReceiveHTTPToMemoryBufferPtr, SizeProper * NMemBProper)
ReceiveHTTPToMemoryBufferPtr + SizeProper * NMemBProper
ProcedureReturn SizeProper * NMemBProper
EndProcedure
Procedure.i CurlReceiveHTTPToMemory(URL$, ProxyURL$="", ProxyPort$="", ProxyUser$="", ProxyPassword$="")
Protected *Buffer, curl.i, Timeout.i, res.i
;Debug "ReceiveHTTPToMemory" + URL$ + ProxyURL$ + ProxyPort$ + ProxyUser$ + ProxyPassword$
If Len(URL$)
curl = curl_easy_init()
If curl
Timeout = 3
curl_easy_setopt(curl, #CURLOPT_URL, str2curl(URL$))
curl_easy_setopt(curl, #CURLOPT_SSL_VERIFYPEER, 0)
curl_easy_setopt(curl, #CURLOPT_SSL_VERIFYHOST, 0)
curl_easy_setopt(curl, #CURLOPT_HEADER, 0)
curl_easy_setopt(curl, #CURLOPT_TIMEOUT, Timeout)
If Len(ProxyURL$)
;curl_easy_setopt(curl, #CURLOPT_HTTPPROXYTUNNEL, #True)
If Len(ProxyPort$)
ProxyURL$ + ":" + ProxyPort$
EndIf
Debug ProxyURL$
curl_easy_setopt(curl, #CURLOPT_PROXY, str2curl(ProxyURL$))
If Len(ProxyUser$)
If Len(ProxyPassword$)
ProxyUser$ + ":" + ProxyPassword$
EndIf
;Debug ProxyUser$
curl_easy_setopt(curl, #CURLOPT_PROXYUSERPWD, str2curl(ProxyUser$))
EndIf
EndIf
curl_easy_setopt(curl, #CURLOPT_WRITEFUNCTION, @ReceiveHTTPWriteToMemoryFunction())
res = curl_easy_perform(curl)
If res = #CURLE_OK
*Buffer = AllocateMemory(ReceiveHTTPToMemoryBufferPtr)
If *Buffer
CopyMemory(*ReceiveHTTPToMemoryBuffer, *Buffer, ReceiveHTTPToMemoryBufferPtr)
FreeMemory(*ReceiveHTTPToMemoryBuffer)
*ReceiveHTTPToMemoryBuffer = #Null
ReceiveHTTPToMemoryBufferPtr = 0
Else
Debug "Problem allocating buffer"
EndIf
;curl_easy_cleanup(curl) ;Was its original place but moved below as it seems more logical to me.
Else
Debug "CURL NOT OK"
EndIf
curl_easy_cleanup(curl)
Else
Debug "Can't Init CURL"
EndIf
EndIf
Debug "Curl Buffer : " + Str(*Buffer)
ProcedureReturn *Buffer
EndProcedure
;- ***
Procedure LatLon2XY(*Location.Location, *Tile.Tile)
Protected n.d = Pow(2.0, OSM\Zoom)
Protected LatRad.d = Radian(*Location\Latitude)
*Tile\x = n * ( (*Location\Longitude + 180.0) / 360.0)
*Tile\y = n * ( 1.0 - Log(Tan(LatRad) + 1.0/Cos(LatRad)) / #PI ) / 2.0
Debug "Latitude : " + StrD(*Location\Latitude) + " ; Longitude : " + StrD(*Location\Longitude)
Debug "Tile X : " + Str(*Tile\x) + " ; Tile Y : " + Str(*Tile\y)
EndProcedure
Procedure XY2LatLon(*Tile.Tile, *Location.Location)
Protected n.d = Pow(2.0, OSM\Zoom)
Protected LatitudeRad.d
*Location\Longitude = *Tile\x / n * 360.0 - 180.0
LatitudeRad = ATan(SinH(#PI * (1.0 - 2.0 * *Tile\y / n)))
*Location\Latitude = Degree(LatitudeRad)
EndProcedure
Procedure getPixelCoorfromLocation(*Location.Location, *Pixel.Pixel) ; TODO to Optimize
Protected mapWidth.l = Pow(2,OSM\Zoom+8)
Protected mapHeight.l = Pow(2,OSM\Zoom+8)
Protected x1.l,y1.l
Protected deltaX = OSM\Position\x - Int(OSM\TargetTile\x) * OSM\TileSize ;Get the position into the tile
Protected deltaY = OSM\Position\y - Int(OSM\TargetTile\y) * OSM\TileSize
; get x value
x1 = (*Location\Longitude+180)*(mapWidth/360)
; convert from degrees To radians
Protected latRad.d = *Location\Latitude*#PI/180;
Protected mercN.d = Log(Tan((#PI/4)+(latRad/2)));
y1 = (mapHeight/2)-(mapWidth*mercN/(2*#PI)) ;
Protected x2.l, y2.l
; get x value
x2 = (OSM\TargetLocation\Longitude+180)*(mapWidth/360)
; convert from degrees To radians
latRad = OSM\TargetLocation\Latitude*#PI/180;
; get y value
mercN = Log(Tan((#PI/4)+(latRad/2))) ;
y2 = (mapHeight/2)-(mapWidth*mercN/(2*#PI));
*Pixel\x=GadgetWidth(OSM\Gadget)/2 - (x2-x1) + deltaX
*Pixel\y=GadgetHeight(OSM\Gadget)/2 - (y2-y1) + deltaY
EndProcedure
Procedure LoadGpxFile(file.s)
If LoadXML(0, file.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))
MessageRequester("Error", Message)
EndIf
Protected *MainNode,*subNode,*child,child.l
*MainNode=MainXMLNode(0)
*MainNode=XMLNodeFromPath(*MainNode,"/gpx/trk/trkseg")
ClearList(OSM\track())
For child = 1 To XMLChildCount(*MainNode)
*child = ChildXMLNode(*MainNode, child)
AddElement(OSM\track())
If ExamineXMLAttributes(*child)
While NextXMLAttribute(*child)
Select XMLAttributeName(*child)
Case "lat"
OSM\track()\Latitude=ValD(XMLAttributeValue(*child))
Case "lon"
OSM\track()\Longitude=ValD(XMLAttributeValue(*child))
EndSelect
Wend
EndIf
Next
EndIf
EndProcedure
Procedure.i GetTileFromMem(Zoom.i, XTile.i, YTile.i)
Protected nImage.i = -1
Debug "Check if we have this image in memory"
LockMutex(OSM\LoadingMutex)
LockMutex(OSM\MemCache\Mutex)
ForEach OSM\MemCache\Image()
If Zoom = OSM\MemCache\Image()\Zoom And OSM\MemCache\Image()\xTile = XTile And OSM\MemCache\Image()\yTile = YTile
nImage = OSM\MemCache\Image()\nImage
Debug "Load from MEM Tile X : " + Str(XTile) + " ; Tile Y : " + Str(YTile) + " nImage:" + Str(nImage)
Break;
;ElseIf Zoom<>OSM\MemCache\Image()\Zoom
; DeleteElement(OSM\MemCache\Image())
EndIf
Next
UnlockMutex(OSM\MemCache\Mutex)
UnlockMutex(OSM\LoadingMutex)
ProcedureReturn nImage
EndProcedure
Procedure.i GetTileFromHDD(Zoom.i, XTile.i, YTile.i)
Protected nImage.i
Protected CacheFile.s = "OSM_" + Str(Zoom) + "_" + Str(XTile) + "_" + Str(YTile) + ".png"
Debug "Check if we have this image on HDD"
If FileSize(OSM\HDDCachePath + cacheFile) > 0
nImage = LoadImage(#PB_Any, OSM\HDDCachePath + CacheFile)
If IsImage(nImage)
Debug "Load from HDD Tile " + CacheFile
ProcedureReturn nImage
EndIf
EndIf
ProcedureReturn -1
EndProcedure
Procedure.i GetTileFromWeb(Zoom.i, XTile.i, YTile.i)
Protected *Buffer
Protected nImage.i = -1
Protected TileURL.s = OSM\ServerURL + Str(Zoom) + "/" + Str(XTile) + "/" + Str(YTile) + ".png"
; Test if in cache else download it
Protected CacheFile.s = "OSM_" + Str(Zoom) + "_" + Str(XTile) + "_" + Str(YTile) + ".png"
Debug "Check if we have this image on Web"
If Proxy
LockMutex(OSM\CurlMutex)
*Buffer = CurlReceiveHTTPToMemory(TileURL, ProxyURL$, ProxyPort$, ProxyUser$, ProxyPassword$)
UnlockMutex(OSM\CurlMutex)
Else
*Buffer = ReceiveHTTPMemory(TileURL) ;TODO to thread by using #PB_HTTP_Asynchronous
EndIf
Debug "Image buffer " + Str(*Buffer)
If *Buffer
LockMutex(OSM\LoadingMutex)
nImage = CatchImage(#PB_Any, *Buffer, MemorySize(*Buffer))
UnlockMutex(OSM\LoadingMutex)
If IsImage(nImage)
Debug "Load from web " + TileURL + " as Tile nb " + nImage
LockMutex(OSM\LoadingMutex)
SaveImage(nImage, OSM\HDDCachePath + CacheFile, #PB_ImagePlugin_PNG)
UnlockMutex(OSM\LoadingMutex)
FreeMemory(*Buffer)
Else
Debug "Can't catch image " + TileURL
nImage = -1
;ShowMemoryViewer(*Buffer, MemorySize(*Buffer))
EndIf
Else
Debug "Problem loading from web " + TileURL
EndIf
ProcedureReturn nImage
EndProcedure
Procedure GetImageThread(*Tile.Tile)
Protected *CacheImagePtr
Protected nImage.i = -1
LockMutex(OSM\LoadingMutex)
If OSM\EmergencyQuit = 0
LockMutex(OSM\MemCache\Mutex)
*CacheImagePtr = AddElement(OSM\MemCache\Image())
Debug " CacheImagePtr : " + Str(*CacheImagePtr)
OSM\MemCache\Image()\xTile = *Tile\OSMTileX
OSM\MemCache\Image()\yTile = *Tile\OSMTileY
OSM\MemCache\Image()\Zoom = *Tile\OSMZoom
OSM\MemCache\Image()\nImage = -1 ;By now, this tile is in "loading" state, for thread synchro
UnlockMutex(OSM\MemCache\Mutex)
nImage = GetTileFromHDD(*Tile\OSMZoom, *Tile\OSMTileX, *Tile\OSMTileY)
If nImage = -1 And OSM\EmergencyQuit = 0
nImage = GetTileFromWeb(*Tile\OSMZoom, *Tile\OSMTileX, *Tile\OSMTileY)
EndIf
LockMutex(OSM\MemCache\Mutex)
If nImage <> -1 And OSM\EmergencyQuit = 0
Debug "Adding tile " + Str(nImage) + " to mem cache"
;AddTileToMemCache(Zoom, XTile, YTile, nImage)
OSM\MemCache\Image()\nImage = nImage
Debug "Image nb " + Str(nImage) + " successfully added to mem cache"
Else
Debug "Error GetImageThread procedure, tile not loaded - Zoom:" + Str(*Tile\OSMZoom) + " X:" + Str(*Tile\OSMTileX) + " Y:" + Str(*Tile\OSMTileY)
DeleteElement(OSM\MemCache\Image())
nImage = -1
EndIf
UnlockMutex(OSM\MemCache\Mutex)
EndIf
*Tile\nImage = nImage
UnlockMutex(OSM\LoadingMutex)
EndProcedure
Procedure DrawTile(*Tile.Tile)
Protected x = *Tile\x - OSM\DeltaX
Protected y = *Tile\y - OSM\DeltaY
Debug " Drawing tile nb " + " X : " + Str(x) + " Y : " + Str(y)
LockMutex(OSM\DrawingMutex)
If OSM\EmergencyQuit = 0 ;Quit before drawing
StartDrawing(CanvasOutput(OSM\Gadget))
If IsImage(*Tile\nImage)
DrawImage(ImageID(*Tile\nImage), x, y)
DrawText( x, y, Str(x) + ", " + Str(y))
Else
Debug "Image missing"
OSM\Dirty = #True ;Signal that this image is missing so we should have to redraw
EndIf
StopDrawing()
EndIf
UnlockMutex(OSM\DrawingMutex)
EndProcedure
Procedure DrawTiles()
Protected x.i, y.i
Protected tx = Int(OSM\TargetTile\x) ;Don't forget the Int() !
Protected ty = Int(OSM\TargetTile\y)
Protected CenterX = GadgetWidth(OSM\Gadget) / 2
Protected CenterY = GadgetHeight(OSM\Gadget) / 2
Protected nx = CenterX / OSM\TileSize ;How many tiles around the point
Protected ny = CenterY / OSM\TileSize
Debug "Drawing tiles"
For y = - ny To ny
For x = - nx To nx
If OSM\EmergencyQuit
Break
EndIf
Protected *NewTile.Tile = AllocateMemory(SizeOf(Tile))
If *NewTile
With *NewTile
\x = CenterX + x * OSM\TileSize
\y = CenterY + y * OSM\TileSize
\OSMTileX = tx + x
\OSMTileY = ty + y
\OSMZoom = OSM\Zoom
;Check if the image exists, if not, load it in the background
\nImage = GetTileFromMem(\OSMZoom, \OSMTileX, \OSMTileY)
If \nImage = -1
\GetImageThread = CreateThread(@GetImageThread(), *NewTile)
AddElement(OSM\TilesThreads())
OSM\TilesThreads()\Tile = *NewTile
OSM\TilesThreads()\GetImageThread = \GetImageThread
EndIf
Debug " Creating get image thread nb " + Str(\GetImageThread)
DrawTile(*NewTile)
EndWith
Else
Debug" Error, can't create a new tile."
Break 2
EndIf
Next
Next
ForEach OSM\TilesThreads()
If IsThread(OSM\TilesThreads()\GetImageThread) = 0
FreeMemory(OSM\TilesThreads()\Tile)
DeleteElement(OSM\TilesThreads())
EndIf
Next
EndProcedure
Procedure DrawTrack()
Protected Pixel.Pixel
Protected Location.Location
Protected n.i = 0, x.i, y.i
StartDrawing(CanvasOutput(OSM\Gadget))
ForEach OSM\track()
n=n+1
If @OSM\TargetLocation\Latitude<>0 And @OSM\TargetLocation\Longitude<>0
getPixelCoorfromLocation(@OSM\track(),@Pixel)
x=Pixel\x
y=Pixel\y
If x>0 And y>0 And x<GadgetWidth(OSM\Gadget) And y<GadgetHeight(OSM\Gadget)
Circle(x,y,2,#Green)
EndIf
EndIf
Next
StopDrawing()
EndProcedure
Procedure DrawingThread(Null)
Debug "--------- Main drawing thread ------------"
OSM\Dirty = #False
LockMutex(OSM\DrawingThreadMutex) ; Only one main drawing thread at once
Protected CenterX = GadgetWidth(OSM\Gadget) / 2
Protected CenterY = GadgetHeight(OSM\Gadget) / 2
DrawTiles()
LockMutex(OSM\DrawingMutex)
StartDrawing(CanvasOutput(OSM\Gadget))
;DrawTrack()
Circle(CenterX, CenterY, 5, #Red)
StopDrawing()
UnlockMutex(OSM\DrawingMutex)
UnlockMutex(OSM\DrawingThreadMutex)
;- Redraw
;If something was not correctly drawn, redraw after a while
If OSM\Dirty
Debug "Something is dirty !"
;Delay(250)
CreateThread(@DrawingThread(), Null)
EndIf
EndProcedure
Procedure SetLocation(latitude.d, longitude.d, zoom = 15)
If zoom > OSM\ZoomMax : zoom = OSM\ZoomMax : EndIf
If zoom < OSM\ZoomMin : zoom = OSM\ZoomMin : EndIf
OSM\Zoom = zoom
OSM\TargetLocation\Latitude = latitude
OSM\TargetLocation\Longitude = longitude
LatLon2XY(@OSM\TargetLocation, @OSM\TargetTile)
OSM\Position\x = OSM\TargetTile\x * OSM\TileSize ;Convert X, Y in tile.decimal into real pixels
OSM\Position\y = OSM\TargetTile\y * OSM\TileSize
OSM\DeltaX = OSM\Position\x - Int(OSM\Position\x / OSM\TileSize) * OSM\TileSize
OSM\DeltaY = OSM\Position\y - Int(OSM\Position\y / OSM\TileSize) * OSM\TileSize
CreateThread(@DrawingThread(), Null)
EndProcedure
Procedure SetZoom(Zoom.i, mode.i = #PB_Relative)
Select mode
Case #PB_Relative
OSM\Zoom = OSM\Zoom + zoom
Case #PB_Absolute
OSM\Zoom = zoom
EndSelect
If OSM\Zoom > OSM\ZoomMax : OSM\Zoom = OSM\ZoomMax : EndIf
If OSM\Zoom < OSM\ZoomMin : OSM\Zoom = OSM\ZoomMin : EndIf
LatLon2XY(@OSM\TargetLocation, @OSM\TargetTile)
OSM\Position\x = OSM\TargetTile\x * OSM\TileSize ;Convert X, Y in tile.decimal into real pixels
OSM\Position\y = OSM\TargetTile\y * OSM\TileSize
OSM\DeltaX = OSM\Position\x - Int(OSM\Position\x / OSM\TileSize) * OSM\TileSize
OSM\DeltaY = OSM\Position\y - Int(OSM\Position\y / OSM\TileSize) * OSM\TileSize
CreateThread(@DrawingThread(), Null)
EndProcedure
Procedure Event(Event.l)
Protected Gadget.i
Protected MouseX.i, MouseY.i
Protected OldX.i, OldY.i
Protected TileX.d, TileY.d
If IsGadget(OSM\Gadget) And GadgetType(OSM\Gadget) = #PB_GadgetType_Canvas
Select Event
Case #PB_Event_Gadget ;{
Gadget = EventGadget()
Select Gadget
Case OSM\Gadget
Select EventType()
Case #PB_EventType_LeftButtonDown
;Mem cursor Coord
OSM\MoveStartingPoint\x = GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseX)
OSM\MoveStartingPoint\y = GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseY)
Case #PB_EventType_MouseMove
If OSM\MoveStartingPoint\x <> - 1
;Need a refresh
;OSM\EmergencyQuit = #True
MouseX = GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseX) - OSM\MoveStartingPoint\x
MouseY = GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseY) - OSM\MoveStartingPoint\y
;Old move values
OldX = OSM\Position\x
OldY = OSM\Position\y
;New move values
OSM\Position\x - MouseX
OSM\Position\y - MouseY
;OSM tile position in tile.decimal
TileX = OSM\Position\x / OSM\TileSize
TileY = OSM\Position\y / OSM\TileSize
;Pixel shift
OSM\DeltaX = OSM\Position\x - Int(TileX) * OSM\TileSize
OSM\DeltaY = OSM\Position\y - Int(TileY) * OSM\TileSize
;Moved to a new tile ?
If (Int(OSM\Position\x / OSM\TileSize)) <> (Int(OldX / OSM\TileSize)) Or (Int(OSM\Position\y / OSM\TileSize)) <> (Int(OldY / OSM\TileSize))
Debug "--- New tile"
OSM\TargetTile\x = TileX
OSM\TargetTile\y = TileY
Debug "OSM\Position\x " + Str(OSM\Position\x) + " ; OSM\Position\y " + Str(OSM\Position\y)
XY2LatLon(@OSM\TargetTile, @OSM\TargetLocation)
Debug "OSM\TargetTile\x " + StrD(OSM\TargetTile\x) + " ; OSM\TargetTile\y " + StrD(OSM\TargetTile\y)
EndIf
OSM\EmergencyQuit = #False
CreateThread(@DrawingThread(), Null)
OSM\MoveStartingPoint\x = GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseX)
OSM\MoveStartingPoint\y = GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseY)
EndIf
Case #PB_EventType_LeftButtonUp
OSM\MoveStartingPoint\x = - 1
OSM\TargetTile\x = OSM\Position\x / OSM\TileSize
OSM\TargetTile\y = OSM\Position\y / OSM\TileSize
Debug "OSM\Position\x " + Str(OSM\Position\x) + " ; OSM\Position\y " + Str(OSM\Position\y)
XY2LatLon(@OSM\TargetTile, @OSM\TargetLocation)
;Draw()
Debug "OSM\TargetTile\x " + StrD(OSM\TargetTile\x) + " ; OSM\TargetTile\y " + StrD(OSM\TargetTile\y)
;SetGadgetText(#String_1, StrD(OSM\TargetLocation\Latitude))
;SetGadgetText(#String_0, StrD(OSM\TargetLocation\Longitude))
EndSelect
EndSelect
EndSelect
Else
MessageRequester("Module OSM", "You must use OSMGadget before", #PB_MessageRequester_Ok )
End
EndIf
EndProcedure
EndModule
Enumeration
#Window_0
#Map
#Button_0
#Button_1
#Button_2
#Button_3
#Button_4
#Button_5
#Combo_0
#Text_0
#Text_1
#Text_2
#Text_3
#Text_4
#String_0
#String_1
EndEnumeration
;- Main
If OpenWindow(#Window_0, 260, 225, 700, 571, "OpenStreetMap", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered )
OSM::InitOSM()
LoadFont(0, "Wingdings", 12)
LoadFont(1, "Arial", 12, #PB_Font_Bold)
OSM::OSMGadget(#Map, 10, 10, 512, 512)
TextGadget(#Text_1, 530, 50, 60, 15, "Movements : ")
ButtonGadget(#Button_0, 550, 100, 30, 30, Chr($E7)) : SetGadgetFont(#Button_0, FontID(0))
ButtonGadget(#Button_1, 610, 100, 30, 30, Chr($E8)) : SetGadgetFont(#Button_1, FontID(0))
ButtonGadget(#Button_2, 580, 070, 30, 30, Chr($E9)) : SetGadgetFont(#Button_2, FontID(0))
ButtonGadget(#Button_3, 580, 130, 30, 30, Chr($EA)) : SetGadgetFont(#Button_3, 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))
TextGadget(#Text_3, 530, 230, 60, 15, "Latitude : ")
StringGadget(#String_0, 600, 230, 90, 20, "")
TextGadget(#Text_4, 530, 250, 60, 15, "Longitude : ")
StringGadget(#String_1, 600, 250, 90, 20, "")
Define Event.i, Gadget.i, Quit.b = #False
Define pfValue.d
OSM::SetLocation(49.04599, 2.03347, 17)
;OSM::SetLocation(49.0361165, 2.0456982)
Repeat
Event = WaitWindowEvent()
OSM::Event(Event)
Select Event
Case #PB_Event_CloseWindow : Quit = 1
Case #PB_Event_Gadget ;{
Gadget = EventGadget()
Select Gadget
Case #Button_4
OSM::SetZoom(1)
Case #Button_5
OSM::SetZoom( - 1)
EndSelect
EndSelect
Until Quit = #True
EndIf
Re: OpenStreetMap dans un Canvas
On bosse en parallèle, pour info. Voici mon dernier code.
Code : Tout sélectionner
;**************************************************************
; Program: OSM (OpenStreetMap Module)
; Author: Thyphoon and djes
; Date: Mai 17, 2016
; License: Free, unrestricted, credit appreciated
; but not required.
; Note: Please share improvement !
; Thanks: Progi1984,
;**************************************************************
CompilerIf #PB_Compiler_Thread = #False
MessageRequester("Warning !!","You must enable ThreadSafe support in compiler options",#PB_MessageRequester_Ok )
End
CompilerEndIf
EnableExplicit
InitNetwork()
UsePNGImageDecoder()
UsePNGImageEncoder()
DeclareModule OSM
Declare InitOSM()
Declare OSMGadget(Gadget.i, X.i, Y.i, Width.i, Height.i)
Declare Event(Event.l)
Declare SetLocation(latitude.d, longitude.d, zoom = 15)
Declare DrawingThread(Null)
Declare SetZoom(Zoom.i, mode.i = #PB_Relative)
Declare SetCallBackLocation(*CallBackLocation)
Declare LoadGpxFile(file.s);
EndDeclareModule
Module OSM
EnableExplicit
Structure Location
Longitude.d
Latitude.d
EndStructure
;- Tile Structure
Structure Tile
x.d
y.d
OSMTileX.i
OSMTileY.i
OSMZoom.i
nImage.i
GetImageThread.i
EndStructure
Structure DrawingParameters
x.d
y.d
OSMTileX.i
OSMTileY.i
OSMZoom.i
Mutex.i
Semaphore.i
Dirty.i
PassNB.i
End.i
EndStructure
Structure TileThread
GetImageThread.i
*Tile.Tile
EndStructure
Structure Pixel
x.i
y.i
EndStructure
Structure ImgMemCach
nImage.i
Zoom.i
XTile.i
YTile.i
Usage.i
EndStructure
Structure TileMemCach
List Image.ImgMemCach()
Mutex.i
Semaphore.i
EndStructure
;-OSM Structure
Structure OSM
Gadget.i ; Canvas Gadget Id
TargetLocation.Location ; Latitude and Longitude from focus point
Drawing.DrawingParameters ; Drawing parameters based on focus point
CallBackLocation.i ; @Procedure(latitude.d,lontitude.d)
Position.Pixel ; Actual focus Point coords in pixels
MoveStartingPoint.Pixel ; Start mouse position coords when dragging the map
ServerURL.s ; Web URL ex: http://tile.openstreetmap.org/
ZoomMin.i ; Min Zoom supported by server
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 ; Image in memory cache
List MapImageIndex.ImgMemCach() ; Index from MemCache\Image() to construct map
Moving.i
Dirty.i ;To signal that drawing need a refresh
LoadingMutex.i
DrawingMutex.i
;CurlMutex.i ;seems that I can't thread curl ! :(((((
List TilesThreads.TileThread()
MapImageMutex.i ; Mutex to lock
List track.Location() ;to display a GPX track
EndStructure
Global OSM.OSM, Null.i
;- *** CURL specific ***
Global *ReceiveHTTPToMemoryBuffer, ReceiveHTTPToMemoryBufferPtr.i, ReceivedData.s
IncludeFile "libcurl.pbi" ; https://github.com/deseven/pbsamples/tree/master/crossplatform/libcurl
ProcedureC ReceiveHTTPWriteToMemoryFunction(*ptr, Size.i, NMemB.i, *Stream)
Protected SizeProper.i = Size & 255
Protected NMemBProper.i = NMemB
If *ReceiveHTTPToMemoryBuffer = 0
*ReceiveHTTPToMemoryBuffer = AllocateMemory(SizeProper * NMemBProper)
If *ReceiveHTTPToMemoryBuffer = 0
Debug "Problem allocating memory"
End
EndIf
Else
*ReceiveHTTPToMemoryBuffer = ReAllocateMemory(*ReceiveHTTPToMemoryBuffer, MemorySize(*ReceiveHTTPToMemoryBuffer) + SizeProper * NMemBProper)
If *ReceiveHTTPToMemoryBuffer = 0
Debug "Problem reallocating memory"
End
EndIf
EndIf
CopyMemory(*ptr, *ReceiveHTTPToMemoryBuffer + ReceiveHTTPToMemoryBufferPtr, SizeProper * NMemBProper)
ReceiveHTTPToMemoryBufferPtr + SizeProper * NMemBProper
ProcedureReturn SizeProper * NMemBProper
EndProcedure
Procedure.i CurlReceiveHTTPToMemory(URL$, ProxyURL$="", ProxyPort$="", ProxyUser$="", ProxyPassword$="")
Protected *Buffer, curl.i, Timeout.i, res.i
;Debug "ReceiveHTTPToMemory" + URL$ + ProxyURL$ + ProxyPort$ + ProxyUser$ + ProxyPassword$
If Len(URL$)
curl = curl_easy_init()
If curl
Timeout = 3
curl_easy_setopt(curl, #CURLOPT_URL, str2curl(URL$))
curl_easy_setopt(curl, #CURLOPT_SSL_VERIFYPEER, 0)
curl_easy_setopt(curl, #CURLOPT_SSL_VERIFYHOST, 0)
curl_easy_setopt(curl, #CURLOPT_HEADER, 0)
curl_easy_setopt(curl, #CURLOPT_TIMEOUT, Timeout)
If Len(ProxyURL$)
;curl_easy_setopt(curl, #CURLOPT_HTTPPROXYTUNNEL, #True)
If Len(ProxyPort$)
ProxyURL$ + ":" + ProxyPort$
EndIf
Debug ProxyURL$
curl_easy_setopt(curl, #CURLOPT_PROXY, str2curl(ProxyURL$))
If Len(ProxyUser$)
If Len(ProxyPassword$)
ProxyUser$ + ":" + ProxyPassword$
EndIf
;Debug ProxyUser$
curl_easy_setopt(curl, #CURLOPT_PROXYUSERPWD, str2curl(ProxyUser$))
EndIf
EndIf
curl_easy_setopt(curl, #CURLOPT_WRITEFUNCTION, @ReceiveHTTPWriteToMemoryFunction())
res = curl_easy_perform(curl)
If res = #CURLE_OK
*Buffer = AllocateMemory(ReceiveHTTPToMemoryBufferPtr)
If *Buffer
CopyMemory(*ReceiveHTTPToMemoryBuffer, *Buffer, ReceiveHTTPToMemoryBufferPtr)
FreeMemory(*ReceiveHTTPToMemoryBuffer)
*ReceiveHTTPToMemoryBuffer = #Null
ReceiveHTTPToMemoryBufferPtr = 0
Else
Debug "Problem allocating buffer"
EndIf
;curl_easy_cleanup(curl) ;Was its original place but moved below as it seems more logical to me.
Else
Debug "CURL NOT OK"
EndIf
curl_easy_cleanup(curl)
Else
Debug "Can't Init CURL"
EndIf
EndIf
Debug "Curl Buffer : " + Str(*Buffer)
ProcedureReturn *Buffer
EndProcedure
;- ***
Procedure InitOSM()
Protected Result.i
OSM\HDDCachePath = GetTemporaryDirectory()
OSM\ServerURL = "http://tile.openstreetmap.org/"
OSM\ZoomMin = 0
OSM\ZoomMax = 18
OSM\MoveStartingPoint\x = - 1
OSM\TileSize = 256
OSM\MemCache\Mutex = CreateMutex()
OSM\LoadingMutex = CreateMutex()
OSM\DrawingMutex = CreateMutex()
;OSM\CurlMutex = CreateMutex()
OSM\Dirty = #False
OSM\Drawing\Semaphore = CreateSemaphore()
OSM\Drawing\Mutex = CreateMutex()
;-*** PROXY
Global Proxy = #False
;- => Use this to customise your preferences
; Result = CreatePreferences(GetHomeDirectory() + "OSM.prefs")
; If Proxy
; PreferenceGroup("PROXY")
; WritePreferenceString("ProxyURL", "myproxy.fr")
; WritePreferenceString("ProxyPort", "myproxyport")
; WritePreferenceString("ProxyUser", "myproxyname")
; EndIf
; If Result
; ClosePreferences()
; EndIf
Result = OpenPreferences(GetHomeDirectory() + "OSM.prefs")
If Proxy
PreferenceGroup("PROXY")
Global ProxyURL$ = ReadPreferenceString("ProxyURL", "") ;InputRequester("ProxyServer", "Do you use a Proxy Server? Then enter the full url:", "")
Global ProxyPort$ = ReadPreferenceString("ProxyPort", "") ;InputRequester("ProxyPort" , "Do you use a specific port? Then enter it", "")
Global ProxyUser$ = ReadPreferenceString("ProxyUser", "") ;InputRequester("ProxyUser" , "Do you use a user name? Then enter it", "")
Global ProxyPassword$ = InputRequester("ProxyPass" , "Do you use a password ? Then enter it", "")
EndIf
If Result
ClosePreferences()
EndIf
curl_global_init(#CURL_GLOBAL_ALL);
CreateThread(@DrawingThread(), @OSM\Drawing)
EndProcedure
;- ***
Procedure OSMGadget(Gadget.i, X.i, Y.i, Width.i, Height.i)
If Gadget = #PB_Any
OSM\Gadget = CanvasGadget(OSM\Gadget, X, Y, Width, Height)
Else
OSM\Gadget = Gadget
CanvasGadget(OSM\Gadget, X, Y, Width, Height)
EndIf
EndProcedure
;*** Converts coords to tile.decimal
Procedure LatLon2XY(*Location.Location, *Tile.Tile)
Protected n.d = Pow(2.0, OSM\Zoom)
Protected LatRad.d = Radian(*Location\Latitude)
*Tile\x = n * ( (*Location\Longitude + 180.0) / 360.0)
*Tile\y = n * ( 1.0 - Log(Tan(LatRad) + 1.0/Cos(LatRad)) / #PI ) / 2.0
Debug "Latitude : " + StrD(*Location\Latitude) + " ; Longitude : " + StrD(*Location\Longitude)
Debug "Tile X : " + Str(*Tile\x) + " ; Tile Y : " + Str(*Tile\y)
EndProcedure
;*** Converts tile.decimal to coords
Procedure XY2LatLon(*Tile.Tile, *Location.Location)
Protected n.d = Pow(2.0, OSM\Zoom)
Protected LatitudeRad.d
*Location\Longitude = *Tile\x / n * 360.0 - 180.0
LatitudeRad = ATan(SinH(#PI * (1.0 - 2.0 * *Tile\y / n)))
*Location\Latitude = Degree(LatitudeRad)
EndProcedure
Procedure getPixelCoorfromLocation(*Location.Location, *Pixel.Pixel) ; TODO to Optimize
Protected mapWidth.l = Pow(2,OSM\Zoom+8)
Protected mapHeight.l = Pow(2,OSM\Zoom+8)
Protected x1.l,y1.l
Protected deltaX = OSM\Position\x - Int(OSM\Drawing\x) * OSM\TileSize ;Get the position into the tile
Protected deltaY = OSM\Position\y - Int(OSM\Drawing\y) * OSM\TileSize
; get x value
x1 = (*Location\Longitude+180)*(mapWidth/360)
; convert from degrees To radians
Protected latRad.d = *Location\Latitude*#PI/180;
Protected mercN.d = Log(Tan((#PI/4)+(latRad/2)));
y1 = (mapHeight/2)-(mapWidth*mercN/(2*#PI)) ;
Protected x2.l, y2.l
; get x value
x2 = (OSM\TargetLocation\Longitude+180)*(mapWidth/360)
; convert from degrees To radians
latRad = OSM\TargetLocation\Latitude*#PI/180;
; get y value
mercN = Log(Tan((#PI/4)+(latRad/2))) ;
y2 = (mapHeight/2)-(mapWidth*mercN/(2*#PI));
*Pixel\x=GadgetWidth(OSM\Gadget)/2 - (x2-x1) - deltaX
*Pixel\y=GadgetHeight(OSM\Gadget)/2 - (y2-y1) - deltaY
EndProcedure
Procedure LoadGpxFile(file.s)
If LoadXML(0, file.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))
MessageRequester("Error", Message)
EndIf
Protected *MainNode,*subNode,*child,child.l
*MainNode=MainXMLNode(0)
*MainNode=XMLNodeFromPath(*MainNode,"/gpx/trk/trkseg")
ClearList(OSM\track())
For child = 1 To XMLChildCount(*MainNode)
*child = ChildXMLNode(*MainNode, child)
AddElement(OSM\track())
If ExamineXMLAttributes(*child)
While NextXMLAttribute(*child)
Select XMLAttributeName(*child)
Case "lat"
OSM\track()\Latitude=ValD(XMLAttributeValue(*child))
Case "lon"
OSM\track()\Longitude=ValD(XMLAttributeValue(*child))
EndSelect
Wend
EndIf
Next
EndIf
EndProcedure
Procedure.i GetTileFromMem(Zoom.i, XTile.i, YTile.i)
Protected nImage.i = -1
Debug "Check if we have this image in memory"
LockMutex(OSM\LoadingMutex)
LockMutex(OSM\MemCache\Mutex)
ForEach OSM\MemCache\Image()
If Zoom = OSM\MemCache\Image()\Zoom And OSM\MemCache\Image()\xTile = XTile And OSM\MemCache\Image()\yTile = YTile
nImage = OSM\MemCache\Image()\nImage
Debug "Load from MEM Tile X : " + Str(XTile) + " ; Tile Y : " + Str(YTile) + " nImage:" + Str(nImage)
Break;
;ElseIf Zoom<>OSM\MemCache\Image()\Zoom
; DeleteElement(OSM\MemCache\Image())
EndIf
Next
UnlockMutex(OSM\MemCache\Mutex)
UnlockMutex(OSM\LoadingMutex)
ProcedureReturn nImage
EndProcedure
Procedure.i GetTileFromHDD(Zoom.i, XTile.i, YTile.i)
Protected nImage.i
Protected CacheFile.s = "OSM_" + Str(Zoom) + "_" + Str(XTile) + "_" + Str(YTile) + ".png"
Debug "Check if we have this image on HDD"
If FileSize(OSM\HDDCachePath + cacheFile) > 0
nImage = LoadImage(#PB_Any, OSM\HDDCachePath + CacheFile)
If IsImage(nImage)
Debug "Load from HDD Tile " + CacheFile
ProcedureReturn nImage
EndIf
EndIf
ProcedureReturn -1
EndProcedure
Procedure.i GetTileFromWeb(Zoom.i, XTile.i, YTile.i)
Protected *Buffer
Protected nImage.i = -1
Protected TileURL.s = OSM\ServerURL + Str(Zoom) + "/" + Str(XTile) + "/" + Str(YTile) + ".png"
; Test if in cache else download it
Protected CacheFile.s = "OSM_" + Str(Zoom) + "_" + Str(XTile) + "_" + Str(YTile) + ".png"
Debug "Check if we have this image on Web"
If Proxy
;LockMutex(OSM\CurlMutex) ;Seems no more necessary
*Buffer = CurlReceiveHTTPToMemory(TileURL, ProxyURL$, ProxyPort$, ProxyUser$, ProxyPassword$)
;UnlockMutex(OSM\CurlMutex)
Else
*Buffer = ReceiveHTTPMemory(TileURL) ;TODO to thread by using #PB_HTTP_Asynchronous
EndIf
Debug "Image buffer " + Str(*Buffer)
If *Buffer
LockMutex(OSM\LoadingMutex)
nImage = CatchImage(#PB_Any, *Buffer, MemorySize(*Buffer))
UnlockMutex(OSM\LoadingMutex)
If IsImage(nImage)
Debug "Load from web " + TileURL + " as Tile nb " + nImage
LockMutex(OSM\LoadingMutex)
SaveImage(nImage, OSM\HDDCachePath + CacheFile, #PB_ImagePlugin_PNG)
UnlockMutex(OSM\LoadingMutex)
FreeMemory(*Buffer)
Else
Debug "Can't catch image " + TileURL
nImage = -1
;ShowMemoryViewer(*Buffer, MemorySize(*Buffer))
EndIf
Else
Debug "Problem loading from web " + TileURL
EndIf
ProcedureReturn nImage
EndProcedure
Procedure GetImageThread(*Tile.Tile)
Protected *CacheImagePtr
Protected nImage.i = -1
LockMutex(OSM\LoadingMutex)
LockMutex(OSM\MemCache\Mutex)
*CacheImagePtr = AddElement(OSM\MemCache\Image())
Debug " CacheImagePtr : " + Str(*CacheImagePtr)
OSM\MemCache\Image()\xTile = *Tile\OSMTileX
OSM\MemCache\Image()\yTile = *Tile\OSMTileY
OSM\MemCache\Image()\Zoom = *Tile\OSMZoom
OSM\MemCache\Image()\nImage = -1 ;By now, this tile is in "loading" state, for thread synchro
UnlockMutex(OSM\MemCache\Mutex)
nImage = GetTileFromHDD(*Tile\OSMZoom, *Tile\OSMTileX, *Tile\OSMTileY)
If nImage = -1
nImage = GetTileFromWeb(*Tile\OSMZoom, *Tile\OSMTileX, *Tile\OSMTileY)
EndIf
LockMutex(OSM\MemCache\Mutex)
If nImage <> -1
Debug "Adding tile " + Str(nImage) + " to mem cache"
;AddTileToMemCache(Zoom, XTile, YTile, nImage)
OSM\MemCache\Image()\nImage = nImage
Debug "Image nb " + Str(nImage) + " successfully added to mem cache"
Else
Debug "Error GetImageThread procedure, tile not loaded - Zoom:" + Str(*Tile\OSMZoom) + " X:" + Str(*Tile\OSMTileX) + " Y:" + Str(*Tile\OSMTileY)
DeleteElement(OSM\MemCache\Image())
nImage = -1
EndIf
UnlockMutex(OSM\MemCache\Mutex)
*Tile\nImage = nImage
UnlockMutex(OSM\LoadingMutex)
EndProcedure
Procedure DrawTile(*Tile.Tile)
Protected x = *Tile\x
Protected y = *Tile\y
Debug " Drawing tile nb " + " X : " + Str(*Tile\OSMTileX) + " Y : " + Str(*Tile\OSMTileX)
Debug " at coords " + Str(x) + "," + Str(y)
LockMutex(OSM\DrawingMutex)
StartVectorDrawing(CanvasVectorOutput(OSM\Gadget))
If IsImage(*Tile\nImage)
MovePathCursor(x, y)
DrawVectorImage(ImageID(*Tile\nImage))
MovePathCursor(x, y)
DrawVectorText(Str(x) + ", " + Str(y))
Else
Debug "Image missing"
OSM\Drawing\Dirty = #True ;Signal that this image is missing so we should have to redraw
EndIf
StopVectorDrawing()
UnlockMutex(OSM\DrawingMutex)
EndProcedure
Procedure DrawTiles(*Drawing.DrawingParameters)
Protected x.i, y.i
Protected tx = Int(*Drawing\x) ;Don't forget the Int() !
Protected ty = Int(*Drawing\y)
Protected CenterX = GadgetWidth(OSM\Gadget) / 2
Protected CenterY = GadgetHeight(OSM\Gadget) / 2
Protected nx = CenterX / OSM\TileSize ;How many tiles around the point
Protected ny = CenterY / OSM\TileSize
;Pixel shift, aka position in the tile
Protected DeltaX = *Drawing\x * OSM\TileSize - (Int(*Drawing\x) * OSM\TileSize)
Protected DeltaY = *Drawing\y * OSM\TileSize - (Int(*Drawing\y) * OSM\TileSize)
Debug "Drawing tiles"
For y = - ny To ny
For x = - nx To nx
;Was quiting the loop if a move occured, giving maybe smoother movement
;If OSM\Moving
; Break 2
;EndIf
Protected *NewTile.Tile = AllocateMemory(SizeOf(Tile))
If *NewTile
With *NewTile
;Keep a track of tiles (especially to free memory)
AddElement(OSM\TilesThreads())
OSM\TilesThreads()\Tile = *NewTile
;New tile parameters
\x = CenterX + x * OSM\TileSize - DeltaX
\y = CenterY + y * OSM\TileSize - DeltaY
\OSMTileX = tx + x
\OSMTileY = ty + y
\OSMZoom = OSM\Zoom
;Check if the image exists
\nImage = GetTileFromMem(\OSMZoom, \OSMTileX, \OSMTileY)
If \nImage = -1
;If not, load it in the background
\GetImageThread = CreateThread(@GetImageThread(), *NewTile)
OSM\TilesThreads()\GetImageThread = \GetImageThread
Debug " Creating get image thread nb " + Str(\GetImageThread)
EndIf
DrawTile(*NewTile)
EndWith
Else
Debug" Error, can't create a new tile."
Break 2
EndIf
Next
Next
;Free tile memory when the loading thread has finished
;TODO : exit this proc from drawtiles in a special "free ressources" task
ForEach OSM\TilesThreads()
If IsThread(OSM\TilesThreads()\GetImageThread) = 0
FreeMemory(OSM\TilesThreads()\Tile)
DeleteElement(OSM\TilesThreads())
EndIf
Next
EndProcedure
Procedure DrawTrack(*Drawing.DrawingParameters)
Protected Pixel.Pixel
Protected Location.Location
Protected DeltaX = *Drawing\x * OSM\TileSize - (Int(*Drawing\x) * OSM\TileSize)
Protected DeltaY = *Drawing\y * OSM\TileSize - (Int(*Drawing\y) * OSM\TileSize)
If ListSize(OSM\track())>0
ForEach OSM\track()
If @OSM\TargetLocation\Latitude<>0 And @OSM\TargetLocation\Longitude<>0
getPixelCoorfromLocation(@OSM\track(), @Pixel)
If ListIndex(OSM\track())=0
MovePathCursor(Pixel\X + DeltaX, Pixel\Y + DeltaY)
Else
AddPathLine(Pixel\X + DeltaX, Pixel\Y + DeltaY)
EndIf
EndIf
Next
VectorSourceColor(RGBA(0, 255, 0, 150))
StrokePath(10, #PB_Path_RoundEnd|#PB_Path_RoundCorner)
EndIf
EndProcedure
Procedure Pointer(x.i, y.i, color.l = #Red)
color=RGBA(255, 0, 0, 255)
VectorSourceColor(color)
MovePathCursor(x, y)
AddPathLine(-8,-16,#PB_Path_Relative)
AddPathCircle(8,0,8,180,0,#PB_Path_Relative)
AddPathLine(-8,16,#PB_Path_Relative)
;FillPath(#PB_Path_Preserve)
;ClipPath(#PB_Path_Preserve)
AddPathCircle(0,-16,5,0,360,#PB_Path_Relative)
VectorSourceColor(color)
FillPath(#PB_Path_Preserve):VectorSourceColor(RGBA(0, 0, 0, 255)):StrokePath(1)
EndProcedure
Procedure DrawingThread(*Drawing.DrawingParameters)
Repeat
WaitSemaphore(*Drawing\Semaphore)
Debug "--------- Main drawing thread ------------"
LockMutex(*Drawing\Mutex) ; Only one main drawing thread at once
*Drawing\Dirty = #False
Protected CenterX = GadgetWidth(OSM\Gadget) / 2
Protected CenterY = GadgetHeight(OSM\Gadget) / 2
DrawTiles(*Drawing)
LockMutex(OSM\DrawingMutex)
StartVectorDrawing(CanvasVectorOutput(OSM\Gadget))
DrawTrack(*Drawing)
Pointer(CenterX, CenterY, #Red)
StopVectorDrawing()
UnlockMutex(OSM\DrawingMutex)
;- Redraw
;If something was not correctly drawn, redraw after a while
If *Drawing\Dirty
Debug "Something was dirty ! We try again to redraw"
;Delay(250)
*Drawing\PassNb + 1
SignalSemaphore(*Drawing\Semaphore)
EndIf
UnlockMutex(*Drawing\Mutex)
Until *Drawing\End
EndProcedure
Procedure SetLocation(latitude.d, longitude.d, zoom = 15)
OSM\TargetLocation\Latitude = latitude
OSM\TargetLocation\Longitude = longitude
OSM\Zoom = zoom
If OSM\Zoom > OSM\ZoomMax : OSM\Zoom = OSM\ZoomMax : EndIf
If OSM\Zoom < OSM\ZoomMin : OSM\Zoom = OSM\ZoomMin : EndIf
LockMutex(OSM\Drawing\Mutex)
LatLon2XY(@OSM\TargetLocation, @OSM\Drawing)
;Convert X, Y in tile.decimal into real pixels
OSM\Position\X = OSM\Drawing\x * OSM\TileSize
OSM\Position\Y = OSM\Drawing\y * OSM\TileSize
OSM\Drawing\PassNb = 1
UnlockMutex(OSM\Drawing\Mutex)
;Start drawing
SignalSemaphore(OSM\Drawing\Semaphore)
;***
EndProcedure
Procedure SetZoom(Zoom.i, mode.i = #PB_Relative)
Select mode
Case #PB_Relative
OSM\Zoom = OSM\Zoom + zoom
Case #PB_Absolute
OSM\Zoom = zoom
EndSelect
If OSM\Zoom > OSM\ZoomMax : OSM\Zoom = OSM\ZoomMax : EndIf
If OSM\Zoom < OSM\ZoomMin : OSM\Zoom = OSM\ZoomMin : EndIf
LockMutex(OSM\Drawing\Mutex)
LatLon2XY(@OSM\TargetLocation, @OSM\Drawing)
;Convert X, Y in tile.decimal into real pixels
OSM\Position\X = OSM\Drawing\x * OSM\TileSize
OSM\Position\Y = OSM\Drawing\y * OSM\TileSize
;*** Creates a drawing thread and fill parameters
OSM\Drawing\PassNb = 1
UnlockMutex(OSM\Drawing\Mutex)
;Start drawing
SignalSemaphore(OSM\Drawing\Semaphore)
;***
EndProcedure
Procedure SetCallBackLocation(CallBackLocation.i)
OSM\CallBackLocation=CallBackLocation
EndProcedure
Procedure Event(Event.l)
Protected Gadget.i
Protected MouseX.i, MouseY.i
Protected OldX.i, OldY.i
Protected *Drawing.DrawingParameters
If IsGadget(OSM\Gadget) And GadgetType(OSM\Gadget) = #PB_GadgetType_Canvas
Select Event
Case #PB_Event_Gadget ;{
Gadget = EventGadget()
Select Gadget
Case OSM\Gadget
Select EventType()
Case #PB_EventType_LeftButtonDown
;Mem cursor Coord
OSM\MoveStartingPoint\x = GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseX)
OSM\MoveStartingPoint\y = GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseY)
Case #PB_EventType_MouseMove
If OSM\MoveStartingPoint\x <> - 1
MouseX = GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseX) - OSM\MoveStartingPoint\x
MouseY = GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseY) - OSM\MoveStartingPoint\y
OSM\Moving = #True
;Old move values
OldX = OSM\Position\x
OldY = OSM\Position\y
;New move values
OSM\Position\x - MouseX
OSM\Position\y - MouseY
;-*** Fill parameters and signal the drawing thread
LockMutex(OSM\Drawing\Mutex)
;OSM tile position in tile.decimal
OSM\Drawing\x = OSM\Position\x / OSM\TileSize
OSM\Drawing\y = OSM\Position\y / OSM\TileSize
OSM\Drawing\PassNb = 1
;Moved to a new tile ?
;If (Int(OSM\Position\x / OSM\TileSize)) <> (Int(OldX / OSM\TileSize)) Or (Int(OSM\Position\y / OSM\TileSize)) <> (Int(OldY / OSM\TileSize))
;Debug "--- New tile"
Debug "OSM\Position\x " + Str(OSM\Position\x) + " ; OSM\Position\y " + Str(OSM\Position\y)
XY2LatLon(@OSM\Drawing, @OSM\TargetLocation)
Debug "OSM\Drawing\x " + StrD(OSM\Drawing\x) + " ; OSM\Drawing\y " + StrD(OSM\Drawing\y)
;EndIf
UnlockMutex(OSM\Drawing\Mutex)
;Start drawing
SignalSemaphore(OSM\Drawing\Semaphore)
;- ***
OSM\MoveStartingPoint\x = GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseX)
OSM\MoveStartingPoint\y = GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseY)
;If CallBackLocation send Location to function
If OSM\CallBackLocation>0
CallFunctionFast(OSM\CallBackLocation, @OSM\TargetLocation)
EndIf
EndIf
Case #PB_EventType_LeftButtonUp
OSM\Moving = #False
OSM\MoveStartingPoint\x = - 1
OSM\Drawing\x = OSM\Position\x / OSM\TileSize
OSM\Drawing\y = OSM\Position\y / OSM\TileSize
Debug "OSM\Position\x " + Str(OSM\Position\x) + " ; OSM\Position\y " + Str(OSM\Position\y)
XY2LatLon(@OSM\Drawing, @OSM\TargetLocation)
;Draw()
Debug "OSM\Drawing\x " + StrD(OSM\Drawing\x) + " ; OSM\Drawing\y " + StrD(OSM\Drawing\y)
;SetGadgetText(#String_1, StrD(OSM\TargetLocation\Latitude))
;SetGadgetText(#String_0, StrD(OSM\TargetLocation\Longitude))
EndSelect
EndSelect
EndSelect
Else
MessageRequester("Module OSM", "You must use OSMGadget before", #PB_MessageRequester_Ok )
End
EndIf
EndProcedure
EndModule
;Demonstration
CompilerIf #PB_Compiler_IsMainFile
Enumeration
#Window_0
#Map
#Button_0
#Button_1
#Button_2
#Button_3
#Button_4
#Button_5
#Combo_0
#Text_0
#Text_1
#Text_2
#Text_3
#Text_4
#String_0
#String_1
#Gdt_LoadGpx
EndEnumeration
Structure Location
Longitude.d
Latitude.d
EndStructure
Procedure UpdateLocation(*Location.Location)
SetGadgetText(#String_0, StrD(*Location\Latitude))
SetGadgetText(#String_1, StrD(*Location\Longitude))
ProcedureReturn 0
EndProcedure
;- Main
If OpenWindow(#Window_0, 260, 225, 700, 571, "OpenStreetMap", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered )
OSM::InitOSM()
LoadFont(0, "Wingdings", 12)
LoadFont(1, "Arial", 12, #PB_Font_Bold)
OSM::OSMGadget(#Map, 10, 10, 512, 512)
TextGadget(#Text_1, 530, 50, 60, 15, "Movements : ")
ButtonGadget(#Button_0, 550, 100, 30, 30, Chr($E7)) : SetGadgetFont(#Button_0, FontID(0))
ButtonGadget(#Button_1, 610, 100, 30, 30, Chr($E8)) : SetGadgetFont(#Button_1, FontID(0))
ButtonGadget(#Button_2, 580, 070, 30, 30, Chr($E9)) : SetGadgetFont(#Button_2, FontID(0))
ButtonGadget(#Button_3, 580, 130, 30, 30, Chr($EA)) : SetGadgetFont(#Button_3, 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))
TextGadget(#Text_3, 530, 230, 60, 15, "Latitude : ")
StringGadget(#String_0, 600, 230, 90, 20, "")
TextGadget(#Text_4, 530, 250, 60, 15, "Longitude : ")
StringGadget(#String_1, 600, 250, 90, 20, "")
ButtonGadget(#Gdt_LoadGpx, 530, 280, 150, 30, "Load GPX")
Define Event.i, Gadget.i, Quit.b = #False
Define pfValue.d
OSM::SetLocation(49.04599, 2.03347, 17)
OSM::SetCallBackLocation(@UpdateLocation())
Repeat
Event = WaitWindowEvent()
OSM::Event(Event)
Select Event
Case #PB_Event_CloseWindow : Quit = 1
Case #PB_Event_Gadget ;{
Gadget = EventGadget()
Select Gadget
Case #Button_4
OSM::SetZoom(1)
Case #Button_5
OSM::SetZoom( - 1)
Case #Gdt_LoadGpx
OSM::LoadGpxFile(OpenFileRequester("Choisissez un fichier à charger", "", "*.gpx", 0))
EndSelect
EndSelect
Until Quit = #True
EndIf
CompilerEndIf
Re: OpenStreetMap dans un Canvas
très beau Boulot Djes ^_^
La différence entre les 2 codes est surtout sur la façon d'afficher la carte.
Et voici mon code. Si vous n'avez pas de proxy vous pouvez tester le code tel qu'il est.
Avec ce code vous pouvez rajouter des marques et les déplacer et afficher un fichier GPX ou il vous affichera chaque km (pas très jolie)
Reste beaucoup a faire... mais ça commence a vraiment bien fonctionner
La différence entre les 2 codes est surtout sur la façon d'afficher la carte.
Et voici mon code. Si vous n'avez pas de proxy vous pouvez tester le code tel qu'il est.
Avec ce code vous pouvez rajouter des marques et les déplacer et afficher un fichier GPX ou il vous affichera chaque km (pas très jolie)
Reste beaucoup a faire... mais ça commence a vraiment bien fonctionner
Code : Tout sélectionner
;**************************************************************
; Name: Module OpenStreetMap
; Version: 0.8
; Author: Thyphoon And Djes
; Date: July 26, 2016
; License: Free, unrestricted, credit appreciated
; but not required.
; Note: Please share improvement !
; Thanks: Progi1984 for the first OSM implementation
; Fred, Freak and all people who made purebasic what is it !
;**************************************************************
;Only if you use a Proxy
;XIncludeFile("..\includes Share\http.pbi") ;<- You must yo use it if your network have a proxy
CompilerIf Defined(http,#PB_Module)
http::SetProxy("yourproxy","8080") ;<- Setup you proxy
CompilerEndIf
CompilerIf #PB_Compiler_Thread=0
CompilerError "Warning !!","You must to Enable 'create ThreadSafe' in compiler option"
End
CompilerEndIf
DeclareModule OSM
Declare InitOSM(window.i=0)
Declare MapGadget(Gadget.i, X.i, Y.i, Width.i, Height.i)
Declare Event(Event.l)
Declare SetLocation(latitude.d, longitude.d, zoom = 15)
Declare SetCallBackLocation(*CallBackLocation)
Declare SetZoom(Zoom.i, mode.i = #PB_Relative)
Declare LoadGpxFile(file.s);
Declare AddMarker(Latitude.d,Longitude.d,color.l=-1)
Declare ZoomToArea()
Declare RefreshMap()
EndDeclareModule
Module OSM
;Just a Hook to replace original ReceiveHTTPMemory() by http::ReceiveHTTPToMemory(URL) if you want to use my http lib
CompilerIf Defined(http,#PB_Module)
Macro ReceiveHTTPMemory(URL)
http::ReceiveHTTPToMemory(URL)
EndMacro
CompilerEndIf
UsePNGImageDecoder()
UsePNGImageEncoder()
Enumeration #PB_Event_FirstCustomValue
#EvenementStartRefresh
#EvenementStopRefresh
EndEnumeration
Structure Location
Longitude.d ; ex: 49.04599
Latitude.d ; ex 2.03347
EndStructure
Structure Tile
X.d ; ex: 66276.367739138892
Y.d ; ex: 44987.
EndStructure
Structure Pixel
X.i
Y.i
EndStructure
Structure ImgMemCach
nImage.i
Zoom.i
XTile.i
YTile.i
LastUseTime.i ; ElapsedMilliseconds value from last Tile Use see GetTileFromMem()
EndStructure
Structure TileMemCach
List Image.ImgMemCach()
Mutex.i
EndStructure
Structure Marker
Location.Location
color.l
EndStructure
Structure OSM
Window.i ; Window used to put the MapGadget
Gadget.i ; Canvas Gadget Id
Font.i
TargetLocation.Location ; Latitude and Longitude from focus point
TargetTile.Tile ; Focus Tile coord
CallBackLocation.i ; pointer to procedure to sen location
Position.Pixel ; Focus Point coord in Pixel
ServerURL.s ; Web Url ex: http://tile.openstreetmap.org/
ZoomMin.i ; Min Zoom supported by Server
ZoomMax.i ; Max Zoom supported by Server
Zoom.i ; Current Zoom
TileSize.i ; Tile Size downloaded on the server ex : 256
ConstructMapMutex.i ; To Lock When a Thread ConstructMap run
HDDCachePath.S ; Path to Load and Save Tile downloaded from server
MemCache.TileMemCach ; to know image always in memory
; List MapImageIndex.ImgMemCach() ; List of Index from MemCache\Image() to construct map
Array MapImage.ImgMemCach(16,16)
MapImageMutex.i ; Mutex to lock when use MapImage() Array
MapImageSemaphore.i ; Semaphore to control Thread
List ThreadGetTile.i() ; Simple List with all thread GetTile run. used to kill them when No Web Connection
ErrorLoadingTile.b ; #True when the answer from Web Connection is too slow
StartCursor.Pixel ; Coord from start drag the map
DeltaCursor.Pixel ; Delta from curent position and the start position
List track.Location() ; To display a track GPX on card
List Marker.Marker() ; To diplay marker
EditMarkerIndex.i ; Index from Marker List about Marker edited
EndStructure
Global OSM.OSM
; Open a CanvasGadget to display the map
Procedure MapGadget(Gadget.i, X.i, Y.i, Width.i, Height.i)
If Gadget = #PB_Any
OSM\Gadget = CanvasGadget(OSM\Gadget, X, Y, Width, Height)
Else
OSM\Gadget = Gadget
CanvasGadget(OSM\Gadget, X, Y, Width, Height)
EndIf
EndProcedure
Macro Min(a,b)
(Bool((a) <= (b)) * (a) + Bool((b) < (a)) * (b))
EndMacro
Macro Max(a,b)
(Bool((a) >= (b)) * (a) + Bool((b) > (a)) * (b))
EndMacro
; Convert Latitude/Longitude Location to Tile Coord
Procedure LatLon2XY(*Location.Location, *Tile.Tile)
Protected n.d = Pow(2.0, OSM\Zoom)
Protected LatRad.d = Radian(*Location\Latitude)
*Tile\X = n * ( (*Location\Longitude + 180.0) / 360.0)
*Tile\Y = n * ( 1.0 - Log(Tan(LatRad) + 1.0/Cos(LatRad)) / #PI ) / 2.0
;Debug "Latitude : " + StrD(*Location\Latitude) + " ; Longitude : " + StrD(*Location\Longitude)
;Debug "Tile X : " + Str(*Tile\X) + " ; Tile Y : " + Str(*Tile\Y)
EndProcedure
; Convert Tile Coord to Latitude/Longitude
Procedure XY2LatLon(*Tile.Tile, *Location.Location)
Protected n.d = Pow(2.0, OSM\Zoom)
Protected LatitudeRad.d
*Location\Longitude = *Tile\X / n * 360.0 - 180.0
LatitudeRad = ATan(SinH(#PI * (1.0 - 2.0 * *Tile\Y / n)))
*Location\Latitude = Degree(LatitudeRad)
EndProcedure
; Convert Latitude/Longitude to Pixel Coord on MapGadget
Procedure GetPixelCoordFromLocation(*Location.Location,*Pixel.Pixel) ; TODO to Optimize
Protected mapWidth.l = Pow(2,OSM\Zoom+8)
Protected mapHeight.l = Pow(2,OSM\Zoom+8)
Protected x1.l,y1.l
; get x value
x1 = (*Location\Longitude+180)*(mapWidth/360)
; convert from degrees To radians
Protected latRad.d = *Location\Latitude*#PI/180;
Protected mercN.d = Log(Tan((#PI/4)+(latRad/2)));
y1 = (mapHeight/2)-(mapWidth*mercN/(2*#PI)) ;
Protected x2.l,y2.l
; get x value
x2 = (OSM\TargetLocation\Longitude+180)*(mapWidth/360)
; convert from degrees To radians
latRad = OSM\TargetLocation\Latitude*#PI/180;
; get y value
mercN = Log(Tan((#PI/4)+(latRad/2))) ;
y2 = (mapHeight/2)-(mapWidth*mercN/(2*#PI));
*Pixel\X=GadgetWidth(OSM\Gadget)/2-(x2-x1)+ OSM\DeltaCursor\X
*Pixel\Y=GadgetHeight(OSM\Gadget)/2-(y2-y1)+ OSM\DeltaCursor\Y
EndProcedure
; HaversineAlgorithm
; http://andrew.hedges.name/experiments/haversine/
Procedure.d HaversineInKM(*posA.Location,*posB.Location)
Protected eQuatorialEarthRadius.d = 6378.1370;6372.795477598;
Protected dlong.d = (*posB\Longitude - *posA\Longitude);
Protected dlat.d = (*posB\Latitude - *posA\Latitude) ;
Protected alpha.d=dlat/2
Protected beta.d=dlong/2
Protected a.d = Sin(Radian(alpha)) * Sin(Radian(alpha)) + Cos(Radian(*posA\Latitude)) * Cos(Radian(*posB\Latitude)) * Sin(Radian(beta)) * Sin(Radian(beta))
Protected c.d = ASin(Min(1,Sqr(a)));
Protected distance.d = 2*eQuatorialEarthRadius * c
ProcedureReturn distance ;
EndProcedure
Procedure.d HaversineInM(*posA.Location,*posB.Location)
ProcedureReturn (1000 * HaversineInKM(@*posA,@*posB));
EndProcedure
; Load a GPX file and convert in Path in OSM\Track()
Procedure LoadGpxFile(file.s)
If LoadXML(0, file.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))
MessageRequester("Error", Message)
EndIf
Protected *MainNode,*subNode,*child,child.l
*MainNode=MainXMLNode(0)
*MainNode=XMLNodeFromPath(*MainNode,"/gpx/trk/trkseg")
ClearList(OSM\track())
For child = 1 To XMLChildCount(*MainNode)
*child = ChildXMLNode(*MainNode, child)
AddElement(OSM\track())
If ExamineXMLAttributes(*child)
While NextXMLAttribute(*child)
Select XMLAttributeName(*child)
Case "lat"
OSM\track()\Latitude=ValD(XMLAttributeValue(*child))
Case "lon"
OSM\track()\Longitude=ValD(XMLAttributeValue(*child))
EndSelect
Wend
EndIf
Next
EndIf
EndProcedure
; Add to memory the image from last Tile Loaded
Procedure AddTileToMemCache(Zoom.i, XTile.i, YTile.i,nImage.i)
Protected Index.i
;If IsImage(nImage)
LockMutex(OSM\MemCache\Mutex)
;We add To the List And load it
FirstElement(OSM\MemCache\Image())
AddElement(OSM\MemCache\Image())
Index=ListIndex(OSM\MemCache\Image())
OSM\MemCache\Image()\XTile=XTile
OSM\MemCache\Image()\YTile=YTile
OSM\MemCache\Image()\Zoom=Zoom
OSM\MemCache\Image()\nImage=nImage
OSM\MemCache\Image()\LastUseTime=ElapsedMilliseconds()
UnlockMutex(OSM\MemCache\Mutex)
ProcedureReturn Index
;Else
;Debug "NO ADD TILE TO MEM CACHE BECAUSE BAD IMAGE"
;EndIf
EndProcedure
; Check if this Tile is already loaded in Memory
Procedure.i GetTileFromMem(Zoom.i, XTile.i, YTile.i)
Protected nImage.i=#False
LockMutex(OSM\MemCache\Mutex)
;Check if we have this Image in Memory
ForEach OSM\MemCache\Image()
If Zoom=OSM\MemCache\Image()\Zoom And OSM\MemCache\Image()\XTile=XTile And OSM\MemCache\Image()\YTile=YTile
OSM\MemCache\Image()\LastUseTime=ElapsedMilliseconds()
nImage=OSM\MemCache\Image()\nImage
Debug "Load From MEM Tile X : " + Str(XTile) + " ; Tile Y : " + Str(YTile)+" IsImage:"+Str(IsImage(nImage))
Break; stop Search
; Clean Image in memory
;TODO Find a better way to clean Image in memory
ElseIf ElapsedMilliseconds()>OSM\MemCache\Image()\LastUseTime+30000 ;If Tile no use after 5 minutes ...
If OSM\MemCache\Image()\nImage>0 And IsImage(OSM\MemCache\Image()\nImage)
;FreeImage(OSM\MemCache\Image()\nImage)
EndIf
;DeleteElement(OSM\MemCache\Image())
EndIf
Next
UnlockMutex(OSM\MemCache\Mutex)
ProcedureReturn nImage
EndProcedure
; Check if this Tile is already on the HDD cache
Procedure.i GetTileFromHDD(Zoom.i, XTile.i, YTile.i)
Protected nImage.i
Protected CacheFile.s = "OSM_" + Str(Zoom) + "_" + Str(XTile) + "_" + Str(YTile) + ".png"
If FileSize(OSM\HDDCachePath + cacheFile) > 0
nImage=LoadImage(#PB_Any, OSM\HDDCachePath + CacheFile)
If IsImage(nImage)
Debug "Load From HDD Tile X : " + Str(XTile) + " ; Tile Y : " + Str(YTile)+ "IsImage:"+Str(IsImage(nImage))
AddTileToMemCache(Zoom, XTile, YTile,nImage)
ProcedureReturn nImage
EndIf
EndIf
ProcedureReturn #False
EndProcedure
; Download Tile From the Web
Procedure.i GetTileFromWeb(Zoom.i, XTile.i, YTile.i)
Protected *Buffer
Protected nImage.i=0
Protected CacheFile.s = "OSM_" + Str(Zoom) + "_" + Str(XTile) + "_" + Str(YTile) + ".png"
Protected TileURL.s = OSM\ServerURL + Str(Zoom) + "/" + Str(XTile) + "/" + Str(YTile) + ".png"
*Buffer = ReceiveHTTPMemory(TileURL)
If *Buffer>0
nImage=CatchImage(#PB_Any, *Buffer, MemorySize(*Buffer))
If IsImage(nImage)
AddTileToMemCache(Zoom, XTile, YTile,nImage)
SaveImage(nImage, OSM\HDDCachePath + CacheFile, #PB_ImagePlugin_PNG)
Debug "Load From WEB Tile X : " + Str(XTile) + " ; Tile Y : " + Str(YTile)
FreeMemory(*Buffer)
Else
Debug "Can't catch image :" + TileURL
AddTileToMemCache(Zoom, XTile, YTile,-1) ;<-To limit overload Download and display Error Loading On map
EndIf
Else
Debug "Problem loading :" + TileURL
AddTileToMemCache(Zoom, XTile, YTile,-1) ;<-To limit overload Download and display Error Loading On map
EndIf
ProcedureReturn nImage
EndProcedure
; Fin Image to Display a Tile
Procedure GetTile(*Index.ImgMemCach)
Protected Zoom.i, XTile.i, YTile.i
LockMutex(OSM\MapImageMutex)
Zoom=*Index\Zoom
XTile=*Index\XTile
YTile=*Index\YTile
*index\nImage=0
UnlockMutex(OSM\MapImageMutex)
Protected nImage.i
nImage=GetTileFromMem(Zoom, XTile, YTile)
If nImage=0
nImage=GetTileFromHDD(Zoom, XTile, YTile)
If nImage=0
nImage=GetTileFromWeb(Zoom, XTile, YTile)
If nImage=0
Debug "Error GetTile Procedure : can't Load this Tile" ; TODO Check Why !!!
ProcedureReturn #False
EndIf
EndIf
EndIf
LockMutex(OSM\MapImageMutex)
*Index\nImage=nImage
UnlockMutex(OSM\MapImageMutex)
SignalSemaphore(OSM\MapImageSemaphore)
PostEvent(#EvenementStopRefresh)
Debug"EndGetTile"
EndProcedure
; Prepare OSM\MapImage(x,y) with Image to display
Procedure ThreadConstructMap(z.i)
; ForEach OSM\ThreadGetTile()
; If IsThread(OSM\ThreadGetTile())
; KillThread(OSM\ThreadGetTile())
; SignalSemaphore(OSM\MapImageSemaphore) ; To restore the good levet to Semaphore
; Debug "Kill Over"
; EndIf
; Next
; Only 1 Thread about ConstrucMap at the same Time
If TryLockMutex(OSM\ConstructMapMutex)
;PostEvent(#EvenementStartRefresh)
Protected x.i, y.i
Protected nx.i = Round(GadgetWidth(OSM\Gadget)/OSM\TileSize,#PB_Round_Up)*2 ; How many tiles horizontally
Protected ny.i = Round(GadgetHeight(OSM\Gadget)/OSM\TileSize,#PB_Round_Up)*2 ; How many tiles Vertically
Protected tx.i = Int(OSM\TargetTile\X) ; Get Tile number
Protected ty.i = Int(OSM\TargetTile\Y)
Protected mx.i = Int(nx/2) ;Find the middle Tile
Protected my.i = Int(ny/2)
Protected NoCnxTime.i = -1 ;Get elapsedMilliseconds() when Semaphore is overload
Protected GetTile.b
ClearList(OSM\ThreadGetTile());
For x = 0 To nx
For y = 0 To ny
Repeat
GetTile=#True
If TrySemaphore(OSM\MapImageSemaphore)
NoCnxTime=-1
OSM\ErrorLoadingTile=#False
LockMutex(OSM\MapImageMutex)
OSM\MapImage(x,y)\XTile=tx+x-mx
OSM\MapImage(x,y)\YTile=ty+y-my
OSM\MapImage(x,y)\Zoom=OSM\Zoom
OSM\MapImage(x,y)\nImage=0
UnlockMutex(OSM\MapImageMutex)
LastElement(OSM\ThreadGetTile())
AddElement(OSM\ThreadGetTile())
; Find the Tile
OSM\ThreadGetTile()=CreateThread(@GetTile(),@OSM\MapImage(x,y))
; Semaphore is Overload we wait
Else
Delay(1)
GetTile=#False
; Take the Time from Overload start
If NoCnxTime=-1
NoCnxTime=ElapsedMilliseconds()
OSM\ErrorLoadingTile=#True
EndIf
; After 4000 Milliseconds Semaphore overload, it's not normal. We kill all Thread to stop Semaphore overload
If OSM\ErrorLoadingTile=#True And ElapsedMilliseconds()>NoCnxTime+5000
Break 2
EndIf
EndIf
Until GetTile=#True
Next
Next
PostEvent(#EvenementStopRefresh) ; in Event() ask a refresh Map
Debug "Unlock"
UnlockMutex(OSM\ConstructMapMutex)
Else
Debug "ConstructMap Overload"
EndIf
EndProcedure
Procedure ConstructMap()
CreateThread(@ThreadConstructMap(),0)
EndProcedure
; Draw a pointer to the screen
Procedure Pointer(x.l,y.l,color=-1)
If color=-1:color=RGBA(255, 0, 0, 255):EndIf
VectorSourceColor(color)
MovePathCursor(x, y)
AddPathLine(-8,-16,#PB_Path_Relative)
AddPathCircle(8,0,8,180,0,#PB_Path_Relative)
AddPathLine(-8,16,#PB_Path_Relative)
AddPathCircle(0,-16,5,0,360,#PB_Path_Relative)
VectorSourceColor(color)
FillPath(#PB_Path_Preserve):VectorSourceColor(RGBA(0, 0, 0, 255)):StrokePath(1)
EndProcedure
; Draw The Track if we have one !
Procedure DrawTrack()
Protected Pixel.Pixel
Protected Location.Location
Protected km.d=0
Protected memKm.l
If ListSize(OSM\track())>0
ForEach OSM\track()
;-Test Distance
If ListIndex(OSM\track())=0
Location\Latitude=OSM\track()\Latitude
Location\Longitude=OSM\track()\Longitude
Else
km=km+HaversineInKM(@Location,@OSM\track()) ;<- display Distance
Location\Latitude=OSM\track()\Latitude
Location\Longitude=OSM\track()\Longitude
EndIf
If @OSM\TargetLocation\Latitude<>0 And @OSM\TargetLocation\Longitude<>0
GetPixelCoordFromLocation(@OSM\track(),@Pixel)
If ListIndex(OSM\track())=0
MovePathCursor(Pixel\X,Pixel\Y)
Else
AddPathLine(Pixel\X,Pixel\Y)
If Int(km)<>memKm
memKm=Int(km)
If OSM\Zoom>10
BeginVectorLayer()
VectorFont(FontID(OSM\Font), OSM\Zoom)
VectorSourceColor(RGBA(50, 50, 50, 255))
DrawVectorText(Str(Int(km)))
EndVectorLayer()
EndIf
EndIf
EndIf
EndIf
Next
VectorSourceColor(RGBA(0, 255, 0, 150))
StrokePath(10, #PB_Path_RoundEnd|#PB_Path_RoundCorner)
EndIf
EndProcedure
; Add a Marker To the Map
Procedure AddMarker(Latitude.d,Longitude.d,color.l=-1)
AddElement(OSM\Marker())
OSM\Marker()\Location\Latitude=Latitude
OSM\Marker()\Location\Longitude=Longitude
OSM\Marker()\color=color
EndProcedure
; Draw All marker on the screen !
Procedure DrawMarker()
Protected Pixel.Pixel
ForEach OSM\Marker()
If OSM\Marker()\Location\Latitude<>0 And OSM\Marker()\Location\Longitude<>0
GetPixelCoordFromLocation(OSM\Marker()\Location,@Pixel)
If Pixel\X>0 And Pixel\Y>0 And Pixel\X<GadgetWidth(OSM\Gadget) And Pixel\Y<GadgetHeight(OSM\Gadget) ; Only if visible ^_^
Pointer(Pixel\X,Pixel\Y,OSM\Marker()\color)
EndIf
EndIf
Next
EndProcedure
; Draw The Map one the MapGadget
Procedure DrawMap()
Static myTimer.i
If myTimer=0 Or ElapsedMilliseconds()-myTimer>25 ;To limit refreash
Protected x.i, y.i, nx.i, ny.i, mx.i, my.i, n.i = 0
Protected deltaX.i, deltaY.i
Protected nImage.i
Protected x2.i, y2.i
Static Fade.f=0
StartVectorDrawing(CanvasVectorOutput(OSM\Gadget))
VectorFont(FontID(OSM\Font), 25)
AddPathBox(0,0,GadgetWidth(OSM\Gadget),GadgetHeight(OSM\Gadget))
VectorSourceColor(RGBA(255,255, 255, 255))
FillPath()
If TryLockMutex(OSM\MapImageMutex)
deltaX = OSM\TileSize*(OSM\TargetTile\X - Int(OSM\TargetTile\X))
deltaY = OSM\TileSize*(OSM\TargetTile\Y - Int(OSM\TargetTile\Y))
mx = GadgetWidth(OSM\Gadget)/2
my = GadgetHeight(OSM\Gadget)/2
nx = Round(GadgetWidth(OSM\Gadget)/OSM\TileSize,#PB_Round_Up)*2 ;How many tiles
ny = Round(GadgetHeight(OSM\Gadget)/OSM\TileSize,#PB_Round_Up)*2
For x = 0 To nx
For y = 0 To ny
x2 = x*256 + OSM\DeltaCursor\X + mx -deltaX-(nx/2)*OSM\TileSize
y2 = y*256 + OSM\DeltaCursor\Y + my - deltaY-(ny/2)*OSM\TileSize
nImage=OSM\MapImage(x,y)\nImage
If nImage<1
VectorSourceColor(RGBA(255, 255, 255, 255))
AddPathBox(x2, y2, OSM\TileSize, OSM\TileSize)
FillPath()
VectorSourceColor(RGBA(0, 0, 0, 255))
MovePathCursor(x2, y2+20)
DrawVectorText("Loading")
ElseIf (x2 + 256) > 0 And (y2 + 256) > 0 And x2 < GadgetWidth(OSM\Gadget) And y2 < GadgetHeight(OSM\Gadget)
If IsImage(nImage)
MovePathCursor(x2,y2)
DrawVectorImage(ImageID(nImage))
Else
VectorSourceColor(RGBA(0, 0, 0, 255))
MovePathCursor(x2, y2+20)
DrawVectorText("Error Loading")
EndIf
EndIf
Next
Next
UnlockMutex(OSM\MapImageMutex)
EndIf
; Draw Track and Markers
DrawTrack()
DrawMarker()
;Draw Central Cursor
BeginVectorLayer()
Pointer(GadgetWidth(OSM\Gadget)/2,GadgetHeight(OSM\Gadget)/2,RGBA(0,0,0,255))
EndVectorLayer()
;Display Red Alert If problem with Error Loading
If OSM\ErrorLoadingTile=#True
Debug "fade"
EndIf
If OSM\ErrorLoadingTile=#True And Fade<100
Fade=Fade+5
ElseIf Fade>0
Fade=Fade-5
EndIf
If Fade>0
AddPathBox(0,0,GadgetWidth(OSM\Gadget),GadgetHeight(OSM\Gadget))
VectorSourceColor(RGBA(255, 0, 0, Int(Fade)))
FillPath()
EndIf
StopVectorDrawing()
myTimer=ElapsedMilliseconds()
EndIf
EndProcedure
Procedure RefreshMap()
ConstructMap()
DrawMap()
EndProcedure
;CallBack to return Location after movement
Procedure SetCallBackLocation(CallBackLocation.i)
OSM\CallBackLocation=CallBackLocation
EndProcedure
Procedure SetLocation(latitude.d, longitude.d, zoom = 15)
If zoom > OSM\ZoomMax : zoom = OSM\ZoomMax : EndIf
If zoom < OSM\ZoomMin : zoom = OSM\ZoomMin : EndIf
OSM\Zoom = zoom
OSM\TargetLocation\Latitude = latitude
OSM\TargetLocation\Longitude = longitude
LatLon2XY(@OSM\TargetLocation, @OSM\TargetTile)
OSM\Position\X = OSM\TargetTile\X * OSM\TileSize ;Convert X, Y in tile.decimal into real pixels
OSM\Position\Y = OSM\TargetTile\Y * OSM\TileSize
EndProcedure
Procedure ZoomToArea()
;Source => http://gis.stackexchange.com/questions/19632/how-to-calculate-the-optimal-zoom-level-to-display-two-or-more-points-on-a-map
;bounding box in long/lat coords (x=long, y=lat)
Protected MinY.d,MaxY.d,MinX.d,MaxX.d
ForEach OSM\track()
If ListIndex(OSM\track())=0 Or OSM\track()\Longitude<MinX
MinX=OSM\track()\Longitude
EndIf
If ListIndex(OSM\track())=0 Or OSM\track()\Longitude>MaxX
MaxX=OSM\track()\Longitude
EndIf
If ListIndex(OSM\track())=0 Or OSM\track()\Latitude<MinY
MinY=OSM\track()\Latitude
EndIf
If ListIndex(OSM\track())=0 Or OSM\track()\Latitude>MaxY
MaxY=OSM\track()\Latitude
EndIf
Next
Protected DeltaX.d=MaxX-MinX ;assumption ! In original code DeltaX have no source
Protected centerX.d=MinX+DeltaX/2 ; assumption ! In original code CenterX have no source
Protected paddingFactor.f= 1.2 ;paddingFactor: this can be used to get the "120%" effect ThomM refers to. Value of 1.2 would get you the 120%.
ry1.d = Log((Sin(Radian(MinY)) + 1) / Cos(Radian(MinY)))
ry2.d = Log((Sin(Radian(MaxY)) + 1) / Cos(Radian(MaxY)))
ryc.d = (ry1 + ry2) / 2
centerY.d = Degree(ATan(SinH(ryc)))
resolutionHorizontal.d = DeltaX / GadgetWidth(OSM\Gadget)
vy0.d = Log(Tan(#PI*(0.25 + centerY/360)));
vy1.d = Log(Tan(#PI*(0.25 + MaxY/360))) ;
viewHeightHalf.d = GadgetHeight(OSM\Gadget)/2;
zoomFactorPowered.d = viewHeightHalf / (40.7436654315252*(vy1 - vy0))
resolutionVertical.d = 360.0 / (zoomFactorPowered * OSM\TileSize)
If resolutionHorizontal<>0 And resolutionVertical<>0
resolution.d = Max(resolutionHorizontal, resolutionVertical)* paddingFactor
zoom.d = Log(360 / (resolution * OSM\TileSize))/Log(2)
lon.d = centerX;
lat.d = centerY;
SetLocation(lat,lon, Round(zoom,#PB_Round_Down))
Else
SetLocation(OSM\TargetLocation\Latitude,OSM\TargetLocation\Longitude, 15)
EndIf
EndProcedure
Procedure TileTranslate(*Tile.Tile, tx.d, ty.d)
Debug " - move - "
Protected pfValue.d
If tx <> 0
pfValue = *Tile\X - tx
If pfValue > Pow(2, OSM\Zoom) - 1
*Tile\X = Pow(2, OSM\Zoom) - 2
ElseIf pfValue < 0
*Tile\X = Pow(2, OSM\Zoom) - 2
Else
*Tile\X = pfValue
EndIf
EndIf
If ty <> 0
pfValue = *Tile\Y - ty
If pfValue > Pow(2, OSM\Zoom) - 1
*Tile\Y = Pow(2, OSM\Zoom) - 2
ElseIf pfValue < 0
*Tile\Y = Pow(2, OSM\Zoom) - 2
Else
*Tile\Y = pfValue
EndIf
EndIf
EndProcedure
Procedure SetZoom(Zoom.i, mode.i = #PB_Relative)
Select mode
Case #PB_Relative
OSM\Zoom = OSM\Zoom + zoom
Case #PB_Absolute
OSM\Zoom = zoom
EndSelect
If OSM\Zoom > OSM\ZoomMax : OSM\Zoom = OSM\ZoomMax : EndIf
If OSM\Zoom < OSM\ZoomMin : OSM\Zoom = OSM\ZoomMin : EndIf
LatLon2XY(@OSM\TargetLocation, @OSM\TargetTile)
OSM\Position\X = OSM\TargetTile\X * OSM\TileSize ;Convert X, Y in tile.decimal into real pixels
OSM\Position\Y = OSM\TargetTile\Y * OSM\TileSize
ConstructMap()
DrawMap()
EndProcedure
;TODO A Better way to init and configure
Procedure InitOSM(window.i=0)
Debug GetTemporaryDirectory()
OSM\HDDCachePath = GetTemporaryDirectory()
Debug OSM\HDDCachePath
OSM\ServerURL = "http://tile.openstreetmap.org/" ;"https://tile.thunderforest.com/cycle/";
OSM\ZoomMin = 0
OSM\ZoomMax = 18
OSM\StartCursor\X = - 1
OSM\TileSize = 256
OSM\MemCache\Mutex=CreateMutex()
;OSM\MemCache\Semaphore=CreateSemaphore(1)
OSM\MapImageMutex=CreateMutex()
OSM\MapImageSemaphore=CreateSemaphore(8)
OSM\Window=window
OSM\EditMarkerIndex=-1
OSM\Font=LoadFont(#PB_Any, "Comic Sans MS", 20, #PB_Font_Bold)
OSM\ConstructMapMutex=CreateMutex()
EndProcedure
Procedure Event(Event.l)
Protected Gadget.i
Protected tx.d, ty.d
Protected OldX.i, OldY.i
If IsGadget(OSM\Gadget) And GadgetType(OSM\Gadget) = #PB_GadgetType_Canvas
Select Event
Case PB_Event_Timer
DrawMap()
Case #EvenementStartRefresh
;Debug "Start"
AddWindowTimer(OSM\Window,1, 500)
Case #EvenementStopRefresh
;Debug "Stop"
Debug "draw Stop Refresh"
DrawMap()
RemoveWindowTimer(OSM\Window,1)
Case #PB_Event_Timer
If EventTimer()=1;=#Timer_Draw
DrawMap()
EndIf
Case #PB_Event_Gadget ;{
Gadget = EventGadget()
Select Gadget
Case OSM\Gadget
Select EventType()
Case #PB_EventType_RightButtonDown
SetLocation(49.0346374511718750,2.0787782669067383,17)
RefreshMap()
OSM\StartCursor\X=-1
OSM\DeltaCursor\X=0
OSM\DeltaCursor\Y=0
Case #PB_EventType_LeftButtonDown
;check if we select a marker
Protected Pixel.Pixel
ForEach OSM\Marker()
GetPixelCoordFromLocation(@OSM\Marker()\Location,@Pixel)
If Pixel\X>GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseX)-4 And Pixel\X<GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseX)+4 And Pixel\Y>GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseY)-4 And Pixel\Y<GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseY)+4
OSM\EditMarkerIndex=ListIndex(OSM\Marker())
Break
EndIf
Next
;Mem cursor Coord
OSM\StartCursor\X = GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseX)
OSM\StartCursor\Y = GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseY)
Case #PB_EventType_MouseMove
If OSM\EditMarkerIndex>-1 ;move Marker
OSM\DeltaCursor\X=GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseX)-OSM\StartCursor\X
OSM\DeltaCursor\Y=GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseY)-OSM\StartCursor\Y
tx=(OSM\DeltaCursor\X/256)
ty=(OSM\DeltaCursor\Y/256)
OSM\DeltaCursor\X=0
OSM\DeltaCursor\Y=0
OSM\StartCursor\X = GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseX)
OSM\StartCursor\Y = GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseY)
SelectElement(OSM\Marker(),OSM\EditMarkerIndex)
Protected Tile.Tile
LatLon2XY(@OSM\Marker()\Location,@Tile)
TileTranslate(@Tile,-tx,-ty)
XY2LatLon(@Tile,@OSM\Marker()\Location)
Else ;Move Map
If OSM\StartCursor\X<>-1
OSM\DeltaCursor\X=GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseX)-OSM\StartCursor\X
OSM\DeltaCursor\Y=GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseY)-OSM\StartCursor\Y
EndIf
EndIf
DrawMap()
Case #PB_EventType_LeftButtonUp
DrawMap()
If OSM\EditMarkerIndex>-1
OSM\EditMarkerIndex=-1
OSM\StartCursor\X=-1
Else ;Move Map
tx=(OSM\DeltaCursor\X/OSM\TileSize)
ty=(OSM\DeltaCursor\Y/OSM\TileSize)
OSM\DeltaCursor\X=0
OSM\DeltaCursor\Y=0
OSM\StartCursor\X=-1
TileTranslate(@OSM\TargetTile,tx,ty)
XY2LatLon(@OSM\TargetTile,@OSM\TargetLocation)
ConstructMap()
If OSM\CallBackLocation>0
CallFunctionFast(OSM\CallBackLocation,@OSM\TargetLocation)
EndIf
EndIf
EndSelect
EndSelect
EndSelect
Else
MessageRequester("Module OSM", "You must use MapGadget before", #PB_MessageRequester_Ok )
End
EndIf
EndProcedure
EndModule
;-Exemple
CompilerIf #PB_Compiler_IsMainFile
InitNetwork()
Enumeration
#Window_0
#Map
#Button_0
#Button_1
#Button_2
#Button_3
#Button_4
#Button_5
#Combo_0
#Text_0
#Text_1
#Text_2
#Text_3
#Text_4
#String_0
#String_1
#Gdt_LoadGpx
#Gdt_AddMarker
EndEnumeration
Structure Location
Longitude.d
Latitude.d
EndStructure
Procedure UpdateLocation(*Location.Location)
SetGadgetText(#String_0,StrD(*Location\Latitude))
SetGadgetText(#String_1,StrD(*Location\Longitude))
ProcedureReturn 0
EndProcedure
Procedure ResizeAll()
ResizeGadget(#Map,10,10,WindowWidth(#Window_0)-198,WindowHeight(#Window_0)-59):OSM::RefreshMap()
ResizeGadget(#Text_1,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore)
ResizeGadget(#Button_0,WindowWidth(#Window_0)-150,#PB_Ignore,#PB_Ignore,#PB_Ignore)
ResizeGadget(#Button_1,WindowWidth(#Window_0)-90,#PB_Ignore,#PB_Ignore,#PB_Ignore)
ResizeGadget(#Button_2,WindowWidth(#Window_0)-110,#PB_Ignore,#PB_Ignore,#PB_Ignore)
ResizeGadget(#Button_3,WindowWidth(#Window_0)-110,#PB_Ignore,#PB_Ignore,#PB_Ignore)
ResizeGadget(#Text_2,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore)
ResizeGadget(#Button_4,WindowWidth(#Window_0)-150,#PB_Ignore,#PB_Ignore,#PB_Ignore)
ResizeGadget(#Button_5,WindowWidth(#Window_0)-100,#PB_Ignore,#PB_Ignore,#PB_Ignore)
ResizeGadget(#Text_3,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore)
ResizeGadget(#String_0,WindowWidth(#Window_0)-100,#PB_Ignore,#PB_Ignore,#PB_Ignore)
ResizeGadget(#String_1,WindowWidth(#Window_0)-100,#PB_Ignore,#PB_Ignore,#PB_Ignore)
ResizeGadget(#Text_4,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore)
ResizeGadget(#Gdt_AddMarker,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore)
ResizeGadget(#Gdt_LoadGpx,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore)
EndProcedure
If OpenWindow(#Window_0, 260, 225, 700, 571, "OpenStreetMap", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered | #PB_Window_SizeGadget)
OSM::InitOSM()
LoadFont(0, "Wingdings", 12)
LoadFont(1, "Arial", 12, #PB_Font_Bold)
OSM::MapGadget(#Map, 10, 10, 512, 512)
TextGadget(#Text_1, 530, 50, 60, 15, "Movements : ")
ButtonGadget(#Button_0, 550, 100, 30, 30, Chr($E7)) : SetGadgetFont(#Button_0, FontID(0))
ButtonGadget(#Button_1, 610, 100, 30, 30, Chr($E8)) : SetGadgetFont(#Button_1, FontID(0))
ButtonGadget(#Button_2, 580, 070, 30, 30, Chr($E9)) : SetGadgetFont(#Button_2, FontID(0))
ButtonGadget(#Button_3, 580, 130, 30, 30, Chr($EA)) : SetGadgetFont(#Button_3, 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))
TextGadget(#Text_3, 530, 230, 60, 15, "Latitude : ")
StringGadget(#String_0, 600, 230, 90, 20, "")
TextGadget(#Text_4, 530, 250, 60, 15, "Longitude : ")
StringGadget(#String_1, 600, 250, 90, 20, "")
ButtonGadget(#Gdt_AddMarker, 530, 280, 150, 30, "Add Marker")
ButtonGadget(#Gdt_LoadGpx, 530, 310, 150, 30, "Load GPX")
Define Event.i, Gadget.i, Quit.b = #False
Define pfValue.d
OSM::SetLocation(49.04599, 2.03347, 17)
OSM::SetCallBackLocation(@UpdateLocation())
OSM::RefreshMap()
Repeat
Event = WaitWindowEvent()
OSM::Event(Event)
Select Event
Case #PB_Event_CloseWindow : Quit = 1
Case #PB_Event_Gadget ;{
Gadget = EventGadget()
Select Gadget
Case #Button_4
OSM::SetZoom(1)
Case #Button_5
OSM::SetZoom(-1)
Case #Gdt_LoadGpx
OSM::LoadGpxFile(OpenFileRequester("Choisissez un fichier à charger", "", "*.gpx", 0))
OSM::ZoomToArea() ; <-To center the view, and to viex all the track
Case #Gdt_AddMarker
OSM:: AddMarker(ValD(GetGadgetText(#String_0)),ValD(GetGadgetText(#String_1)),RGBA(Random(255),Random(255),Random(255),255))
EndSelect
Case #PB_Event_SizeWindow
ResizeAll()
EndSelect
Until Quit = #True
EndIf
CompilerEndIf
Re: OpenStreetMap dans un Canvas
Excellent ! C'est bien plus fluide que le mien ! Va falloir que je regarde comment tu as fait 
Edit : Punaise, je viens de voir que depuis le début je fais plusieurs StartVectorDrawing()/StopVectorDrawing() ... :/ Je m'étais tellement concentré sur le chargement et les synchros que j'ai complètement zappé ça ! J'ai corrigé sur le GIT, on verra plus tard pour le forum
Edit : Punaise, je viens de voir que depuis le début je fais plusieurs StartVectorDrawing()/StopVectorDrawing() ... :/ Je m'étais tellement concentré sur le chargement et les synchros que j'ai complètement zappé ça ! J'ai corrigé sur le GIT, on verra plus tard pour le forum
Re: OpenStreetMap dans un Canvas
Vous gérez ^^
rendu et zoom nickel
déplacement avec les flèches nickel.
rendu et zoom nickel
déplacement avec les flèches nickel.
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Re: OpenStreetMap dans un Canvas
Non mais avec ta dernière mise à jour c'est toi qui est le plus fluide ^_^ C'est vraiment très propre ce que tu as faitdjes a écrit :Excellent ! C'est bien plus fluide que le mien ! Va falloir que je regarde comment tu as fait
Edit : Punaise, je viens de voir que depuis le début je fais plusieurs StartVectorDrawing()/StopVectorDrawing() ... :/ Je m'étais tellement concentré sur le chargement et les synchros que j'ai complètement zappé ça ! J'ai corrigé sur le GIT, on verra plus tard pour le forum
Merci ! Encore un peu de boulot mais franchement on est plus très loin du butAr-S a écrit :Vous gérez ^^
rendu et zoom nickel
déplacement avec les flèches nickel.
Re: OpenStreetMap dans un Canvas
Totalement d'accord c'est nickel.Ar-S a écrit :Vous gérez ^^
rendu et zoom nickel
déplacement avec les flèches nickel.
Re: OpenStreetMap dans un Canvas
Merci les gars, ça fait du bien d'avoir des encouragements
Re: OpenStreetMap dans un Canvas
Il est possible de projeter des points en chargent un fichier json qui contient des coordonnées géographiques ?