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

Code cleaning, event handling work

Browse Source
This commit is contained in:
djes
2016-08-29 11:52:31 +02:00
parent d274490ada
commit 31d763455f
1 changed files with 202 additions and 216 deletions
Download Patch File Download Diff File Expand all files Collapse all files

418
PBMap.pb
View File

@@ -31,7 +31,7 @@ DeclareModule PBMap
Global Verbose = 1
Global MyDebugLevel = 3
;-Proxy ON/OFF
Global Proxy = #False
Global Proxy = #True
#SCALE_NAUTICAL = 1
#SCALE_KM = 0
@@ -39,7 +39,6 @@ DeclareModule PBMap
Declare InitPBMap(window)
Declare SetMapServer(ServerURL.s = "http://tile.openstreetmap.org/", TileSize = 256, ZoomMin = 0, ZoomMax = 18)
Declare MapGadget(Gadget.i, X.i, Y.i, Width.i, Height.i)
Declare Event(Event.l)
Declare SetLocation(latitude.d, longitude.d, zoom = 15, mode.i = #PB_Absolute)
Declare Drawing()
Declare SetZoom(Zoom.i, mode.i = #PB_Relative)
@@ -55,7 +54,6 @@ DeclareModule PBMap
Declare.d GetLatitude()
Declare.d GetLongitude()
Declare.i GetZoom()
EndDeclareModule
Module PBMap
@@ -87,7 +85,7 @@ Module PBMap
key.s
CacheFile.s
GetImageThread.i
layer.i
Layer.i
EndStructure
Structure DrawingParameters
@@ -173,6 +171,7 @@ Module PBMap
EndStructure
#PB_MAP_REDRAW = #PB_EventType_FirstCustomValue + 1
#PB_MAP_RETRY = #PB_EventType_FirstCustomValue + 2
;-Global variables
Global PBMap.PBMap, Null.i
@@ -204,8 +203,8 @@ Module PBMap
Procedure.i CurlReceiveHTTPToFile(URL$, DestFileName$, ProxyURL$="", ProxyPort$="", ProxyUser$="", ProxyPassword$="")
Protected *Buffer, curl.i, Timeout.i, res.i
Protected FileHandle.i
MyDebug("ReceiveHTTPToFile from " + URL$ + " " + ProxyURL$ + ProxyPort$ + ProxyUser$, 3)
MyDebug(" to file : " + DestFileName$, 3)
MyDebug("CurlReceiveHTTPToFile from " + URL$ + " " + ProxyURL$ + " " + ProxyPort$ + " " + ProxyUser$, 4)
MyDebug(" to file : " + DestFileName$, 4)
FileHandle = CreateFile(#PB_Any, DestFileName$)
If FileHandle And Len(URL$)
curl = curl_easy_init()
@@ -238,11 +237,11 @@ Module PBMap
curl_easy_setopt(curl, #CURLOPT_WRITEFUNCTION, @ReceiveHTTPWriteToFileFunction())
res = curl_easy_perform(curl)
If res <> #CURLE_OK
MyDebug("CURL problem", 3)
MyDebug("CURL problem", 4)
EndIf
curl_easy_cleanup(curl)
Else
MyDebug("Can't init CURL", 3)
MyDebug("Can't init CURL", 4)
EndIf
CloseFile(FileHandle)
ProcedureReturn FileSize(DestFileName$)
@@ -270,7 +269,7 @@ Module PBMap
EndIf
EndProcedure
Procedure InitPBMap(window)
Procedure InitPBMap(Window)
Protected Result.i
If Verbose
OpenConsole()
@@ -284,7 +283,7 @@ Module PBMap
PBMap\TileThreadMutex = CreateMutex()
PBMap\EditMarkerIndex = -1 ;Initialised with "no marker selected"
PBMap\Font = LoadFont(#PB_Any, "Arial", 20, #PB_Font_Bold)
PBMap\Window = window
PBMap\Window = Window
PBMap\Options\WheelMouseRelative = #True
SetMapServer("http://tile.openstreetmap.org/")
@@ -324,7 +323,6 @@ Module PBMap
PBMap\ZoomMax = ZoomMax
PBMap\TileSize = TileSize
EndProcedure
Procedure Quit()
PBMap\Drawing\End = #True
@@ -359,16 +357,7 @@ Module PBMap
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)
@@ -460,83 +449,92 @@ Module PBMap
EndIf
EndProcedure
Procedure LoadErrorHandler()
MessageRequester("Error", "")
EndProcedure
Procedure.i GetTileFromHDD(CacheFile.s)
Protected nImage.i
; Debug "Loading image " + CacheFile + " ; Size : " + Str(FileSize(CacheFile))
If FileSize(CacheFile) > 0
OnErrorCall(@LoadErrorHandler())
nImage = LoadImage(#PB_Any, CacheFile)
OnErrorDefault()
If IsImage(nImage)
;Debug "Success loading " + CacheFile + " as nImage " + Str(nImage)
MyDebug("Success loading " + CacheFile + " as nImage " + Str(nImage), 3)
ProcedureReturn nImage
Else
; Debug "Failed loading " + CacheFile + " as nImage " + Str(nImage) + " -> not an image !"
MyDebug("Failed loading " + CacheFile + " as nImage " + Str(nImage) + " -> not an image !", 3)
MyDebug("Failed loading " + CacheFile + " as nImage " + Str(nImage) + " -> not an image !", 3)
EndIf
Else
; Debug "Failed loading " + CacheFile + " -> Size <= 0"
MyDebug("Failed loading " + CacheFile + " -> Size <= 0", 3)
EndIf
ProcedureReturn -1
EndProcedure
Procedure.i GetLocalTile(key.s, CacheFile.s)
Protected timg
MyDebug("Check if we have this image in memory", 3)
Protected timg = -1
If FindMapElement(PBMap\MemCache\Images(), key)
MyDebug("Key : " + key + " found !", 3)
MyDebug("Key : " + key + " found in memory cache!", 3)
ProcedureReturn PBMap\MemCache\Images()\nImage
Else
MyDebug("Key : " + key + " Try HDD!")
MyDebug("Trying to load from HDD " + CacheFile)
timg = GetTileFromHDD(CacheFile.s)
If timg <> -1
AddMapElement(PBMap\MemCache\Images(),key)
PBMap\MemCache\Images()\nImage = timg
EndIf
ProcedureReturn timg
If timg <> -1
MyDebug("Key : " + key + " found on HDD")
LockMutex(PBMap\TileThreadMutex)
AddMapElement(PBMap\MemCache\Images(), key)
PBMap\MemCache\Images()\nImage = timg
UnlockMutex(PBMap\TileThreadMutex)
Else
MyDebug("Key : " + key + " not found")
EndIf
ProcedureReturn timg
EndIf
EndProcedure
Procedure.i GetTileFromWeb(Zoom.i, XTile.i, YTile.i, CacheFile.s,layer.i)
Procedure.i GetTileFromWeb(Zoom.i, XTile.i, YTile.i, CacheFile.s, Layer.i)
Protected *Buffer
Protected nImage.i = -1
Protected FileHandle.i,timg
Protected TileURL.s = PBMap\ServerURL(layer) + Str(Zoom) + "/" + Str(XTile) + "/" + Str(YTile) + ".png"
MyDebug("Check if we have this image on Web", 3)
Protected FileSize.i, timg
Protected TileURL.s = PBMap\ServerURL(Layer) + Str(Zoom) + "/" + Str(XTile) + "/" + Str(YTile) + ".png"
If Proxy
FileHandle = CurlReceiveHTTPToFile(TileURL, CacheFile, ProxyURL$, ProxyPort$, ProxyUser$, ProxyPassword$)
If FileHandle
FileSize = CurlReceiveHTTPToFile(TileURL, CacheFile, ProxyURL$, ProxyPort$, ProxyUser$, ProxyPassword$)
If FileSize > 0
MyDebug("Loaded from web " + TileURL + " as CacheFile " + CacheFile, 3)
nImage = GetTileFromHDD(CacheFile)
Else
MyDebug("File " + TileURL + " not correctly received with Curl and proxy", 3)
MyDebug("Problem loading from web " + TileURL, 3)
EndIf
Else
*Buffer = ReceiveHTTPMemory(TileURL) ;TODO to thread by using #PB_HTTP_Asynchronous
If *Buffer
nImage = CatchImage(#PB_Any, *Buffer, MemorySize(*Buffer))
If IsImage(nImage)
MyDebug("Load from web " + TileURL + " as Tile nb " + nImage, 3)
; Debug "url: " + TileURL
; Debug "cache file: " + CacheFile
; timg = LoadImage(#PB_Any,CacheFile)
; If timg
; StartDrawing(ImageOutput(timg))
; DrawImage(ImageID(nimage))
; StopDrawing()
; SaveImage(timg, CacheFile, #PB_ImagePlugin_PNG)
; FreeImage(timg)
; Else
SaveImage(nImage, CacheFile, #PB_ImagePlugin_PNG)
FreeMemory(*Buffer)
; EndIf
; Debug "url: " + TileURL
; Debug "cache file: " + CacheFile
; timg = LoadImage(#PB_Any,CacheFile)
; If timg
; StartDrawing(ImageOutput(timg))
; DrawImage(ImageID(nimage))
; StopDrawing()
; SaveImage(timg, CacheFile, #PB_ImagePlugin_PNG)
; FreeImage(timg)
; Else
If SaveImage(nImage, CacheFile, #PB_ImagePlugin_PNG)
MyDebug("Loaded from web " + TileURL + " as CacheFile " + CacheFile, 3)
Else
MyDebug("Loaded from web " + TileURL + " but cannot save to CacheFile " + CacheFile, 3)
EndIf
FreeMemory(*Buffer)
; EndIf
Else
MyDebug("Can't catch image " + TileURL, 3)
MyDebug("Can't catch image loaded from web " + TileURL, 3)
nImage = -1
;ShowMemoryViewer(*Buffer, MemorySize(*Buffer))
EndIf
Else
; Debug("ReceiveHTTPMemory's buffer is empty")
MyDebug("ReceiveHTTPMemory's buffer is empty", 3)
MyDebug(" Problem loading from web " + TileURL, 3)
EndIf
EndIf
ProcedureReturn nImage
@@ -544,20 +542,19 @@ Module PBMap
Procedure GetImageThread(*Tile.Tile)
Protected nImage.i = -1
nImage = GetTileFromWeb(*Tile\PBMapZoom, *Tile\PBMapTileX, *Tile\PBMapTileY, *Tile\CacheFile,*tile\layer)
nImage = GetTileFromWeb(*Tile\PBMapZoom, *Tile\PBMapTileX, *Tile\PBMapTileY, *Tile\CacheFile, *Tile\Layer)
If nImage <> -1
LockMutex(PBMap\TileThreadMutex)
AddMapElement(PBMap\MemCache\Images(), *Tile\key) ;Add the image to the cache, once
PBMap\MemCache\Images(*Tile\key)\nImage = nImage
UnlockMutex(PBMap\TileThreadMutex)
MyDebug("Image nb " + Str(nImage) + " successfully added to mem cache")
MyDebug("With the following key : " + *Tile\key)
MyDebug("Image key : " + *Tile\key + " added in memory cache!", 3)
*Tile\nImage = nImage
PostEvent(#PB_Event_Gadget, PBMap\window,PBmap\Gadget, #PB_MAP_REDRAW, *Tile)
Else
MyDebug("Error GetImageThread procedure, image not loaded - " + *Tile\key)
;nImage = -1
EndIf
PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_REDRAW, *Tile) ;If image is loaded from web, redraw
Else
PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_RETRY, *Tile) ;If image is not loaded, retry
EndIf
EndProcedure
Procedure DrawTile(*Tile.Tile)
@@ -577,10 +574,10 @@ Module PBMap
MyDebug(" at coords " + Str(x) + "," + Str(y))
EndProcedure
Procedure DrawTiles(*Drawing.DrawingParameters,layer.i,alpha.i=255)
Procedure DrawTiles(*Drawing.DrawingParameters, Layer.i, alpha.i=255)
;DisableDebugger
Protected x.i, y.i,kq.q
Protected tx = Int(*Drawing\Position\x) ;Don't forget the Int() !
Protected tx = Int(*Drawing\Position\x) ;Don't forget the Int() !
Protected ty = Int(*Drawing\Position\y)
Protected nx = *Drawing\CenterX / PBMap\TileSize ;How many tiles around the point
Protected ny = *Drawing\CenterY / PBMap\TileSize
@@ -588,61 +585,53 @@ Module PBMap
MyDebug("Drawing tiles")
For y = - ny - 1 To ny + 1
For x = - nx - 1 To nx + 1
px = *Drawing\CenterX + x * PBMap\TileSize - *Drawing\DeltaX
py = *Drawing\CenterY + y * PBMap\TileSize - *Drawing\DeltaY
tilex = ((tx+x) % (1<< PBMap\Zoom))
tiley = ty+y
kq = layer | (pbmap\zoom << 8) | (tilex << 16) | (tiley << 36)
key = Str(kq)
CacheFile = PBMap\HDDCachePath + key + ".png"
img = GetLocalTile(key, CacheFile)
If img <> -1
MovePathCursor(px, py)
DrawVectorImage(ImageID(img),alpha)
Else
MovePathCursor(px, py)
DrawVectorImage(ImageID(PBMap\ImgLoading),alpha)
Protected *NewTile.Tile = AllocateMemory(SizeOf(Tile))
If *NewTile
With *NewTile
;Keep a track of tiles (especially to free memory)
;TODO : not sure if it really needs a mutex here, i'm still trying to find where the white tile issue is coming from
;a tile download is either getting clobbered or timing out or getting kicked and it results in a corrupted png file on linux
LockMutex(PBMap\TileThreadMutex)
AddElement(PBMap\TilesThreads())
PBMap\TilesThreads()\Tile = *NewTile
UnlockMutex(PBMap\TileThreadMutex)
;New tile parameters
\Position\x = px
\Position\y = py
\PBMapTileX = tilex
\PBMapTileY = tiley
\PBMapZoom = PBMap\Zoom
\key = key
\CacheFile = CacheFile
\layer = layer
LockMutex(PBMap\TileThreadMutex)
AddMapElement(PBMap\MemCache\Images(), \key) ;Add the image to the cache, once in this loop
PBMap\MemCache\Images()\nImage = PBMap\ImgLoading
UnlockMutex(PBMap\TileThreadMutex)
\GetImageThread = CreateThread(@GetImageThread(), *NewTile)
PBMap\TilesThreads()\GetImageThread = \GetImageThread
myDebug(" Creating get image thread nb " + Str(\GetImageThread))
EndWith
Else
MyDebug(" Error, can't create a new tile")
Break 2
EndIf
EndIf
Next
Next
px = *Drawing\CenterX + x * PBMap\TileSize - *Drawing\DeltaX
py = *Drawing\CenterY + y * PBMap\TileSize - *Drawing\DeltaY
tilex = ((tx+x) % (1<< PBMap\Zoom))
tiley = ty+y
kq = Layer | (pbmap\zoom << 8) | (tilex << 16) | (tiley << 36)
key = Str(kq)
CacheFile = PBMap\HDDCachePath + key + ".png"
img = GetLocalTile(key, CacheFile)
If img <> -1
MovePathCursor(px, py)
DrawVectorImage(ImageID(img), alpha)
Else
MovePathCursor(px, py)
DrawVectorImage(ImageID(PBMap\ImgLoading), alpha)
Protected *NewTile.Tile = AllocateMemory(SizeOf(Tile))
If *NewTile
With *NewTile
;Keep a track of tiles (especially to free memory)
;TODO : not sure if it really needs a mutex here, i'm still trying to find where the white tile issue is coming from
;a tile download is either getting clobbered or timing out or getting kicked and it results in a corrupted png file on linux
LockMutex(PBMap\TileThreadMutex)
AddElement(PBMap\TilesThreads())
PBMap\TilesThreads()\Tile = *NewTile
UnlockMutex(PBMap\TileThreadMutex)
;New tile parameters
\Position\x = px
\Position\y = py
\PBMapTileX = tilex
\PBMapTileY = tiley
\PBMapZoom = PBMap\Zoom
\key = key
\CacheFile = CacheFile
\Layer = Layer
\GetImageThread = CreateThread(@GetImageThread(), *NewTile)
PBMap\TilesThreads()\GetImageThread = \GetImageThread
myDebug(" Creating get image thread nb " + Str(\GetImageThread))
EndWith
Else
MyDebug(" Error, can't create a new tile")
Break 2
EndIf
EndIf
Next
Next
;Free tile memory
;Free tile memory
;TODO : maybe get out this proc from drawtiles in a special "free ressources" task
ForEach PBMap\TilesThreads()
;Check if there's no more loading thread
@@ -651,7 +640,7 @@ Module PBMap
DeleteElement(PBMap\TilesThreads())
EndIf
Next
;EnableDebugger
EndProcedure
; ;-**** Clean Mem Cache
@@ -1001,95 +990,94 @@ Module PBMap
ProcedureReturn Value
EndProcedure
Procedure Event(Event.l)
Protected Gadget.i
Procedure Events()
; Protected Gadget.i
Protected MouseX.i, MouseY.i
Protected Marker.Position
Protected *Drawing.DrawingParameters
If IsGadget(PBMap\Gadget) And GadgetType(PBMap\Gadget) = #PB_GadgetType_Canvas
Select Event
Case #PB_Event_Gadget ;{
Gadget = EventGadget()
Select Gadget
Case PBMap\Gadget
Select EventType()
Case #PB_EventType_MouseWheel
If PBMap\Options\WheelMouseRelative
;Relative zoom (centered on the mouse)
SetZoomOnPosition(GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX), GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY), GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_WheelDelta))
Else
;Absolute zoom (centered on the center of the map)
SetZoom(GetGadgetAttribute(PBMap\Gadget,#PB_Canvas_WheelDelta), #PB_Relative)
EndIf
Case #PB_EventType_LeftButtonDown
;Check if we select a marker
MouseX = PBMap\Position\x - GadgetWidth(PBMap\Gadget) / 2 + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX)
MouseY = PBMap\Position\y - GadgetHeight(PBMap\Gadget) / 2 + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY)
ForEach PBMap\Marker()
LatLon2XY(@PBMap\Marker()\Location, @Marker)
Marker\x * PBMap\TileSize
Marker\y * PBMap\TileSize
If Distance(Marker\x, Marker\y, MouseX, MouseY) < 8
PBMap\EditMarkerIndex = ListIndex(PBMap\Marker())
Break
EndIf
Next
;Mem cursor Coord
PBMap\MoveStartingPoint\x = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX)
PBMap\MoveStartingPoint\y = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY)
Case #PB_EventType_MouseMove
If PBMap\MoveStartingPoint\x <> - 1
MouseX = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) - PBMap\MoveStartingPoint\x
MouseY = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY) - PBMap\MoveStartingPoint\y
PBMap\Moving = #True
;Move marker
If PBMap\EditMarkerIndex > -1
SelectElement(PBMap\Marker(), PBMap\EditMarkerIndex)
LatLon2XY(@PBMap\Marker()\Location, @Marker)
Marker\x + MouseX / PBMap\TileSize
Marker\y + MouseY / PBMap\TileSize
XY2LatLon(@Marker, @PBMap\Marker()\Location)
Else
;New move values
PBMap\Position\x - MouseX
PBMap\Position\y - MouseY
;PBMap tile position in tile.decimal
PBMap\Drawing\Position\x = PBMap\Position\x / PBMap\TileSize
PBMap\Drawing\Position\y = PBMap\Position\y / PBMap\TileSize
PBMap\Drawing\PassNb = 1
XY2LatLon(@PBMap\Drawing, @PBMap\TargetLocation)
;If CallBackLocation send Location to function
If PBMap\CallBackLocation > 0
CallFunctionFast(PBMap\CallBackLocation, @PBMap\TargetLocation)
EndIf
EndIf
Drawing()
PBMap\MoveStartingPoint\x = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX)
PBMap\MoveStartingPoint\y = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY)
EndIf
Case #PB_EventType_LeftButtonUp
PBMap\Moving = #False
PBMap\MoveStartingPoint\x = - 1
If PBMap\EditMarkerIndex > -1
PBMap\EditMarkerIndex = -1
Else ;Move Map
PBMap\Drawing\Position\x = PBMap\Position\x / PBMap\TileSize
PBMap\Drawing\Position\y = PBMap\Position\y / PBMap\TileSize
MyDebug("PBMap\Drawing\Position\x " + Str(PBMap\Drawing\Position\x) + " ; PBMap\Drawing\Position\y " + Str(PBMap\Drawing\Position\y) )
XY2LatLon(@PBMap\Drawing, @PBMap\TargetLocation)
Drawing()
EndIf
Case #PB_MAP_REDRAW
Drawing()
EndSelect
EndSelect
EndSelect
Else
MessageRequester("Module PBMap", "You must use PBMapGadget before", #PB_MessageRequester_Ok )
End
EndIf
Select EventType()
Case #PB_EventType_MouseWheel
If PBMap\Options\WheelMouseRelative
;Relative zoom (centered on the mouse)
SetZoomOnPosition(GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX), GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY), GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_WheelDelta))
Else
;Absolute zoom (centered on the center of the map)
SetZoom(GetGadgetAttribute(PBMap\Gadget,#PB_Canvas_WheelDelta), #PB_Relative)
EndIf
Case #PB_EventType_LeftButtonDown
;Check if we select a marker
MouseX = PBMap\Position\x - GadgetWidth(PBMap\Gadget) / 2 + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX)
MouseY = PBMap\Position\y - GadgetHeight(PBMap\Gadget) / 2 + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY)
ForEach PBMap\Marker()
LatLon2XY(@PBMap\Marker()\Location, @Marker)
Marker\x * PBMap\TileSize
Marker\y * PBMap\TileSize
If Distance(Marker\x, Marker\y, MouseX, MouseY) < 8
PBMap\EditMarkerIndex = ListIndex(PBMap\Marker())
Break
EndIf
Next
;Mem cursor Coord
PBMap\MoveStartingPoint\x = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX)
PBMap\MoveStartingPoint\y = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY)
Case #PB_EventType_MouseMove
If PBMap\MoveStartingPoint\x <> - 1
MouseX = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) - PBMap\MoveStartingPoint\x
MouseY = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY) - PBMap\MoveStartingPoint\y
PBMap\Moving = #True
;Move marker
If PBMap\EditMarkerIndex > -1
SelectElement(PBMap\Marker(), PBMap\EditMarkerIndex)
LatLon2XY(@PBMap\Marker()\Location, @Marker)
Marker\x + MouseX / PBMap\TileSize
Marker\y + MouseY / PBMap\TileSize
XY2LatLon(@Marker, @PBMap\Marker()\Location)
Else
;New move values
PBMap\Position\x - MouseX
PBMap\Position\y - MouseY
;PBMap tile position in tile.decimal
PBMap\Drawing\Position\x = PBMap\Position\x / PBMap\TileSize
PBMap\Drawing\Position\y = PBMap\Position\y / PBMap\TileSize
PBMap\Drawing\PassNb = 1
XY2LatLon(@PBMap\Drawing, @PBMap\TargetLocation)
;If CallBackLocation send Location to function
If PBMap\CallBackLocation > 0
CallFunctionFast(PBMap\CallBackLocation, @PBMap\TargetLocation)
EndIf
EndIf
Drawing()
PBMap\MoveStartingPoint\x = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX)
PBMap\MoveStartingPoint\y = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY)
EndIf
Case #PB_EventType_LeftButtonUp
PBMap\Moving = #False
PBMap\MoveStartingPoint\x = - 1
If PBMap\EditMarkerIndex > -1
PBMap\EditMarkerIndex = -1
Else ;Move Map
PBMap\Drawing\Position\x = PBMap\Position\x / PBMap\TileSize
PBMap\Drawing\Position\y = PBMap\Position\y / PBMap\TileSize
MyDebug("PBMap\Drawing\Position\x " + Str(PBMap\Drawing\Position\x) + " ; PBMap\Drawing\Position\y " + Str(PBMap\Drawing\Position\y) )
XY2LatLon(@PBMap\Drawing, @PBMap\TargetLocation)
Drawing()
EndIf
Case #PB_MAP_REDRAW
Drawing()
EndSelect
EndProcedure
Procedure MapGadget(Gadget.i, X.i, Y.i, Width.i, Height.i)
If Gadget = #PB_Any
PBMap\Gadget = CanvasGadget(PBMap\Gadget, X, Y, Width, Height, #PB_Canvas_Keyboard) ;#PB_Canvas_Keyboard has to be set for mousewheel to work on windows
Else
PBMap\Gadget = Gadget
CanvasGadget(PBMap\Gadget, X, Y, Width, Height, #PB_Canvas_Keyboard)
EndIf
BindGadgetEvent(PBMap\Gadget, @Events())
EndProcedure
EndModule
;-Exemple
@@ -1172,10 +1160,10 @@ CompilerIf #PB_Compiler_IsMainFile
LoadFont(1, "Arial", 12, #PB_Font_Bold)
TextGadget(#Text_1, 530, 50, 60, 15, "Movements")
ButtonGadget(#Gdt_Left, 550, 100, 30, 30, Chr($E7)) : SetGadgetFont(#Gdt_Left, FontID(0))
ButtonGadget(#Gdt_Right, 610, 100, 30, 30, Chr($E8)) : SetGadgetFont(#Gdt_Right, FontID(0))
ButtonGadget(#Gdt_Up, 580, 070, 30, 30, Chr($E9)) : SetGadgetFont(#Gdt_Up, FontID(0))
ButtonGadget(#Gdt_Down, 580, 130, 30, 30, Chr($EA)) : SetGadgetFont(#Gdt_Down, FontID(0))
ButtonGadget(#Gdt_Left, 550, 100, 30, 30, Chr($25C4)) : SetGadgetFont(#Gdt_Left, FontID(0))
ButtonGadget(#Gdt_Right, 610, 100, 30, 30, Chr($25BA)) : SetGadgetFont(#Gdt_Right, FontID(0))
ButtonGadget(#Gdt_Up, 580, 070, 30, 30, Chr($25B2)) : SetGadgetFont(#Gdt_Up, FontID(0))
ButtonGadget(#Gdt_Down, 580, 130, 30, 30, Chr($25BC)) : SetGadgetFont(#Gdt_Down, FontID(0))
TextGadget(#Text_2, 530, 160, 60, 15, "Zoom")
ButtonGadget(#Button_4, 550, 180, 50, 30, " + ") : SetGadgetFont(#Button_4, FontID(1))
ButtonGadget(#Button_5, 600, 180, 50, 30, " - ") : SetGadgetFont(#Button_5, FontID(1))
@@ -1201,7 +1189,6 @@ CompilerIf #PB_Compiler_IsMainFile
Repeat
Event = WaitWindowEvent()
PBMap::Event(Event)
Select Event
Case #PB_Event_CloseWindow : Quit = 1
Case #PB_Event_Gadget ;{
@@ -1237,10 +1224,9 @@ CompilerIf #PB_Compiler_IsMainFile
CompilerEndIf
; IDE Options = PureBasic 5.50 (Windows - x64)
; CursorPosition = 1219
; FirstLine = 1193
; CursorPosition = 452
; FirstLine = 442
; Folding = ----------
; EnableThread
; EnableXP
; DisableDebugger
; EnableUnicode