From 60647f49282e5d9c5dbda193c5e87628329a30e6 Mon Sep 17 00:00:00 2001 From: thyphoonfr Date: Mon, 3 Jul 2017 23:41:25 +0200 Subject: [PATCH] Change some SetCallBackMarker Fonctionnality replace CallFunctionFast(PBMap\CallBackMarker, @PBMap\Markers()\GeographicCoordinates) by CallFunctionFast(PBMap\CallBackMarker, @PBMap\Markers()) To use Marker identifier if necessary move "Marker" and "GeographicCoordinates" from Module to DeclareModule. I need it's public to read easly data send to callback function. --- PBMap.pb | 2134 ++++++++++++++++++++++++++++++++++-------------------- 1 file changed, 1354 insertions(+), 780 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index 950d7f9..4b213eb 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -1,18 +1,18 @@ -;******************************************************************** +; ******************************************************************** ; Program: PBMap ; Description: Permits the use of tiled maps like ; OpenStreetMap in a handy PureBASIC module -; Author: Thyphoon, djes And Idle -; Date: March, 2017 +; Author: Thyphoon, djes, Idle, yves86 +; Date: June, 2017 ; License: PBMap : Free, unrestricted, credit -; appreciated but not required. -; OSM : see http://www.openstreetmap.org/copyright +; appreciated but not required. +; OSM : see http://www.openstreetmap.org/copyright ; Note: Please share improvement ! -; Thanks: Progi1984, yves86 -;******************************************************************** +; Thanks: Progi1984 +; ******************************************************************** CompilerIf #PB_Compiler_Thread = #False - MessageRequester("Warning !!","You must enable ThreadSafe support in compiler options",#PB_MessageRequester_Ok ) + MessageRequester("Warning !", "You must enable ThreadSafe support in compiler options", #PB_MessageRequester_Ok ) End CompilerEndIf @@ -20,25 +20,18 @@ EnableExplicit InitNetwork() UsePNGImageDecoder() +UseJPEGImageDecoder() UsePNGImageEncoder() +UseJPEGImageEncoder() + +;- Module declaration DeclareModule PBMap - ;-Show debug infos - Global MyDebugLevel = 0 CompilerIf #PB_Compiler_OS = #PB_OS_Linux #Red = 255 CompilerEndIf - Global slash.s - - CompilerSelect #PB_Compiler_OS - CompilerCase #PB_OS_Windows - slash = "\" - CompilerDefault - slash = "/" - CompilerEndSelect - #SCALE_NAUTICAL = 1 #SCALE_KM = 0 @@ -49,25 +42,63 @@ DeclareModule PBMap #MARKER_EDIT_EVENT = #PB_Event_FirstCustomValue - ;-Declarations + #PB_MAP_REDRAW = #PB_EventType_FirstCustomValue + 1 + #PB_MAP_RETRY = #PB_EventType_FirstCustomValue + 2 + #PB_MAP_TILE_CLEANUP = #PB_EventType_FirstCustomValue + 3 + + Structure GeographicCoordinates + Longitude.d + Latitude.d + EndStructure + + Structure Marker + GeographicCoordinates.GeographicCoordinates ; Marker latitude and longitude + Identifier.s + Legend.s + Color.l ; Marker color + Focus.i + Selected.i ; Is the marker selected ? + CallBackPointer.i ; @Procedure(X.i, Y.i) to DrawPointer (you must use VectorDrawing lib) + EditWindow.i + EndStructure + + Declare InitPBMap(window) + Declare SetDebugLevel(level.i) Declare SetOption(Option.s, Value.s) + Declare.s GetOption(Option.s) Declare LoadOptions(PreferencesFile.s = "PBMap.prefs") Declare SaveOptions(PreferencesFile.s = "PBMap.prefs") - Declare.i AddMapServerLayer(LayerName.s, Order.i, ServerURL.s = "http://tile.openstreetmap.org/", TileSize = 256, ZoomMin = 0, ZoomMax = 18) - Declare DeleteLayer(Nb.i) + Declare.i AddOSMServerLayer(LayerName.s, Order.i, ServerURL.s = "http://tile.openstreetmap.org/") + Declare.i AddHereServerLayer(LayerName.s, Order.i, APP_ID.s = "", APP_CODE.s = "", ServerURL.s = "aerial.maps.api.here.com", path.s = "/maptile/2.1/", ressource.s = "maptile", id.s = "newest", scheme.s = "satellite.day", format.s = "jpg", lg.s = "eng", lg2.s = "eng", param.s = "") + Declare.i AddGeoServerLayer(LayerName.s, Order.i, ServerLayerName.s, ServerURL.s = "http://localhost:8080/", path.s = "geowebcache/service/gmaps", format.s = "image/png") + Declare IsLayer(Name.s) + Declare DeleteLayer(Name.s) + Declare EnableLayer(Name.s) + Declare DisableLayer(Name.s) + Declare SetLayerAlpha(Name.s, Alpha.d) + Declare.d GetLayerAlpha(Name.s) Declare BindMapGadget(Gadget.i) - Declare MapGadget(Gadget.i, X.i, Y.i, Width.i, Height.i) - Declare SetLocation(latitude.d, longitude.d, Zoom = -1, mode.i = #PB_Absolute) - Declare Drawing() - Declare SetAngle(Angle.d, Mode = #PB_Absolute) - Declare SetZoom(Zoom.i, mode.i = #PB_Relative) - Declare ZoomToArea(MinY.d, MaxY.d, MinX.d, MaxX.d) - Declare ZoomToTracks(*Tracks) Declare SetCallBackLocation(*CallBackLocation) Declare SetCallBackMainPointer(CallBackMainPointer.i) + Declare MapGadget(Gadget.i, X.i, Y.i, Width.i, Height.i) + Declare.d GetLatitude() + Declare.d GetLongitude() + Declare.d GetMouseLatitude() + Declare.d GetMouseLongitude() + Declare.d GetAngle() + Declare.i GetZoom() + Declare.i GetMode() + Declare SetMode(Mode.i = #MODE_DEFAULT) Declare SetMapScaleUnit(ScaleUnit=PBMAP::#SCALE_KM) - Declare.i LoadGpxFile(file.s); + Declare SetLocation(latitude.d, longitude.d, Zoom = -1, mode.i = #PB_Absolute) + Declare SetAngle(Angle.d, Mode = #PB_Absolute) + Declare SetZoom(Zoom.i, mode.i = #PB_Relative) + Declare SetZoomToArea(MinY.d, MaxY.d, MinX.d, MaxX.d) + Declare SetZoomToTracks(*Tracks) + Declare NominatimGeoLocationQuery(Address.s, *ReturnPosition = 0) ; Send back the position *ptr.GeographicCoordinates + Declare.i LoadGpxFile(FileName.s) ; + Declare.i SaveGpxFile(FileName.s, *Track) ; Declare ClearTracks() Declare DeleteTrack(*Ptr) Declare DeleteSelectedTracks() @@ -76,29 +107,24 @@ DeclareModule PBMap Declare ClearMarkers() Declare DeleteMarker(*Ptr) Declare DeleteSelectedMarkers() + Declare Drawing() Declare Quit() + Declare FatalError(msg.s) Declare Error(msg.s) Declare Refresh() - Declare.d GetLatitude() - Declare.d GetLongitude() - Declare.d MouseLatitude() - Declare.d MouseLongitude() - Declare.d GetAngle() - Declare.i GetZoom() - Declare.i GetMode() - Declare SetMode(Mode.i = #MODE_DEFAULT) - Declare NominatimGeoLocationQuery(Address.s, *ReturnPosition= 0) ;Send back the position *ptr.GeographicCoordinates Declare.i ClearDiskCache() + Declare SetCallBackMarker(*CallBackLocation) + Declare SetCallBackLeftClic(*CallBackLocation) + EndDeclareModule Module PBMap EnableExplicit - Structure GeographicCoordinates - Longitude.d - Latitude.d - EndStructure + ;-*** Structures + + Structure PixelCoordinates x.d @@ -110,14 +136,15 @@ Module PBMap y.d EndStructure - ;- Tile Structure Structure Tile nImage.i key.s URL.s CacheFile.s GetImageThread.i - RetryNb.i + Download.i + Time.i + Size.i EndStructure Structure BoundingBox @@ -145,8 +172,9 @@ Module PBMap Structure ImgMemCach nImage.i + Size.i *Tile.Tile - TimeStackPosition.i + *TimeStackPtr Alpha.i EndStructure @@ -159,16 +187,7 @@ Module PBMap List ImagesTimeStack.ImgMemCachKey() ; Usage of the tile (first = older) EndStructure - Structure Marker - GeographicCoordinates.GeographicCoordinates ; Marker latitude and longitude - Identifier.s - Legend.s - Color.l ; Marker color - Focus.i - Selected.i ; Is the marker selected ? - CallBackPointer.i ; @Procedure(X.i, Y.i) to DrawPointer (you must use VectorDrawing lib) - EditWindow.i - EndStructure + ;-Options Structure Option @@ -181,7 +200,8 @@ Module PBMap ProxyPort.s ProxyUser.s ProxyPassword.s - ShowDegrees.i + ShowDegrees.i + ShowZoom.i ShowDebugInfos.i ShowScale.i ShowTrack.i @@ -190,22 +210,47 @@ Module PBMap ShowPointer.i TimerInterval.i MaxMemCache.i ; in MiB + MaxThreads.i ; Maximum simultaneous web loading threads + MaxDownloadSlots.i ; Maximum simultaneous download slots + TileLifetime.i Verbose.i ; Maximum debug informations Warning.i ; Warning requesters ShowMarkersNb.i ShowMarkersLegend.i - ;Drawing stuff + ShowTrackSelection.i ; YA to show or not track selection + ; Drawing stuff StrokeWidthTrackDefault.i - ;Colours + ; Colours ColourFocus.i ColourSelected.i ColourTrackDefault.i + ; HERE specific + appid.s + appcode.s EndStructure Structure Layer Order.i ; Layer nb Name.s ServerURL.s ; Web URL ex: http://tile.openstreetmap.org/ + path.s + LayerType.i ; OSM : 0 ; Here : 1 + Enabled.i + Alpha.d ; 1 : opaque ; 0 : transparent + format.s + ; > HERE specific params + APP_ID.s + APP_CODE.s + ressource.s + param.s + id.s + scheme.s + lg.s + lg2.s + ; < + ; > GeoServer specific params + ServerLayerName.s + ; < EndStructure Structure Box @@ -225,7 +270,7 @@ Module PBMap StrokeWidth.i EndStructure - ;-PBMap Structure + ;- PBMap Structure PBMap Window.i ; Parent Window Gadget.i ; Canvas Gadget Id @@ -237,11 +282,14 @@ Module PBMap CallBackLocation.i ; @Procedure(latitude.d,lontitude.d) CallBackMainPointer.i ; @Procedure(X.i, Y.i) to DrawPointer (you must use VectorDrawing lib) + CallBackMarker.i ; @Procedure (latitude.d,lontitude.d) pour connaitre la nouvelle position du marqueur (YA) + CallBackLeftClic.i ; @Procdeure (latitude.d,lontitude.d) pour connaitre la position lors du clic gauche (YA) PixelCoordinates.PixelCoordinates ; Actual focus point coords in pixels (global) MoveStartingPoint.PixelCoordinates ; Start mouse position coords when dragging the map - List Layers.Layer() ; + List LayersList.Layer() + Map *Layers.Layer() Angle.d ZoomMin.i ; Min Zoom supported by server @@ -251,11 +299,16 @@ Module PBMap MemCache.TileMemCach ; Images in memory cache + ThreadsNB.i ; Current web threads nb + Mode.i ; User mode : 0 (default)->hand (moving map) and select markers, 1->hand, 2->select only (moving objects), 3->drawing (todo) Redraw.i - Moving.i + Dragging.i Dirty.i ; To signal that drawing need a refresh + MemoryCacheAccessMutex.i ; Memorycache access variable mutual exclusion + DownloadSlots.i ; Actual nb of used download slots + List TracksList.Tracks() ; To display a GPX track List Markers.Marker() ; To diplay marker EditMarker.l @@ -267,33 +320,114 @@ Module PBMap EndStructure - #PB_MAP_REDRAW = #PB_EventType_FirstCustomValue + 1 - #PB_MAP_RETRY = #PB_EventType_FirstCustomValue + 2 - #PB_MAP_TILE_CLEANUP = #PB_EventType_FirstCustomValue + 3 + ;-*** Global variables - ;-Global variables - Global PBMap.PBMap, Null.i + ;-Show debug infos + Global MyDebugLevel = 5 - ;Shows an error msg and terminates the program - Procedure Error(msg.s) - MessageRequester("PBMap", msg, #PB_MessageRequester_Ok) + Global PBMap.PBMap, Null.i, NullPtrMem.i, *NullPtr = @NullPtrMem + Global slash.s + + CompilerSelect #PB_Compiler_OS + CompilerCase #PB_OS_Windows + Global slash = "\" + CompilerDefault + Global slash = "/" + CompilerEndSelect + + ;- *** GetText - Translation purpose + + ; TODO use this for all text + IncludeFile "gettext.pbi" + + ;-*** Misc tools + + 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 + + ;-Error management + + ; Shows an error msg and terminates the program + Procedure FatalError(msg.s) + If PBMap\Options\Warning + MessageRequester("PBMap", msg, #PB_MessageRequester_Ok) + EndIf End EndProcedure - ;Send debug infos to stdout (allowing mixed debug infos with curl or other libs) + ; Shows an error msg + Procedure Error(msg.s) + If PBMap\Options\Warning + MessageRequester("PBMap", msg, #PB_MessageRequester_Ok) + EndIf + EndProcedure + + ; Set the debug level allowing more or less debug infos + Procedure SetDebugLevel(level.i) + MyDebugLevel = level + EndProcedure + + ; Send debug infos to stdout (allowing mixed debug infos with curl or other libs) Procedure MyDebug(msg.s, DbgLevel = 0) - If PBMap\Options\Verbose And DbgLevel >= MyDebugLevel + If PBMap\Options\Verbose And DbgLevel <= MyDebugLevel PrintN(msg) - ;Debug msg + ; Debug msg EndIf EndProcedure - ;- *** GetText - Translation purpose - ;TODO use this for all text - IncludeFile "gettext.pbi" + ; Creates a full tree + ; by Thomas (ts-soft) Schulz + ; http://www.purebasic.fr/english/viewtopic.php?f=12&t=58657&hilit=createdirectory&view=unread#unread + CompilerSelect #PB_Compiler_OS + CompilerCase #PB_OS_Windows + #FILE_ATTRIBUTE_DEVICE = 64 ; (0x40) + #FILE_ATTRIBUTE_INTEGRITY_STREAM = 32768 ; (0x8000) + #FILE_ATTRIBUTE_NOT_CONTENT_INDEXED = 8192; (0x2000) + #FILE_ATTRIBUTE_NO_SCRUB_DATA = 131072; (0x20000) + #FILE_ATTRIBUTE_VIRTUAL = 65536; (0x10000) + #FILE_ATTRIBUTE_DONTSETFLAGS = ~(#FILE_ATTRIBUTE_DIRECTORY| + #FILE_ATTRIBUTE_SPARSE_FILE| + #FILE_ATTRIBUTE_OFFLINE| + #FILE_ATTRIBUTE_NOT_CONTENT_INDEXED| + #FILE_ATTRIBUTE_VIRTUAL| + 0) + Macro SetFileAttributesEx(Name, Attribs) + SetFileAttributes(Name, Attribs & #FILE_ATTRIBUTE_DONTSETFLAGS) + EndMacro + CompilerDefault + Macro SetFileAttributesEx(Name, Attribs) + SetFileAttributes(Name, Attribs) + EndMacro + CompilerEndSelect + + Procedure CreateDirectoryEx(DirectoryName.s, FileAttribute = #PB_Default) + Protected i, c, tmp.s + If Right(DirectoryName, 1) = slash + DirectoryName = Left(DirectoryName, Len(DirectoryName) -1) + EndIf + c = CountString(DirectoryName, slash) + 1 + For i = 1 To c + tmp + StringField(DirectoryName, i, slash) + If FileSize(tmp) <> -2 + CreateDirectory(tmp) + EndIf + tmp + slash + Next + If FileAttribute <> #PB_Default + SetFileAttributesEx(DirectoryName, FileAttribute) + EndIf + If FileSize(DirectoryName) = -2 + ProcedureReturn #True + EndIf + EndProcedure Procedure TechnicalImagesCreation() - ;"Loading" image + ; "Loading" image Protected LoadingText$ = "Loading" Protected NothingText$ = "Nothing" PBmap\ImgLoading = CreateImage(#PB_Any, 256, 256) @@ -311,283 +445,46 @@ Module PBMap EndVectorLayer() StopVectorDrawing() EndIf - ;"Nothing" tile + ; "Nothing" tile PBmap\ImgNothing = CreateImage(#PB_Any, 256, 256) If PBmap\ImgNothing StartVectorDrawing(ImageVectorOutput(PBMap\ImgNothing)) - ;BeginVectorLayer() + ; BeginVectorLayer() VectorSourceColor(RGBA(220, 230, 255, 255)) AddPathBox(0, 0, 256, 256) FillPath() - ;MovePathCursor(0, 0) - ;VectorFont(FontID(PBMap\Font), 256 / 20) - ;VectorSourceColor(RGBA(150, 150, 150, 255)) - ;MovePathCursor(0 + (256 - VectorTextWidth(NothingText$)) / 2, 0 + (256 - VectorTextHeight(NothingText$)) / 2) - ;DrawVectorText(NothingText$) - ;EndVectorLayer() + ; MovePathCursor(0, 0) + ; VectorFont(FontID(PBMap\Font), 256 / 20) + ; VectorSourceColor(RGBA(150, 150, 150, 255)) + ; MovePathCursor(0 + (256 - VectorTextWidth(NothingText$)) / 2, 0 + (256 - VectorTextHeight(NothingText$)) / 2) + ; DrawVectorText(NothingText$) + ; EndVectorLayer() StopVectorDrawing() EndIf EndProcedure - ;TODO : best cleaning of the string from bad behaviour - Procedure.s StringCheck(String.s) - ProcedureReturn Trim(RemoveString(RemoveString(RemoveString(RemoveString(RemoveString(RemoveString(RemoveString(RemoveString(RemoveString(RemoveString(String, Chr(0)), Chr(32)), Chr(39)), Chr(33)), Chr(34)), "@"), "/"), "\"), "$"), "%")) - EndProcedure - - Macro SelBool(Name) - Select UCase(Value) - Case "0", "FALSE", "DISABLE" - PBMap\Options\Name = #False - Default - PBMap\Options\Name = #True - EndSelect - EndMacro - - Procedure.i ColourString2Value(Value.s) - ;TODO : better string check - Protected Col.s = RemoveString(Value, " ") - If Left(Col, 1) = "$" - Protected r.i, g.i, b.i, a.i = 255 - Select Len(Col) - Case 4 ;RGB (eg : "$9BC" - r = Val("$"+Mid(Col, 2, 1)) : g = Val("$"+Mid(Col, 3, 1)) : b = Val("$"+Mid(Col, 4, 1)) - Case 5 ;RGBA (eg : "$9BC5") - r = Val("$"+Mid(Col, 2, 1)) : g = Val("$"+Mid(Col, 3, 1)) : b = Val("$"+Mid(Col, 4, 1)) : a = Val("$"+Mid(Col, 5, 1)) - Case 7 ;RRGGBB (eg : "$95B4C2") - r = Val("$"+Mid(Col, 2, 2)) : g = Val("$"+Mid(Col, 4, 2)) : b = Val("$"+Mid(Col, 6, 2)) - Case 9 ;RRGGBBAA (eg : "$95B4C249") - r = Val("$"+Mid(Col, 2, 2)) : g = Val("$"+Mid(Col, 4, 2)) : b = Val("$"+Mid(Col, 6, 2)) : a = Val("$"+Mid(Col, 8, 2)) - EndSelect - ProcedureReturn RGBA(r, g, b, a) - Else - ProcedureReturn Val(Value) - EndIf - EndProcedure - - Procedure SetOption(Option.s, Value.s) - Option = StringCheck(Option) - Select LCase(Option) - Case "proxy" - SelBool(Proxy) - Case "proxyurl" - PBMap\Options\ProxyURL = Value - Case "proxyport" - PBMap\Options\ProxyPort = Value - Case "proxyuser" - PBMap\Options\ProxyUser = Value - Case "tilescachepath" - PBMap\Options\HDDCachePath = Value - Case "maxmemcache" - PBMap\Options\MaxMemCache = Val(Value) - Case "verbose" - SelBool(Verbose) - Case "warning" - SelBool(Warning) - Case "wheelmouserelative" - SelBool(WheelMouseRelative) - Case "showdegrees" - SelBool(ShowDegrees) - Case "showdebuginfos" - SelBool(ShowDebugInfos) - Case "showscale" - SelBool(ShowScale) - Case "showmarkers" - SelBool(ShowMarkers) - Case "showpointer" - SelBool(ShowPointer) - Case "showtrack" - SelBool(ShowTrack) - Case "showmarkersnb" - SelBool(ShowMarkersNb) - Case "showmarkerslegend" - SelBool(ShowMarkersLegend) - Case "showtrackkms" - SelBool(ShowTrackKms) - Case "strokewidthtrackdefault" - SelBool(StrokeWidthTrackDefault) - Case "colourfocus" - PBMap\Options\ColourFocus = ColourString2Value(Value) - Case "colourselected" - PBMap\Options\ColourSelected = ColourString2Value(Value) - Case "colourtrackdefault" - PBMap\Options\ColourTrackDefault = ColourString2Value(Value) - EndSelect - EndProcedure - - ;By default, save options in the user's home directory - Procedure SaveOptions(PreferencesFile.s = "PBMap.prefs") - If PreferencesFile = "PBMap.prefs" - CreatePreferences(GetHomeDirectory() + "PBMap.prefs") - Else - CreatePreferences(PreferencesFile) - EndIf - With PBMap\Options - PreferenceGroup("PROXY") - WritePreferenceInteger("Proxy", \Proxy) - WritePreferenceString("ProxyURL", \ProxyURL) - WritePreferenceString("ProxyPort", \ProxyPort) - WritePreferenceString("ProxyUser", \ProxyUser) - PreferenceGroup("URL") - WritePreferenceString("DefaultOSMServer", \DefaultOSMServer) - PreferenceGroup("PATHS") - WritePreferenceString("TilesCachePath", \HDDCachePath) - PreferenceGroup("OPTIONS") - WritePreferenceInteger("WheelMouseRelative", \WheelMouseRelative) - WritePreferenceInteger("MaxMemCache", \MaxMemCache) - WritePreferenceInteger("Verbose", \Verbose) - WritePreferenceInteger("Warning", \Warning) - WritePreferenceInteger("ShowDegrees", \ShowDegrees) - WritePreferenceInteger("ShowDebugInfos", \ShowDebugInfos) - WritePreferenceInteger("ShowScale", \ShowScale) - WritePreferenceInteger("ShowMarkers", \ShowMarkers) - WritePreferenceInteger("ShowPointer", \ShowPointer) - WritePreferenceInteger("ShowTrack", \ShowTrack) - WritePreferenceInteger("ShowTrackKms", \ShowTrackKms) - WritePreferenceInteger("ShowMarkersNb", \ShowMarkersNb) - WritePreferenceInteger("ShowMarkersLegend", \ShowMarkersLegend) - PreferenceGroup("DRAWING") - WritePreferenceInteger("StrokeWidthTrackDefault", \StrokeWidthTrackDefault) - ;Colours; - WritePreferenceInteger("ColourFocus", \ColourFocus) - WritePreferenceInteger("ColourSelected", \ColourSelected) - WritePreferenceInteger("ColourTrackDefault", \ColourTrackDefault) - ClosePreferences() - EndWith - EndProcedure - - Procedure LoadOptions(PreferencesFile.s = "PBMap.prefs") - If PreferencesFile = "PBMap.prefs" - OpenPreferences(GetHomeDirectory() + "PBMap.prefs") - Else - OpenPreferences(PreferencesFile) - EndIf - ;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() - With PBMap\Options - PreferenceGroup("PROXY") - \Proxy = ReadPreferenceInteger("Proxy", #False) - If \Proxy - \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", "") - \ProxyUser = ReadPreferenceString("ProxyUser", "") ;InputRequester("ProxyUser" , "Do you use a user name? Then enter it", "") - \ProxyPassword = InputRequester("ProxyPass", "Do you use a password ? Then enter it", "") ;TODO - EndIf - PreferenceGroup("URL") - \DefaultOSMServer = ReadPreferenceString("DefaultOSMServer", "http://tile.openstreetmap.org/") - - PreferenceGroup("PATHS") - \HDDCachePath = ReadPreferenceString("TilesCachePath", GetTemporaryDirectory() + "PBMap" + slash) - PreferenceGroup("OPTIONS") - \WheelMouseRelative = ReadPreferenceInteger("WheelMouseRelative", #True) - \MaxMemCache = ReadPreferenceInteger("MaxMemCache", 20480) ;20 MiB, about 80 tiles in memory - \Verbose = ReadPreferenceInteger("Verbose", #True) - \Warning = ReadPreferenceInteger("Warning", #False) - \ShowDegrees = ReadPreferenceInteger("ShowDegrees", #False) - \ShowDebugInfos = ReadPreferenceInteger("ShowDebugInfos", #False) - \ShowScale = ReadPreferenceInteger("ShowScale", #False) - \ShowMarkers = ReadPreferenceInteger("ShowMarkers", #True) - \ShowPointer = ReadPreferenceInteger("ShowPointer", #True) - \ShowTrack = ReadPreferenceInteger("ShowTrack", #True) - \ShowTrackKms = ReadPreferenceInteger("ShowTrackKms", #False) - \ShowMarkersNb = ReadPreferenceInteger("ShowMarkersNb", #True) - \ShowMarkersLegend = ReadPreferenceInteger("ShowMarkersLegend", #False) - PreferenceGroup("DRAWING") - \StrokeWidthTrackDefault = ReadPreferenceInteger("StrokeWidthTrackDefault", 10) - PreferenceGroup("COLOURS") - \ColourFocus = ReadPreferenceInteger("ColourFocus", RGBA(255, 255, 0, 255)) - \ColourSelected = ReadPreferenceInteger("ColourSelected", RGBA(225, 225, 0, 255)) - \ColourTrackDefault = ReadPreferenceInteger("ColourTrackDefault", RGBA(0, 255, 0, 150)) - \TimerInterval = 20 - ClosePreferences() - EndWith - EndProcedure - - Procedure.i AddMapServerLayer(LayerName.s, Order.i, ServerURL.s = "http://tile.openstreetmap.org/", TileSize = 256, ZoomMin = 0, ZoomMax = 18) - Protected *Ptr = AddElement(PBMap\Layers()) - If *Ptr - PBMap\Layers()\Name = LayerName - PBMap\Layers()\Order = Order - PBMap\Layers()\ServerURL = ServerURL - SortStructuredList(PBMap\Layers(), #PB_Sort_Ascending, OffsetOf(Layer\Order),TypeOf(Layer\Order)) - ProcedureReturn *Ptr - Else - ProcedureReturn #False - EndIf - EndProcedure - - Procedure DeleteLayer(*Ptr) - ChangeCurrentElement(PBMap\Layers(), *Ptr) - DeleteElement(PBMap\Layers()) - FirstElement(PBMap\Layers()) - SortStructuredList(PBMap\Layers(), #PB_Sort_Ascending, OffsetOf(Layer\Order),TypeOf(Layer\Order)) - EndProcedure - - Procedure Quit() - PBMap\Drawing\End = #True - ;Wait for loading threads to finish nicely. Passed 2 seconds, kills them. - Protected TimeCounter = ElapsedMilliseconds() - Repeat - ForEach PBMap\MemCache\Images() - If PBMap\MemCache\Images()\Tile <> 0 - If IsThread(PBMap\MemCache\Images()\Tile\GetImageThread) - PBMap\MemCache\Images()\Tile\RetryNb = 0 - If ElapsedMilliseconds() - TimeCounter > 2000 - ;Should not occur - KillThread(PBMap\MemCache\Images()\Tile\GetImageThread) - EndIf - Else - FreeMemory(PBMap\MemCache\Images()\Tile) - PBMap\MemCache\Images()\Tile = 0 - EndIf - Else - DeleteMapElement(PBMap\MemCache\Images()) - EndIf - Next - Delay(10) - Until MapSize(PBMap\MemCache\Images()) = 0 - 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 - ;*** Converts coords to tile.decimal - ;Warning, structures used in parameters are not tested + ; *** Converts coords to tile.decimal + ; Warning, structures used in parameters are not tested Procedure LatLon2TileXY(*Location.GeographicCoordinates, *Coords.Coordinates, Zoom) Protected n.d = Pow(2.0, Zoom) Protected LatRad.d = Radian(*Location\Latitude) *Coords\x = n * (Mod( *Location\Longitude + 180.0, 360) / 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), 5) - MyDebug("Coords X : " + Str(*Coords\x) + " ; Y : " + Str(*Coords\y), 5) + MyDebug("Coords X : " + Str(*Coords\x) + " ; Y : " + Str(*Coords\y), 5) EndProcedure - ;*** Converts tile.decimal to coords - ;Warning, structures used in parameters are not tested + ; *** Converts tile.decimal to coords + ; Warning, structures used in parameters are not tested Procedure TileXY2LatLon(*Coords.Coordinates, *Location.GeographicCoordinates, Zoom) Protected n.d = Pow(2.0, Zoom) - ;Ensures the longitude to be in the range [-180;180[ + ; Ensures the longitude to be in the range [-180; 180[ *Location\Longitude = Mod(Mod(*Coords\x / n * 360.0, 360.0) + 360.0, 360.0) - 180 *Location\Latitude = Degree(ATan(SinH(#PI * (1.0 - 2.0 * *Coords\y / n)))) If *Location\Latitude <= -89 @@ -600,7 +497,7 @@ Module PBMap Procedure Pixel2LatLon(*Coords.PixelCoordinates, *Location.GeographicCoordinates, Zoom) Protected n.d = PBMap\TileSize * Pow(2.0, Zoom) - ;Ensures the longitude to be in the range [-180;180[ + ; Ensures the longitude to be in the range [-180; 180[ *Location\Longitude = Mod(Mod(*Coords\x / n * 360.0, 360.0) + 360.0, 360.0) - 180 *Location\Latitude = Degree(ATan(SinH(#PI * (1.0 - 2.0 * *Coords\y / n)))) If *Location\Latitude <= -89 @@ -611,12 +508,12 @@ Module PBMap EndIf EndProcedure - ;Ensures the longitude to be in the range [-180;180[ + ; Ensures the longitude to be in the range [-180; 180[ Procedure.d ClipLongitude(Longitude.d) ProcedureReturn Mod(Mod(Longitude + 180, 360.0) + 360.0, 360.0) - 180 EndProcedure - ;Lat Lon coordinates 2 pixel absolute [0 to 2^Zoom * TileSize [ + ; Lat Lon coordinates 2 pixel absolute [0 to 2^Zoom * TileSize [ Procedure LatLon2Pixel(*Location.GeographicCoordinates, *Pixel.PixelCoordinates, Zoom) Protected tilemax = Pow(2.0, Zoom) * PBMap\TileSize Protected LatRad.d = Radian(*Location\Latitude) @@ -624,7 +521,7 @@ Module PBMap *Pixel\y = tilemax * ( 1.0 - Log(Tan(LatRad) + (1.0/Cos(LatRad))) / #PI ) / 2.0 EndProcedure - ;Lat Lon coordinates 2 pixel relative to the center of view + ; Lat Lon coordinates 2 pixel relative to the center of view Procedure LatLon2PixelRel(*Location.GeographicCoordinates, *Pixel.PixelCoordinates, Zoom) Protected tilemax = Pow(2.0, Zoom) * PBMap\TileSize Protected cx.d = PBMap\Drawing\RadiusX @@ -632,39 +529,52 @@ Module PBMap Protected LatRad.d = Radian(*Location\Latitude) Protected px.d = tilemax * (Mod( *Location\Longitude + 180.0, 360) / 360.0 ) Protected py.d = tilemax * ( 1.0 - Log(Tan(LatRad) + (1.0/Cos(LatRad))) / #PI ) / 2.0 - ;check the x boundaries of the map to adjust the position (coz of the longitude wrapping) + ; check the x boundaries of the map to adjust the position (coz of the longitude wrapping) If dpx - px >= tilemax / 2 - ;Debug "c1" + ; Debug "c1" *Pixel\x = cx + (px - dpx + tilemax) ElseIf px - dpx > tilemax / 2 - ;Debug "c2" + ; Debug "c2" *Pixel\x = cx + (px - dpx - tilemax) ElseIf px - dpx < 0 - ;Debug "c3" + ; Debug "c3" *Pixel\x = cx - (dpx - px) Else - ;Debug "c0" + ; Debug "c0" *Pixel\x = cx + (px - dpx) EndIf *Pixel\y = PBMap\Drawing\RadiusY + (py - PBMap\PixelCoordinates\y) EndProcedure + Procedure.d Pixel2Lon(x) + Protected NewX.d = (PBMap\PixelCoordinates\x - PBMap\Drawing\RadiusX + x) / PBMap\TileSize + Protected n.d = Pow(2.0, PBMap\Zoom) + ; double mod is to ensure the longitude to be in the range [-180; 180[ + ProcedureReturn Mod(Mod(NewX / n * 360.0, 360.0) + 360.0, 360.0) - 180 + EndProcedure + + Procedure.d Pixel2Lat(y) + Protected NewY.d = (PBMap\PixelCoordinates\y - PBMap\Drawing\RadiusY + y) / PBMap\TileSize + Protected n.d = Pow(2.0, PBMap\Zoom) + ProcedureReturn Degree(ATan(SinH(#PI * (1.0 - 2.0 * NewY / n)))) + EndProcedure + ; HaversineAlgorithm ; http://andrew.hedges.name/experiments/haversine/ Procedure.d HaversineInKM(*posA.GeographicCoordinates, *posB.GeographicCoordinates) - Protected eQuatorialEarthRadius.d = 6378.1370;6372.795477598; - Protected dlong.d = (*posB\Longitude - *posA\Longitude); - Protected dlat.d = (*posB\Latitude - *posA\Latitude) ; + 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 c.d = ASin(Min(1,Sqr(a))); Protected distance.d = 2*eQuatorialEarthRadius * c - ProcedureReturn distance ; + ProcedureReturn distance ; EndProcedure Procedure.d HaversineInM(*posA.GeographicCoordinates, *posB.GeographicCoordinates) - ProcedureReturn (1000 * HaversineInKM(@*posA,@*posB)); + ProcedureReturn (1000 * HaversineInKM(@*posA,@*posB)); EndProcedure ; No more used, see LatLon2PixelRel @@ -674,15 +584,15 @@ Module PBMap Protected x1.l,y1.l 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 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 x2 = (PBMap\GeographicCoordinates\Longitude+180)*(mapWidth/360) ; convert from degrees To radians - latRad = PBMap\GeographicCoordinates\Latitude*#PI/180; + latRad = PBMap\GeographicCoordinates\Latitude*#PI/180; mercN = Log(Tan((#PI/4)+(latRad/2))) - y2 = (mapHeight/2)-(mapWidth*mercN/(2*#PI)); + y2 = (mapHeight/2)-(mapWidth*mercN/(2*#PI)); *Pixel\x=PBMap\Drawing\RadiusX - (x2-x1) *Pixel\y=PBMap\Drawing\RadiusY - (y2-y1) EndProcedure @@ -697,7 +607,7 @@ Module PBMap EndIf EndProcedure - Procedure IsInDrawingBoundaries(*Drawing.DrawingParameters, *Position.GeographicCoordinates) + Procedure.i IsInDrawingBoundaries(*Drawing.DrawingParameters, *Position.GeographicCoordinates) Protected Lat.d = *Position\Latitude, Lon.d = *Position\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 @@ -724,169 +634,712 @@ Module PBMap EndIf EndProcedure - ;-*** These are threaded + ; TODO : best cleaning of the string from bad behaviour + Procedure.s StringCheck(String.s) + ProcedureReturn Trim(RemoveString(RemoveString(RemoveString(RemoveString(RemoveString(RemoveString(RemoveString(RemoveString(RemoveString(RemoveString(String, Chr(0)), Chr(32)), Chr(39)), Chr(33)), Chr(34)), "@"), "/"), "\"), "$"), "%")) + EndProcedure + + Procedure.i ColourString2Value(Value.s) + ; TODO : better string check + Protected Col.s = RemoveString(Value, " ") + If Left(Col, 1) = "$" + Protected r.i, g.i, b.i, a.i = 255 + Select Len(Col) + Case 4 ; RGB (eg : "$9BC" + r = Val("$"+Mid(Col, 2, 1)) : g = Val("$"+Mid(Col, 3, 1)) : b = Val("$"+Mid(Col, 4, 1)) + Case 5 ; RGBA (eg : "$9BC5") + r = Val("$"+Mid(Col, 2, 1)) : g = Val("$"+Mid(Col, 3, 1)) : b = Val("$"+Mid(Col, 4, 1)) : a = Val("$"+Mid(Col, 5, 1)) + Case 7 ; RRGGBB (eg : "$95B4C2") + r = Val("$"+Mid(Col, 2, 2)) : g = Val("$"+Mid(Col, 4, 2)) : b = Val("$"+Mid(Col, 6, 2)) + Case 9 ; RRGGBBAA (eg : "$95B4C249") + r = Val("$"+Mid(Col, 2, 2)) : g = Val("$"+Mid(Col, 4, 2)) : b = Val("$"+Mid(Col, 6, 2)) : a = Val("$"+Mid(Col, 8, 2)) + EndSelect + ProcedureReturn RGBA(r, g, b, a) + Else + ProcedureReturn Val(Value) + EndIf + EndProcedure + + Procedure.s Value2ColourString(Value.i) + ProcedureReturn "$" + StrU(Red(Value), #PB_Byte) + StrU(Green(Value), #PB_Byte) + StrU(Blue(Value), #PB_Byte) + EndProcedure + + ;-*** 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) + Select UCase(Value) + Case "0", "FALSE", "DISABLE" + PBMap\Options\Name = #False + Default + PBMap\Options\Name = #True + EndSelect + EndMacro + + Procedure SetOption(Option.s, Value.s) + Option = StringCheck(Option) + Select LCase(Option) + Case "proxy" + SelBool(Proxy) + Case "proxyurl" + PBMap\Options\ProxyURL = Value + Case "proxyport" + PBMap\Options\ProxyPort = Value + Case "proxyuser" + PBMap\Options\ProxyUser = Value + Case "appid" + PBMap\Options\appid = Value + Case "appcode" + PBMap\Options\appcode = Value + Case "tilescachepath" + PBMap\Options\HDDCachePath = Value + Case "maxmemcache" + PBMap\Options\MaxMemCache = Val(Value) + Case "maxthreads" + PBMap\Options\MaxThreads = Val(Value) + Case "maxdownloadslots" + PBMap\Options\MaxDownloadSlots = Val(Value) + Case "tilelifetime" + PBMap\Options\TileLifetime = Val(Value) + Case "verbose" + SelBool(Verbose) + Case "warning" + SelBool(Warning) + Case "wheelmouserelative" + SelBool(WheelMouseRelative) + Case "showdegrees" + SelBool(ShowDegrees) + Case "showzoom" + SelBool(ShowZoom) + Case "showdebuginfos" + SelBool(ShowDebugInfos) + Case "showscale" + SelBool(ShowScale) + Case "showmarkers" + SelBool(ShowMarkers) + Case "showpointer" + SelBool(ShowPointer) + Case "showtrack" + SelBool(ShowTrack) + Case "showtrackselection" + SelBool(ShowTrackSelection) + Case "showmarkersnb" + SelBool(ShowMarkersNb) + Case "showmarkerslegend" + SelBool(ShowMarkersLegend) + Case "showtrackkms" + SelBool(ShowTrackKms) + Case "strokewidthtrackdefault" + SelBool(StrokeWidthTrackDefault) + Case "colourfocus" + PBMap\Options\ColourFocus = ColourString2Value(Value) + Case "colourselected" + PBMap\Options\ColourSelected = ColourString2Value(Value) + Case "colourtrackdefault" + PBMap\Options\ColourTrackDefault = ColourString2Value(Value) + 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 "maxthreads" + ProcedureReturn StrU(\MaxThreads) + Case "maxdownloadslots" + ProcedureReturn StrU(\MaxDownloadSlots) + Case "tilelifetime" + ProcedureReturn StrU(\TileLifetime) + 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 "showzoom" + ProcedureReturn GetBoolString(\ShowZoom) + Case "showmarkers" + ProcedureReturn GetBoolString(\ShowMarkers) + Case "showpointer" + ProcedureReturn GetBoolString(\ShowPointer) + Case "showtrack" + ProcedureReturn GetBoolString(\ShowTrack) + Case "showtrackselection" + ProcedureReturn GetBoolString(\ShowTrackSelection) + 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 + + ; By default, save options in the user's home directory + Procedure SaveOptions(PreferencesFile.s = "PBMap.prefs") + If PreferencesFile = "PBMap.prefs" + CreatePreferences(GetHomeDirectory() + "PBMap.prefs") + Else + CreatePreferences(PreferencesFile) + EndIf + With PBMap\Options + PreferenceGroup("PROXY") + WritePreferenceInteger("Proxy", \Proxy) + WritePreferenceString("ProxyURL", \ProxyURL) + WritePreferenceString("ProxyPort", \ProxyPort) + WritePreferenceString("ProxyUser", \ProxyUser) + PreferenceGroup("HERE") + WritePreferenceString("APP_ID", \appid) + WritePreferenceString("APP_CODE", \appcode) + PreferenceGroup("URL") + WritePreferenceString("DefaultOSMServer", \DefaultOSMServer) + PreferenceGroup("PATHS") + WritePreferenceString("TilesCachePath", \HDDCachePath) + PreferenceGroup("OPTIONS") + WritePreferenceInteger("WheelMouseRelative", \WheelMouseRelative) + WritePreferenceInteger("MaxMemCache", \MaxMemCache) + WritePreferenceInteger("MaxThreads", \MaxThreads) + WritePreferenceInteger("MaxDownloadSlots", \MaxDownloadSlots) + WritePreferenceInteger("TileLifetime", \TileLifetime) + WritePreferenceInteger("Verbose", \Verbose) + WritePreferenceInteger("Warning", \Warning) + WritePreferenceInteger("ShowDegrees", \ShowDegrees) + WritePreferenceInteger("ShowDebugInfos", \ShowDebugInfos) + WritePreferenceInteger("ShowScale", \ShowScale) + WritePreferenceInteger("ShowZoom", \ShowZoom) + WritePreferenceInteger("ShowMarkers", \ShowMarkers) + WritePreferenceInteger("ShowPointer", \ShowPointer) + WritePreferenceInteger("ShowTrack", \ShowTrack) + WritePreferenceInteger("ShowTrackSelection", \ShowTrackSelection) + WritePreferenceInteger("ShowTrackKms", \ShowTrackKms) + WritePreferenceInteger("ShowMarkersNb", \ShowMarkersNb) + WritePreferenceInteger("ShowMarkersLegend", \ShowMarkersLegend) + PreferenceGroup("DRAWING") + WritePreferenceInteger("StrokeWidthTrackDefault", \StrokeWidthTrackDefault) + ; Colours; + WritePreferenceInteger("ColourFocus", \ColourFocus) + WritePreferenceInteger("ColourSelected", \ColourSelected) + WritePreferenceInteger("ColourTrackDefault", \ColourTrackDefault) + ClosePreferences() + EndWith + EndProcedure + + Procedure LoadOptions(PreferencesFile.s = "PBMap.prefs") + If PreferencesFile = "PBMap.prefs" + OpenPreferences(GetHomeDirectory() + "PBMap.prefs") + Else + OpenPreferences(PreferencesFile) + EndIf + ; 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! + ; PreferenceGroup("HERE") + ; WritePreferenceString("APP_ID", "myhereid") ; TODO !Warning! !not encoded! + ; WritePreferenceString("APP_CODE", "myherecode") ; TODO !Warning! !not encoded! + ; ClosePreferences() + With PBMap\Options + PreferenceGroup("PROXY") + \Proxy = ReadPreferenceInteger("Proxy", #False) + If \Proxy + \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", "") + \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 + EndIf + PreferenceGroup("HERE") + \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 + PreferenceGroup("URL") + \DefaultOSMServer = ReadPreferenceString("DefaultOSMServer", "http://tile.openstreetmap.org/") + + PreferenceGroup("PATHS") + \HDDCachePath = ReadPreferenceString("TilesCachePath", GetTemporaryDirectory() + "PBMap" + slash) + PreferenceGroup("OPTIONS") + \WheelMouseRelative = ReadPreferenceInteger("WheelMouseRelative", #True) + \MaxMemCache = ReadPreferenceInteger("MaxMemCache", 20480) ; 20 MiB, about 80 tiles in memory + \MaxThreads = ReadPreferenceInteger("MaxThreads", 40) + \MaxDownloadSlots = ReadPreferenceInteger("MaxDownloadSlots", 2) + \TileLifetime = ReadPreferenceInteger("TileLifetime", 1209600) ; about 2 weeks ;-1 = unlimited + \Verbose = ReadPreferenceInteger("Verbose", #False) + \Warning = ReadPreferenceInteger("Warning", #False) + \ShowDegrees = ReadPreferenceInteger("ShowDegrees", #False) + \ShowDebugInfos = ReadPreferenceInteger("ShowDebugInfos", #False) + \ShowScale = ReadPreferenceInteger("ShowScale", #False) + \ShowZoom = ReadPreferenceInteger("ShowZoom", #True) + \ShowMarkers = ReadPreferenceInteger("ShowMarkers", #True) + \ShowPointer = ReadPreferenceInteger("ShowPointer", #True) + \ShowTrack = ReadPreferenceInteger("ShowTrack", #True) + \ShowTrackSelection = ReadPreferenceInteger("ShowTrackSelection", #False) + \ShowTrackKms = ReadPreferenceInteger("ShowTrackKms", #False) + \ShowMarkersNb = ReadPreferenceInteger("ShowMarkersNb", #True) + \ShowMarkersLegend = ReadPreferenceInteger("ShowMarkersLegend", #False) + PreferenceGroup("DRAWING") + \StrokeWidthTrackDefault = ReadPreferenceInteger("StrokeWidthTrackDefault", 10) + PreferenceGroup("COLOURS") + \ColourFocus = ReadPreferenceInteger("ColourFocus", RGBA(255, 255, 0, 255)) + \ColourSelected = ReadPreferenceInteger("ColourSelected", RGBA(225, 225, 0, 255)) + \ColourTrackDefault = ReadPreferenceInteger("ColourTrackDefault", RGBA(0, 255, 0, 150)) + \TimerInterval = 12 + ClosePreferences() + EndWith + SetOptions() + EndProcedure + + ;-*** Layers + + ; Add a layer to a list (to get things ordered) and to a map (to access things easily) + Procedure.i AddLayer(Name.s, Order.i, Alpha.d) + Protected *Ptr = 0 + *Ptr = AddMapElement(PBMap\Layers(), Name) + If *Ptr + PBMap\Layers() = AddElement(PBMap\LayersList()) ; This map element is a ptr to a linked list element + If PBMap\Layers() + PBMap\LayersList()\Name = Name + PBMap\LayersList()\Order = Order + PBMap\LayersList()\Alpha = Alpha + SortStructuredList(PBMap\LayersList(), #PB_Sort_Ascending, OffsetOf(Layer\Order), TypeOf(Layer\Order)) + ProcedureReturn PBMap\Layers() + Else + *Ptr = 0 + EndIf + EndIf + ProcedureReturn *Ptr + EndProcedure + + ; "OpenStreetMap" layer + Procedure.i AddOSMServerLayer(LayerName.s, Order.i, ServerURL.s = "http://tile.openstreetmap.org/") + Protected *Ptr.Layer = AddLayer(LayerName, Order, 1) + If *Ptr + *Ptr\ServerURL = ServerURL + *Ptr\LayerType = 0 ; OSM + *Ptr\Enabled = #True + PBMap\Redraw = #True + ProcedureReturn *Ptr + Else + ProcedureReturn #False + EndIf + EndProcedure + + ; "Here" layer + ; see there for parameters : https://developer.here.com/rest-apis/documentation/enterprise-map-tile/topics/resource-base-maptile.html + ; you could use base.maps.api.here.com or aerial.maps.api.here.com or traffic.maps.api.here.com or pano.maps.api.here.com. + ; use *.cit.map.api.com For Customer Integration Testing (see https://developer.here.com/rest-apis/documentation/enterprise-Map-tile/common/request-cit-environment-rest.html) + Procedure.i AddHereServerLayer(LayerName.s, Order.i, APP_ID.s = "", APP_CODE.s = "", ServerURL.s = "aerial.maps.api.here.com", path.s = "/maptile/2.1/", ressource.s = "maptile", id.s = "newest", scheme.s = "satellite.day", format.s = "jpg", lg.s = "eng", lg2.s = "eng", param.s = "") + Protected *Ptr.Layer = AddLayer(LayerName, Order, 1) + If *Ptr + With *Ptr ; PBMap\Layers() + \ServerURL = ServerURL + \path = path + \ressource = ressource + \LayerType = 1 ; HERE + \Enabled = #True + If APP_ID = "" + APP_ID = PBMap\Options\appid + EndIf + If APP_CODE = "" + APP_CODE = PBMap\Options\appcode + EndIf + \APP_CODE = APP_CODE + \APP_ID = APP_ID + \format = format + \id = id + \lg = lg + \lg2 = lg2 + \param = param + \scheme = scheme + EndWith + PBMap\Redraw = #True + ProcedureReturn *Ptr + Else + ProcedureReturn #False + EndIf + EndProcedure + + ; GeoServer / geowebcache - google maps service + ; template 'http://localhost:8080/geowebcache/service/gmaps?layers=layer-name&zoom={Z}&x={X}&y={Y}&format=image/png' + Procedure.i AddGeoServerLayer(LayerName.s, Order.i, ServerLayerName.s, ServerURL.s = "http://localhost:8080/", path.s = "geowebcache/service/gmaps", format.s = "image/png") + Protected *Ptr.Layer = AddLayer(LayerName, Order, 1) + If *Ptr + With *Ptr ; PBMap\Layers() + \ServerURL = ServerURL + \path = path + \LayerType = 2 ; GeoServer + \format = format + \Enabled = #True + \ServerLayerName = ServerLayerName + EndWith + PBMap\Redraw = #True + ProcedureReturn *Ptr + Else + ProcedureReturn #False + EndIf + EndProcedure + + Procedure.i IsLayer(Name.s) + ProcedureReturn FindMapElement(PBMap\Layers(), Name) + EndProcedure + + Procedure DeleteLayer(Name.s) + FindMapElement(PBMap\Layers(), Name) + Protected *Ptr = PBMap\Layers() + ; Free the list element + ChangeCurrentElement(PBMap\LayersList(), *Ptr) + DeleteElement(PBMap\LayersList()) + ; Free the map element + DeleteMapElement(PBMap\Layers()) + PBMap\Redraw = #True + EndProcedure + + Procedure EnableLayer(Name.s) + PBMap\Layers(Name)\Enabled = #True + PBMap\Redraw = #True + EndProcedure + + Procedure DisableLayer(Name.s) + PBMap\Layers(Name)\Enabled = #False + PBMap\Redraw = #True + EndProcedure + + Procedure SetLayerAlpha(Name.s, Alpha.d) + PBMap\Layers(Name)\Alpha = Alpha + PBMap\Redraw = #True + EndProcedure + + Procedure.d GetLayerAlpha(Name.s) + ProcedureReturn PBMap\Layers(Name)\Alpha + EndProcedure + + ;-*** + ; If cache size exceeds limit, try to delete the oldest tiles used (first in the time stack) + Procedure MemoryCacheManagement() + LockMutex(PBMap\MemoryCacheAccessMutex) ; Prevents thread to start or finish + Protected CacheSize = MapSize(PBMap\MemCache\Images()) * Pow(PBMap\TileSize, 2) * 4 ; Size of a tile = TileSize * TileSize * 4 bytes (RGBA) + Protected CacheLimit = PBMap\Options\MaxMemCache * 1024 + MyDebug("Cache size : " + Str(CacheSize/1024) + " / CacheLimit : " + Str(CacheLimit/1024), 5) + If CacheSize > CacheLimit + MyDebug(" Cache full. Trying cache cleaning", 5) + ResetList(PBMap\MemCache\ImagesTimeStack()) + ; Try to free half the cache memory (one pass) + While NextElement(PBMap\MemCache\ImagesTimeStack()) And CacheSize > (CacheLimit / 2) ; /2 = half + Protected CacheMapKey.s = PBMap\MemCache\ImagesTimeStack()\MapKey + ; Is the loading over + If PBMap\MemCache\Images(CacheMapKey)\Tile <= 0 ;TODO Should not verify this var directly + MyDebug(" Delete " + CacheMapKey, 5) + If PBMap\MemCache\Images(CacheMapKey)\nImage;IsImage(PBMap\MemCache\Images(CacheMapKey)\nImage) + FreeImage(PBMap\MemCache\Images(CacheMapKey)\nImage) + MyDebug(" and free image nb " + Str(PBMap\MemCache\Images(CacheMapKey)\nImage), 5) + PBMap\MemCache\Images(CacheMapKey)\nImage = 0 + EndIf + DeleteMapElement(PBMap\MemCache\Images(), CacheMapKey) + DeleteElement(PBMap\MemCache\ImagesTimeStack(), 1) + ; ElseIf PBMap\MemCache\Images(CacheMapKey)\Tile = 0 + ; MyDebug(" Delete " + CacheMapKey, 5) + ; DeleteMapElement(PBMap\MemCache\Images(), CacheMapKey) + ; DeleteElement(PBMap\MemCache\ImagesTimeStack(), 1) + ; ElseIf PBMap\MemCache\Images(CacheMapKey)\Tile > 0 + ; ; If the thread is running, try to abort the download + ; If PBMap\MemCache\Images(CacheMapKey)\Tile\Download + ; AbortHTTP(PBMap\MemCache\Images(CacheMapKey)\Tile\Download) ; Could lead to error + ; EndIf + EndIf + CacheSize = MapSize(PBMap\MemCache\Images()) * Pow(PBMap\TileSize, 2) * 4 ; Size of a tile = TileSize * TileSize * 4 bytes (RGBA) + Wend + MyDebug(" New cache size : " + Str(CacheSize/1024) + " / CacheLimit : " + Str(CacheLimit/1024), 5) + If CacheSize > CacheLimit + MyDebug(" Cache cleaning unsuccessfull, can't add new tiles.", 5) + EndIf + EndIf + UnlockMutex(PBMap\MemoryCacheAccessMutex) + EndProcedure + Procedure.i GetTileFromHDD(CacheFile.s) - Protected nImage.i - If FileSize(CacheFile) > 0 + Protected nImage.i, LifeTime.i, MaxLifeTime.i + ; Everything is OK, loads the file nImage = LoadImage(#PB_Any, CacheFile) - If IsImage(nImage) - MyDebug("Success loading " + CacheFile + " as nImage " + Str(nImage), 3) + If nImage + MyDebug(" Success loading " + CacheFile + " as nImage " + Str(nImage), 3) ProcedureReturn nImage 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) + If DeleteFile(CacheFile) + MyDebug(" Deleting faulty image file " + CacheFile, 3) + Else + MyDebug(" Can't delete faulty image file " + CacheFile, 3) + EndIf EndIf - Else - MyDebug("Failed loading " + CacheFile + " -> Size <= 0", 3) - EndIf - ProcedureReturn -1 + ProcedureReturn #False EndProcedure - Procedure.i GetTileFromWeb(TileURL.s, CacheFile.s) - Protected *Buffer - Protected nImage.i = -1 - Protected FileSize.i, timg - HTTPProxy(PBMap\Options\ProxyURL + ":" + PBMap\Options\ProxyPort, PBMap\Options\ProxyUser, PBMap\Options\ProxyPassword) - FileSize = ReceiveHTTPFile(TileURL, CacheFile) - If FileSize > 0 - MyDebug("Loaded from web " + TileURL + " as CacheFile " + CacheFile, 3) - nImage = GetTileFromHDD(CacheFile) - Else - MyDebug("Problem loading from web " + TileURL, 3) + ; **** OLD IMPORTANT NOTICE (please not remove) + ; This original catchimage/saveimage method is a double operation (uncompress/recompress PNG) + ; and is modifying the original PNG image which could lead to PNG error (Idle has spent hours debunking the 1 bit PNG bug) + ; Protected *Buffer + ; Protected nImage.i = -1 + ; Protected timg + ; *Buffer = ReceiveHTTPMemory(TileURL) ; TODO to thread by using #PB_HTTP_Asynchronous + ; If *Buffer + ; nImage = CatchImage(#PB_Any, *Buffer, MemorySize(*Buffer)) + ; If IsImage(nImage) + ; If SaveImage(nImage, CacheFile, #PB_ImagePlugin_PNG, 0, 32) ; The 32 is needed !!!! + ; 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) + ; Else + ; MyDebug("Can't catch image loaded from web " + TileURL, 3) + ; nImage = -1 + ; EndIf + ; Else + ; MyDebug(" Problem loading from web " + TileURL, 3) + ; EndIf + ; **** + + ;-*** These are threaded + + Threaded Progress = 0, Quit = #False + + Procedure GetImageThread(*Tile.Tile) + LockMutex(PBMap\MemoryCacheAccessMutex) + MyDebug("Thread nb " + Str(*Tile\GetImageThread) + " " + *Tile\key + " starting for image " + *Tile\CacheFile, 5) + ; If MemoryCache is currently being cleaned, abort +; If PBMap\MemoryCacheAccessNB = -1 +; MyDebug(" Thread nb " + Str(*Tile\GetImageThread) + " " + *Tile\key + " for image " + *Tile\CacheFile + " canceled because of cleaning.", 5) +; *Tile\Size = 0 ; \Size = 0 signals that the download has failed +; PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ; To free memory outside the thread +; UnlockMutex(PBMap\MemoryCacheAccessMutex) +; ProcedureReturn +; EndIf + ; We're accessing MemoryCache + UnlockMutex(PBMap\MemoryCacheAccessMutex) + *Tile\Size = 0 + *Tile\Download = ReceiveHTTPFile(*Tile\URL, *Tile\CacheFile, #PB_HTTP_Asynchronous) + If *Tile\Download + Repeat + Progress = HTTPProgress(*Tile\Download) + Select Progress + Case #PB_Http_Success + *Tile\Size = FinishHTTP(*Tile\Download) ; \Size signals that the download is OK + MyDebug(" Thread nb " + Str(*Tile\GetImageThread) + " " + *Tile\key + " for image " + *Tile\CacheFile + " finished. Size : " + Str(*Tile\Size), 5) + Quit = #True + Case #PB_Http_Failed + FinishHTTP(*Tile\Download) + *Tile\Size = 0 ; \Size = 0 signals that the download has failed + MyDebug(" Thread nb " + Str(*Tile\GetImageThread) + " " + *Tile\key + " for image " + *Tile\CacheFile + " failed.", 5) + Quit = #True + Case #PB_Http_Aborted + FinishHTTP(*Tile\Download) + *Tile\Size = 0 ; \Size = 0 signals that the download has failed + MyDebug(" Thread nb " + Str(*Tile\GetImageThread) + " " + *Tile\key + " for image " + *Tile\CacheFile + " aborted.", 5) + Quit = #True + Default + MyDebug(" Thread nb " + Str(*Tile\GetImageThread) + " " + *Tile\key + " for image " + *Tile\CacheFile + " downloading " + Str(Progress) + " bytes", 5) + If ElapsedMilliseconds() - *Tile\Time > 10000 + MyDebug(" Thread nb " + Str(*Tile\GetImageThread) + " " + *Tile\key + " for image " + *Tile\CacheFile + " canceled after 10 seconds.", 5) + AbortHTTP(*Tile\Download) + EndIf + EndSelect + Delay(200) ; Frees CPU + Until Quit EndIf - ; **** IMPORTANT NOTICE (please not remove) - ; I'm (djes) now using Curl (actually, just normal pb) only, as this original catchimage/saveimage method is a double operation (uncompress/recompress PNG) - ; and is modifying the original PNG image which could lead to PNG error (Idle has spent hours debunking the 1 bit PNG bug) - ; More than that, the original Purebasic Receive library is still not Proxy enabled. - ; *Buffer = ReceiveHTTPMemory(TileURL) ;TODO to thread by using #PB_HTTP_Asynchronous - ; If *Buffer - ; nImage = CatchImage(#PB_Any, *Buffer, MemorySize(*Buffer)) - ; If IsImage(nImage) - ; If SaveImage(nImage, CacheFile, #PB_ImagePlugin_PNG, 0, 32) ;The 32 is needed !!!! - ; 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) - ; Else - ; MyDebug("Can't catch image loaded from web " + TileURL, 3) - ; nImage = -1 - ; EndIf - ; Else - ; MyDebug(" Problem loading from web " + TileURL, 3) - ; EndIf - ; **** - ProcedureReturn nImage + ; End of the memory cache access + LockMutex(PBMap\MemoryCacheAccessMutex) + PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ; To free memory outside the thread + UnlockMutex(PBMap\MemoryCacheAccessMutex) EndProcedure - Procedure GetImageThread(*Tile.Tile) - Protected nImage.i = -1 - Repeat - nImage = GetTileFromWeb(*Tile\URL, *Tile\CacheFile) - If nImage <> -1 - MyDebug("Image key : " + *Tile\key + " web image loaded", 3) - *Tile\RetryNb = 0 - Else - MyDebug("Image key : " + *Tile\key + " web image not correctly loaded", 3) - Delay(2000) - *Tile\RetryNb - 1 - EndIf - Until *Tile\RetryNb <= 0 - *Tile\nImage = nImage - *Tile\RetryNb = -2 ;End of the thread - PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ;To free memory outside the thread - EndProcedure ;-*** Procedure.i GetTile(key.s, URL.s, CacheFile.s) - ; Try to find the tile in memory cache. If not found, add it, try To load it from the - ; HDD, or launch a loading thread, and try again on the next drawing loop. - Protected img.i = -1 + ; MemoryCache access management + LockMutex(PBMap\MemoryCacheAccessMutex) + ; Try to find the tile in memory cache Protected *timg.ImgMemCach = FindMapElement(PBMap\MemCache\Images(), key) If *timg - MyDebug("Key : " + key + " found in memory cache!", 3) - img = *timg\nImage - If img <> -1 - MyDebug("Image : " + img + " found in memory cache!", 3) - ;*** Cache management - ; Move the newly used element to the last position of the time stack - SelectElement(PBMap\MemCache\ImagesTimeStack(), *timg\TimeStackPosition) + MyDebug("Key : " + key + " found in memory cache", 4) + ; Is the associated image already been loaded in memory ? + If *timg\nImage + ; Yes, returns the image's nb + MyDebug(" as image " + *timg\nImage, 4) + ; *** Cache management + ; Retrieves the image in the time stack, push it to the end (to say it's the lastly used) + ChangeCurrentElement(PBMap\MemCache\ImagesTimeStack(), *timg\TimeStackPtr) MoveElement(PBMap\MemCache\ImagesTimeStack(), #PB_List_Last) - ;*** + ; *timg\TimeStackPtr = LastElement(PBMap\MemCache\ImagesTimeStack()) + ; *** + UnlockMutex(PBMap\MemoryCacheAccessMutex) ProcedureReturn *timg + Else + ; No, try to load it from HD (see below) + MyDebug(" but not the image.", 4) EndIf Else - ;PushMapPosition(PBMap\MemCache\Images()) - ;*** Cache management - ; if cache size exceeds limit, try to delete the oldest tile used (first in the list) - Protected CacheSize = MapSize(PBMap\MemCache\Images()) * Pow(PBMap\TileSize, 2) * 4 ; Size of a tile = TileSize * TileSize * 4 bytes (RGBA) - Protected CacheLimit = PBMap\Options\MaxMemCache * 1024 - MyDebug("Cache size : " + Str(CacheSize/1024) + " / CacheLimit : " + Str(CacheLimit/1024), 4) - ResetList(PBMap\MemCache\ImagesTimeStack()) - While NextElement(PBMap\MemCache\ImagesTimeStack()) And CacheSize > CacheLimit - Protected CacheMapKey.s = PBMap\MemCache\ImagesTimeStack()\MapKey - Protected Image = PBMap\MemCache\Images(CacheMapKey)\nImage - If IsImage(Image) ; Check if the image is valid (is a loading thread running ?) - FreeImage(Image) - MyDebug("Delete " + CacheMapKey + " As image nb " + Str(Image), 4) - DeleteMapElement(PBMap\MemCache\Images(), CacheMapKey) - DeleteElement(PBMap\MemCache\ImagesTimeStack()) - CacheSize = MapSize(PBMap\MemCache\Images()) * Pow(PBMap\TileSize, 2) * 4 ; Size of a tile = TileSize * TileSize * 4 bytes (RGBA) - EndIf - Wend - LastElement(PBMap\MemCache\ImagesTimeStack()) - ;PopMapPosition(PBMap\MemCache\Images()) - AddMapElement(PBMap\MemCache\Images(), key) - AddElement(PBMap\MemCache\ImagesTimeStack()) - ;MoveElement(PBMap\MemCache\ImagesTimeStack(), #PB_List_Last) - PBMap\MemCache\ImagesTimeStack()\MapKey = MapKey(PBMap\MemCache\Images()) - ;*** - MyDebug("Key : " + key + " added in memory cache!", 3) - *timg = PBMap\MemCache\Images() - *timg\nImage = -1 - EndIf - If *timg\Tile = 0 ; Check if a loading thread is not running - MyDebug("Trying to load from HDD " + CacheFile, 3) - img = GetTileFromHDD(CacheFile.s) - If img <> -1 - MyDebug("Key : " + key + " found on HDD", 3) - *timg\nImage = img - *timg\Alpha = 256 - ProcedureReturn *timg + ; The tile has not been found in the cache, so creates a new cache element + *timg = AddMapElement(PBMap\MemCache\Images(), key) + If *timg = 0 + MyDebug(" Can't add a new cache element.", 4) + UnlockMutex(PBMap\MemoryCacheAccessMutex) + ProcedureReturn #False EndIf - MyDebug("Key : " + key + " not found on HDD", 3) - ;Launch a new thread - Protected *NewTile.Tile = AllocateMemory(SizeOf(Tile)) - If *NewTile - With *NewTile - *timg\Tile = *NewTile - *timg\Alpha = 0 - ;*timg\nImage = -1 - ;New tile parameters - \key = key - \URL = URL - \CacheFile = CacheFile - \RetryNb = 5 - \nImage = -1 - MyDebug(" Creating get image thread nb " + Str(\GetImageThread) + " to get " + CacheFile, 3) - \GetImageThread = CreateThread(@GetImageThread(), *NewTile) - EndWith - Else - MyDebug(" Error, can't create a new tile loading thread", 3) - EndIf + ; add a new time stack element at the End + LastElement(PBMap\MemCache\ImagesTimeStack()) + ; Stores the time stack ptr + *timg\TimeStackPtr = AddElement(PBMap\MemCache\ImagesTimeStack()) + If *timg\TimeStackPtr = 0 + MyDebug(" Can't add a new time stack element.", 4) + DeleteMapElement(PBMap\MemCache\Images()) + UnlockMutex(PBMap\MemoryCacheAccessMutex) + ProcedureReturn #False + EndIf + ; Associates the time stack element to the cache element + PBMap\MemCache\ImagesTimeStack()\MapKey = MapKey(PBMap\MemCache\Images()) + MyDebug("Key : " + key + " added in memory cache", 4) EndIf - ProcedureReturn *timg + ; If there's no active download thread for this tile + If *timg\Tile <= 0 + ; Manage tile file lifetime, delete if too old + If PBMap\Options\TileLifetime <> -1 + If FileSize(CacheFile) > 0 ; Does the file exists ? + If Date() - GetFileDate(CacheFile, #PB_Date_Modified) > PBMap\Options\TileLifetime ; If Lifetime > MaxLifeTime ; There's a bug with #PB_Date_Created + If DeleteFile(CacheFile) + MyDebug(" Deleting too old image file " + CacheFile, 3) + Else + MyDebug(" Can't delete too old image file " + CacheFile, 3) + UnlockMutex(PBMap\MemoryCacheAccessMutex) + ProcedureReturn #False + EndIf + EndIf + EndIf + EndIf + ; Try To load it from HD + *timg\nImage = 0 + *timg\Size = FileSize(CacheFile) + If *timg\Size > 0 + *timg\nImage = GetTileFromHDD(CacheFile.s) + Else + MyDebug(" Failed loading from HDD " + CacheFile + " -> Filesize = " + FileSize(CacheFile), 3) + EndIf + If *timg\nImage + ; Image found and loaded from HDD + *timg\Alpha = 0 + UnlockMutex(PBMap\MemoryCacheAccessMutex) + ProcedureReturn *timg + Else + ; If GetTileFromHDD failed, will load it (again?) from the web + If PBMap\ThreadsNB < PBMap\Options\MaxThreads + If PBMap\DownloadSlots < PBMap\Options\MaxDownloadSlots + ; Launch a new web loading thread + PBMap\DownloadSlots + 1 + Protected *NewTile.Tile = AllocateMemory(SizeOf(Tile)) + If *NewTile + With *NewTile + ; New tile parameters + \key = key + \URL = URL + \CacheFile = CacheFile + \nImage = 0 + \Time = ElapsedMilliseconds() + \GetImageThread = CreateThread(@GetImageThread(), *NewTile) + If \GetImageThread + *timg\Tile = *NewTile ; There's now a loading thread + *timg\Alpha = 0 + MyDebug(" Creating get image thread nb " + Str(\GetImageThread) + " to get " + CacheFile + " (key = " + key, 3) + PBMap\ThreadsNB + 1 + Else + MyDebug(" Can't create get image thread to get " + CacheFile, 3) + FreeMemory(*NewTile) + EndIf + EndWith + Else + MyDebug(" Error, can't allocate memory for a new tile loading thread", 3) + EndIf + Else + MyDebug(" Thread needed " + key + " for image " + CacheFile + " canceled because no free download slot.", 5) + EndIf + Else + MyDebug(" Error, maximum threads nb reached", 3) + EndIf + EndIf + EndIf + UnlockMutex(PBMap\MemoryCacheAccessMutex) + ProcedureReturn #False EndProcedure - Procedure DrawTiles(*Drawing.DrawingParameters, Layer) + Procedure DrawTiles(*Drawing.DrawingParameters, LayerName.s) Protected x.i, y.i,kq.q - Protected tx = Int(*Drawing\TileCoordinates\x) ;Don't forget the Int() ! + Protected tx = Int(*Drawing\TileCoordinates\x) ; Don't forget the Int() ! Protected ty = Int(*Drawing\TileCoordinates\y) - Protected nx = *Drawing\RadiusX / PBMap\TileSize ;How many tiles around the point + Protected nx = *Drawing\RadiusX / PBMap\TileSize ; How many tiles around the point Protected ny = *Drawing\RadiusY / PBMap\TileSize Protected px, py, *timg.ImgMemCach, tilex, tiley, key.s Protected URL.s, CacheFile.s Protected tilemax = 1<= 0 And tiley < tilemax kq = (PBMap\Zoom << 8) | (tilex << 16) | (tiley << 36) - key = PBMap\Layers()\Name + Str(kq) + key = LayerName + Str(kq) ; Creates the cache tree based on the OSM tree+Layer : layer/zoom/x/y.png - Protected DirName.s = PBMap\Options\HDDCachePath + PBMap\Layers()\Name + Protected DirName.s = PBMap\Options\HDDCachePath + LayerName If FileSize(DirName) <> -2 If CreateDirectory(DirName) = #False ; Creates a directory based on the layer name Error("Can't create the following layer directory : " + DirName) @@ -927,29 +1380,51 @@ Module PBMap MyDebug(DirName + " successfully created", 4) EndIf EndIf - ; Tile cache name based on y - URL = PBMap\Layers()\ServerURL + Str(PBMap\Zoom) + "/" + Str(tilex) + "/" + Str(tiley) + ".png" - CacheFile = DirName + slash + Str(tiley) + ".png" + With PBMap\Layers() + Select \LayerType + ;---- OSM tiles + Case 0 + URL = \ServerURL + Str(PBMap\Zoom) + "/" + Str(tilex) + "/" + Str(tiley) + ".png" + ; Tile cache name based on y + CacheFile = DirName + slash + Str(tiley) + ".png" + ;---- Here tiles + Case 1 + HereLoadBalancing = 1 + ((tiley + tilex) % 4) + ; {Base URL}{Path}{resource (tile type)}/{Map id}/{scheme}/{zoom}/{column}/{row}/{size}/{format}?app_id={YOUR_APP_ID}&app_code={YOUR_APP_CODE}&{param}={value} + URL = "https://" + StrU(HereLoadBalancing, #PB_Byte) + "." + \ServerURL + \path + \ressource + "/" + \id + "/" + \scheme + "/" + Str(PBMap\Zoom) + "/" + Str(tilex) + "/" + Str(tiley) + "/256/" + \format + "?app_id=" + \APP_ID + "&app_code=" + \APP_CODE + "&lg=" + \lg + "&lg2=" + \lg2 + If \param <> "" + URL + "&" + \param + EndIf + ; Tile cache name based on y + CacheFile = DirName + slash + Str(tiley) + "." + \format + ;---- GeoServer / geowebcache - google maps service tiles + Case 2 + ; template 'http://localhost:8080/geowebcache/service/gmaps?layers=layer-name&zoom={Z}&x={X}&y={Y}&format=image/png' + URL = \ServerURL + \path + "?layers=" + \ServerLayerName + "&zoom={" + Str(PBMap\Zoom) + "}&x={" + Str(tilex) + "}&y={" + Str(tiley) + "}&format=" + \format + ; Tile cache name based on y + CacheFile = DirName + slash + Str(tiley) + ".png" + EndSelect + EndWith *timg = GetTile(key, URL, CacheFile) - If *timg\nImage <> -1 + If *timg And *timg\nImage MovePathCursor(px, py) If *timg\Alpha <= 224 - DrawVectorImage(ImageID(*timg\nImage), *timg\Alpha) + DrawVectorImage(ImageID(*timg\nImage), *timg\Alpha * PBMap\Layers()\Alpha) *timg\Alpha + 32 PBMap\Redraw = #True Else - DrawVectorImage(ImageID(*timg\nImage), 255) + DrawVectorImage(ImageID(*timg\nImage), 255 * PBMap\Layers()\Alpha) *timg\Alpha = 256 EndIf Else MovePathCursor(px, py) - DrawVectorImage(ImageID(PBMap\ImgLoading), 255) + DrawVectorImage(ImageID(PBMap\ImgLoading), 255 * PBMap\Layers()\Alpha) EndIf Else - ;If PBMap\Layers()\Name = "" + ; If PBMap\Layers()\Name = "" MovePathCursor(px, py) - DrawVectorImage(ImageID(PBMap\ImgNothing), 255) - ;EndIf + DrawVectorImage(ImageID(PBMap\ImgNothing), 255 * PBMap\Layers()\Alpha) + ; EndIf EndIf If PBMap\Options\ShowDebugInfos VectorFont(FontID(PBMap\Font), 16) @@ -975,7 +1450,7 @@ Module PBMap AddPathLine(-8, 16, #PB_Path_Relative) 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)) + FillPath(#PB_Path_Preserve):VectorSourceColor(RGBA($FF, 0, 0, $FF)); RGBA(0, 0, 0, 255)) StrokePath(1) EndIf EndProcedure @@ -1000,31 +1475,11 @@ Module PBMap EndProcedure Procedure DrawDegrees(*Drawing.DrawingParameters, alpha=192) - Protected tx, ty, nx,ny,nx1,ny1,x,y,n,cx,dperpixel.d - Protected pos1.PixelCoordinates,pos2.PixelCoordinates,Degrees1.GeographicCoordinates,degrees2.GeographicCoordinates - Protected realx - - ;TODO to find why it doesn't work + Protected nx, ny, nx1, ny1, x, y + Protected pos1.PixelCoordinates, pos2.PixelCoordinates, Degrees1.GeographicCoordinates, degrees2.GeographicCoordinates CopyStructure(*Drawing\Bounds\NorthWest, @Degrees1, GeographicCoordinates) - Debug "----" - Debug Degrees1\Longitude-1 CopyStructure(*Drawing\Bounds\SouthEast, @Degrees2, GeographicCoordinates) - ;tx = Int(*Drawing\TileCoordinates\x) - ;ty = Int(*Drawing\TileCoordinates\y) - tx = *Drawing\TileCoordinates\x - ty = *Drawing\TileCoordinates\y - nx = *Drawing\RadiusX / PBMap\TileSize ;How many tiles around the point - ny = *Drawing\RadiusY / PBMap\TileSize - *Drawing\Bounds\TopLeft\x = tx-nx-1 - *Drawing\Bounds\TopLeft\y = ty-ny-1 - *Drawing\Bounds\BottomRight\x = tx+nx+2 - *Drawing\Bounds\BottomRight\y = ty+ny+2 - TileXY2LatLon(*Drawing\Bounds\TopLeft, @Degrees1, PBMap\Zoom) - TileXY2LatLon(*Drawing\Bounds\BottomRight, @Degrees2, PBMap\Zoom) - Debug Degrees1\Longitude - ;*** - - ;ensure we stay positive for the drawing + ; ensure we stay positive for the drawing nx = Mod(Mod(Round(Degrees1\Longitude, #PB_Round_Down)-1, 360) + 360, 360) ny = Round(Degrees1\Latitude, #PB_Round_Up) +1 nx1 = Mod(Mod(Round(Degrees2\Longitude, #PB_Round_Up) +1, 360) + 360, 360) @@ -1033,12 +1488,12 @@ Module PBMap Degrees1\Latitude = ny Degrees2\Longitude = nx1 Degrees2\Latitude = ny1 - ; Debug "NW : " + StrD(Degrees1\Longitude) + " ; NE : " + StrD(Degrees2\Longitude) + ; Debug "NW : " + StrD(Degrees1\Longitude) + " ; NE : " + StrD(Degrees2\Longitude) LatLon2PixelRel(@Degrees1, @pos1, PBMap\Zoom) LatLon2PixelRel(@Degrees2, @pos2, PBMap\Zoom) VectorFont(FontID(PBMap\Font), 10) VectorSourceColor(RGBA(0, 0, 0, alpha)) - ;draw latitudes + ; draw latitudes For y = ny1 To ny Degrees1\Longitude = nx Degrees1\Latitude = y @@ -1048,7 +1503,7 @@ Module PBMap MovePathCursor(10, pos1\y) DrawVectorText(StrD(y, 1)) Next - ;draw longitudes + ; draw longitudes x = nx Repeat Degrees1\Longitude = x @@ -1063,6 +1518,14 @@ Module PBMap StrokePath(1) EndProcedure + Procedure DrawZoom(x.i, y.i) + VectorFont(FontID(PBMap\Font), 20) + VectorSourceColor(RGBA(0, 0, 0,150)) + MovePathCursor(x,y) + DrawVectorText(Str(GetZoom())) + EndProcedure + ;-*** Tracks + Procedure DrawTrackPointer(x.d, y.d, dist.l) Protected color.l color=RGBA(0, 0, 0, 255) @@ -1135,12 +1598,12 @@ Module PBMap Protected Location.GeographicCoordinates Protected km.f, memKm.i With PBMap\TracksList() - ;Trace Track + ; Trace Track If ListSize(PBMap\TracksList()) > 0 BeginVectorLayer() ForEach PBMap\TracksList() If ListSize(\Track()) > 0 - ;Check visibility + ; Check visibility \Visible = #False ForEach \Track() If IsInDrawingPixelBoundaries(*Drawing, @PBMap\TracksList()\Track()) @@ -1149,7 +1612,7 @@ Module PBMap EndIf Next If \Visible - ;Draw tracks + ; Draw tracks ForEach \Track() LatLon2PixelRel(@PBMap\TracksList()\Track(), @Pixel, PBMap\Zoom) If ListIndex(\Track()) = 0 @@ -1158,10 +1621,10 @@ Module PBMap AddPathLine(Pixel\x, Pixel\y) EndIf Next - ; \BoundingBox\x = PathBoundsX() - ; \BoundingBox\y = PathBoundsY() - ; \BoundingBox\w = PathBoundsWidth() - ; \BoundingBox\h = PathBoundsHeight() + ; \BoundingBox\x = PathBoundsX() + ; \BoundingBox\y = PathBoundsY() + ; \BoundingBox\w = PathBoundsWidth() + ; \BoundingBox\h = PathBoundsHeight() If \Focus VectorSourceColor(PBMap\Options\ColourFocus) ElseIf \Selected @@ -1170,6 +1633,15 @@ Module PBMap VectorSourceColor(\Colour) EndIf StrokePath(\StrokeWidth, #PB_Path_RoundEnd|#PB_Path_RoundCorner) + + ; YA pour marquer chaque point d'un rond + ForEach \Track() + LatLon2PixelRel(@PBMap\TracksList()\Track(), @Pixel, PBMap\Zoom) + AddPathCircle(Pixel\x,Pixel\y,(\StrokeWidth / 4)) + Next + VectorSourceColor(RGBA(255, 255, 0, 255)) + StrokePath(1) + EndIf EndIf Next @@ -1181,7 +1653,7 @@ Module PBMap If \Visible km = 0 : memKm = -1 ForEach PBMap\TracksList()\Track() - ;Test Distance + ; Test Distance If ListIndex(\Track()) = 0 Location\Latitude = \Track()\Latitude Location\Longitude = \Track()\Longitude @@ -1208,18 +1680,18 @@ Module PBMap EndWith EndProcedure - Procedure.i LoadGpxFile(file.s) - If LoadXML(0, file.s) + Procedure.i LoadGpxFile(FileName.s) + If LoadXML(0, FileName.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) + Error(Message) EndIf Protected *MainNode,*subNode,*child,child.l - *MainNode=MainXMLNode(0) - *MainNode=XMLNodeFromPath(*MainNode,"/gpx/trk/trkseg") + *MainNode = MainXMLNode(0) + *MainNode = XMLNodeFromPath(*MainNode, "/gpx/trk/trkseg") Protected *NewTrack.Tracks = AddElement(PBMap\TracksList()) PBMap\TracksList()\StrokeWidth = PBMap\Options\StrokeWidthTrackDefault PBMap\TracksList()\Colour = PBMap\Options\ColourTrackDefault @@ -1230,18 +1702,45 @@ Module PBMap While NextXMLAttribute(*child) Select XMLAttributeName(*child) Case "lat" - *NewTrack\Track()\Latitude=ValD(XMLAttributeValue(*child)) + *NewTrack\Track()\Latitude = ValD(XMLAttributeValue(*child)) Case "lon" - *NewTrack\Track()\Longitude=ValD(XMLAttributeValue(*child)) + *NewTrack\Track()\Longitude = ValD(XMLAttributeValue(*child)) EndSelect Wend EndIf Next - ZoomToTracks(LastElement(PBMap\TracksList())) ; <-To center the view, and zoom on the tracks + SetZoomToTracks(LastElement(PBMap\TracksList())) ; <-To center the view, and zoom on the tracks ProcedureReturn *NewTrack EndIf EndProcedure + Procedure.i SaveGpxFile(FileName.s, *Track.Tracks) + Protected Message.s + If CreateXML(0) + Protected *MainNode, *subNode, *child + *MainNode = CreateXMLNode(RootXMLNode(0), "gpx") + *subNode = CreateXMLNode(*MainNode, "trk") + *subNode = CreateXMLNode(*subNode, "trkseg") + ForEach *Track\Track() + *child = CreateXMLNode(*subNode, "trkpt") + SetXMLAttribute(*child, "lat", StrD(*Track\Track()\Latitude)) + SetXMLAttribute(*child, "lon", StrD(*Track\Track()\Longitude)) + Next + SaveXML(0, FileName) + 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)) + Error(Message) + ProcedureReturn #False + EndIf + ProcedureReturn #True + Else + ProcedureReturn #False + EndIf + EndProcedure + + ;-*** Markers Procedure ClearMarkers() ClearList(PBMap\Markers()) @@ -1279,19 +1778,20 @@ Module PBMap EndIf EndProcedure - ;-*** Marker Edit Procedure MarkerIdentifierChange() Protected *Marker.Marker = GetGadgetData(EventGadget()) If GetGadgetText(EventGadget()) <> *Marker\Identifier *Marker\Identifier = GetGadgetText(EventGadget()) EndIf - EndProcedure + EndProcedure + Procedure MarkerLegendChange() Protected *Marker.Marker = GetGadgetData(EventGadget()) If GetGadgetText(EventGadget()) <> *Marker\Legend *Marker\Legend = GetGadgetText(EventGadget()) EndIf - EndProcedure + EndProcedure + Procedure MarkerEditCloseWindow() ForEach PBMap\Markers() If PBMap\Markers()\EditWindow = EventWindow() @@ -1300,8 +1800,9 @@ Module PBMap Next CloseWindow(EventWindow()) EndProcedure + Procedure MarkerEdit(*Marker.Marker) - If *Marker\EditWindow = 0 ;Check that this marker has no already opened window + If *Marker\EditWindow = 0 ; Check that this marker has no already opened window Protected WindowMarkerEdit = OpenWindow(#PB_Any, WindowX(PBMap\Window) + WindowWidth(PBMap\Window) / 2 - 150, WindowY(PBMap\Window)+ WindowHeight(PBMap\Window) / 2 + 50, 300, 100, "Marker Edit", #PB_Window_SystemMenu | #PB_Window_TitleBar) StickyWindow(WindowMarkerEdit, #True) TextGadget(#PB_Any, 2, 2, 80, 25, gettext("Identifier")) @@ -1316,7 +1817,6 @@ Module PBMap SetActiveWindow(*Marker\EditWindow) EndIf EndProcedure - ;-*** Procedure DrawMarker(x.i, y.i, Nb.i, *Marker.Marker) Protected Text.s @@ -1325,8 +1825,8 @@ Module PBMap 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) + ; FillPath(#PB_Path_Preserve) + ; ClipPath(#PB_Path_Preserve) AddPathCircle(0, -16, 5, 0, 360, #PB_Path_Relative) VectorSourceColor(*Marker\Color) FillPath(#PB_Path_Preserve) @@ -1353,7 +1853,7 @@ Module PBMap EndIf If PBMap\Options\ShowMarkersLegend And *Marker\Legend <> "" VectorFont(FontID(PBMap\Font), 13) - ;dessin d'un cadre avec fond transparent + ; dessin d'un cadre avec fond transparent Protected Height = VectorParagraphHeight(*Marker\Legend, 100, 100) Protected Width.l If Height < 20 ; une ligne @@ -1388,47 +1888,49 @@ Module PBMap Next EndProcedure + ;-*** Main drawing stuff + Procedure DrawDebugInfos(*Drawing.DrawingParameters) ; Display how many images in cache VectorFont(FontID(PBMap\Font), 16) VectorSourceColor(RGBA(0, 0, 0, 80)) MovePathCursor(50, 50) - DrawVectorText(Str(MapSize(PBMap\MemCache\Images()))) + DrawVectorText("Images in cache : " + Str(MapSize(PBMap\MemCache\Images()))) MovePathCursor(50, 70) Protected ThreadCounter = 0 ForEach PBMap\MemCache\Images() - If PBMap\MemCache\Images()\Tile <> 0 + If PBMap\MemCache\Images()\Tile > 0 If IsThread(PBMap\MemCache\Images()\Tile\GetImageThread) ThreadCounter + 1 EndIf EndIf Next - DrawVectorText(Str(ThreadCounter)) + DrawVectorText("Threads nb : " + Str(ThreadCounter)) MovePathCursor(50, 90) - DrawVectorText(Str(PBMap\Zoom)) + DrawVectorText("Zoom : " + Str(PBMap\Zoom)) MovePathCursor(50, 110) - DrawVectorText(StrD(*Drawing\Bounds\NorthWest\Latitude) + "," + StrD(*Drawing\Bounds\NorthWest\Longitude)) + DrawVectorText("Lat-Lon 1 : " + StrD(*Drawing\Bounds\NorthWest\Latitude) + "," + StrD(*Drawing\Bounds\NorthWest\Longitude)) MovePathCursor(50, 130) - DrawVectorText(StrD(*Drawing\Bounds\SouthEast\Latitude) + "," + StrD(*Drawing\Bounds\SouthEast\Longitude)) + DrawVectorText("Lat-Lon 2 : " + StrD(*Drawing\Bounds\SouthEast\Latitude) + "," + StrD(*Drawing\Bounds\SouthEast\Longitude)) EndProcedure Procedure DrawOSMCopyright(*Drawing.DrawingParameters) - Protected Text.s = "© OpenStreetMap contributors" + Protected Text.s = "© OpenStreetMap contributors" VectorFont(FontID(PBMap\Font), 12) VectorSourceColor(RGBA(0, 0, 0, 80)) MovePathCursor(GadgetWidth(PBMAP\Gadget) - VectorTextWidth(Text), GadgetHeight(PBMAP\Gadget) - 20) DrawVectorText(Text) EndProcedure - ;-*** Main drawing Procedure Drawing() Protected *Drawing.DrawingParameters = @PBMap\Drawing Protected PixelCenter.PixelCoordinates Protected Px.d, Py.d,a, ts = PBMap\TileSize, nx, ny + Protected LayerOrder.i = 0 Protected NW.Coordinates, SE.Coordinates PBMap\Dirty = #False PBMap\Redraw = #False - ;*** Precalc some values + ; *** Precalc some values *Drawing\RadiusX = GadgetWidth(PBMap\Gadget) / 2 *Drawing\RadiusY = GadgetHeight(PBMap\Gadget) / 2 *Drawing\GeographicCoordinates\Latitude = PBMap\GeographicCoordinates\Latitude @@ -1438,10 +1940,10 @@ Module PBMap ; Pixel shift, aka position in the tile Px = *Drawing\TileCoordinates\x Py = *Drawing\TileCoordinates\y - *Drawing\DeltaX = Px * ts - (Int(Px) * ts) ;Don't forget the Int() ! + *Drawing\DeltaX = Px * ts - (Int(Px) * ts) ; Don't forget the Int() ! *Drawing\DeltaY = Py * ts - (Int(Py) * ts) - ;Drawing boundaries - nx = *Drawing\RadiusX / ts ;How many tiles around the point + ; Drawing boundaries + nx = *Drawing\RadiusX / ts ; How many tiles around the point ny = *Drawing\RadiusY / ts NW\x = Px - nx - 1 NW\y = Py - ny - 1 @@ -1449,18 +1951,21 @@ Module PBMap SE\y = Py + ny + 2 TileXY2LatLon(@NW, *Drawing\Bounds\NorthWest, PBMap\Zoom) TileXY2LatLon(@SE, *Drawing\Bounds\SouthEast, PBMap\Zoom) - ;*Drawing\Width = (SE\x / Pow(2, PBMap\Zoom) * 360.0) - (NW\x / Pow(2, PBMap\Zoom) * 360.0) ;Calculus without clipping - ;*Drawing\Height = *Drawing\Bounds\NorthWest\Latitude - *Drawing\Bounds\SouthEast\Latitude - ;*** + ; *Drawing\Width = (SE\x / Pow(2, PBMap\Zoom) * 360.0) - (NW\x / Pow(2, PBMap\Zoom) * 360.0) ; Calculus without clipping + ; *Drawing\Height = *Drawing\Bounds\NorthWest\Latitude - *Drawing\Bounds\SouthEast\Latitude + ; *** ; Main drawing stuff StartVectorDrawing(CanvasVectorOutput(PBMap\Gadget)) - ;Clearscreen + ; Clearscreen VectorSourceColor(RGBA(150, 150, 150, 255)) FillVectorOutput() - ;TODO add in layers of tiles ;this way we can cache them as 0 base 1.n layers + ; TODO add in layers of tiles ; this way we can cache them as 0 base 1.n layers ; such as for openseamap tiles which are overlaid. not that efficent from here though. - ForEach PBMap\Layers() - DrawTiles(*Drawing, ListIndex(PBMap\Layers())) + ; Draws layers based on their number + ForEach PBMap\LayersList() + If PBMap\LayersList()\Enabled + DrawTiles(*Drawing, PBMap\LayersList()\Name) + EndIf Next If PBMap\Options\ShowTrack DrawTracks(*Drawing) @@ -1480,36 +1985,28 @@ Module PBMap If PBMap\Options\ShowScale DrawScale(*Drawing, 10, GadgetHeight(PBMAP\Gadget) - 20, 192) EndIf + If PBMap\Options\ShowZoom + DrawZoom(GadgetWidth(PBMap\Gadget) - 30, 5) ; ajout YA - affiche le niveau de zoom + EndIf DrawOSMCopyright(*Drawing) StopVectorDrawing() EndProcedure Procedure Refresh() PBMap\Redraw = #True - ;Drawing() + ; Drawing() EndProcedure - Procedure.d Pixel2Lon(x) - Protected NewX.d = (PBMap\PixelCoordinates\x - PBMap\Drawing\RadiusX + x) / PBMap\TileSize - Protected n.d = Pow(2.0, PBMap\Zoom) - ; double mod is to ensure the longitude to be in the range [-180;180[ - ProcedureReturn Mod(Mod(NewX / n * 360.0, 360.0) + 360.0, 360.0) - 180 - EndProcedure + ;-*** Misc functions - Procedure.d Pixel2Lat(y) - Protected NewY.d = (PBMap\PixelCoordinates\y - PBMap\Drawing\RadiusY + y) / PBMap\TileSize - Protected n.d = Pow(2.0, PBMap\Zoom) - ProcedureReturn Degree(ATan(SinH(#PI * (1.0 - 2.0 * NewY / n)))) - EndProcedure - - Procedure.d MouseLongitude() + Procedure.d GetMouseLongitude() Protected MouseX.d = (PBMap\PixelCoordinates\x - PBMap\Drawing\RadiusX + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX)) / PBMap\TileSize Protected n.d = Pow(2.0, PBMap\Zoom) - ; double mod is to ensure the longitude to be in the range [-180;180[ + ; double mod is to ensure the longitude to be in the range [-180; 180[ ProcedureReturn Mod(Mod(MouseX / n * 360.0, 360.0) + 360.0, 360.0) - 180 EndProcedure - Procedure.d MouseLatitude() + Procedure.d GetMouseLatitude() Protected MouseY.d = (PBMap\PixelCoordinates\y - PBMap\Drawing\RadiusY + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY)) / PBMap\TileSize Protected n.d = Pow(2.0, PBMap\Zoom) ProcedureReturn Degree(ATan(SinH(#PI * (1.0 - 2.0 * MouseY / n)))) @@ -1549,34 +2046,34 @@ Module PBMap EndIf EndProcedure - Procedure ZoomToArea(MinY.d, MaxY.d, MinX.d, MaxX.d) - ;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 DeltaX.d = MaxX - MinX ;assumption ! In original code DeltaX have no source + Procedure SetZoomToArea(MinY.d, MaxY.d, MinX.d, MaxX.d) + ; 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 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 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 / (PBMap\Drawing\RadiusX * 2) - Protected vy0.d = Log(Tan(#PI*(0.25 + centerY/360))); - Protected vy1.d = Log(Tan(#PI*(0.25 + MaxY/360))) ; - Protected viewHeightHalf.d = PBMap\Drawing\RadiusY ; + Protected vy0.d = Log(Tan(#PI*(0.25 + centerY/360))); + Protected vy1.d = Log(Tan(#PI*(0.25 + MaxY/360))) ; + Protected viewHeightHalf.d = PBMap\Drawing\RadiusY ; 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; + Protected lon.d = centerX; + Protected lat.d = centerY; SetLocation(lat, lon, Round(zoom,#PB_Round_Down)) Else SetLocation(PBMap\GeographicCoordinates\Latitude, PBMap\GeographicCoordinates\Longitude, 15) EndIf EndProcedure - Procedure ZoomToTracks(*Tracks.Tracks) + Procedure SetZoomToTracks(*Tracks.Tracks) Protected MinY.d, MaxY.d, MinX.d, MaxX.d If ListSize(*Tracks\Track()) > 0 With *Tracks\Track() @@ -1596,7 +2093,7 @@ Module PBMap MaxY = \Latitude EndIf Next - ZoomToArea(MinY.d, MaxY.d, MinX.d, MaxX.d) + SetZoomToArea(MinY.d, MaxY.d, MinX.d, MaxX.d) EndWith EndIf EndProcedure @@ -1639,10 +2136,18 @@ Module PBMap PBMap\CallBackMainPointer = CallBackMainPointer EndProcedure + Procedure SetCallBackMarker(CallBackLocation.i) + PBMap\CallBackMarker = CallBackLocation + EndProcedure + + Procedure SetCallBackLeftClic(CallBackLocation.i) + PBMap\CallBackLeftClic = CallBackLocation + EndProcedure + Procedure SetMapScaleUnit(ScaleUnit.i = PBMAP::#SCALE_KM) PBMap\Options\ScaleUnit = ScaleUnit PBMap\Redraw = #True - ;Drawing() + ; Drawing() EndProcedure ; User mode @@ -1658,9 +2163,9 @@ Module PBMap ProcedureReturn PBMap\Mode EndProcedure - ;Zoom on x, y pixel position from the center - Procedure ZoomOnPixel(x, y, zoom) - ;*** First : Zoom + ; Zoom on x, y pixel position from the center + Procedure SetZoomOnPixel(x, y, zoom) + ; *** First : Zoom PBMap\Zoom + zoom If PBMap\Zoom > PBMap\ZoomMax : PBMap\Zoom = PBMap\ZoomMax : ProcedureReturn : EndIf If PBMap\Zoom < PBMap\ZoomMin : PBMap\Zoom = PBMap\ZoomMin : ProcedureReturn : EndIf @@ -1681,12 +2186,12 @@ Module PBMap EndIf EndProcedure - ;Zoom on x, y position relative to the canvas gadget - Procedure ZoomOnPixelRel(x, y, zoom) - ZoomOnPixel(x - PBMap\Drawing\RadiusX, y - PBMap\Drawing\RadiusY, zoom) + ; Zoom on x, y position relative to the canvas gadget + Procedure SetZoomOnPixelRel(x, y, zoom) + SetZoomOnPixel(x - PBMap\Drawing\RadiusX, y - PBMap\Drawing\RadiusY, zoom) EndProcedure - ;Go to x, y position relative to the canvas gadget left up + ; Go to x, y position relative to the canvas gadget left up Procedure GotoPixelRel(x, y) LatLon2Pixel(@PBMap\GeographicCoordinates, @PBMap\PixelCoordinates, PBMap\Zoom) PBMap\PixelCoordinates\x + x - PBMap\Drawing\RadiusX @@ -1700,7 +2205,7 @@ Module PBMap EndIf EndProcedure - ;Go to x, y position relative to the canvas gadget + ; Go to x, y position relative to the canvas gadget Procedure GotoPixel(x, y) PBMap\PixelCoordinates\x = x PBMap\PixelCoordinates\y = y @@ -1735,14 +2240,16 @@ Module PBMap URLEncoder(Address) + "?format=json&addressdetails=0&polygon=0&limit=1" Protected JSONFileName.s = PBMap\Options\HDDCachePath + "nominatimresponse.json" - ; Protected *Buffer = CurlReceiveHTTPToMemory("http://nominatim.openstreetmap.org/search/Unter%20den%20Linden%201%20Berlin?format=json&addressdetails=1&limit=1&polygon_svg=1", PBMap\Options\ProxyURL, PBMap\Options\ProxyPort, PBMap\Options\ProxyUser, PBMap\Options\ProxyPassword) - ; Debug *Buffer - ; Debug MemorySize(*Buffer) - ; Protected JSon.s = PeekS(*Buffer, MemorySize(*Buffer), #PB_UTF8) - HTTPProxy(PBMap\Options\ProxyURL + ":" + PBMap\Options\ProxyPort, PBMap\Options\ProxyUser, PBMap\Options\ProxyPassword) + ; Protected *Buffer = CurlReceiveHTTPToMemory("http://nominatim.openstreetmap.org/search/Unter%20den%20Linden%201%20Berlin?format=json&addressdetails=1&limit=1&polygon_svg=1", PBMap\Options\ProxyURL, PBMap\Options\ProxyPort, PBMap\Options\ProxyUser, PBMap\Options\ProxyPassword) + ; Debug *Buffer + ; Debug MemorySize(*Buffer) + ; Protected JSon.s = PeekS(*Buffer, MemorySize(*Buffer), #PB_UTF8) + If PBMap\Options\Proxy + HTTPProxy(PBMap\Options\ProxyURL + ":" + PBMap\Options\ProxyPort, PBMap\Options\ProxyUser, PBMap\Options\ProxyPassword) + EndIf Size = ReceiveHTTPFile(Query, JSONFileName) If LoadJSON(0, JSONFileName) = 0 - ;Demivec's code + ; Demivec's code MyDebug( JSONErrorMessage() + " at position " + JSONErrorPosition() + " in line " + JSONErrorLine() + " of JSON web Data", 1) @@ -1760,57 +2267,13 @@ Module PBMap *ReturnPosition\Latitude = ValD(lat) *ReturnPosition\Longitude = ValD(lon) EndIf - If lat<> "" And lon <> "" - ZoomToArea(bbox\SouthEast\Latitude, bbox\NorthWest\Latitude, bbox\NorthWest\Longitude, bbox\SouthEast\Longitude) - ;SetLocation(Position\Latitude, Position\Longitude) + If lat <> "" And lon <> "" + SetZoomToArea(bbox\SouthEast\Latitude, bbox\NorthWest\Latitude, bbox\NorthWest\Longitude, bbox\SouthEast\Longitude) + ; SetLocation(Position\Latitude, Position\Longitude) EndIf EndIf EndProcedure - ;(c) ts-soft http://www.purebasic.fr/english/viewtopic.php?f=12&t=58657&hilit=createdirectory&view=unread#unread - CompilerSelect #PB_Compiler_OS - CompilerCase #PB_OS_Windows - #FILE_ATTRIBUTE_DEVICE = 64 ;(0x40) - #FILE_ATTRIBUTE_INTEGRITY_STREAM = 32768 ;(0x8000) - #FILE_ATTRIBUTE_NOT_CONTENT_INDEXED = 8192;(0x2000) - #FILE_ATTRIBUTE_NO_SCRUB_DATA = 131072;(0x20000) - #FILE_ATTRIBUTE_VIRTUAL = 65536;(0x10000) - #FILE_ATTRIBUTE_DONTSETFLAGS = ~(#FILE_ATTRIBUTE_DIRECTORY| - #FILE_ATTRIBUTE_SPARSE_FILE| - #FILE_ATTRIBUTE_OFFLINE| - #FILE_ATTRIBUTE_NOT_CONTENT_INDEXED| - #FILE_ATTRIBUTE_VIRTUAL| - 0) - Macro SetFileAttributesEx(Name, Attribs) - SetFileAttributes(Name, Attribs & #FILE_ATTRIBUTE_DONTSETFLAGS) - EndMacro - CompilerDefault - Macro SetFileAttributesEx(Name, Attribs) - SetFileAttributes(Name, Attribs) - EndMacro - CompilerEndSelect - - Procedure CreateDirectoryEx(DirectoryName.s, FileAttribute = #PB_Default) - Protected i, c, tmp.s - If Right(DirectoryName, 1) = slash - DirectoryName = Left(DirectoryName, Len(DirectoryName) -1) - EndIf - c = CountString(DirectoryName, slash) + 1 - For i = 1 To c - tmp + StringField(DirectoryName, i, slash) - If FileSize(tmp) <> -2 - CreateDirectory(tmp) - EndIf - tmp + slash - Next - If FileAttribute <> #PB_Default - SetFileAttributesEx(DirectoryName, FileAttribute) - EndIf - If FileSize(DirectoryName) = -2 - ProcedureReturn #True - EndIf - EndProcedure - Procedure.i ClearDiskCache() If PBMap\Options\Warning Protected Result.i = MessageRequester("Warning", "You will clear all cache content in " + PBMap\Options\HDDCachePath + ". Are you sure ?",#PB_MessageRequester_YesNo) @@ -1819,30 +2282,32 @@ Module PBMap EndIf EndIf If DeleteDirectory(PBMap\Options\HDDCachePath, "", #PB_FileSystem_Recursive) - MyDebug("Cache in : " + PBMap\Options\HDDCachePath + " cleared") + MyDebug("Cache in : " + PBMap\Options\HDDCachePath + " cleared", 3) CreateDirectoryEx(PBMap\Options\HDDCachePath) ProcedureReturn #True Else - MyDebug("Can't clear cache in " + PBMap\Options\HDDCachePath) + MyDebug("Can't clear cache in " + PBMap\Options\HDDCachePath, 3) ProcedureReturn #False EndIf EndProcedure + ;-*** Main PBMap functions + Procedure CanvasEvents() Protected CanvasMouseX.d, CanvasMouseY.d, MouseX.d, MouseY.d Protected MarkerCoords.PixelCoordinates, *Tile.Tile, MapWidth = Pow(2, PBMap\Zoom) * PBMap\TileSize Protected key.s, Touch.i Protected Pixel.PixelCoordinates Static CtrlKey - PBMap\Moving = #False + Protected Location.GeographicCoordinates CanvasMouseX = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) - PBMap\Drawing\RadiusX CanvasMouseY = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY) - PBMap\Drawing\RadiusY ; rotation wip - ; StartVectorDrawing(CanvasVectorOutput(PBMap\Gadget)) - ; RotateCoordinates(0, 0, PBMap\Angle) - ; CanvasMouseX = ConvertCoordinateX(MouseX, MouseY, #PB_Coordinate_Device, #PB_Coordinate_User) - ; CanvasMouseY = ConvertCoordinateY(MouseX, MouseY, #PB_Coordinate_Device, #PB_Coordinate_User) - ; StopVectorDrawing() + ; StartVectorDrawing(CanvasVectorOutput(PBMap\Gadget)) + ; RotateCoordinates(0, 0, PBMap\Angle) + ; CanvasMouseX = ConvertCoordinateX(MouseX, MouseY, #PB_Coordinate_Device, #PB_Coordinate_User) + ; CanvasMouseY = ConvertCoordinateY(MouseX, MouseY, #PB_Coordinate_Device, #PB_Coordinate_User) + ; StopVectorDrawing() Select EventType() Case #PB_EventType_Focus PBMap\Drawing\RadiusX = GadgetWidth(PBMap\Gadget) / 2 @@ -1894,19 +2359,19 @@ Module PBMap LatLon2Pixel(@PBMap\GeographicCoordinates, @PBMap\PixelCoordinates, PBMap\Zoom) MouseX = PBMap\PixelCoordinates\x + CanvasMouseX MouseY = PBMap\PixelCoordinates\y + CanvasMouseY - ;Clip MouseX to the map range (in X, the map is infinite) + ; Clip MouseX to the map range (in X, the map is infinite) MouseX = Mod(Mod(MouseX, MapWidth) + MapWidth, MapWidth) Touch = #False - ;Check if the mouse touch a marker + ; Check if the mouse touch a marker ForEach PBMap\Markers() LatLon2Pixel(@PBMap\Markers()\GeographicCoordinates, @MarkerCoords, PBMap\Zoom) If Distance(MarkerCoords\x, MarkerCoords\y, MouseX, MouseY) < 8 If PBMap\Mode = #MODE_DEFAULT Or PBMap\Mode = #MODE_SELECT - ;Jump to the marker + ; Jump to the marker Touch = #True SetLocation(PBMap\Markers()\GeographicCoordinates\Latitude, PBMap\Markers()\GeographicCoordinates\Longitude) ElseIf PBMap\Mode = #MODE_EDIT - ;Edit the legend + ; Edit the legend MarkerEdit(@PBMap\Markers()) EndIf Break @@ -1917,36 +2382,37 @@ Module PBMap EndIf Case #PB_EventType_MouseWheel If PBMap\Options\WheelMouseRelative - ;Relative zoom (centered on the mouse) - ZoomOnPixel(CanvasMouseX, CanvasMouseY, GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_WheelDelta)) + ; Relative zoom (centered on the mouse) + SetZoomOnPixel(CanvasMouseX, CanvasMouseY, GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_WheelDelta)) Else - ;Absolute zoom (centered on the center of the map) + ; Absolute zoom (centered on the center of the map) SetZoom(GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_WheelDelta), #PB_Relative) EndIf Case #PB_EventType_LeftButtonDown - ;LatLon2Pixel(@PBMap\GeographicCoordinates, @PBMap\PixelCoordinates, PBMap\Zoom) - ;Mem cursor Coord + ; LatLon2Pixel(@PBMap\GeographicCoordinates, @PBMap\PixelCoordinates, PBMap\Zoom) + PBMap\Dragging = #True + ; Memorize cursor Coord PBMap\MoveStartingPoint\x = CanvasMouseX PBMap\MoveStartingPoint\y = CanvasMouseY - ;Clip MouseX to the map range (in X, the map is infinite) + ; Clip MouseX to the map range (in X, the map is infinite) PBMap\MoveStartingPoint\x = Mod(Mod(PBMap\MoveStartingPoint\x, MapWidth) + MapWidth, MapWidth) If PBMap\Mode = #MODE_DEFAULT Or PBMap\Mode = #MODE_SELECT PBMap\EditMarker = #False - ;Check if we select marker(s) + ; Check if we select marker(s) ForEach PBMap\Markers() If CtrlKey = #False - PBMap\Markers()\Selected = #False ;If no CTRL key, deselect everything and select only the focused marker + PBMap\Markers()\Selected = #False ; If no CTRL key, deselect everything and select only the focused marker EndIf If PBMap\Markers()\Focus PBMap\Markers()\Selected = #True - PBMap\EditMarker = #True;ListIndex(PBMap\Markers()) + PBMap\EditMarker = #True; ListIndex(PBMap\Markers()) PBMap\Markers()\Focus = #False EndIf Next - ;Check if we select track(s) + ; Check if we select track(s) ForEach PBMap\TracksList() If CtrlKey = #False - PBMap\TracksList()\Selected = #False ;If no CTRL key, deselect everything and select only the focused track + PBMap\TracksList()\Selected = #False ; If no CTRL key, deselect everything and select only the focused track EndIf If PBMap\TracksList()\Focus PBMap\TracksList()\Selected = #True @@ -1954,15 +2420,27 @@ Module PBMap EndIf Next EndIf + ; YA pour sélectionner un point de la trace avec le clic gauche + If PBMap\EditMarker = #False + Location\Latitude = GetMouseLatitude() + Location\Longitude = GetMouseLongitude() + If PBMap\CallBackLeftClic > 0 + CallFunctionFast(PBMap\CallBackLeftClic, @Location) + EndIf + ; ajout YA // change la forme du pointeur de souris pour les déplacements de la carte + SetGadgetAttribute(PBMap\Gadget,#PB_Canvas_Cursor,#PB_Cursor_Hand) + Else + SetGadgetAttribute(PBMap\Gadget,#PB_Canvas_Cursor,#PB_Cursor_Default) ; ajout YA pour remettre le pointeur souris en normal + EndIf Case #PB_EventType_MouseMove - PBMap\Moving = #True ; Drag - If PBMap\MoveStartingPoint\x <> - 1 + If PBMap\Dragging + ; If PBMap\MoveStartingPoint\x <> - 1 MouseX = CanvasMouseX - PBMap\MoveStartingPoint\x MouseY = CanvasMouseY - PBMap\MoveStartingPoint\y PBMap\MoveStartingPoint\x = CanvasMouseX PBMap\MoveStartingPoint\y = CanvasMouseY - ;Move selected markers + ; Move selected markers If PBMap\EditMarker And (PBMap\Mode = #MODE_DEFAULT Or PBMap\Mode = #MODE_SELECT) ForEach PBMap\Markers() If PBMap\Markers()\Selected @@ -1973,14 +2451,14 @@ Module PBMap EndIf Next ElseIf PBMap\Mode = #MODE_DEFAULT Or PBMap\Mode = #MODE_HAND - ;Move map only - LatLon2Pixel(@PBMap\GeographicCoordinates, @PBMap\PixelCoordinates, PBMap\Zoom) ;This line could be removed as the coordinates don't have to change but I want to be sure we rely only on geographic coordinates + ; Move map only + LatLon2Pixel(@PBMap\GeographicCoordinates, @PBMap\PixelCoordinates, PBMap\Zoom) ; This line could be removed as the coordinates don't have to change but I want to be sure we rely only on geographic coordinates PBMap\PixelCoordinates\x - MouseX - ;Ensures that pixel position stay in the range [0..2^Zoom*PBMap\TileSize[ coz of the wrapping of the map + ; Ensures that pixel position stay in the range [0..2^Zoom*PBMap\TileSize[ coz of the wrapping of the map PBMap\PixelCoordinates\x = Mod(Mod(PBMap\PixelCoordinates\x, MapWidth) + MapWidth, MapWidth) PBMap\PixelCoordinates\y - MouseY Pixel2LatLon(@PBMap\PixelCoordinates, @PBMap\GeographicCoordinates, PBMap\Zoom) - ;If CallBackLocation send Location to function + ; If CallBackLocation send Location to function If PBMap\CallBackLocation > 0 CallFunctionFast(PBMap\CallBackLocation, @PBMap\GeographicCoordinates) EndIf @@ -1991,30 +2469,31 @@ Module PBMap LatLon2Pixel(@PBMap\GeographicCoordinates, @PBMap\PixelCoordinates, PBMap\Zoom) MouseX = PBMap\PixelCoordinates\x + CanvasMouseX MouseY = PBMap\PixelCoordinates\y + CanvasMouseY - ;Clip MouseX to the map range (in X, the map is infinite) + ; Clip MouseX to the map range (in X, the map is infinite) MouseX = Mod(Mod(MouseX, MapWidth) + MapWidth, MapWidth) If PBMap\Mode = #MODE_DEFAULT Or PBMap\Mode = #MODE_SELECT Or PBMap\Mode = #MODE_EDIT - ;Check if mouse touch markers + ; Check if mouse touch markers ForEach PBMap\Markers() LatLon2Pixel(@PBMap\Markers()\GeographicCoordinates, @MarkerCoords, PBMap\Zoom) If Distance(MarkerCoords\x, MarkerCoords\y, MouseX, MouseY) < 8 PBMap\Markers()\Focus = #True PBMap\Redraw = #True ElseIf PBMap\Markers()\Focus - ;If CtrlKey = #False + ; If CtrlKey = #False PBMap\Markers()\Focus = #False PBMap\Redraw = #True EndIf Next - ;Check if mouse touch tracks + ; Check if mouse touch tracks + If PBMap\Options\ShowTrackSelection ; YA ajout pour éviter la sélection de la trace With PBMap\TracksList() - ;Trace Track + ; Trace Track If ListSize(PBMap\TracksList()) > 0 ForEach PBMap\TracksList() If ListSize(\Track()) > 0 If \Visible StartVectorDrawing(CanvasVectorOutput(PBMap\Gadget)) - ;Simulate tracks drawing + ; Simulates track drawing ForEach \Track() LatLon2Pixel(@PBMap\TracksList()\Track(), @Pixel, PBMap\Zoom) If ListIndex(\Track()) = 0 @@ -2038,24 +2517,43 @@ Module PBMap EndWith EndIf EndIf + EndIf Case #PB_EventType_LeftButtonUp - PBMap\MoveStartingPoint\x = - 1 + SetGadgetAttribute(PBMap\Gadget,#PB_Canvas_Cursor,#PB_Cursor_Default) ; ajout YA pour remettre le pointeur souris en normal + ; PBMap\MoveStartingPoint\x = - 1 + PBMap\Dragging = #False PBMap\Redraw = #True + ;YA pour connaitre les coordonnées d'un marqueur après déplacement + ForEach PBMap\Markers() + If PBMap\Markers()\Selected = #True + If PBMap\CallBackMarker > 0 + ;CallFunctionFast(PBMap\CallBackMarker, @PBMap\Markers()\GeographicCoordinates) + CallFunctionFast(PBMap\CallBackMarker, @PBMap\Markers()); + EndIf + EndIf + Next Case #PB_MAP_REDRAW - Debug "Redraw" PBMap\Redraw = #True Case #PB_MAP_RETRY - Debug "Reload" PBMap\Redraw = #True + ;- Tile web loading thread cleanup + ; After a Web tile loading thread, clean the tile structure memory, see GetImageThread() Case #PB_MAP_TILE_CLEANUP *Tile = EventData() - key = *Tile\key - ;After a Web tile loading thread, clean the tile structure memory and set the image nb in the cache - ;avoid to have threads accessing vars (and avoid mutex), see GetImageThread() - Protected timg = PBMap\MemCache\Images(key)\Tile\nImage ;Get this new tile image nb - PBMap\MemCache\Images(key)\nImage = timg ;store it in the cache using the key - FreeMemory(PBMap\MemCache\Images(key)\Tile) ;free the data needed for the thread - PBMap\MemCache\Images(key)\Tile = 0 ;clear the data ptr + key = *Tile\key + *Tile\Download = 0 + If FindMapElement(PBMap\MemCache\Images(), key) <> 0 + ; If the map element has not been deleted during the thread lifetime (should not occur) + PBMap\MemCache\Images(key)\Tile = *Tile\Size + If *Tile\Size + PBMap\MemCache\Images(key)\Tile = -1 ; Web loading thread has finished successfully + Else + PBMap\MemCache\Images(key)\Tile = 0 + EndIf + EndIf + FreeMemory(*Tile) ; Frees the data needed for the thread (*tile=PBMap\MemCache\Images(key)\Tile) + PBMap\ThreadsNB - 1 + PBMap\DownloadSlots - 1 PBMap\Redraw = #True EndSelect EndProcedure @@ -2063,6 +2561,7 @@ Module PBMap ; Redraws at regular intervals Procedure TimerEvents() If EventTimer() = PBMap\Timer And (PBMap\Redraw Or PBMap\Dirty) + MemoryCacheManagement() Drawing() EndIf EndProcedure @@ -2080,7 +2579,7 @@ Module PBMap ; Creates a canvas and attach our map 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 + 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) @@ -2088,37 +2587,61 @@ Module PBMap BindMapGadget(PBMap\Gadget) EndProcedure + Procedure Quit() + PBMap\Drawing\End = #True + ; Wait for loading threads to finish nicely. Passed 2 seconds, kills them. + Protected TimeCounter = ElapsedMilliseconds() + Repeat + ForEach PBMap\MemCache\Images() + If PBMap\MemCache\Images()\Tile > 0 + If IsThread(PBMap\MemCache\Images()\Tile\GetImageThread) + If ElapsedMilliseconds() - TimeCounter > 2000 + ; Should not occur + KillThread(PBMap\MemCache\Images()\Tile\GetImageThread) + EndIf + Else + FreeMemory(PBMap\MemCache\Images()\Tile) + PBMap\MemCache\Images()\Tile = 0 + EndIf + Else + DeleteMapElement(PBMap\MemCache\Images()) + EndIf + Next + Delay(10) + Until MapSize(PBMap\MemCache\Images()) = 0 + EndProcedure + Procedure InitPBMap(Window) - Protected Result.i - PBMap\ZoomMin = 0 - PBMap\ZoomMax = 18 - PBMap\MoveStartingPoint\x = - 1 - PBMap\TileSize = 256 - PBMap\Dirty = #False - PBMap\EditMarker = #False - PBMap\Font = LoadFont(#PB_Any, "Arial", 20, #PB_Font_Bold) - PBMap\Window = Window - PBMap\Timer = 1 - PBMap\Mode = #MODE_DEFAULT + With PBMap + Protected Result.i + \ZoomMin = 1 + \ZoomMax = 18 + \Dragging = #False + \TileSize = 256 + \Dirty = #False + \EditMarker = #False + \Font = LoadFont(#PB_Any, "Arial", 20, #PB_Font_Bold) + \Window = Window + \Timer = 1 + \Mode = #MODE_DEFAULT + \MemoryCacheAccessMutex = CreateMutex() + If \MemoryCacheAccessMutex = #False + MyDebug("Cannot create a mutex", 0) + End + EndIf + EndWith LoadOptions() - If PBMap\Options\Verbose - OpenConsole() - EndIf - CreateDirectoryEx(PBMap\Options\HDDCachePath) - If PBMap\Options\DefaultOSMServer <> "" - AddMapServerLayer("OSM", 1, PBMap\Options\DefaultOSMServer) - EndIf TechnicalImagesCreation() SetLocation(0, 0) EndProcedure EndModule -;**************************************************************** -; +; **************************************************************** +; ;- Example of application -; -;**************************************************************** +; +; **************************************************************** CompilerIf #PB_Compiler_IsMainFile InitNetwork() @@ -2130,8 +2653,8 @@ CompilerIf #PB_Compiler_IsMainFile #Gdt_Right #Gdt_Up #Gdt_Down - ;#Gdt_RotateLeft - ;#Gdt_RotateRight + ; #Gdt_RotateLeft + ; #Gdt_RotateRight #Button_4 #Button_5 #Combo_0 @@ -2143,8 +2666,11 @@ CompilerIf #PB_Compiler_IsMainFile #StringLatitude #StringLongitude #Gdt_LoadGpx + #Gdt_SaveGpx #Gdt_AddMarker #Gdt_AddOpenseaMap + #Gdt_AddHereMap + #Gdt_AddGeoServerMap #Gdt_Degrees #Gdt_EditMode #Gdt_ClearDiskCache @@ -2152,7 +2678,7 @@ CompilerIf #PB_Compiler_IsMainFile #StringGeoLocationQuery EndEnumeration - ;Menu events + ; Menu events Enumeration #MenuEventLonLatStringEnter #MenuEventGeoLocationStringEnter @@ -2169,7 +2695,7 @@ CompilerIf #PB_Compiler_IsMainFile ProcedureReturn 0 EndProcedure - ;This callback demonstration procedure will receive relative coords from canvas + ; This callback demonstration procedure will receive relative coords from canvas Procedure MyMarker(x.i, y.i, Focus = #False, Selected = #False) Protected color = RGBA(0, 255, 0, 255) MovePathCursor(x, y) @@ -2190,6 +2716,10 @@ CompilerIf #PB_Compiler_IsMainFile EndIf EndProcedure + Procedure MarkerMoveCallBack(*Marker.PBMap::Marker) + Debug "Identifier:"+*Marker\Identifier+"("+StrD(*Marker\GeographicCoordinates\Latitude)+","+StrD(*Marker\GeographicCoordinates\Longitude)+")" + 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) @@ -2200,8 +2730,8 @@ CompilerIf #PB_Compiler_IsMainFile 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_RotateLeft, WindowWidth(#Window_0) - 150 ,#PB_Ignore,#PB_Ignore,#PB_Ignore) - ;ResizeGadget(#Gdt_RotateRight,WindowWidth(#Window_0) - 90 ,#PB_Ignore,#PB_Ignore,#PB_Ignore) + ; ResizeGadget(#Gdt_RotateLeft, WindowWidth(#Window_0) - 150 ,#PB_Ignore,#PB_Ignore,#PB_Ignore) + ; ResizeGadget(#Gdt_RotateRight,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) @@ -2213,7 +2743,10 @@ CompilerIf #PB_Compiler_IsMainFile 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) + ResizeGadget(#Gdt_SaveGpx,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#Gdt_AddOpenseaMap,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore) + ResizeGadget(#Gdt_AddHereMap,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore) + ResizeGadget(#Gdt_AddGeoServerMap,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#Gdt_Degrees,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#Gdt_EditMode,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#Gdt_ClearDiskCache,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore) @@ -2229,64 +2762,70 @@ CompilerIf #PB_Compiler_IsMainFile LoadFont(1, "Arial", 12, #PB_Font_Bold) LoadFont(2, "Arial", 8) - TextGadget(#Text_1, 530, 50, 60, 15, "Movements") - ;ButtonGadget(#Gdt_RotateLeft, 550, 070, 30, 30, "LRot") : SetGadgetFont(#Gdt_RotateLeft, FontID(2)) - ;ButtonGadget(#Gdt_RotateRight, 610, 070, 30, 30, "RRot") : SetGadgetFont(#Gdt_RotateRight, FontID(2)) - 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)) - TextGadget(#Text_3, 530, 230, 50, 15, "Latitude ") - StringGadget(#StringLatitude, 580, 230, 90, 20, "") - TextGadget(#Text_4, 530, 250, 50, 15, "Longitude ") - StringGadget(#StringLongitude, 580, 250, 90, 20, "") - ButtonGadget(#Gdt_AddMarker, 530, 280, 150, 30, "Add Marker") - ButtonGadget(#Gdt_LoadGpx, 530, 310, 150, 30, "Load GPX") - ButtonGadget(#Gdt_AddOpenseaMap, 530, 340, 150, 30, "Show/Hide OpenSeaMap", #PB_Button_Toggle) - ButtonGadget(#Gdt_Degrees, 530, 370, 150, 30, "Show/Hide Degrees", #PB_Button_Toggle) - ButtonGadget(#Gdt_EditMode, 530, 400, 150, 30, "Edit mode ON/OFF", #PB_Button_Toggle) - ButtonGadget(#Gdt_ClearDiskCache, 530, 430, 150, 30, "Clear disk cache", #PB_Button_Toggle) - TextGadget(#TextGeoLocationQuery, 530, 465, 150, 15, "Enter an address") - StringGadget(#StringGeoLocationQuery, 530, 480, 150, 20, "") + TextGadget(#Text_1, 530, 10, 60, 15, "Movements") + ; ButtonGadget(#Gdt_RotateLeft, 550, 070, 30, 30, "LRot") : SetGadgetFont(#Gdt_RotateLeft, FontID(2)) + ; ButtonGadget(#Gdt_RotateRight, 610, 070, 30, 30, "RRot") : SetGadgetFont(#Gdt_RotateRight, FontID(2)) + ButtonGadget(#Gdt_Left, 550, 60, 30, 30, Chr($25C4)) : SetGadgetFont(#Gdt_Left, FontID(0)) + ButtonGadget(#Gdt_Right, 610, 60, 30, 30, Chr($25BA)) : SetGadgetFont(#Gdt_Right, FontID(0)) + ButtonGadget(#Gdt_Up, 580, 030, 30, 30, Chr($25B2)) : SetGadgetFont(#Gdt_Up, FontID(0)) + ButtonGadget(#Gdt_Down, 580, 90, 30, 30, Chr($25BC)) : SetGadgetFont(#Gdt_Down, FontID(0)) + TextGadget(#Text_2, 530, 120, 60, 15, "Zoom") + ButtonGadget(#Button_4, 550, 140, 50, 30, " + ") : SetGadgetFont(#Button_4, FontID(1)) + ButtonGadget(#Button_5, 600, 140, 50, 30, " - ") : SetGadgetFont(#Button_5, FontID(1)) + TextGadget(#Text_3, 530, 190, 50, 15, "Latitude ") + StringGadget(#StringLatitude, 580, 190, 90, 20, "") + TextGadget(#Text_4, 530, 210, 50, 15, "Longitude ") + StringGadget(#StringLongitude, 580, 210, 90, 20, "") + ButtonGadget(#Gdt_AddMarker, 530, 240, 150, 30, "Add Marker") + ButtonGadget(#Gdt_LoadGpx, 530, 270, 150, 30, "Load GPX") + ButtonGadget(#Gdt_SaveGpx, 530, 300, 150, 30, "Save GPX") + ButtonGadget(#Gdt_AddOpenseaMap, 530, 330, 150, 30, "Show/Hide OpenSeaMap", #PB_Button_Toggle) + ButtonGadget(#Gdt_AddHereMap, 530, 360, 150, 30, "Show/Hide HERE Aerial", #PB_Button_Toggle) + ButtonGadget(#Gdt_AddGeoServerMap, 530, 390, 150, 30, "Show/Hide Geoserver layer", #PB_Button_Toggle) + ButtonGadget(#Gdt_Degrees, 530, 420, 150, 30, "Show/Hide Degrees", #PB_Button_Toggle) + ButtonGadget(#Gdt_EditMode, 530, 450, 150, 30, "Edit mode ON/OFF", #PB_Button_Toggle) + ButtonGadget(#Gdt_ClearDiskCache, 530, 480, 150, 30, "Clear disk cache", #PB_Button_Toggle) + TextGadget(#TextGeoLocationQuery, 530, 515, 150, 15, "Enter an address") + StringGadget(#StringGeoLocationQuery, 530, 530, 150, 20, "") SetActiveGadget(#StringGeoLocationQuery) AddKeyboardShortcut(#Window_0, #PB_Shortcut_Return, #MenuEventGeoLocationStringEnter) - ;*** TODO : code to remove when the SetActiveGadget(-1) will be fixed + ; *** TODO : code to remove when the SetActiveGadget(-1) will be fixed CompilerIf #PB_Compiler_OS = #PB_OS_Linux Define Dummy = ButtonGadget(#PB_Any, 0, 0, 1, 1, "Dummy") HideGadget(Dummy, 1) CompilerElse Define Dummy = -1 CompilerEndIf - ;*** + ; *** Define Event.i, Gadget.i, Quit.b = #False Define pfValue.d - Define OpenSeaMap = 0, Degrees = 1 + Define Degrees = 1 Define *Track - ;Our main gadget + ; Our main gadget PBMap::InitPBMap(#Window_0) - PBMap::SetOption("ShowDegrees", "0") : Degrees = 0 + PBMap::SetOption("ShowDegrees", "1") : Degrees = 0 PBMap::SetOption("ShowDebugInfos", "0") + PBMap::SetDebugLevel(5) + PBMap::SetOption("Verbose", "0") PBMap::SetOption("ShowScale", "1") PBMap::SetOption("Warning", "1") PBMap::SetOption("ShowMarkersLegend", "1") PBMap::SetOption("ShowTrackKms", "1") - PBMap::SetOption("ColourFocus", "$FFFF00AA") + PBMap::SetOption("ColourFocus", "$FFFF00AA") PBMap::MapGadget(#Map, 10, 10, 512, 512) PBMap::SetCallBackMainPointer(@MainPointer()) ; To change the main pointer (center of the view) PBMap::SetCallBackLocation(@UpdateLocation()) ; To obtain realtime coordinates PBMap::SetLocation(-36.81148, 175.08634,12) ; Change the PBMap coordinates PBMAP::SetMapScaleUnit(PBMAP::#SCALE_KM) ; To change the scale unit PBMap::AddMarker(49.0446828398, 2.0349812508, "", "", -1, @MyMarker()) ; To add a marker with a customised GFX + PBMap::SetCallBackMarker(@MarkerMoveCallBack()) Repeat Event = WaitWindowEvent() Select Event Case #PB_Event_CloseWindow : Quit = 1 - Case #PB_Event_Gadget ;{ + Case #PB_Event_Gadget ; { Gadget = EventGadget() Select Gadget Case #Gdt_Up @@ -2297,12 +2836,12 @@ CompilerIf #PB_Compiler_IsMainFile 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 #Gdt_RotateLeft - ; PBMAP::SetAngle(-5,#PB_Relative) - ; PBMap::Refresh() - ;Case #Gdt_RotateRight - ; PBMAP::SetAngle(5,#PB_Relative) - ; PBMap::Refresh() + ; Case #Gdt_RotateLeft + ; PBMAP::SetAngle(-5,#PB_Relative) + ; PBMap::Refresh() + ; Case #Gdt_RotateRight + ; PBMAP::SetAngle(5,#PB_Relative) + ; PBMap::Refresh() Case #Button_4 PBMap::SetZoom(1) Case #Button_5 @@ -2310,6 +2849,16 @@ CompilerIf #PB_Compiler_IsMainFile Case #Gdt_LoadGpx *Track = PBMap::LoadGpxFile(OpenFileRequester("Choose a file to load", "", "Gpx|*.gpx", 0)) PBMap::SetTrackColour(*Track, RGBA(Random(255), Random(255), Random(255), 128)) + Case #Gdt_SaveGpx + If *Track + If PBMap::SaveGpxFile(SaveFileRequester("Choose a filename", "mytrack.gpx", "Gpx|*.gpx", 0), *Track) + MessageRequester("PBMap", "Saving OK !", #PB_MessageRequester_Ok) + Else + MessageRequester("PBMap", "Problem while saving.", #PB_MessageRequester_Ok) + EndIf + Else + MessageRequester("PBMap", "No track to save.", #PB_MessageRequester_Ok) + EndIf Case #StringLatitude, #StringLongitude Select EventType() Case #PB_EventType_Focus @@ -2320,15 +2869,39 @@ CompilerIf #PB_Compiler_IsMainFile Case #Gdt_AddMarker PBMap::AddMarker(ValD(GetGadgetText(#StringLatitude)), ValD(GetGadgetText(#StringLongitude)), "", "Test", RGBA(Random(255), Random(255), Random(255), 255)) Case #Gdt_AddOpenseaMap - If OpenSeaMap = 0 - OpenSeaMap = PBMap::AddMapServerLayer("OpenSeaMap", 2, "http://t1.openseamap.org/seamark/") ; Add a special osm overlay map on layer nb 2 - SetGadgetState(#Gdt_AddOpenseaMap, 1) - Else - PBMap::DeleteLayer(OpenSeaMap) - OpenSeaMap = 0 + If PBMap::IsLayer("OpenSeaMap") + PBMap::DeleteLayer("OpenSeaMap") SetGadgetState(#Gdt_AddOpenseaMap, 0) + Else + PBMap::AddOSMServerLayer("OpenSeaMap", 3, "http://t1.openseamap.org/seamark/") ; Add a special osm overlay map on layer nb 3 + SetGadgetState(#Gdt_AddOpenseaMap, 1) EndIf - PBMAP::Refresh() + PBMap::Refresh() + Case #Gdt_AddHereMap + If PBMap::IsLayer("Here") + PBMap::DeleteLayer("Here") + SetGadgetState(#Gdt_AddHereMap, 0) + Else + If PBMap::GetOption("appid") <> "" And PBMap::GetOption("appcode") <> "" + PBMap::AddHereServerLayer("Here", 2) ; Add a "HERE" overlay map on layer nb 2 + PBMap::SetLayerAlpha("Here", 0.75) + 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 + EndIf + SetGadgetState(#Gdt_AddHereMap, 1) + EndIf + PBMap::Refresh() + Case #Gdt_AddGeoServerMap + If PBMap::IsLayer("GeoServer") + PBMap::DeleteLayer("GeoServer") + SetGadgetState(#Gdt_AddGeoServerMap, 0) + Else + PBMap::AddGeoServerLayer("GeoServer", 3, "demolayer", "http://localhost:8080/", "geowebcache/service/gmaps", "image/png") ; Add a geoserver overlay map on layer nb 3 + PBMap::SetLayerAlpha("GeoServer", 0.75) + SetGadgetState(#Gdt_AddGeoServerMap, 1) + EndIf + PBMap::Refresh() Case #Gdt_Degrees Degrees = 1 - Degrees PBMap::SetOption("ShowDegrees", Str(Degrees)) @@ -2355,16 +2928,16 @@ CompilerIf #PB_Compiler_IsMainFile Case #PB_Event_SizeWindow ResizeAll() Case #PB_Event_Menu - ;Receive "enter" key events + ; Receive "enter" key events Select EventMenu() Case #MenuEventGeoLocationStringEnter If GetGadgetText(#StringGeoLocationQuery) <> "" PBMap::NominatimGeoLocationQuery(GetGadgetText(#StringGeoLocationQuery)) PBMap::Refresh() EndIf - ;*** TODO : code to change when the SetActiveGadget(-1) will be fixed + ; *** TODO : code to change when the SetActiveGadget(-1) will be fixed SetActiveGadget(Dummy) - ;*** + ; *** Case #MenuEventLonLatStringEnter PBMap::SetLocation(ValD(GetGadgetText(#StringLatitude)), ValD(GetGadgetText(#StringLongitude))) ; Change the PBMap coordinates PBMap::Refresh() @@ -2377,10 +2950,11 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf - -; IDE Options = PureBasic 5.60 beta 7 (Windows - x64) -; CursorPosition = 33 -; Folding = ----------------- +; IDE Options = PureBasic 5.60 (Windows - x86) +; CursorPosition = 2821 +; FirstLine = 2780 +; Folding = -------------------- ; EnableThread ; EnableXP -; EnableUnicode \ No newline at end of file +; CompileSourceDirectory +; DisablePurifier = 1,1,1,1 \ No newline at end of file