thyphoon/PBMap
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
a4f2ea5bb71b9ff32f4d058c30c268254238a0fb
PBMap/PBMap.pb
djes a4f2ea5bb7 code cleanup
2016-08-25 12:52:36 +02:00

1197 lines
48 KiB
Plaintext
Raw Blame History

;**************************************************************
; Program: PBMap
; Description: Permits the use of tiled maps like
; OpenStreetMap in a handy PureBASIC module
; Author: Thyphoon And Djes
; Date: Mai 17, 2016
; License: Free, unrestricted, credit appreciated
; but not required.
; Note: Please share improvement !
; Thanks: Progi1984
; Usage: Change the Proxy global variables if needed
; (see also Proxy Details)
;**************************************************************
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 PBMap
;-Show debug infos
Global Verbose = #True
Global MyDebugLevel = 3
Global Proxy = #False
Declare InitPBMap()
Declare SetMapServer(ServerURL.s="http://tile.openstreetmap.org/",TileSize.l=256,ZoomMin.l=0,ZoomMax.l=18)
Declare MapGadget(Gadget.i, X.i, Y.i, Width.i, Height.i)
Declare Event(Event.l)
Declare SetLocation(latitude.d, longitude.d, zoom = 15, mode.i = #PB_Absolute)
Declare DrawingThread(Null)
Declare SetZoom(Zoom.i, mode.i = #PB_Relative)
Declare ZoomToArea()
Declare SetCallBackLocation(CallBackLocation.i)
Declare SetCallBackMainPointer(CallBackMainPointer.i)
Declare LoadGpxFile(file.s);
Declare AddMarker(Latitude.d,Longitude.d,color.l=-1, CallBackPointer.i = -1)
Declare Quit()
Declare Error(msg.s)
Declare Refresh()
Declare.d GetLatitude()
Declare.d GetLongitude()
Declare.i GetZoom()
EndDeclareModule
Module PBMap
EnableExplicit
Structure Location
Longitude.d
Latitude.d
EndStructure
Structure Position
x.d
y.d
EndStructure
Structure PixelPosition
x.i
y.i
EndStructure
;- Tile Structure
Structure Tile
Position.Position
PBMapTileX.i
PBMapTileY.i
PBMapZoom.i
nImage.i
key.s
GetImageThread.i
EndStructure
Structure DrawingParameters
Position.Position
Canvas.i
PBMapTileX.i
PBMapTileY.i
PBMapZoom.i
Mutex.i
TargetLocation.Location
CenterX.i
CenterY.i
DeltaX.i
DeltaY.i
Semaphore.i
Dirty.i
PassNB.i
End.i
EndStructure
Structure TileThread
*Tile.Tile
GetImageThread.i
EndStructure
Structure ImgMemCach
nImage.i
;Location.Location
;Mutex.i
EndStructure
Structure TileMemCach
Map Images.ImgMemCach()
EndStructure
Structure Marker
Location.Location ; Marker latitude and longitude
color.l ; Marker color
CallBackPointer.i ; @Procedure(X.i, Y.i) to DrawPointer (you must use VectorDrawing lib)
EndStructure
Structure Option
WheelMouseRelative.i
EndStructure
;-PBMap Structure
Structure PBMap
Gadget.i ; Canvas Gadget Id
Font.i ; Font to uses when write on the map
TargetLocation.Location ; Latitude and Longitude from focus point
Drawing.DrawingParameters ; Drawing parameters based on focus point
;
CallBackLocation.i ; @Procedure(latitude.d,lontitude.d)
CallBackMainPointer.i ; @Procedure(X.i, Y.i) to DrawPointer (you must use VectorDrawing lib)
;
Position.PixelPosition ; Actual focus point coords in pixels (global)
MoveStartingPoint.PixelPosition ; Start mouse position coords when dragging the map
;
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 ; Images in memory cache
;
Moving.i ;
Dirty.i ; To signal that drawing need a refresh
;
MainDrawingThread.i ;
List TilesThreads.TileThread() ;
;
List track.Location() ; To display a GPX track
List Marker.Marker() ; To diplay marker
EditMarkerIndex.l ;
;
Options.option ;
EndStructure
Global PBMap.PBMap, Null.i
;Shows an error msg and terminates the program
Procedure Error(msg.s)
MessageRequester("MapGadget", msg, #PB_MessageRequester_Ok)
End
EndProcedure
;Send debug infos to stdout (allowing mixed debug infos with curl or other libs)
Procedure MyDebug(msg.s, DbgLevel = 0)
If Verbose And MyDebugLevel >= DbgLevel
PrintN(msg)
EndIf
EndProcedure
;- *** CURL specific
; (program has To be compiled in console format for curl debug infos)
IncludeFile "libcurl.pbi" ; https://github.com/deseven/pbsamples/tree/master/crossplatform/libcurl
;Curl write callback (needed for win32 dll)
ProcedureC ReceiveHTTPWriteToFileFunction(*ptr, Size.i, NMemB.i, FileHandle.i)
ProcedureReturn WriteData(FileHandle, *ptr, Size * NMemB)
EndProcedure
Procedure.i CurlReceiveHTTPToFile(URL$, DestFileName$, ProxyURL$="", ProxyPort$="", ProxyUser$="", ProxyPassword$="")
Protected *Buffer, curl.i, Timeout.i, res.i
Protected FileHandle.i
MyDebug("ReceiveHTTPToFile from " + URL$ + " " + ProxyURL$ + ProxyPort$ + ProxyUser$, 3)
MyDebug(" to file : " + DestFileName$, 3)
FileHandle = CreateFile(#PB_Any, DestFileName$)
If FileHandle And Len(URL$)
curl = curl_easy_init()
If curl
Timeout = 120
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_FOLLOWLOCATION, 1)
curl_easy_setopt(curl, #CURLOPT_TIMEOUT, Timeout)
curl_easy_setopt(curl, #CURLOPT_VERBOSE, 1)
;curl_easy_setopt(curl, #CURLOPT_CONNECTTIMEOUT, 60)
If Len(ProxyURL$)
;curl_easy_setopt(curl, #CURLOPT_HTTPPROXYTUNNEL, #True)
If Len(ProxyPort$)
ProxyURL$ + ":" + ProxyPort$
EndIf
MyDebug( ProxyURL$)
curl_easy_setopt(curl, #CURLOPT_PROXY, str2curl(ProxyURL$))
If Len(ProxyUser$)
If Len(ProxyPassword$)
ProxyUser$ + ":" + ProxyPassword$
EndIf
MyDebug( ProxyUser$)
curl_easy_setopt(curl, #CURLOPT_PROXYUSERPWD, str2curl(ProxyUser$))
EndIf
EndIf
curl_easy_setopt(curl, #CURLOPT_WRITEDATA, FileHandle)
curl_easy_setopt(curl, #CURLOPT_WRITEFUNCTION, @ReceiveHTTPWriteToFileFunction())
res = curl_easy_perform(curl)
If res <> #CURLE_OK
MyDebug("CURL problem", 3)
EndIf
curl_easy_cleanup(curl)
Else
MyDebug("Can't init CURL", 3)
EndIf
CloseFile(FileHandle)
ProcedureReturn FileSize(DestFileName$)
EndIf
ProcedureReturn #False
EndProcedure
;- ***
Procedure InitPBMap()
Protected Result.i
If Verbose
OpenConsole()
EndIf
PBMap\HDDCachePath = GetTemporaryDirectory()
PBMap\ServerURL = "http://tile.openstreetmap.org/"
PBMap\ZoomMin = 0
PBMap\ZoomMax = 18
PBMap\MoveStartingPoint\x = - 1
PBMap\TileSize = 256
PBMap\Dirty = #False
PBMap\Drawing\Mutex = CreateMutex()
PBMap\Drawing\Semaphore = CreateSemaphore()
PBMap\EditMarkerIndex = -1 ;Initialised with "no marker selected"
PBMap\Font = LoadFont(#PB_Any, "Arial", 20, #PB_Font_Bold)
;-Options
PBMap\Options\WheelMouseRelative = #True
;-Preferences
;Use this to create and customize your preferences file for the first time
; CreatePreferences(GetHomeDirectory() + "PBMap.prefs")
; ;Or this to modify
; ;OpenPreferences(GetHomeDirectory() + "PBMap.prefs")
; ;Or this
; ;RunProgram("notepad.exe", GetHomeDirectory() + "PBMap.prefs", GetHomeDirectory())
; PreferenceGroup("PROXY")
; WritePreferenceInteger("Proxy", #True)
; WritePreferenceString("ProxyURL", "myproxy.fr")
; WritePreferenceString("ProxyPort", "myproxyport")
; WritePreferenceString("ProxyUser", "myproxyname")
; WritePreferenceString("ProxyPass", "myproxypass") ;TODO !Warning! !not encoded!
; ClosePreferences()
OpenPreferences(GetHomeDirectory() + "PBMap.prefs")
PreferenceGroup("PROXY")
Proxy = ReadPreferenceInteger("Proxy", #False)
If 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", "") ;TODO
EndIf
ClosePreferences()
curl_global_init(#CURL_GLOBAL_WIN32)
;- Main drawing thread launching
PBMap\MainDrawingThread = CreateThread(@DrawingThread(), @PBMap\Drawing)
If PBMap\MainDrawingThread = 0
Error("MapGadget : can't create main drawing thread.")
EndIf
EndProcedure
Procedure SetMapServer(ServerURL.s="http://tile.openstreetmap.org/",TileSize.l=256,ZoomMin.l=0,ZoomMax.l=18)
PBMap\ServerURL = ServerURL
PBMap\ZoomMin = ZoomMin
PBMap\ZoomMax = ZoomMax
PBMap\TileSize = TileSize
EndProcedure
Procedure Quit()
;Ask main drawing thread to stop and wait for it (nicer than KillThread(PBMap\MainDrawingThread))
LockMutex(PBMap\Drawing\Mutex)
PBMap\Drawing\End = #True
;KillThread(PBMap\MainDrawingThread)
UnlockMutex(PBMap\Drawing\Mutex)
Repeat : Until Not IsThread(PBMap\MainDrawingThread)
;wait for loading threads to finish nicely
ResetList(PBMap\TilesThreads())
While NextElement(PBMap\TilesThreads())
If IsThread(PBMap\TilesThreads()\GetImageThread) = 0
FreeMemory(PBMap\TilesThreads()\Tile)
DeleteElement(PBMap\TilesThreads())
ResetList( PBMap\TilesThreads())
EndIf
Wend
curl_global_cleanup()
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
Procedure.d Distance(x1.d, y1.d, x2.d, y2.d)
Protected Result.d
Result = Sqr( (x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2))
ProcedureReturn Result
EndProcedure
Procedure MapGadget(Gadget.i, X.i, Y.i, Width.i, Height.i)
If Gadget = #PB_Any
PBMap\Gadget = CanvasGadget(PBMap\Gadget, X, Y, Width, Height, #PB_Canvas_Keyboard) ;#PB_Canvas_Keyboard has to be set for mousewheel to work on windows
Else
PBMap\Gadget = Gadget
CanvasGadget(PBMap\Gadget, X, Y, Width, Height, #PB_Canvas_Keyboard)
EndIf
EndProcedure
;*** Converts coords to tile.decimal
;Warning, structures used in parameters are not tested
Procedure LatLon2XY(*Location.Location, *Coords.Position)
Protected n.d = Pow(2.0, PBMap\Zoom)
Protected LatRad.d = Radian(*Location\Latitude)
*Coords\x = n * ( (*Location\Longitude + 180.0) / 360.0)
*Coords\y = n * ( 1.0 - Log(Tan(LatRad) + 1.0/Cos(LatRad)) / #PI ) / 2.0
MyDebug("Latitude : " + StrD(*Location\Latitude) + " ; Longitude : " + StrD(*Location\Longitude))
MyDebug("Coords X : " + Str(*Coords\x) + " ; Y : " + Str(*Coords\y))
EndProcedure
;*** Converts tile.decimal to coords
;Warning, structures used in parameters are not tested
Procedure XY2LatLon(*Coords.Position, *Location.Location)
Protected n.d = Pow(2.0, PBMap\Zoom)
Protected LatitudeRad.d
*Location\Longitude = *Coords\x / n * 360.0 - 180.0
LatitudeRad = ATan(SinH(#PI * (1.0 - 2.0 * *Coords\y / n)))
*Location\Latitude = Degree(LatitudeRad)
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
Procedure GetPixelCoordFromLocation(*Location.Location, *Pixel.PixelPosition) ; TODO to Optimize
Protected mapWidth.l = Pow(2, PBMap\Zoom + 8)
Protected mapHeight.l = Pow(2, PBMap\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 = (PBMap\TargetLocation\Longitude+180)*(mapWidth/360)
; convert from degrees To radians
latRad = PBMap\TargetLocation\Latitude*#PI/180;
; get y value
mercN = Log(Tan((#PI/4)+(latRad/2)))
y2 = (mapHeight/2)-(mapWidth*mercN/(2*#PI));
*Pixel\x=GadgetWidth(PBMap\Gadget)/2 - (x2-x1)
*Pixel\y=GadgetHeight(PBMap\Gadget)/2 - (y2-y1)
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(PBMap\track())
For child = 1 To XMLChildCount(*MainNode)
*child = ChildXMLNode(*MainNode, child)
AddElement(PBMap\track())
If ExamineXMLAttributes(*child)
While NextXMLAttribute(*child)
Select XMLAttributeName(*child)
Case "lat"
PBMap\track()\Latitude=ValD(XMLAttributeValue(*child))
Case "lon"
PBMap\track()\Longitude=ValD(XMLAttributeValue(*child))
EndSelect
Wend
EndIf
Next
EndIf
EndProcedure
Procedure.i GetTileFromMem(key.s)
MyDebug("Check if we have this image in memory", 3)
If FindMapElement(PBMap\MemCache\Images(), key)
MyDebug("Key : " + key + " found !", 3)
ProcedureReturn PBMap\MemCache\Images()\nImage
Else
MyDebug("Key : " + key + " not found !", 3)
ProcedureReturn -1
EndIf
EndProcedure
Procedure.i GetTileFromHDD(CacheFile.s)
Protected nImage.i
If FileSize(CacheFile) > 0
nImage = LoadImage(#PB_Any, CacheFile)
If IsImage(nImage)
MyDebug("Loadimage " + CacheFile + " -> Success !", 3)
ProcedureReturn nImage
EndIf
EndIf
MyDebug("Loadimage " + CacheFile + " -> Failed !", 3)
ProcedureReturn -1
EndProcedure
Procedure.i GetTileFromWeb(Zoom.i, XTile.i, YTile.i, CacheFile.s)
Protected *Buffer
Protected nImage.i = -1
Protected FileHandle.i
Protected TileURL.s = PBMap\ServerURL + Str(Zoom) + "/" + Str(XTile) + "/" + Str(YTile) + ".png"
MyDebug("Check if we have this image on Web", 3)
If Proxy
FileHandle = CurlReceiveHTTPToFile(TileURL, CacheFile, ProxyURL$, ProxyPort$, ProxyUser$, ProxyPassword$)
If FileHandle
nImage = GetTileFromHDD(CacheFile)
Else
MyDebug("File " + TileURL + " not correctly received with Curl and proxy", 3)
EndIf
Else
*Buffer = ReceiveHTTPMemory(TileURL) ;TODO to thread by using #PB_HTTP_Asynchronous
If *Buffer
nImage = CatchImage(#PB_Any, *Buffer, MemorySize(*Buffer))
If IsImage(nImage)
MyDebug("Load from web " + TileURL + " as Tile nb " + nImage, 3)
SaveImage(nImage, CacheFile, #PB_ImagePlugin_PNG)
FreeMemory(*Buffer)
Else
MyDebug("Can't catch image " + TileURL, 3)
nImage = -1
;ShowMemoryViewer(*Buffer, MemorySize(*Buffer))
EndIf
Else
MyDebug("ReceiveHTTPMemory's buffer is empty", 3)
EndIf
EndIf
ProcedureReturn nImage
EndProcedure
Procedure GetImageThread(*Tile.Tile)
Protected nImage.i = -1
Protected CacheFile.s = PBMap\HDDCachePath + "PBMap_" + Str(*Tile\PBMapZoom) + "_" + Str(*Tile\PBMapTileX) + "_" + Str(*Tile\PBMapTileY) + ".png"
Protected Tile.position
; PBMap\MemCache\Images(*Tile\key)\Mutex = CreateMutex()
; LockMutex(PBMap\MemCache\Images(*Tile\key)\Mutex)
nImage = GetTileFromHDD(CacheFile)
If nImage = -1
nImage = GetTileFromWeb(*Tile\PBMapZoom, *Tile\PBMapTileX, *Tile\PBMapTileY, CacheFile)
If nImage = -1
MyDebug("Error GetImageThread procedure, image not loaded - " + *Tile\key, 3)
*Tile\nImage = -1
ProcedureReturn
EndIf
EndIf
PBMap\MemCache\Images(*Tile\key)\nImage = nImage
; Tile\x=*Tile\PBMapTileX
; Tile\y=*Tile\PBMapTiley
; XY2LatLon(@Tile,@PBMap\MemCache\Images(*Tile\key)\Location)
MyDebug("Image nb " + Str(nImage) + " successfully added to mem cache", 3)
MyDebug("With the following key : " + *Tile\key, 3)
;Define this tile image nb
*Tile\nImage = nImage
; UnlockMutex(PBMap\MemCache\Images(key)\Mutex)
EndProcedure
Procedure DrawTile(*Tile.Tile)
Protected x = *Tile\Position\x
Protected y = *Tile\Position\y
MyDebug(" Drawing tile nb " + " X : " + Str(*Tile\PBMapTileX) + " Y : " + Str(*Tile\PBMapTileX), 2)
MyDebug(" at coords " + Str(x) + "," + Str(y), 2)
MovePathCursor(x, y)
DrawVectorImage(ImageID(*Tile\nImage))
EndProcedure
Procedure DrawLoading(*Tile.Tile)
Protected x = *Tile\Position\x
Protected y = *Tile\Position\y
Protected Text$ = "Loading"
MyDebug(" Drawing tile nb " + " X : " + Str(*Tile\PBMapTileX) + " Y : " + Str(*Tile\PBMapTileX), 2)
MyDebug(" at coords " + Str(x) + "," + Str(y), 2)
BeginVectorLayer()
;MovePathCursor(x, y)
VectorSourceColor(RGBA(255, 255, 255, 128))
AddPathBox(x, y, PBMap\TileSize, PBMap\TileSize)
FillPath()
MovePathCursor(x, y)
VectorFont(FontID(PBMap\Font), PBMap\TileSize / 20)
VectorSourceColor(RGBA(150, 150, 150, 255))
MovePathCursor(x + (PBMap\TileSize - VectorTextWidth(Text$)) / 2, y + (PBMap\TileSize - VectorTextHeight(Text$)) / 2)
DrawVectorText(Text$)
EndVectorLayer()
EndProcedure
Procedure DrawTiles(*Drawing.DrawingParameters)
Protected x.i, y.i
Protected tx = Int(*Drawing\Position\x) ;Don't forget the Int() !
Protected ty = Int(*Drawing\Position\y)
Protected nx = *Drawing\CenterX / PBMap\TileSize ;How many tiles around the point
Protected ny = *Drawing\CenterY / PBMap\TileSize
MyDebug("Drawing tiles", 2)
For y = - ny - 1 To ny + 1
For x = - nx - 1 To nx + 1
;Was quiting the loop if a move occured, giving maybe smoother movement
;If PBMap\Moving
; Break 2
;EndIf
;Store parameters in only one memory place, and give it to the thread if needed
Protected *NewTile.Tile = AllocateMemory(SizeOf(Tile))
If *NewTile
With *NewTile
;Keep a track of tiles, and eventually associated threads, to free memory
AddElement(PBMap\TilesThreads())
PBMap\TilesThreads()\Tile = *NewTile
;New tile parameters
\Position\x = *Drawing\CenterX + x * PBMap\TileSize - *Drawing\DeltaX
\Position\y = *Drawing\CenterY + y * PBMap\TileSize - *Drawing\DeltaY
\PBMapTileX = tx + x
\PBMapTileY = ty + y
\PBMapZoom = PBMap\Zoom
\key = "Z" + RSet(Str(\PBMapZoom), 4, "0") + "X" + RSet(Str(\PBMapTileX), 8, "0") + "Y" + RSet(Str(\PBMapTileY), 8, "0") ;Unique identifier
;Check if the image exists
\nImage = GetTileFromMem(\key)
If \nImage = -1
;If not, load it in the background
If AddMapElement(PBMap\MemCache\Images(), \key) ;Add the image to the cache, once in this loop
\GetImageThread = CreateThread(@GetImageThread(), *NewTile)
PBMap\TilesThreads()\GetImageThread = \GetImageThread
MyDebug(" Creating get image thread nb " + Str(\GetImageThread), 2)
Else
MyDebug(" Can't add a new image to the map list", 2)
EndIf
EndIf
If IsImage(\nImage)
DrawTile(*NewTile)
Else
MyDebug("Image missing", 2)
DrawLoading(*NewTile)
*Drawing\Dirty = #True ;Signals that this image is missing so we should have to redraw
EndIf
EndWith
Else
MyDebug(" Error, can't create a new tile", 2)
Break 2
EndIf
Next
Next
;Free tile memory
;TODO : get out this proc from drawtiles in a special "free ressources" task
ForEach PBMap\TilesThreads()
;Check if there's no more loading thread
If IsThread(PBMap\TilesThreads()\GetImageThread) = 0
FreeMemory(PBMap\TilesThreads()\Tile)
DeleteElement(PBMap\TilesThreads())
EndIf
Next
; ;-**** Clean Mem Cache
; ;TODO in development, by now there's many cache problem as the loading thread could be perturbed
; ;GadgetWidth(PBMap\Gadget)/PBMap\TileSize
; Protected MaxNbTile.l
; If GadgetWidth(PBMap\Gadget)>GadgetHeight(PBMap\Gadget)
; MaxNbTile=GadgetWidth(PBMap\Gadget)/PBMap\TileSize
; Else
; MaxNbTile=GadgetHeight(PBMap\Gadget)/PBMap\TileSize
; EndIf
; Protected Scale.d= 40075*Cos(Radian(PBMap\TargetLocation\Latitude))/Pow(2,PBMap\Zoom)
; Protected Limit.d=Scale*(MaxNbTile)*1.5
; Debug "Cache cleaning"
; ForEach PBMap\MemCache\Images()
; Protected Distance.d = HaversineInKM(@PBMap\MemCache\Images()\Location, @PBMap\TargetLocation)
; Debug "Limit:"+StrD(Limit)+" Distance:"+StrD(Distance)
; If Distance>Limit And IsImage(PBMap\MemCache\Images()\nImage)
; LockMutex(PBMap\MemCache\Images()\Mutex)
; Debug "delete"
; Debug PBMap\MemCache\Images()
; FreeImage(PBMap\MemCache\Images()\nImage)
; UnlockMutex(PBMap\MemCache\Images()\Mutex)
; FreeMutex(PBMap\MemCache\Images()\Mutex)
; DeleteMapElement(PBMap\MemCache\Images())
; EndIf
; Next
EndProcedure
Procedure DrawPointer(*Drawing.DrawingParameters)
If PBMap\CallBackMainPointer > 0
; @Procedure(X.i, Y.i) to DrawPointer (you must use VectorDrawing lib)
CallFunctionFast(PBMap\CallBackMainPointer, *Drawing\CenterX, *Drawing\CenterY)
Else
VectorSourceColor(RGBA($FF, 0, 0, $FF))
MovePathCursor(*Drawing\CenterX, *Drawing\CenterY)
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(RGBA($FF, 0, 0, $FF))
FillPath(#PB_Path_Preserve):VectorSourceColor(RGBA($FF, 0, 0, $FF));RGBA(0, 0, 0, 255))
StrokePath(1)
EndIf
EndProcedure
Procedure DrawScale(*Drawing.DrawingParameters)
;TODO Add Option and function to display Scale on Map
Protected Scale.d= 40075*Cos(Radian(PBMap\TargetLocation\Latitude))/Pow(2,PBMap\Zoom)
VectorFont(FontID(PBMap\Font), 30)
VectorSourceColor(RGBA(0, 0, 0, 80))
MovePathCursor(50,50)
DrawVectorText(StrD(Scale))
EndProcedure
Procedure TrackPointer(x.i, y.i,dist.l)
Protected color.l
color=RGBA(0, 0, 0, 255)
MovePathCursor(x,y)
AddPathLine(-8,-16,#PB_Path_Relative)
AddPathLine(16,0,#PB_Path_Relative)
AddPathLine(-8,16,#PB_Path_Relative)
VectorSourceColor(color)
AddPathCircle(x,y-20,14)
FillPath()
VectorSourceColor(RGBA(255, 255, 255, 255))
AddPathCircle(x,y-20,12)
FillPath()
VectorFont(FontID(PBMap\Font), 13)
MovePathCursor(x-VectorTextWidth(Str(dist))/2, y-20-VectorTextHeight(Str(dist))/2)
VectorSourceColor(RGBA(0, 0, 0, 255))
DrawVectorText(Str(dist))
EndProcedure
Procedure DrawTrack(*Drawing.DrawingParameters)
Protected Pixel.PixelPosition
Protected Location.Location
Protected km.f, memKm.i
If ListSize(PBMap\track())>0
;Trace Track
LockMutex(PBMap\Drawing\Mutex)
ForEach PBMap\track()
If *Drawing\TargetLocation\Latitude<>0 And *Drawing\TargetLocation\Longitude<>0
GetPixelCoordFromLocation(@PBMap\track(),@Pixel)
If ListIndex(PBMap\track())=0
MovePathCursor(Pixel\X, Pixel\Y)
Else
AddPathLine(Pixel\X, Pixel\Y)
EndIf
EndIf
Next
VectorSourceColor(RGBA(0, 255, 0, 150))
StrokePath(10, #PB_Path_RoundEnd|#PB_Path_RoundCorner)
;Draw Distance
ForEach PBMap\track()
;Distance test
If ListIndex(PBMap\track())=0
Location\Latitude=PBMap\track()\Latitude
Location\Longitude=PBMap\track()\Longitude
Else
km=km+HaversineInKM(@Location,@PBMap\track()) ;<- display Distance
Location\Latitude=PBMap\track()\Latitude
Location\Longitude=PBMap\track()\Longitude
EndIf
GetPixelCoordFromLocation(@PBMap\track(),@Pixel)
If Int(km)<>memKm
memKm=Int(km)
If PBMap\Zoom>10
BeginVectorLayer()
TrackPointer(Pixel\X , Pixel\Y,Int(km))
EndVectorLayer()
EndIf
EndIf
Next
UnlockMutex(PBMap\Drawing\Mutex)
EndIf
EndProcedure
; Add a Marker To the Map
Procedure AddMarker(Latitude.d,Longitude.d,color.l=-1, CallBackPointer.i = -1)
AddElement(PBMap\Marker())
PBMap\Marker()\Location\Latitude=Latitude
PBMap\Marker()\Location\Longitude=Longitude
PBMap\Marker()\color=color
PBMap\Marker()\CallBackPointer = CallBackPointer
EndProcedure
; Draw all markers on the screen !
Procedure DrawMarker(*Drawing.DrawingParameters)
Protected Pixel.PixelPosition
ForEach PBMap\Marker()
If PBMap\Marker()\Location\Latitude <> 0 And PBMap\Marker()\Location\Longitude <> 0
GetPixelCoordFromLocation(PBMap\Marker()\Location, @Pixel)
If Pixel\X >= 0 And Pixel\Y >= 0 And Pixel\X < GadgetWidth(PBMap\Gadget) And Pixel\Y < GadgetHeight(PBMap\Gadget) ; Only if visible ^_^
If PBMap\Marker()\CallBackPointer > 0
CallFunctionFast(PBMap\Marker()\CallBackPointer, Pixel\X, Pixel\Y)
Else
DrawPointer(*Drawing)
EndIf
EndIf
EndIf
Next
EndProcedure
;-*** Main drawing thread
; always running, waiting for a semaphore to start refreshing
Procedure DrawingThread(*SharedDrawing.DrawingParameters)
Protected Drawing.DrawingParameters
Protected Px.d, Py.d
Repeat
WaitSemaphore(*SharedDrawing\Semaphore)
MyDebug("--------- Main drawing thread ------------")
;Creates a copy of the structure to work with to avoid multiple mutex locks
LockMutex(*SharedDrawing\Mutex)
CopyStructure(*SharedDrawing, @Drawing, DrawingParameters)
UnlockMutex(*SharedDrawing\Mutex)
;Precalc some values
Drawing\CenterX = GadgetWidth(PBMap\Gadget) / 2
Drawing\CenterY = GadgetHeight(PBMap\Gadget) / 2
;Pixel shift, aka position in the tile
Px = Drawing\Position\x : Py = Drawing\Position\y
Drawing\DeltaX = Px * PBMap\TileSize - (Int(Px) * PBMap\TileSize) ;Don't forget the Int() !
Drawing\DeltaY = Py * PBMap\TileSize - (Int(Py) * PBMap\TileSize)
Drawing\TargetLocation\Latitude = PBMap\TargetLocation\Latitude
Drawing\TargetLocation\Longitude = PBMap\TargetLocation\Longitude
Drawing\Dirty = #False
;Main drawing stuff
StartVectorDrawing(CanvasVectorOutput(PBMap\Gadget))
DrawTiles(@Drawing)
DrawTrack(@Drawing)
DrawMarker(@Drawing)
DrawPointer(@Drawing)
;DrawScale(@Drawing)
;- Display how many images in cache
VectorFont(FontID(PBMap\Font), 30)
VectorSourceColor(RGBA(0, 0, 0, 80))
MovePathCursor(50,50)
DrawVectorText(Str(MapSize(PBMap\MemCache\Images())))
MovePathCursor(50,60)
DrawVectorText(Str(ListSize(PBMap\TilesThreads())))
StopVectorDrawing()
;Redraw
; If something was not correctly drawn, redraw after a while
LockMutex(*SharedDrawing\Mutex) ;Be sure that we're not modifying variables while moving (seems not useful, but it is, especially to clean the semaphore)
If Drawing\Dirty
MyDebug("Something was dirty ! We try again to redraw")
Drawing\PassNb + 1
SignalSemaphore(*SharedDrawing\Semaphore)
Else
;Clean the semaphore to avoid multiple unuseful redraws
Repeat : Until TrySemaphore(*SharedDrawing\Semaphore) = 0
EndIf
UnlockMutex(*SharedDrawing\Mutex)
Until Drawing\End
EndProcedure
Procedure Refresh()
SignalSemaphore(PBMap\Drawing\Semaphore)
EndProcedure
Procedure SetLocation(latitude.d, longitude.d, zoom = 15, Mode.i = #PB_Absolute)
Select Mode
Case #PB_Absolute
PBMap\TargetLocation\Latitude = latitude
PBMap\TargetLocation\Longitude = longitude
PBMap\Zoom = zoom
Case #PB_Relative
PBMap\TargetLocation\Latitude + latitude
PBMap\TargetLocation\Longitude + longitude
PBMap\Zoom + zoom
EndSelect
If PBMap\Zoom > PBMap\ZoomMax : PBMap\Zoom = PBMap\ZoomMax : EndIf
If PBMap\Zoom < PBMap\ZoomMin : PBMap\Zoom = PBMap\ZoomMin : EndIf
LatLon2XY(@PBMap\TargetLocation, @PBMap\Drawing)
;Convert X, Y in tile.decimal into real pixels
PBMap\Position\x = PBMap\Drawing\Position\x * PBMap\TileSize
PBMap\Position\y = PBMap\Drawing\Position\y * PBMap\TileSize
PBMap\Drawing\PassNb = 1
;Start drawing
SignalSemaphore(PBMap\Drawing\Semaphore)
;***
If PBMap\CallBackLocation > 0
CallFunctionFast(PBMap\CallBackLocation, @PBMap\TargetLocation)
EndIf
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 PBMap\track()
If ListIndex(PBMap\track())=0 Or PBMap\track()\Longitude<MinX
MinX=PBMap\track()\Longitude
EndIf
If ListIndex(PBMap\track())=0 Or PBMap\track()\Longitude>MaxX
MaxX=PBMap\track()\Longitude
EndIf
If ListIndex(PBMap\track())=0 Or PBMap\track()\Latitude<MinY
MinY=PBMap\track()\Latitude
EndIf
If ListIndex(PBMap\track())=0 Or PBMap\track()\Latitude>MaxY
MaxY=PBMap\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%.
Protected ry1.d = Log((Sin(Radian(MinY)) + 1) / Cos(Radian(MinY)))
Protected ry2.d = Log((Sin(Radian(MaxY)) + 1) / Cos(Radian(MaxY)))
Protected ryc.d = (ry1 + ry2) / 2
Protected centerY.d = Degree(ATan(SinH(ryc)))
Protected resolutionHorizontal.d = DeltaX / GadgetWidth(PBMap\Gadget)
Protected vy0.d = Log(Tan(#PI*(0.25 + centerY/360)));
Protected vy1.d = Log(Tan(#PI*(0.25 + MaxY/360))) ;
Protected viewHeightHalf.d = GadgetHeight(PBMap\Gadget)/2;
Protected zoomFactorPowered.d = viewHeightHalf / (40.7436654315252*(vy1 - vy0))
Protected resolutionVertical.d = 360.0 / (zoomFactorPowered * PBMap\TileSize)
If resolutionHorizontal<>0 And resolutionVertical<>0
Protected resolution.d = Max(resolutionHorizontal, resolutionVertical)* paddingFactor
Protected zoom.d = Log(360 / (resolution * PBMap\TileSize))/Log(2)
Protected lon.d = centerX;
Protected lat.d = centerY;
SetLocation(lat,lon, Round(zoom,#PB_Round_Down))
Else
SetLocation(PBMap\TargetLocation\Latitude,PBMap\TargetLocation\Longitude, 15)
EndIf
EndProcedure
Procedure SetZoom(Zoom.i, mode.i = #PB_Relative)
Select mode
Case #PB_Relative
PBMap\Zoom = PBMap\Zoom + zoom
Case #PB_Absolute
PBMap\Zoom = zoom
EndSelect
If PBMap\Zoom > PBMap\ZoomMax : PBMap\Zoom = PBMap\ZoomMax : EndIf
If PBMap\Zoom < PBMap\ZoomMin : PBMap\Zoom = PBMap\ZoomMin : EndIf
LatLon2XY(@PBMap\TargetLocation, @PBMap\Drawing)
;Convert X, Y in tile.decimal into real pixels
PBMap\Position\X = PBMap\Drawing\Position\x * PBMap\TileSize
PBMap\Position\Y = PBMap\Drawing\Position\y * PBMap\TileSize
;*** Creates a drawing thread and fill parameters
PBMap\Drawing\PassNb = 1
;Start drawing
SignalSemaphore(PBMap\Drawing\Semaphore)
;***
If PBMap\CallBackLocation > 0
CallFunctionFast(PBMap\CallBackLocation, @PBMap\TargetLocation)
EndIf
EndProcedure
;Zoom on x, y position relative to the canvas gadget
Procedure SetZoomOnPosition(x, y, zoom)
Protected MouseX.d, MouseY.d
Protected OldPx.d, OldPy.d, OldMx.d, OldMy.d
;Fast and dirty code
OldPx = PBMap\Position\x : OldPy = PBMap\Position\y
OldMx = OldPx + GadgetWidth(PBMap\Gadget) / 2 - x
OldMy = OldPy + GadgetHeight(PBMap\Gadget) / 2 - y
PBMap\Zoom = PBMap\Zoom + zoom
If PBMap\Zoom > PBMap\ZoomMax : PBMap\Zoom = PBMap\ZoomMax : EndIf
If PBMap\Zoom < PBMap\ZoomMin : PBMap\Zoom = PBMap\ZoomMin : EndIf
;Centered Zoom
LockMutex(PBMap\Drawing\Mutex)
LatLon2XY(@PBMap\TargetLocation, @PBMap\Drawing)
;Convert X, Y in tile.decimal into real pixels
PBMap\Position\x = PBMap\Drawing\Position\x * PBMap\TileSize
PBMap\Position\y = PBMap\Drawing\Position\y * PBMap\TileSize
MouseX = PBMap\Position\x + GadgetWidth(PBMap\Gadget) / 2 - x
MouseY = PBMap\Position\y + GadgetHeight(PBMap\Gadget) / 2 - y
;Cross-multiply to get the new center
PBMap\Position\x = (OldPx * MouseX) / OldMx
PBMap\Position\y = (OldPy * MouseY) / OldMy
;PBMap tile position in tile.decimal
PBMap\Drawing\Position\x = PBMap\Position\x / PBMap\TileSize
PBMap\Drawing\Position\y = PBMap\Position\y / PBMap\TileSize
PBMap\Drawing\PassNb = 1
XY2LatLon(@PBMap\Drawing, @PBMap\TargetLocation)
UnlockMutex(PBMap\Drawing\Mutex)
;Start drawing
SignalSemaphore(PBMap\Drawing\Semaphore)
;If CallBackLocation send Location to function
If PBMap\CallBackLocation > 0
CallFunctionFast(PBMap\CallBackLocation, @PBMap\TargetLocation)
EndIf
EndProcedure
Procedure SetCallBackLocation(CallBackLocation.i)
PBMap\CallBackLocation = CallBackLocation
EndProcedure
Procedure SetCallBackMainPointer(CallBackMainPointer.i)
PBMap\CallBackMainPointer = CallBackMainPointer
EndProcedure
Procedure.d GetLatitude()
Protected Value.d
LockMutex(PBMap\Drawing\Mutex)
Value = PBMap\TargetLocation\Latitude
UnlockMutex(PBMap\Drawing\Mutex)
ProcedureReturn Value
EndProcedure
Procedure.d GetLongitude()
Protected Value.d
LockMutex(PBMap\Drawing\Mutex)
Value = PBMap\TargetLocation\Longitude
UnlockMutex(PBMap\Drawing\Mutex)
ProcedureReturn Value
EndProcedure
Procedure.i GetZoom()
Protected Value.d
LockMutex(PBMap\Drawing\Mutex)
Value = PBMap\Zoom
UnlockMutex(PBMap\Drawing\Mutex)
ProcedureReturn Value
EndProcedure
Procedure Event(Event.l)
Protected Gadget.i
Protected MouseX.i, MouseY.i
Protected Marker.Position
If IsGadget(PBMap\Gadget) And GadgetType(PBMap\Gadget) = #PB_GadgetType_Canvas
Select Event
Case #PB_Event_Gadget ;{
Gadget = EventGadget()
Select Gadget
Case PBMap\Gadget
Select EventType()
Case #PB_EventType_MouseWheel
If PBMap\Options\WheelMouseRelative
;Relative zoom (centered on the mouse)
SetZoomOnPosition(GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX), GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY), GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_WheelDelta))
Else
;Absolute zoom (centered on the center of the map)
SetZoom(GetGadgetAttribute(PBMap\Gadget,#PB_Canvas_WheelDelta), #PB_Relative)
EndIf
Case #PB_EventType_LeftButtonDown
;Check if we select a marker
MouseX = PBMap\Position\x - GadgetWidth(PBMap\Gadget) / 2 + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX)
MouseY = PBMap\Position\y - GadgetHeight(PBMap\Gadget) / 2 + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY)
ForEach PBMap\Marker()
LatLon2XY(@PBMap\Marker()\Location, @Marker)
Marker\x * PBMap\TileSize
Marker\y * PBMap\TileSize
If Distance(Marker\x, Marker\y, MouseX, MouseY) < 8
PBMap\EditMarkerIndex = ListIndex(PBMap\Marker())
Break
EndIf
Next
;Mem cursor Coord
PBMap\MoveStartingPoint\x = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX)
PBMap\MoveStartingPoint\y = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY)
Case #PB_EventType_MouseMove
;If a move has been initiated by a left click
If PBMap\MoveStartingPoint\x <> - 1
MouseX = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) - PBMap\MoveStartingPoint\x
MouseY = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY) - PBMap\MoveStartingPoint\y
PBMap\Moving = #True
;If it's marker move
If PBMap\EditMarkerIndex > -1
SelectElement(PBMap\Marker(), PBMap\EditMarkerIndex)
LatLon2XY(@PBMap\Marker()\Location, @Marker)
Marker\x + MouseX / PBMap\TileSize
Marker\y + MouseY / PBMap\TileSize
XY2LatLon(@Marker, @PBMap\Marker()\Location)
Else
;New move values
PBMap\Position\x - MouseX
PBMap\Position\y - MouseY
;Fill parameters and send a signal to the drawing thread
LockMutex(PBMap\Drawing\Mutex)
;PBMap tile position in tile.decimal
PBMap\Drawing\Position\x = PBMap\Position\x / PBMap\TileSize
PBMap\Drawing\Position\y = PBMap\Position\y / PBMap\TileSize
PBMap\Drawing\PassNb = 1
XY2LatLon(@PBMap\Drawing, @PBMap\TargetLocation)
UnlockMutex(PBMap\Drawing\Mutex)
;Start drawing
SignalSemaphore(PBMap\Drawing\Semaphore)
EndIf
;If CallBackLocation send Location to function
If PBMap\CallBackLocation > 0
CallFunctionFast(PBMap\CallBackLocation, @PBMap\TargetLocation)
EndIf
PBMap\MoveStartingPoint\x = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX)
PBMap\MoveStartingPoint\y = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY)
EndIf
Case #PB_EventType_LeftButtonUp
PBMap\Moving = #False
PBMap\MoveStartingPoint\x = - 1
;Stop marker move
If PBMap\EditMarkerIndex > -1
PBMap\EditMarkerIndex = -1
Else
;Stop map move
LockMutex(PBMap\Drawing\Mutex)
PBMap\Drawing\Position\x = PBMap\Position\x / PBMap\TileSize
PBMap\Drawing\Position\y = PBMap\Position\y / PBMap\TileSize
MyDebug("PBMap\Drawing\Position\x " + Str(PBMap\Drawing\Position\x) + " ; PBMap\Drawing\Position\y " + Str(PBMap\Drawing\Position\y) )
XY2LatLon(@PBMap\Drawing, @PBMap\TargetLocation)
UnlockMutex(PBMap\Drawing\Mutex)
EndIf
EndSelect
EndSelect
EndSelect
Else
MessageRequester("Module PBMap", "You must use PBMapGadget before", #PB_MessageRequester_Ok )
End
EndIf
EndProcedure
EndModule
;-Exemple
CompilerIf #PB_Compiler_IsMainFile
InitNetwork()
Enumeration
#Window_0
#Map
#Gdt_Left
#Gdt_Right
#Gdt_Up
#Gdt_Down
#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 MyPointer(x.i, y.i)
Protected color.l
color=RGBA(0, 255, 0, 255)
VectorSourceColor(color)
MovePathCursor(x, y)
AddPathLine(-16,-32,#PB_Path_Relative)
AddPathCircle(16,0,16,180,0,#PB_Path_Relative)
AddPathLine(-16,32,#PB_Path_Relative)
VectorSourceColor(color)
FillPath(#PB_Path_Preserve):VectorSourceColor(RGBA(0, 0, 0, 255)):StrokePath(1)
EndProcedure
Procedure MainPointer(x.i, y.i)
VectorSourceColor(RGBA(255, 255,255, 255)):AddPathCircle(x, y,32):StrokePath(1)
VectorSourceColor(RGBA(0,0,0, 255)):AddPathCircle(x, y,29):StrokePath(2)
EndProcedure
Procedure ResizeAll()
ResizeGadget(#Map,10,10,WindowWidth(#Window_0)-198,WindowHeight(#Window_0)-59)
ResizeGadget(#Text_1,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore)
ResizeGadget(#Gdt_Left, WindowWidth(#Window_0) - 150 ,#PB_Ignore,#PB_Ignore,#PB_Ignore)
ResizeGadget(#Gdt_Right,WindowWidth(#Window_0) - 90 ,#PB_Ignore,#PB_Ignore,#PB_Ignore)
ResizeGadget(#Gdt_Up, WindowWidth(#Window_0) - 120 ,#PB_Ignore,#PB_Ignore,#PB_Ignore)
ResizeGadget(#Gdt_Down, WindowWidth(#Window_0) - 120 ,#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)
PBMap::Refresh()
EndProcedure
;- MAIN TEST
If OpenWindow(#Window_0, 260, 225, 700, 571, "PBMap", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered | #PB_Window_SizeGadget)
LoadFont(0, "Wingdings", 12)
LoadFont(1, "Arial", 12, #PB_Font_Bold)
TextGadget(#Text_1, 530, 50, 60, 15, "Movements")
ButtonGadget(#Gdt_Left, 550, 100, 30, 30, Chr($E7)) : SetGadgetFont(#Gdt_Left, FontID(0))
ButtonGadget(#Gdt_Right, 610, 100, 30, 30, Chr($E8)) : SetGadgetFont(#Gdt_Right, FontID(0))
ButtonGadget(#Gdt_Up, 580, 070, 30, 30, Chr($E9)) : SetGadgetFont(#Gdt_Up, FontID(0))
ButtonGadget(#Gdt_Down, 580, 130, 30, 30, Chr($EA)) : SetGadgetFont(#Gdt_Down, FontID(0))
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
;Our main gadget
PBMap::InitPBMap()
PBMap::MapGadget(#Map, 10, 10, 512, 512)
PBMap::SetCallBackLocation(@UpdateLocation())
PBMap::SetCallBackMainPointer(@MainPointer()) ;To change the Main Pointer
PBMap::SetLocation(49.04599, 2.03347, 17)
PBMap::AddMarker(49.0446828398, 2.0349812508, -1, @MyPointer())
Repeat
Event = WaitWindowEvent()
PBMap::Event(Event)
Select Event
Case #PB_Event_CloseWindow : Quit = 1
Case #PB_Event_Gadget ;{
Gadget = EventGadget()
Select Gadget
Case #Gdt_Up
PBMap::SetLocation(10* 360 / Pow(2, PBMap::GetZoom() + 8), 0, 0, #PB_Relative)
Case #Gdt_Down
PBMap::SetLocation(10* -360 / Pow(2, PBMap::GetZoom() + 8), 0, 0, #PB_Relative)
Case #Gdt_Left
PBMap::SetLocation(0, 10* -360 / Pow(2, PBMap::GetZoom() + 8), 0, #PB_Relative)
Case #Gdt_Right
PBMap::SetLocation(0, 10* 360 / Pow(2, PBMap::GetZoom() + 8), 0, #PB_Relative)
Case #Button_4
PBMap::SetZoom(1)
Case #Button_5
PBMap::SetZoom( - 1)
Case #Gdt_LoadGpx
PBMap::LoadGpxFile(OpenFileRequester("Choose a file to load", "", "*.gpx", 0))
PBMap::ZoomToArea() ; <-To center the view, and zoom on the tracks
Case #Gdt_AddMarker
PBMap:: 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
PBMap::Quit()
EndIf
CompilerEndIf
; IDE Options = PureBasic 5.50 (Windows - x64)
; ExecutableFormat = Console
; Folding = ---------
; EnableThread
; EnableXP
; EnableUnicode
Reference in New Issue View Git Blame Copy Permalink