Merge pull request #11 from djes/djes

Important fix on tile loading.
This commit is contained in:
djes
2017-03-20 17:42:50 +01:00
committed by GitHub

138
PBMap.pb
View File

@@ -48,6 +48,7 @@ DeclareModule PBMap
Declare InitPBMap(window) Declare InitPBMap(window)
Declare SetOption(Option.s, Value.s) Declare SetOption(Option.s, Value.s)
Declare.s GetOption(Option.s)
Declare LoadOptions(PreferencesFile.s = "PBMap.prefs") Declare LoadOptions(PreferencesFile.s = "PBMap.prefs")
Declare SaveOptions(PreferencesFile.s = "PBMap.prefs") Declare SaveOptions(PreferencesFile.s = "PBMap.prefs")
Declare.i AddOSMServerLayer(LayerName.s, Order.i, ServerURL.s = "http://tile.openstreetmap.org/") Declare.i AddOSMServerLayer(LayerName.s, Order.i, ServerURL.s = "http://tile.openstreetmap.org/")
@@ -289,7 +290,7 @@ Module PBMap
;-*** Global variables ;-*** Global variables
;-Show debug infos ;-Show debug infos
Global MyDebugLevel = 0 Global MyDebugLevel = 3
Global PBMap.PBMap, Null.i Global PBMap.PBMap, Null.i
Global slash.s Global slash.s
@@ -353,6 +354,8 @@ Module PBMap
EndMacro EndMacro
CompilerEndSelect CompilerEndSelect
;Creates a full tree
;by Thomas (ts-soft) Schulz
Procedure CreateDirectoryEx(DirectoryName.s, FileAttribute = #PB_Default) Procedure CreateDirectoryEx(DirectoryName.s, FileAttribute = #PB_Default)
Protected i, c, tmp.s Protected i, c, tmp.s
If Right(DirectoryName, 1) = slash If Right(DirectoryName, 1) = slash
@@ -555,7 +558,7 @@ Module PBMap
EndIf EndIf
EndProcedure EndProcedure
Procedure IsInDrawingBoundaries(*Drawing.DrawingParameters, *Position.GeographicCoordinates) Procedure.i IsInDrawingBoundaries(*Drawing.DrawingParameters, *Position.GeographicCoordinates)
Protected Lat.d = *Position\Latitude, Lon.d = *Position\Longitude Protected Lat.d = *Position\Latitude, Lon.d = *Position\Longitude
Protected LatNW.d = *Drawing\Bounds\NorthWest\Latitude, LonNW.d = *Drawing\Bounds\NorthWest\Longitude Protected LatNW.d = *Drawing\Bounds\NorthWest\Latitude, LonNW.d = *Drawing\Bounds\NorthWest\Longitude
Protected LatSE.d = *Drawing\Bounds\SouthEast\Latitude, LonSE.d = *Drawing\Bounds\SouthEast\Longitude Protected LatSE.d = *Drawing\Bounds\SouthEast\Latitude, LonSE.d = *Drawing\Bounds\SouthEast\Longitude
@@ -608,8 +611,27 @@ Module PBMap
EndIf EndIf
EndProcedure EndProcedure
Procedure.s Value2ColourString(Value.i)
ProcedureReturn "$" + StrU(Red(Value), #PB_Byte) + StrU(Green(Value), #PB_Byte) + StrU(Blue(Value), #PB_Byte)
EndProcedure
;-*** Options ;-*** Options
Procedure SetOptions()
With PBMap\Options
If \Proxy
HTTPProxy(PBMap\Options\ProxyURL + ":" + PBMap\Options\ProxyPort, PBMap\Options\ProxyUser, PBMap\Options\ProxyPassword)
EndIf
If \Verbose
OpenConsole()
EndIf
CreateDirectoryEx(\HDDCachePath)
If \DefaultOSMServer <> "" And IsLayer("OSM") = #False ;First time creation of the basis OSM layer
AddOSMServerLayer("OSM", 1, \DefaultOSMServer)
EndIf
EndWith
EndProcedure
Macro SelBool(Name) Macro SelBool(Name)
Select UCase(Value) Select UCase(Value)
Case "0", "FALSE", "DISABLE" Case "0", "FALSE", "DISABLE"
@@ -671,6 +693,72 @@ Module PBMap
Case "colourtrackdefault" Case "colourtrackdefault"
PBMap\Options\ColourTrackDefault = ColourString2Value(Value) PBMap\Options\ColourTrackDefault = ColourString2Value(Value)
EndSelect EndSelect
SetOptions()
EndProcedure
Procedure.s GetBoolString(Value.i)
Select Value
Case #False
ProcedureReturn "0"
Default
ProcedureReturn "1"
EndSelect
EndProcedure
Procedure.s GetOption(Option.s)
Option = StringCheck(Option)
With PBMap\Options
Select LCase(Option)
Case "proxy"
ProcedureReturn GetBoolString(\Proxy)
Case "proxyurl"
ProcedureReturn \ProxyURL
Case "proxyport"
ProcedureReturn \ProxyPort
Case "proxyuser"
ProcedureReturn \ProxyUser
Case "appid"
ProcedureReturn \appid
Case "appcode"
ProcedureReturn \appcode
Case "tilescachepath"
ProcedureReturn \HDDCachePath
Case "maxmemcache"
ProcedureReturn StrU(\MaxMemCache)
Case "verbose"
ProcedureReturn GetBoolString(\Verbose)
Case "warning"
ProcedureReturn GetBoolString(\Warning)
Case "wheelmouserelative"
ProcedureReturn GetBoolString(\WheelMouseRelative)
Case "showdegrees"
ProcedureReturn GetBoolString(\ShowDegrees)
Case "showdebuginfos"
ProcedureReturn GetBoolString(\ShowDebugInfos)
Case "showscale"
ProcedureReturn GetBoolString(\ShowScale)
Case "showmarkers"
ProcedureReturn GetBoolString(\ShowMarkers)
Case "showpointer"
ProcedureReturn GetBoolString(\ShowPointer)
Case "showtrack"
ProcedureReturn GetBoolString(\ShowTrack)
Case "showmarkersnb"
ProcedureReturn GetBoolString(\ShowMarkersNb)
Case "showmarkerslegend"
ProcedureReturn GetBoolString(\ShowMarkersLegend)
Case "showtrackkms"
ProcedureReturn GetBoolString(\ShowTrackKms)
Case "strokewidthtrackdefault"
ProcedureReturn GetBoolString(\StrokeWidthTrackDefault)
Case "colourfocus"
ProcedureReturn Value2ColourString(\ColourFocus)
Case "colourselected"
ProcedureReturn Value2ColourString(\ColourSelected)
Case "colourtrackdefault"
ProcedureReturn Value2ColourString(\ColourTrackDefault)
EndSelect
EndWith
EndProcedure EndProcedure
;By default, save options in the user's home directory ;By default, save options in the user's home directory
@@ -743,14 +831,14 @@ Module PBMap
PreferenceGroup("PROXY") PreferenceGroup("PROXY")
\Proxy = ReadPreferenceInteger("Proxy", #False) \Proxy = ReadPreferenceInteger("Proxy", #False)
If \Proxy If \Proxy
\ProxyURL = ReadPreferenceString("ProxyURL", "") ;InputRequester("ProxyServer", "Do you use a Proxy Server? Then enter the full url:", "") \ProxyURL = ReadPreferenceString("ProxyURL", "") ; = InputRequester("ProxyServer", "Do you use a Proxy Server? Then enter the full url:", "")
\ProxyPort = ReadPreferenceString("ProxyPort", "") ;InputRequester("ProxyPort" , "Do you use a specific port? Then enter it", "") \ProxyPort = ReadPreferenceString("ProxyPort", "") ; = InputRequester("ProxyPort" , "Do you use a specific port? Then enter it", "")
\ProxyUser = ReadPreferenceString("ProxyUser", "") ;InputRequester("ProxyUser" , "Do you use a user name? Then enter it", "") \ProxyUser = ReadPreferenceString("ProxyUser", "") ; = InputRequester("ProxyUser" , "Do you use a user name? Then enter it", "")
\ProxyPassword = ReadPreferenceString("ProxyPass", "") ;InputRequester("ProxyPass", "Do you use a password ? Then enter it", "") ;TODO \ProxyPassword = ReadPreferenceString("ProxyPass", "") ; = InputRequester("ProxyPass", "Do you use a password ? Then enter it", "") ;TODO
EndIf EndIf
PreferenceGroup("HERE") PreferenceGroup("HERE")
\appid = ReadPreferenceString("APP_ID", "") ;InputRequester("Here App ID", "Do you use HERE ? Enter app ID", "") ;TODO \appid = ReadPreferenceString("APP_ID", "") ; = InputRequester("Here App ID", "Do you use HERE ? Enter app ID", "") ;TODO
\appcode = ReadPreferenceString("APP_CODE", "") ;InputRequester("Here App Code", "Do you use HERE ? Enter app Code", "") ;TODO \appcode = ReadPreferenceString("APP_CODE", "") ; = InputRequester("Here App Code", "Do you use HERE ? Enter app Code", "") ;TODO
PreferenceGroup("URL") PreferenceGroup("URL")
\DefaultOSMServer = ReadPreferenceString("DefaultOSMServer", "http://tile.openstreetmap.org/") \DefaultOSMServer = ReadPreferenceString("DefaultOSMServer", "http://tile.openstreetmap.org/")
@@ -779,6 +867,7 @@ Module PBMap
\TimerInterval = 20 \TimerInterval = 20
ClosePreferences() ClosePreferences()
EndWith EndWith
SetOptions()
EndProcedure EndProcedure
;-*** Layers ;-*** Layers
@@ -875,13 +964,15 @@ Module PBMap
Procedure.i GetTileFromHDD(CacheFile.s) Procedure.i GetTileFromHDD(CacheFile.s)
Protected nImage.i Protected nImage.i
If FileSize(CacheFile) > 0 If FileSize(CacheFile) <> -1
nImage = LoadImage(#PB_Any, CacheFile) nImage = LoadImage(#PB_Any, CacheFile)
If IsImage(nImage) If IsImage(nImage)
MyDebug("Success loading " + CacheFile + " as nImage " + Str(nImage), 3) MyDebug("Success loading " + CacheFile + " as nImage " + Str(nImage), 3)
ProcedureReturn nImage ProcedureReturn nImage
Else Else
MyDebug("Failed loading " + CacheFile + " as nImage " + Str(nImage) + " -> not an image !", 3) MyDebug("Failed loading " + CacheFile + " as nImage " + Str(nImage) + " -> not an image !", 3)
MyDebug("Deleting faulty image file " + CacheFile, 3)
DeleteFile(CacheFile)
EndIf EndIf
Else Else
MyDebug("Failed loading " + CacheFile + " -> Size <= 0", 3) MyDebug("Failed loading " + CacheFile + " -> Size <= 0", 3)
@@ -893,9 +984,6 @@ Module PBMap
Protected *Buffer Protected *Buffer
Protected nImage.i = -1 Protected nImage.i = -1
Protected FileSize.i, timg Protected FileSize.i, timg
If PBMap\Options\Proxy
HTTPProxy(PBMap\Options\ProxyURL + ":" + PBMap\Options\ProxyPort, PBMap\Options\ProxyUser, PBMap\Options\ProxyPassword)
EndIf
FileSize = ReceiveHTTPFile(TileURL, CacheFile) FileSize = ReceiveHTTPFile(TileURL, CacheFile)
If FileSize > 0 If FileSize > 0
MyDebug("Loaded from web " + TileURL + " as CacheFile " + CacheFile, 3) MyDebug("Loaded from web " + TileURL + " as CacheFile " + CacheFile, 3)
@@ -936,7 +1024,7 @@ Module PBMap
MyDebug("Image key : " + *Tile\key + " web image loaded", 3) MyDebug("Image key : " + *Tile\key + " web image loaded", 3)
*Tile\RetryNb = 0 *Tile\RetryNb = 0
Else Else
MyDebug("Image key : " + *Tile\key + " web image not correctly loaded", 3) MyDebug("Image key : " + *Tile\key + " web image not correctly loaded, will retry in 2 secs", 3)
Delay(2000) Delay(2000)
*Tile\RetryNb - 1 *Tile\RetryNb - 1
EndIf EndIf
@@ -2235,7 +2323,7 @@ Module PBMap
Procedure InitPBMap(Window) Procedure InitPBMap(Window)
Protected Result.i Protected Result.i
PBMap\ZoomMin = 0 PBMap\ZoomMin = 1
PBMap\ZoomMax = 18 PBMap\ZoomMax = 18
PBMap\Dragging = #False PBMap\Dragging = #False
PBMap\TileSize = 256 PBMap\TileSize = 256
@@ -2246,13 +2334,6 @@ Module PBMap
PBMap\Timer = 1 PBMap\Timer = 1
PBMap\Mode = #MODE_DEFAULT PBMap\Mode = #MODE_DEFAULT
LoadOptions() LoadOptions()
If PBMap\Options\Verbose
OpenConsole()
EndIf
CreateDirectoryEx(PBMap\Options\HDDCachePath)
If PBMap\Options\DefaultOSMServer <> ""
AddOSMServerLayer("OSM", 1, PBMap\Options\DefaultOSMServer)
EndIf
TechnicalImagesCreation() TechnicalImagesCreation()
SetLocation(0, 0) SetLocation(0, 0)
EndProcedure EndProcedure
@@ -2418,6 +2499,7 @@ CompilerIf #PB_Compiler_IsMainFile
PBMap::InitPBMap(#Window_0) PBMap::InitPBMap(#Window_0)
PBMap::SetOption("ShowDegrees", "0") : Degrees = 0 PBMap::SetOption("ShowDegrees", "0") : Degrees = 0
PBMap::SetOption("ShowDebugInfos", "0") PBMap::SetOption("ShowDebugInfos", "0")
PBMap::SetOption("Verbose", "0")
PBMap::SetOption("ShowScale", "1") PBMap::SetOption("ShowScale", "1")
PBMap::SetOption("Warning", "1") PBMap::SetOption("Warning", "1")
PBMap::SetOption("ShowMarkersLegend", "1") PBMap::SetOption("ShowMarkersLegend", "1")
@@ -2481,8 +2563,12 @@ CompilerIf #PB_Compiler_IsMainFile
PBMap::DeleteLayer("Here") PBMap::DeleteLayer("Here")
SetGadgetState(#Gdt_AddHereMap, 0) SetGadgetState(#Gdt_AddHereMap, 0)
Else Else
MessageRequester("Info", "Don't forget to register on HERE and change the line 2485 or edit options file") If PBMap::GetOption("appid") <> "" And PBMap::GetOption("appcode") <> ""
PBMap::AddHereServerLayer("Here", 2) ; Add a "HERE" overlay map on layer nb 2
Else
MessageRequester("Info", "Don't forget to register on HERE and change the following line or edit options file")
PBMap::AddHereServerLayer("Here", 2, "my_id", "my_code") ; Add a here overlay map on layer nb 2 PBMap::AddHereServerLayer("Here", 2, "my_id", "my_code") ; Add a here overlay map on layer nb 2
EndIf
SetGadgetState(#Gdt_AddHereMap, 1) SetGadgetState(#Gdt_AddHereMap, 1)
EndIf EndIf
PBMap::Refresh() PBMap::Refresh()
@@ -2535,10 +2621,8 @@ CompilerIf #PB_Compiler_IsMainFile
CompilerEndIf CompilerEndIf
; IDE Options = PureBasic 5.60 (Windows - x64) ; IDE Options = PureBasic 5.60 (Windows - x64)
; CursorPosition = 2475 ; CursorPosition = 758
; FirstLine = 2453 ; FirstLine = 733
; Folding = ------------------ ; Folding = -------------------
; EnableThread ; EnableThread
; EnableXP ; EnableXP
; DisableDebugger
; EnableUnicode