From cdd8ba1074d506aa15568fc59dffcc4383dbaadb Mon Sep 17 00:00:00 2001 From: thyphoonfr Date: Tue, 21 Feb 2017 15:42:29 +0100 Subject: [PATCH 1/5] remove curl Dependencies Use PB command only with Proxy Support --- PBMap.pb | 2026 +++++++++++++++++++++++++++++++++++------------------- 1 file changed, 1306 insertions(+), 720 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index 9985f29..b2a4c3d 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -2,8 +2,8 @@ ; Program: PBMap ; Description: Permits the use of tiled maps like ; OpenStreetMap in a handy PureBASIC module -; Author: Thyphoon And Djes -; Date: Mai 17, 2016 +; Author: Thyphoon, Djes And Idle +; Date: Februry 21, 2017 ; License: Free, unrestricted, credit appreciated ; but not required. ; Note: Please share improvement ! @@ -12,6 +12,8 @@ ; (see also Proxy Details) ;************************************************************** +;#Red = 255 + CompilerIf #PB_Compiler_Thread = #False MessageRequester("Warning !!","You must enable ThreadSafe support in compiler options",#PB_MessageRequester_Ok ) End @@ -24,26 +26,48 @@ UsePNGImageDecoder() UsePNGImageEncoder() DeclareModule PBMap - ;-Show debug infos - Global Verbose = #False - Global Proxy = #False - Declare InitPBMap() - Declare SetMapServer(ServerURL.s="http://tile.openstreetmap.org/",TileSize.l=256,ZoomMin.l=0,ZoomMax.l=18) + #Red = 255 + + ;-Show debug infos + Global Verbose = 0 + Global MyDebugLevel = 5 + + #SCALE_NAUTICAL = 1 + #SCALE_KM = 0 + + #MODE_DEFAULT = 0 + #MODE_HAND = 1 + #MODE_SELECT = 2 + #MODE_EDIT = 3 + + ;-Declarations + Declare InitPBMap(window) + Declare SetOption(Option.s, Value.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 MapGadget(Gadget.i, X.i, Y.i, Width.i, Height.i) - Declare Event(Event.l) - Declare SetLocation(latitude.d, longitude.d, zoom = 15, mode.i = #PB_Absolute) - Declare DrawingThread(Null) + Declare SetLocation(latitude.d, longitude.d, Zoom = -1, mode.i = #PB_Absolute) + Declare Drawing() Declare SetZoom(Zoom.i, mode.i = #PB_Relative) - Declare ZoomToArea() - Declare SetCallBackLocation(CallBackLocation.i) + Declare ZoomToArea(MinY.d, MaxY.d, MinX.d, MaxX.d) + Declare ZoomToTracks(*Tracks) + Declare SetCallBackLocation(*CallBackLocation) Declare SetCallBackMainPointer(CallBackMainPointer.i) + Declare SetMapScaleUnit(ScaleUnit=PBMAP::#SCALE_KM) Declare LoadGpxFile(file.s); - Declare AddMarker(Latitude.d,Longitude.d,color.l=-1, CallBackPointer.i = -1) + Declare.i AddMarker(Latitude.d, Longitude.d, Legend.s = "", color.l=-1, CallBackPointer.i = -1) + Declare ClearMarkers() + Declare DeleteMarker(*Ptr) + Declare DeleteSelectedMarkers() Declare Quit() Declare Error(msg.s) Declare Refresh() Declare.d GetLatitude() Declare.d GetLongitude() + Declare.d MouseLatitude() + Declare.d MouseLongitude() Declare.i GetZoom() EndDeclareModule @@ -51,202 +75,298 @@ Module PBMap EnableExplicit - Structure Location + Structure GeographicCoordinates Longitude.d Latitude.d EndStructure - Structure Position - x.d - y.d - EndStructure - - Structure PixelPosition + Structure PixelCoordinates x.i y.i EndStructure + Structure Coordinates + x.d + y.d + EndStructure + ;- Tile Structure Structure Tile - Position.Position + Position.Coordinates PBMapTileX.i PBMapTileY.i PBMapZoom.i nImage.i + key.s + CacheFile.s GetImageThread.i + RetryNb.i + ServerURL.s + EndStructure + + Structure TileBounds + NorthWest.Coordinates + SouthEast.Coordinates EndStructure Structure DrawingParameters - Position.Position + TileCoordinates.Coordinates + Bounds.TileBounds Canvas.i - PBMapTileX.i - PBMapTileY.i PBMapZoom.i - Mutex.i - TargetLocation.Location + GeographicCoordinates.GeographicCoordinates CenterX.i CenterY.i DeltaX.i DeltaY.i - Semaphore.i Dirty.i - PassNB.i End.i EndStructure - Structure TileThread - GetImageThread.i - *Tile.Tile - EndStructure - Structure ImgMemCach nImage.i - Location.Location + *Tile.Tile + TimeStackPosition.i + EndStructure + + Structure ImgMemCachKey + MapKey.s EndStructure Structure TileMemCach - Map Images.ImgMemCach() + Map Images.ImgMemCach(4096) + List ImagesTimeStack.ImgMemCachKey() ; Usage of the tile (first = older) EndStructure Structure Marker - Location.Location ; Marker latitude and longitude - color.l ; Marker color - CallBackPointer.i ; @Procedure(X.i, Y.i) to DrawPointer (you must use VectorDrawing lib) + GeographicCoordinates.GeographicCoordinates ; Marker latitude and longitude + 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) EndStructure Structure Option + HDDCachePath.s ; Path where to load and save tiles downloaded from server + DefaultOSMServer.s ; Base layer OSM server WheelMouseRelative.i + ScaleUnit.i ; Scale unit to use for measurements + Proxy.i ; Proxy ON/OFF + ProxyURL.s + ProxyPort.s + ProxyUser.s + ProxyPassword.s + ShowDegrees.i + ShowDebugInfos.i + ShowScale.i + ShowTrack.i + ShowMarkers.i + ShowPointer.i + TimerInterval.i + MaxMemCache.i ; in MiB + TrackShowKms.i + ShowMarkersNb.i + ShowMarkersLegend.i EndStructure + Structure Layer + Order.i ; Layer nb + Name.s + ServerURL.s ; Web URL ex: http://tile.openstreetmap.org/ + EndStructure + + Structure Tracks + List Track.GeographicCoordinates() + EndStructure ;-PBMap Structure Structure PBMap - Gadget.i ; Canvas Gadget Id - Font.i ; Font to uses when write on the map - TargetLocation.Location ; Latitude and Longitude from focus point - Drawing.DrawingParameters ; Drawing parameters based on focus point - ; - CallBackLocation.i ; @Procedure(latitude.d,lontitude.d) - CallBackMainPointer.i ; @Procedure(X.i, Y.i) to DrawPointer (you must use VectorDrawing lib) - ; - Position.PixelPosition ; Actual focus point coords in pixels (global) - MoveStartingPoint.PixelPosition ; Start mouse position coords when dragging the map - ; - ServerURL.s ; Web URL ex: http://tile.openstreetmap.org/ - ZoomMin.i ; Min Zoom supported by server - ZoomMax.i ; Max Zoom supported by server - Zoom.i ; Current zoom - TileSize.i ; Tile size downloaded on the server ex : 256 - ; - HDDCachePath.S ; Path where to load and save tiles downloaded from server - MemCache.TileMemCach ; Images in memory cache - ; - Moving.i ; - Dirty.i ; To signal that drawing need a refresh - ; - MainDrawingThread.i ; - List TilesThreads.TileThread() ; - ; - List track.Location() ; To display a GPX track - List Marker.Marker() ; To diplay marker - EditMarkerIndex.l ; - ; - Options.option ; + Window.i ; Parent Window + Gadget.i ; Canvas Gadget Id + Font.i ; Font to uses when write on the map + Timer.i ; Redraw/update timer + + GeographicCoordinates.GeographicCoordinates ; Latitude and Longitude from focus point + Drawing.DrawingParameters ; Drawing parameters based on focus point + + CallBackLocation.i ; @Procedure(latitude.d,lontitude.d) + CallBackMainPointer.i ; @Procedure(X.i, Y.i) to DrawPointer (you must use VectorDrawing lib) + + PixelCoordinates.PixelCoordinates ; Actual focus point coords in pixels (global) + MoveStartingPoint.PixelCoordinates ; Start mouse position coords when dragging the map + + List Layers.Layer() ; + + ZoomMin.i ; Min Zoom supported by server + ZoomMax.i ; Max Zoom supported by server + Zoom.i ; Current zoom + TileSize.i ; Tile size downloaded on the server ex : 256 + + MemCache.TileMemCach ; Images in memory cache + + 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 + Dirty.i ; To signal that drawing need a refresh + + List TracksList.Tracks() ; To display a GPX track + List Markers.Marker() ; To diplay marker + EditMarker.l + + ImgLoading.i ; Image Loading Tile + ImgNothing.i ; Image Nothing Tile + + Options.option ; Options + 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 PBMap.PBMap, Null.i ;Shows an error msg and terminates the program Procedure Error(msg.s) - MessageRequester("MapGadget", msg, #PB_MessageRequester_Ok) + MessageRequester("PBMap", msg, #PB_MessageRequester_Ok) End EndProcedure - ;Send debug infos to stdout - Procedure MyDebug(msg.s) - If Verbose + ;Send debug infos to stdout (allowing mixed debug infos with curl or other libs) + Procedure MyDebug(msg.s, DbgLevel = 0) + If Verbose And MyDebugLevel >= DbgLevel PrintN(msg) + ;Debug msg EndIf EndProcedure + + Procedure TechnicalImagesCreation() + ;"Loading" image + Protected LoadingText$ = "Loading" + Protected NothingText$ = "Nothing" + PBmap\ImgLoading = CreateImage(#PB_Any, 256, 256) + If PBmap\ImgLoading + StartVectorDrawing(ImageVectorOutput(PBMap\Imgloading)) + BeginVectorLayer() + VectorSourceColor(RGBA(255, 255, 255, 128)) + 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(LoadingText$)) / 2, 0 + (256 - VectorTextHeight(LoadingText$)) / 2) + DrawVectorText(LoadingText$) + EndVectorLayer() + StopVectorDrawing() + EndIf + ;"Nothing" tile + PBmap\ImgNothing = CreateImage(#PB_Any, 256, 256) + If PBmap\ImgNothing + StartVectorDrawing(ImageVectorOutput(PBMap\ImgNothing)) + ;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() + StopVectorDrawing() + EndIf + EndProcedure - ;- *** CURL specific - ; (program has To be compiled in console format for curl debug infos) - - IncludeFile "libcurl.pbi" ; https://github.com/deseven/pbsamples/tree/master/crossplatform/libcurl - - ;Curl write callback (needed for win32 dll) - ProcedureC ReceiveHTTPWriteToFileFunction(*ptr, Size.i, NMemB.i, FileHandle.i) - ProcedureReturn WriteData(FileHandle, *ptr, Size * NMemB) + ;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 CurlReceiveHTTPToFile(URL$, DestFileName$, ProxyURL$="", ProxyPort$="", ProxyUser$="", ProxyPassword$="") - Protected *Buffer, curl.i, Timeout.i, res.i - Protected FileHandle.i - MyDebug("ReceiveHTTPToFile from " + URL$ + " " + ProxyURL$ + ProxyPort$ + ProxyUser$) - MyDebug(" to file : " + DestFileName$) - FileHandle = CreateFile(#PB_Any, DestFileName$) - If FileHandle And Len(URL$) - curl = curl_easy_init() - If curl - Timeout = 120 - curl_easy_setopt(curl, #CURLOPT_URL, str2curl(URL$)) - curl_easy_setopt(curl, #CURLOPT_SSL_VERIFYPEER, 0) - curl_easy_setopt(curl, #CURLOPT_SSL_VERIFYHOST, 0) - curl_easy_setopt(curl, #CURLOPT_HEADER, 0) - curl_easy_setopt(curl, #CURLOPT_FOLLOWLOCATION, 1) - curl_easy_setopt(curl, #CURLOPT_TIMEOUT, Timeout) - curl_easy_setopt(curl, #CURLOPT_VERBOSE, 1) - ;curl_easy_setopt(curl, #CURLOPT_CONNECTTIMEOUT, 60) - If Len(ProxyURL$) - ;curl_easy_setopt(curl, #CURLOPT_HTTPPROXYTUNNEL, #True) - If Len(ProxyPort$) - ProxyURL$ + ":" + ProxyPort$ - EndIf - MyDebug( ProxyURL$) - curl_easy_setopt(curl, #CURLOPT_PROXY, str2curl(ProxyURL$)) - If Len(ProxyUser$) - If Len(ProxyPassword$) - ProxyUser$ + ":" + ProxyPassword$ - EndIf - MyDebug( ProxyUser$) - curl_easy_setopt(curl, #CURLOPT_PROXYUSERPWD, str2curl(ProxyUser$)) - EndIf - EndIf - curl_easy_setopt(curl, #CURLOPT_WRITEDATA, FileHandle) - curl_easy_setopt(curl, #CURLOPT_WRITEFUNCTION, @ReceiveHTTPWriteToFileFunction()) - res = curl_easy_perform(curl) - If res <> #CURLE_OK - MyDebug("CURL problem") - EndIf - curl_easy_cleanup(curl) - Else - MyDebug("Can't init CURL") - EndIf - CloseFile(FileHandle) - ProcedureReturn FileSize(DestFileName$) - EndIf - ProcedureReturn #False - EndProcedure - ;- *** + Macro SelBool(Name) + Select UCase(Value) + Case "0", "FALSE", "DISABLE" + PBMap\Options\Name = #False + Default + PBMap\Options\Name = #True + EndSelect + EndMacro - Procedure InitPBMap() - Protected Result.i - If Verbose - OpenConsole() + 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 "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 "trackshowkms" + SelBool(TrackShowKms) + 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 + PreferenceGroup("PROXY") + WritePreferenceInteger("Proxy", PBMap\Options\Proxy) + WritePreferenceString("ProxyURL", PBMap\Options\ProxyURL) + WritePreferenceString("ProxyPort", PBMap\Options\ProxyPort) + WritePreferenceString("ProxyUser", PBMap\Options\ProxyUser) + PreferenceGroup("URL") + WritePreferenceString("DefaultOSMServer", PBMap\Options\DefaultOSMServer) + PreferenceGroup("PATHS") + WritePreferenceString("TilesCachePath", PBMap\Options\HDDCachePath) + PreferenceGroup("OPTIONS") + WritePreferenceInteger("WheelMouseRelative", PBMap\Options\WheelMouseRelative) + WritePreferenceInteger("MaxMemCache", PBMap\Options\MaxMemCache) + WritePreferenceInteger("ShowDegrees", PBMap\Options\ShowDegrees) + WritePreferenceInteger("ShowDebugInfos", PBMap\Options\ShowDebugInfos) + WritePreferenceInteger("ShowScale", PBMap\Options\ShowScale) + WritePreferenceInteger("ShowMarkers", PBMap\Options\ShowMarkers) + WritePreferenceInteger("ShowPointer", PBMap\Options\ShowPointer) + WritePreferenceInteger("ShowTrack", PBMap\Options\ShowTrack) + WritePreferenceInteger("ShowMarkersNb", PBMap\Options\ShowMarkersNb) + WritePreferenceInteger("ShowMarkersLegend", PBMap\Options\ShowMarkersLegend) + WritePreferenceInteger("TrackShowKms", PBMap\Options\TrackShowKms) + ClosePreferences() + EndProcedure + + Procedure LoadOptions(PreferencesFile.s = "PBMap.prefs") + If PreferencesFile = "PBMap.prefs" + OpenPreferences(GetHomeDirectory() + "PBMap.prefs") + Else + OpenPreferences(PreferencesFile) EndIf - PBMap\HDDCachePath = GetTemporaryDirectory() - PBMap\ServerURL = "http://tile.openstreetmap.org/" - PBMap\ZoomMin = 0 - PBMap\ZoomMax = 18 - PBMap\MoveStartingPoint\x = - 1 - PBMap\TileSize = 256 - PBMap\Dirty = #False - PBMap\Drawing\Mutex = CreateMutex() - PBMap\Drawing\Semaphore = CreateSemaphore() - PBMap\EditMarkerIndex = -1 ;<- You must initialize with No Marker selected - PBMap\Font = LoadFont(#PB_Any, "Arial", 20, #PB_Font_Bold) - ;-Options - PBMap\Options\WheelMouseRelative = #True - ;-Preferences ;Use this to create and customize your preferences file for the first time ; CreatePreferences(GetHomeDirectory() + "PBMap.prefs") ; ;Or this to modify @@ -260,46 +380,109 @@ Module PBMap ; WritePreferenceString("ProxyUser", "myproxyname") ; WritePreferenceString("ProxyPass", "myproxypass") ;TODO !Warning! !not encoded! ; ClosePreferences() - OpenPreferences(GetHomeDirectory() + "PBMap.prefs") PreferenceGroup("PROXY") - Proxy = ReadPreferenceInteger("Proxy", #False) - If Proxy - Global ProxyURL$ = ReadPreferenceString("ProxyURL", "") ;InputRequester("ProxyServer", "Do you use a Proxy Server? Then enter the full url:", "") - Global ProxyPort$ = ReadPreferenceString("ProxyPort", "") ;InputRequester("ProxyPort" , "Do you use a specific port? Then enter it", "") - Global ProxyUser$ = ReadPreferenceString("ProxyUser", "") ;InputRequester("ProxyUser" , "Do you use a user name? Then enter it", "") - Global ProxyPassword$ = InputRequester("ProxyPass", "Do you use a password ? Then enter it", "") ;TODO + PBMap\Options\Proxy = ReadPreferenceInteger("Proxy", #False) + If PBMap\Options\Proxy + PBMap\Options\ProxyURL = ReadPreferenceString("ProxyURL", "") ;InputRequester("ProxyServer", "Do you use a Proxy Server? Then enter the full url:", "") + PBMap\Options\ProxyPort = ReadPreferenceString("ProxyPort", "") ;InputRequester("ProxyPort" , "Do you use a specific port? Then enter it", "") + PBMap\Options\ProxyUser = ReadPreferenceString("ProxyUser", "") ;InputRequester("ProxyUser" , "Do you use a user name? Then enter it", "") + PBMap\Options\ProxyPassword = InputRequester("ProxyPass", "Do you use a password ? Then enter it", "") ;TODO EndIf + PreferenceGroup("URL") + PBMap\Options\DefaultOSMServer = ReadPreferenceString("DefaultOSMServer", "http://tile.openstreetmap.org/") + + PreferenceGroup("PATHS") + PBMap\Options\HDDCachePath = ReadPreferenceString("TilesCachePath", GetTemporaryDirectory()) + PreferenceGroup("OPTIONS") + PBMap\Options\WheelMouseRelative = ReadPreferenceInteger("WheelMouseRelative", #True) + PBMap\Options\MaxMemCache = ReadPreferenceInteger("MaxMemCache", 20480) ;20 MiB, about 80 tiles in memory + PBMap\Options\ShowDegrees = ReadPreferenceInteger("ShowDegrees", #False) + PBMap\Options\ShowDebugInfos = ReadPreferenceInteger("ShowDebugInfos", #False) + PBMap\Options\ShowScale = ReadPreferenceInteger("ShowScale", #False) + PBMap\Options\ShowMarkers = ReadPreferenceInteger("ShowMarkers", #True) + PBMap\Options\ShowPointer = ReadPreferenceInteger("ShowPointer", #True) + PBMap\Options\ShowTrack = ReadPreferenceInteger("ShowTrack", #True) + PBMap\Options\ShowMarkersNb = ReadPreferenceInteger("ShowMarkersNb", #True) + PBMap\Options\ShowMarkersLegend = ReadPreferenceInteger("ShowMarkersLegend", #False) + PBMap\Options\TrackShowKms = ReadPreferenceInteger("TrackShowKms", #False) + PBMap\Options\TimerInterval = 20 ClosePreferences() - curl_global_init(#CURL_GLOBAL_WIN32) - ;- Main drawing thread launching - PBMap\MainDrawingThread = CreateThread(@DrawingThread(), @PBMap\Drawing) - If PBMap\MainDrawingThread = 0 - Error("MapGadget : can't create main drawing thread.") + EndProcedure + + Procedure InitPBMap(Window) + Protected Result.i + If Verbose + OpenConsole() + EndIf + 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 + LoadOptions() + If PBMap\Options\DefaultOSMServer <> "" + AddMapServerLayer("OSM", 1, PBMap\Options\DefaultOSMServer) + EndIf + TechnicalImagesCreation() + SetLocation(0, 0) + 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()) + 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 cache directory : " + DirName) + Else + MyDebug(DirName + " successfully created", 4) + EndIf + EndIf + 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 SetMapServer(ServerURL.s="http://tile.openstreetmap.org/",TileSize.l=256,ZoomMin.l=0,ZoomMax.l=18) - PBMap\ServerURL = ServerURL - PBMap\ZoomMin = ZoomMin - PBMap\ZoomMax = ZoomMax - PBMap\TileSize = TileSize + 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() - ;kill main drawing thread (nicer than KillThread(PBMap\MainDrawingThread)) - LockMutex(PBMap\Drawing\Mutex) PBMap\Drawing\End = #True - UnlockMutex(PBMap\Drawing\Mutex) - ;wait for loading threads to finish nicely - ResetList(PBMap\TilesThreads()) - While NextElement(PBMap\TilesThreads()) - If IsThread(PBMap\TilesThreads()\GetImageThread) = 0 - FreeMemory(PBMap\TilesThreads()\Tile) - DeleteElement(PBMap\TilesThreads()) - ResetList( PBMap\TilesThreads()) - EndIf - Wend - curl_global_cleanup() + ;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) @@ -316,39 +499,74 @@ Module PBMap ProcedureReturn Result EndProcedure - Procedure MapGadget(Gadget.i, X.i, Y.i, Width.i, Height.i) - If Gadget = #PB_Any - PBMap\Gadget = CanvasGadget(PBMap\Gadget, X, Y, Width, Height, #PB_Canvas_Keyboard) ;#PB_Canvas_Keyboard has to be set for mousewheel to work on windows - Else - PBMap\Gadget = Gadget - CanvasGadget(PBMap\Gadget, X, Y, Width, Height, #PB_Canvas_Keyboard) - EndIf - EndProcedure - ;*** Converts coords to tile.decimal ;Warning, structures used in parameters are not tested - Procedure LatLon2XY(*Location.Location, *Coords.Position) - Protected n.d = Pow(2.0, PBMap\Zoom) + Procedure LatLon2TileXY(*Location.GeographicCoordinates, *Coords.Coordinates, Zoom) + Protected n.d = Pow(2.0, Zoom) Protected LatRad.d = Radian(*Location\Latitude) - *Coords\x = n * ( (*Location\Longitude + 180.0) / 360.0) - *Coords\y = n * ( 1.0 - Log(Tan(LatRad) + 1.0/Cos(LatRad)) / #PI ) / 2.0 - MyDebug("Latitude : " + StrD(*Location\Latitude) + " ; Longitude : " + StrD(*Location\Longitude)) - MyDebug("Coords X : " + Str(*Coords\x) + " ; Y : " + Str(*Coords\y)) + *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) EndProcedure ;*** Converts tile.decimal to coords ;Warning, structures used in parameters are not tested - Procedure XY2LatLon(*Coords.Position, *Location.Location) - Protected n.d = Pow(2.0, PBMap\Zoom) - Protected LatitudeRad.d - *Location\Longitude = *Coords\x / n * 360.0 - 180.0 - LatitudeRad = ATan(SinH(#PI * (1.0 - 2.0 * *Coords\y / n))) - *Location\Latitude = Degree(LatitudeRad) + Procedure TileXY2LatLon(*Coords.Coordinates, *Location.GeographicCoordinates, Zoom) + Protected n.d = Pow(2.0, Zoom) + ;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)))) + EndProcedure + + 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[ + *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)))) + EndProcedure + + ;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 [ + Procedure LatLon2Pixel(*Location.GeographicCoordinates, *Pixel.PixelCoordinates, Zoom) + Protected tilemax = Pow(2.0, Zoom) * PBMap\TileSize + Protected LatRad.d = Radian(*Location\Latitude) + *Pixel\x = tilemax * (Mod( *Location\Longitude + 180.0, 360) / 360.0 ) + *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 + Procedure LatLon2PixelRel(*Location.GeographicCoordinates, *Pixel.PixelCoordinates, Zoom) + Protected tilemax = Pow(2.0, Zoom) * PBMap\TileSize + Protected cx.d = PBMap\Drawing\CenterX + Protected dpx.d = PBMap\PixelCoordinates\x + Protected LatRad.d = Radian(*Location\Latitude) + Protected px = tilemax * (Mod( *Location\Longitude + 180.0, 360) / 360.0 ) + Protected py = 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) + If dpx - px >= tilemax / 2 + ;Debug "c1" + *Pixel\x = cx + (px - dpx + tilemax) + ElseIf px - dpx > tilemax / 2 + ;Debug "c2" + *Pixel\x = cx + (px - dpx - tilemax) + ElseIf px - dpx < 0 + ;Debug "c3" + *Pixel\x = cx - (dpx - px) + Else + ;Debug "c0" + *Pixel\x = cx + (px - dpx) + EndIf + *Pixel\y = PBMap\Drawing\CenterY + (py - PBMap\PixelCoordinates\y) EndProcedure ; HaversineAlgorithm ; http://andrew.hedges.name/experiments/haversine/ - Procedure.d HaversineInKM(*posA.Location, *posB.Location) + 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) ; @@ -360,26 +578,23 @@ Module PBMap ProcedureReturn distance ; EndProcedure - Procedure.d HaversineInM(*posA.Location, *posB.Location) + Procedure.d HaversineInM(*posA.GeographicCoordinates, *posB.GeographicCoordinates) ProcedureReturn (1000 * HaversineInKM(@*posA,@*posB)); EndProcedure - Procedure GetPixelCoordFromLocation(*Location.Location, *Pixel.PixelPosition) ; TODO to Optimize - Protected mapWidth.l = Pow(2, PBMap\Zoom + 8) - Protected mapHeight.l = Pow(2, PBMap\Zoom + 8) + Procedure GetPixelCoordFromLocation(*Location.GeographicCoordinates, *Pixel.PixelCoordinates, Zoom) ; TODO to Optimize + Protected mapWidth.l = Pow(2, Zoom + 8) + Protected mapHeight.l = Pow(2, Zoom + 8) Protected x1.l,y1.l - ; get x value x1 = (*Location\Longitude+180)*(mapWidth/360) ; convert from degrees To radians Protected latRad.d = *Location\Latitude*#PI/180; Protected mercN.d = Log(Tan((#PI/4)+(latRad/2))); y1 = (mapHeight/2)-(mapWidth*mercN/(2*#PI)) ; Protected x2.l, y2.l - ; get x value - x2 = (PBMap\TargetLocation\Longitude+180)*(mapWidth/360) + x2 = (PBMap\GeographicCoordinates\Longitude+180)*(mapWidth/360) ; convert from degrees To radians - latRad = PBMap\TargetLocation\Latitude*#PI/180; - ; get y value + latRad = PBMap\GeographicCoordinates\Latitude*#PI/180; mercN = Log(Tan((#PI/4)+(latRad/2))) y2 = (mapHeight/2)-(mapWidth*mercN/(2*#PI)); *Pixel\x=GadgetWidth(PBMap\Gadget)/2 - (x2-x1) @@ -398,227 +613,333 @@ Module PBMap Protected *MainNode,*subNode,*child,child.l *MainNode=MainXMLNode(0) *MainNode=XMLNodeFromPath(*MainNode,"/gpx/trk/trkseg") - ClearList(PBMap\track()) + Protected *NewTrack.Tracks = AddElement(PBMap\TracksList()) For child = 1 To XMLChildCount(*MainNode) *child = ChildXMLNode(*MainNode, child) - AddElement(PBMap\track()) + AddElement(*NewTrack\Track()) If ExamineXMLAttributes(*child) While NextXMLAttribute(*child) Select XMLAttributeName(*child) Case "lat" - PBMap\track()\Latitude=ValD(XMLAttributeValue(*child)) + *NewTrack\Track()\Latitude=ValD(XMLAttributeValue(*child)) Case "lon" - PBMap\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 EndIf EndProcedure - Procedure.i GetTileFromMem(Zoom.i, XTile.i, YTile.i) - Protected key.s = "Z" + RSet(Str(Zoom), 4, "0") + "X" + RSet(Str(XTile), 8, "0") + "Y" + RSet(Str(YTile), 8, "0") - MyDebug("Check if we have this image in memory") - If FindMapElement(PBMap\MemCache\Images(), key) - MyDebug("Key : " + key + " found !") - ProcedureReturn PBMap\MemCache\Images()\nImage - Else - MyDebug("Key : " + key + " not found !") - ProcedureReturn -1 - EndIf - EndProcedure - + ;-*** These are threaded Procedure.i GetTileFromHDD(CacheFile.s) - Protected nImage.i + Protected nImage.i If FileSize(CacheFile) > 0 nImage = LoadImage(#PB_Any, CacheFile) If IsImage(nImage) - MyDebug("Loadimage " + CacheFile + " -> Success !") + MyDebug("Success loading " + CacheFile + " as nImage " + Str(nImage), 3) ProcedureReturn nImage + Else + MyDebug("Failed loading " + CacheFile + " as nImage " + Str(nImage) + " -> not an image !", 3) EndIf + Else + MyDebug("Failed loading " + CacheFile + " -> Size <= 0", 3) EndIf - MyDebug("Loadimage " + CacheFile + " -> Failed !") ProcedureReturn -1 EndProcedure - Procedure.i GetTileFromWeb(Zoom.i, XTile.i, YTile.i, CacheFile.s) + Procedure.i GetTileFromWeb(TileURL.s, CacheFile.s) Protected *Buffer Protected nImage.i = -1 - Protected FileHandle.i - Protected TileURL.s = PBMap\ServerURL + Str(Zoom) + "/" + Str(XTile) + "/" + Str(YTile) + ".png" - MyDebug("Check if we have this image on Web") - If Proxy - FileHandle = CurlReceiveHTTPToFile(TileURL, CacheFile, ProxyURL$, ProxyPort$, ProxyUser$, ProxyPassword$) - If FileHandle - nImage = GetTileFromHDD(CacheFile) - Else - MyDebug("File " + TileURL + " not correctly received with Curl and proxy") - EndIf + 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 - *Buffer = ReceiveHTTPMemory(TileURL) ;TODO to thread by using #PB_HTTP_Asynchronous - If *Buffer - nImage = CatchImage(#PB_Any, *Buffer, MemorySize(*Buffer)) - If IsImage(nImage) - MyDebug("Load from web " + TileURL + " as Tile nb " + nImage) - SaveImage(nImage, CacheFile, #PB_ImagePlugin_PNG) - FreeMemory(*Buffer) - Else - MyDebug("Can't catch image " + TileURL) - nImage = -1 - ;ShowMemoryViewer(*Buffer, MemorySize(*Buffer)) - EndIf - Else - MyDebug("ReceiveHTTPMemory's buffer is empty") - EndIf + MyDebug("Problem loading from web " + TileURL, 3) EndIf + ; **** IMPORTANT NOTICE + ; I'm (djes) now using Curl 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 EndProcedure Procedure GetImageThread(*Tile.Tile) Protected nImage.i = -1 - Protected key.s = "Z" + RSet(Str(*Tile\PBMapZoom), 4, "0") + "X" + RSet(Str(*Tile\PBMapTileX), 8, "0") + "Y" + RSet(Str(*Tile\PBMapTileY), 8, "0") - Protected CacheFile.s = PBMap\HDDCachePath + "PBMap_" + Str(*Tile\PBMapZoom) + "_" + Str(*Tile\PBMapTileX) + "_" + Str(*Tile\PBMapTileY) + ".png" - Protected Tile.position - ;Adding the image to the cache if possible - AddMapElement(PBMap\MemCache\Images(), key) - nImage = GetTileFromHDD(CacheFile) - If nImage = -1 - nImage = GetTileFromWeb(*Tile\PBMapZoom, *Tile\PBMapTileX, *Tile\PBMapTileY, CacheFile) - EndIf - If nImage <> -1 - PBMap\MemCache\Images(key)\nImage = nImage - Tile\x=*Tile\PBMapTileX - Tile\y=*Tile\PBMapTiley - XY2LatLon(@Tile,@PBMap\MemCache\Images(key)\Location) - MyDebug("Image nb " + Str(nImage) + " successfully added to mem cache") - MyDebug("With the following key : " + key) - Else - MyDebug("Error GetImageThread procedure, image not loaded - " + key) - nImage = -1 - EndIf - ;Define this tile image nb + Protected TileURL.s = *Tile\ServerURL + Str(*Tile\PBMapZoom) + "/" + Str(*Tile\PBMapTileX) + "/" + Str(*Tile\PBMapTileY) + ".png" + Repeat + nImage = GetTileFromWeb(TileURL, *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(1000) + *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, CacheFile.s, px.i, py.i, tilex.i, tiley.i, ServerURL.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 timg = -1 + If FindMapElement(PBMap\MemCache\Images(), key) + MyDebug("Key : " + key + " found in memory cache!", 3) + timg = PBMap\MemCache\Images()\nImage + If timg <> -1 + MyDebug("Image : " + timg + " found in memory cache!", 3) + ;*** Cache management + ; Move the newly used element to the last position of the time stack + SelectElement(PBMap\MemCache\ImagesTimeStack(), PBMap\MemCache\Images()\TimeStackPosition) + MoveElement(PBMap\MemCache\ImagesTimeStack(), #PB_List_Last) + ;*** + ProcedureReturn timg + EndIf + Else + AddMapElement(PBMap\MemCache\Images(), key) + PushMapPosition(PBMap\MemCache\Images()) + ;*** Cache management + ; if cache size exceeds limit, try to delete the oldest tile used + 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 + PopMapPosition(PBMap\MemCache\Images()) + AddElement(PBMap\MemCache\ImagesTimeStack()) + PBMap\MemCache\ImagesTimeStack()\MapKey = MapKey(PBMap\MemCache\Images()) + ;*** + MyDebug("Key : " + key + " added in memory cache!", 3) + PBMap\MemCache\Images()\nImage = -1 + EndIf + If PBMap\MemCache\Images()\Tile = 0 ; Check if a loading thread is not running + MyDebug("Trying to load from HDD " + CacheFile, 3) + timg = GetTileFromHDD(CacheFile.s) + If timg <> -1 + MyDebug("Key : " + key + " found on HDD", 3) + PBMap\MemCache\Images()\nImage = timg + ProcedureReturn timg + EndIf + MyDebug("Key : " + key + " not found on HDD", 3) + ;Launch a new thread + Protected *NewTile.Tile = AllocateMemory(SizeOf(Tile)) + If *NewTile + With *NewTile + PBMap\MemCache\Images()\Tile = *NewTile + ;New tile parameters + \Position\x = px + \Position\y = py + \PBMapTileX = tilex + \PBMapTileY = tiley + \PBMapZoom = PBMap\Zoom + \key = key + \CacheFile = CacheFile + \ServerURL = ServerURL + \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 + EndIf + ProcedureReturn timg EndProcedure - Procedure DrawTile(*Tile.Tile) - Protected x = *Tile\Position\x - Protected y = *Tile\Position\y - MyDebug(" Drawing tile nb " + " X : " + Str(*Tile\PBMapTileX) + " Y : " + Str(*Tile\PBMapTileX)) - MyDebug(" at coords " + Str(x) + "," + Str(y)) - MovePathCursor(x, y) - DrawVectorImage(ImageID(*Tile\nImage)) - EndProcedure - - Procedure DrawLoading(*Tile.Tile) - Protected x = *Tile\Position\x - Protected y = *Tile\Position\y - Protected Text$ = "Loading" - MyDebug(" Drawing tile nb " + " X : " + Str(*Tile\PBMapTileX) + " Y : " + Str(*Tile\PBMapTileX)) - MyDebug(" at coords " + Str(x) + "," + Str(y)) - BeginVectorLayer() - ;MovePathCursor(x, y) - VectorSourceColor(RGBA(255, 255, 255, 128)) - AddPathBox(x, y, PBMap\TileSize, PBMap\TileSize) - FillPath() - MovePathCursor(x, y) - VectorFont(FontID(PBMap\Font), PBMap\TileSize / 20) - VectorSourceColor(RGBA(150, 150, 150, 255)) - MovePathCursor(x + (PBMap\TileSize - VectorTextWidth(Text$)) / 2, y + (PBMap\TileSize - VectorTextHeight(Text$)) / 2) - DrawVectorText(Text$) - EndVectorLayer() - EndProcedure - - Procedure DrawTiles(*Drawing.DrawingParameters) - Protected x.i, y.i - Protected tx = Int(*Drawing\Position\x) ;Don't forget the Int() ! - Protected ty = Int(*Drawing\Position\y) - Protected nx = *Drawing\CenterX / PBMap\TileSize ;How many tiles around the point + Procedure DrawTiles(*Drawing.DrawingParameters, Layer, alpha.i=255) + Protected x.i, y.i,kq.q + Protected tx = Int(*Drawing\TileCoordinates\x) ;Don't forget the Int() ! + Protected ty = Int(*Drawing\TileCoordinates\y) + Protected nx = *Drawing\CenterX / PBMap\TileSize ;How many tiles around the point Protected ny = *Drawing\CenterY / PBMap\TileSize + Protected px, py, img, tilex,tiley, key.s, CacheFile.s + Protected tilemax = 1<= 0 And tiley < tilemax + kq = (PBMap\Zoom << 8) | (tilex << 16) | (tiley << 36) + key = PBMap\Layers()\Name + Str(kq) + ; Creates the cache tree based on the OSM tree+Layer : layer/zoom/x/y.png + ; Creates the sub-directory based on the zoom + Protected DirName.s = PBMap\Options\HDDCachePath + PBMap\Layers()\Name + "\" + Str(PBMap\Zoom) + If FileSize(DirName) <> -2 + If CreateDirectory(DirName) = #False + Error("Can't create the following cache directory : " + DirName) EndIf - If IsImage(\nImage) - DrawTile(*NewTile) - Else - MyDebug("Image missing") - DrawLoading(*NewTile) - *Drawing\Dirty = #True ;Signals that this image is missing so we should have to redraw + EndIf + ; Creates the sub-directory based on x + DirName.s + "\" + Str(tilex) + If FileSize(DirName) <> -2 + If CreateDirectory(DirName) = #False + Error("Can't create the following cache directory : " + DirName) EndIf - EndWith + EndIf + ; Tile cache name based on y + CacheFile = DirName + "\" + Str(tiley) + ".png" + img = GetTile(key, CacheFile, px, py, tilex, tiley, PBMap\Layers()\ServerURL) + If img <> -1 + MovePathCursor(px, py) + DrawVectorImage(ImageID(img), alpha) + Else + MovePathCursor(px, py) + DrawVectorImage(ImageID(PBMap\ImgLoading), alpha) + EndIf Else - MyDebug(" Error, can't create a new tile") - Break 2 - EndIf + ;If PBMap\Layers()\Name = "" + MovePathCursor(px, py) + DrawVectorImage(ImageID(PBMap\ImgNothing)) + ;EndIf + EndIf + If PBMap\Options\ShowDebugInfos + VectorFont(FontID(PBMap\Font), 16) + VectorSourceColor(RGBA(0, 0, 0, 80)) + MovePathCursor(px, py) + DrawVectorText("x:" + Str(tilex)) + MovePathCursor(px, py + 16) + DrawVectorText("y:" + Str(tiley)) + EndIf Next - Next - ;Free tile memory when the loading thread has finished - ;TODO : get out this proc from drawtiles in a special "free ressources" task - ForEach PBMap\TilesThreads() - If IsThread(PBMap\TilesThreads()\GetImageThread) = 0 - FreeMemory(PBMap\TilesThreads()\Tile) - DeleteElement(PBMap\TilesThreads()) - EndIf - Next - ;-****Clean Mem Cache - ForEach PBMap\MemCache\Images() - ;GadgetWidth(PBMap\Gadget)/PBMap\TileSize - Protected MaxNbTile.l - If GadgetWidth(PBMap\Gadget)>GadgetHeight(PBMap\Gadget) - MaxNbTile=GadgetWidth(PBMap\Gadget)/PBMap\TileSize - Else - MaxNbTile=GadgetHeight(PBMap\Gadget)/PBMap\TileSize - EndIf - Protected Scale.d= 40075*Cos(Radian(PBMap\TargetLocation\Latitude))/Pow(2,PBMap\Zoom) - Protected Limit.d=Scale*(MaxNbTile)*1.5 - Protected Distance.d=HaversineInKM(@PBMap\MemCache\Images()\Location, @PBMap\TargetLocation) - Debug "Limit:"+StrD(Limit)+" Distance:"+StrD(Distance) - If Distance>Limit - Debug "delete" - DeleteMapElement(PBMap\MemCache\Images()) - EndIf - Next - + Next EndProcedure - Procedure Pointer(x.i, y.i, color.l = 0) - VectorSourceColor(color) - MovePathCursor(x, y) - AddPathLine(-8, -16, #PB_Path_Relative) - AddPathCircle(8, 0, 8, 180, 0, #PB_Path_Relative) - AddPathLine(-8, 16, #PB_Path_Relative) - ;FillPath(#PB_Path_Preserve) - ;ClipPath(#PB_Path_Preserve) - AddPathCircle(0, -16, 5, 0, 360, #PB_Path_Relative) - VectorSourceColor(color) - FillPath(#PB_Path_Preserve):VectorSourceColor(color);RGBA(0, 0, 0, 255)) + Procedure DrawPointer(*Drawing.DrawingParameters) + If PBMap\CallBackMainPointer > 0 + ; @Procedure(X.i, Y.i) to DrawPointer (you must use VectorDrawing lib) + CallFunctionFast(PBMap\CallBackMainPointer, *Drawing\CenterX, *Drawing\CenterY) + Else + VectorSourceColor(RGBA($FF, 0, 0, $FF)) + MovePathCursor(*Drawing\CenterX, *Drawing\CenterY) + AddPathLine(-8, -16, #PB_Path_Relative) + AddPathCircle(8, 0, 8, 180, 0, #PB_Path_Relative) + AddPathLine(-8, 16, #PB_Path_Relative) + AddPathCircle(0, -16, 5, 0, 360, #PB_Path_Relative) + VectorSourceColor(RGBA($FF, 0, 0, $FF)) + FillPath(#PB_Path_Preserve):VectorSourceColor(RGBA($FF, 0, 0, $FF));RGBA(0, 0, 0, 255)) + StrokePath(1) + EndIf + EndProcedure + + Procedure DrawScale(*Drawing.DrawingParameters,x,y,alpha=80) + Protected sunit.s + Protected Scale.d= 40075*Cos(Radian(PBMap\GeographicCoordinates\Latitude))/Pow(2,PBMap\Zoom) / 2 + Select PBMap\Options\ScaleUnit + Case #SCALE_Nautical + Scale * 0.539957 + sunit = " Nm" + Case #SCALE_KM; + sunit = " Km" + EndSelect + VectorFont(FontID(PBMap\Font), 10) + VectorSourceColor(RGBA(0, 0, 0,alpha)) + MovePathCursor(x,y) + DrawVectorText(StrD(Scale,3)+sunit) + MovePathCursor(x,y+12) + AddPathLine(x+128,y+12) StrokePath(1) EndProcedure - Procedure TrackPointer(x.i, y.i,dist.l) + 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 + tx = Int(*Drawing\TileCoordinates\x) + ty = Int(*Drawing\TileCoordinates\y) + nx = *Drawing\CenterX / PBMap\TileSize ;How many tiles around the point + ny = *Drawing\CenterY / PBMap\TileSize + *Drawing\Bounds\NorthWest\x = tx-nx-1 + *Drawing\Bounds\NorthWest\y = ty-ny-1 + *Drawing\Bounds\SouthEast\x = tx+nx+2 + *Drawing\Bounds\SouthEast\y = ty+ny+2 + ; Debug "------------------" + TileXY2LatLon(*Drawing\Bounds\NorthWest, @Degrees1, PBMap\Zoom) + TileXY2LatLon(*Drawing\Bounds\SouthEast, @Degrees2, PBMap\Zoom) + ;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) + ny1 = Round(Degrees2\Latitude, #PB_Round_Down)-1 + Degrees1\Longitude = nx + Degrees1\Latitude = ny + Degrees2\Longitude = nx1 + Degrees2\Latitude = ny1 + ; 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 + For y = ny1 To ny + Degrees1\Longitude = nx + Degrees1\Latitude = y + LatLon2PixelRel(@Degrees1, @pos1, PBMap\Zoom) + MovePathCursor(pos1\x, pos1\y) + AddPathLine( pos2\x, pos1\y) + MovePathCursor(10, pos1\y) + DrawVectorText(StrD(y, 1)) + Next + ;draw longitudes + x = nx + Repeat + Degrees1\Longitude = x + Degrees1\Latitude = ny + LatLon2PixelRel(@Degrees1, @pos1, PBMap\Zoom) + MovePathCursor(pos1\x, pos1\y) + AddPathLine( pos1\x, pos2\y) + MovePathCursor(pos1\x,10) + DrawVectorText(StrD(Mod(x + 180, 360) - 180, 1)) + x = (x + 1)%360 + Until x = nx1 + StrokePath(1) + EndProcedure + + Procedure TrackPointer(x.i, y.i, dist.l) Protected color.l color=RGBA(0, 0, 0, 255) MovePathCursor(x,y) @@ -637,185 +958,270 @@ Module PBMap DrawVectorText(Str(dist)) EndProcedure - Procedure DrawTrack(*Drawing.DrawingParameters) - Protected Pixel.PixelPosition - Protected Location.Location + Procedure DrawTracks(*Drawing.DrawingParameters) + Protected Pixel.PixelCoordinates + Protected Location.GeographicCoordinates Protected km.f, memKm.i - If ListSize(PBMap\track())>0 - ;Trace Track - LockMutex(PBMap\Drawing\Mutex) - ForEach PBMap\track() - If *Drawing\TargetLocation\Latitude<>0 And *Drawing\TargetLocation\Longitude<>0 - GetPixelCoordFromLocation(@PBMap\track(),@Pixel) - If ListIndex(PBMap\track())=0 - MovePathCursor(Pixel\X, Pixel\Y) - Else - AddPathLine(Pixel\X, Pixel\Y) - EndIf - EndIf - Next - VectorSourceColor(RGBA(0, 255, 0, 150)) - StrokePath(10, #PB_Path_RoundEnd|#PB_Path_RoundCorner) - ;Draw Distance - ForEach PBMap\track() - ;Distance test - If ListIndex(PBMap\track())=0 - Location\Latitude=PBMap\track()\Latitude - Location\Longitude=PBMap\track()\Longitude - Else - km=km+HaversineInKM(@Location,@PBMap\track()) ;<- display Distance - Location\Latitude=PBMap\track()\Latitude - Location\Longitude=PBMap\track()\Longitude - EndIf - GetPixelCoordFromLocation(@PBMap\track(),@Pixel) - If Int(km)<>memKm - memKm=Int(km) - If PBMap\Zoom>10 - BeginVectorLayer() - TrackPointer(Pixel\X , Pixel\Y,Int(km)) - EndVectorLayer() - EndIf + ;Trace Track + If ListSize(PBMap\TracksList()) > 0 + BeginVectorLayer() + ForEach PBMap\TracksList() + If ListSize(PBMap\TracksList()\Track()) > 0 + ForEach PBMap\TracksList()\Track() + ;If *Drawing\GeographicCoordinates\Latitude<>0 And *Drawing\GeographicCoordinates\Longitude<>0 + LatLon2PixelRel(@PBMap\TracksList()\Track(), @Pixel, PBMap\Zoom) + If ListIndex(PBMap\TracksList()\Track()) = 0 + MovePathCursor(Pixel\X, Pixel\Y) + Else + AddPathLine(Pixel\X, Pixel\Y) + EndIf + ;EndIf + Next + VectorSourceColor(RGBA(0, 255, 0, 150)) + StrokePath(10, #PB_Path_RoundEnd|#PB_Path_RoundCorner) EndIf Next - UnlockMutex(PBMap\Drawing\Mutex) + EndVectorLayer() + EndIf + ;Draw Distance + If PBMap\Options\TrackShowKms And ListSize(PBMap\TracksList()) > 0 + BeginVectorLayer() + ForEach PBMap\TracksList() + km = 0 : memKm = -1 + ForEach PBMap\TracksList()\Track() + ;Test Distance + If ListIndex(PBMap\TracksList()\Track()) = 0 + Location\Latitude = PBMap\TracksList()\Track()\Latitude + Location\Longitude = PBMap\TracksList()\Track()\Longitude + Else + km = km + HaversineInKM(@Location, @PBMap\TracksList()\Track()) + Location\Latitude = PBMap\TracksList()\Track()\Latitude + Location\Longitude = PBMap\TracksList()\Track()\Longitude + EndIf + LatLon2PixelRel(@PBMap\TracksList()\Track(), @Pixel, PBMap\Zoom) + If Int(km) <> memKm + memKm = Int(km) + If PBMap\Zoom > 10 + TrackPointer(Pixel\X , Pixel\Y, Int(km)) + EndIf + EndIf + Next + Next + EndVectorLayer() EndIf EndProcedure - ; Add a Marker To the Map - Procedure AddMarker(Latitude.d,Longitude.d,color.l=-1, CallBackPointer.i = -1) - AddElement(PBMap\Marker()) - PBMap\Marker()\Location\Latitude=Latitude - PBMap\Marker()\Location\Longitude=Longitude - PBMap\Marker()\color=color - PBMap\Marker()\CallBackPointer = CallBackPointer + Procedure DrawMarker(x.i, y.i, Nb, Color.l, Legend.s, Focus.i, Selected.i) + VectorSourceColor(color) + MovePathCursor(x, y) + AddPathLine(-8, -16, #PB_Path_Relative) + AddPathCircle(8, 0, 8, 180, 0, #PB_Path_Relative) + AddPathLine(-8, 16, #PB_Path_Relative) + ;FillPath(#PB_Path_Preserve) + ;ClipPath(#PB_Path_Preserve) + AddPathCircle(0, -16, 5, 0, 360, #PB_Path_Relative) + VectorSourceColor(Color) + FillPath(#PB_Path_Preserve) + If Focus + VectorSourceColor(RGBA(255, 255, 0, 255)) + StrokePath(3) + ElseIf Selected + VectorSourceColor(RGBA(255, 255, 0, 255)) + StrokePath(4) + Else + VectorSourceColor(Color) + StrokePath(1) + EndIf + If PBMap\Options\ShowMarkersNb + Protected Text.s = Str(Nb) + VectorFont(FontID(PBMap\Font), 13) + MovePathCursor(x - 10, y) + VectorSourceColor(RGBA(0, 0, 0, 255)) + DrawVectorParagraph(Text, 20, 20, #PB_VectorParagraph_Center) + EndIf + If PBMap\Options\ShowMarkersLegend + VectorFont(FontID(PBMap\Font), 13) + Protected Height = VectorParagraphHeight(Legend, 100, 13) + MovePathCursor(x - 50, y - 30 - Height) + VectorSourceColor(RGBA(0, 0, 0, 255)) + DrawVectorParagraph(Legend, 100, Height, #PB_VectorParagraph_Center) + EndIf EndProcedure - ; Draw all markers on the screen ! - Procedure DrawMarker(*Drawing.DrawingParameters) - Protected Pixel.PixelPosition - ForEach PBMap\Marker() - If PBMap\Marker()\Location\Latitude <> 0 And PBMap\Marker()\Location\Longitude <> 0 - GetPixelCoordFromLocation(PBMap\Marker()\Location, @Pixel) + Procedure ClearMarkers() + ClearList(PBMap\Markers()) + EndProcedure + + Procedure DeleteMarker(*Ptr) + ChangeCurrentElement(PBMap\Markers(), *Ptr) + DeleteElement(PBMap\Markers()) + EndProcedure + + Procedure DeleteSelectedMarkers() + ForEach PBMap\Markers() + If PBMap\Markers()\Selected + DeleteElement(PBMap\Markers()) + PBMap\Redraw = #True + EndIf + Next + EndProcedure + + Procedure.i AddMarker(Latitude.d, Longitude.d, Legend.s = "", Color.l=-1, CallBackPointer.i = -1) + Protected *Ptr = AddElement(PBMap\Markers()) + If *Ptr + PBMap\Markers()\GeographicCoordinates\Latitude = Latitude + PBMap\Markers()\GeographicCoordinates\Longitude = Mod(Mod(Longitude, 360) + 360, 360) + PBMap\Markers()\Legend = Legend + PBMap\Markers()\Color = Color + PBMap\Markers()\CallBackPointer = CallBackPointer + PBMap\Redraw = #True + ProcedureReturn *Ptr + EndIf + EndProcedure + + ; Draw all markers + Procedure DrawMarkers() + Protected Pixel.PixelCoordinates + ForEach PBMap\Markers() + If PBMap\Markers()\GeographicCoordinates\Latitude <> 0 And PBMap\Markers()\GeographicCoordinates\Longitude <> 0 + ;GetPixelCoordFromLocation(PBMap\Markers()\GeographicCoordinates, @Pixel) + LatLon2PixelRel(PBMap\Markers()\GeographicCoordinates, @Pixel, PBMap\Zoom) If Pixel\X >= 0 And Pixel\Y >= 0 And Pixel\X < GadgetWidth(PBMap\Gadget) And Pixel\Y < GadgetHeight(PBMap\Gadget) ; Only if visible ^_^ - If PBMap\Marker()\CallBackPointer > 0 - CallFunctionFast(PBMap\Marker()\CallBackPointer, Pixel\X, Pixel\Y) + If PBMap\Markers()\CallBackPointer > 0 + CallFunctionFast(PBMap\Markers()\CallBackPointer, Pixel\X, Pixel\Y, PBMap\Markers()\Focus, PBMap\Markers()\Selected) Else - Pointer(Pixel\X, Pixel\Y, PBMap\Marker()\color) + DrawMarker(Pixel\X, Pixel\Y, ListIndex(PBMap\Markers()), PBMap\Markers()\Color, PBMap\Markers()\Legend, PBMap\Markers()\Focus, PBMap\Markers()\Selected) EndIf EndIf EndIf Next EndProcedure - ;-*** Main drawing thread - ; always running, waiting for a semaphore to start refreshing - Procedure DrawingThread(*SharedDrawing.DrawingParameters) - Protected Drawing.DrawingParameters - Protected Px.d, Py.d - Repeat - WaitSemaphore(*SharedDrawing\Semaphore) - MyDebug("--------- Main drawing thread ------------") - ;Creates a copy of the structure to work with to avoid multiple mutex locks - LockMutex(*SharedDrawing\Mutex) - CopyStructure(*SharedDrawing, @Drawing, DrawingParameters) - UnlockMutex(*SharedDrawing\Mutex) - ;Precalc some values - Drawing\CenterX = GadgetWidth(PBMap\Gadget) / 2 - Drawing\CenterY = GadgetHeight(PBMap\Gadget) / 2 - ;Pixel shift, aka position in the tile - Px = Drawing\Position\x : Py = Drawing\Position\y - Drawing\DeltaX = Px * PBMap\TileSize - (Int(Px) * PBMap\TileSize) ;Don't forget the Int() ! - Drawing\DeltaY = Py * PBMap\TileSize - (Int(Py) * PBMap\TileSize) - Drawing\TargetLocation\Latitude = PBMap\TargetLocation\Latitude - Drawing\TargetLocation\Longitude = PBMap\TargetLocation\Longitude - Drawing\Dirty = #False - ;Main drawing stuff - StartVectorDrawing(CanvasVectorOutput(PBMap\Gadget)) - DrawTiles(@Drawing) - DrawTrack(@Drawing) - DrawMarker(@Drawing) - ; @Procedure(X.i, Y.i) to DrawPointer (you must use VectorDrawing lib) - If PBMap\CallBackMainPointer > 0 - CallFunctionFast(PBMap\CallBackMainPointer, Drawing\CenterX, Drawing\CenterY) - Else - Pointer(Drawing\CenterX, Drawing\CenterY, RGBA($FF, 0, 0, $FF)) - EndIf - ;TODO Add Option and function to display Scale on Map - ;Protected Scale.d= 40075*Cos(Radian(PBMap\TargetLocation\Latitude))/Pow(2,PBMap\Zoom) - ;VectorFont(FontID(PBMap\Font), 30) - ;VectorSourceColor(RGBA(0, 0, 0, 80)) - ;MovePathCursor(50,50) - ;DrawVectorText(StrD(Scale)) - - ;- Display How Many Image in Cache - VectorFont(FontID(PBMap\Font), 30) - VectorSourceColor(RGBA(0, 0, 0, 80)) - MovePathCursor(50,50) - DrawVectorText(Str(MapSize(PBMap\MemCache\Images()))) - StopVectorDrawing() - ;Redraw - ; If something was not correctly drawn, redraw after a while - LockMutex(*SharedDrawing\Mutex) ;Be sure that we're not modifying variables while moving (seems not useful, but it is, especially to clean the semaphore) - If Drawing\Dirty - MyDebug("Something was dirty ! We try again to redraw") - Drawing\PassNb + 1 - SignalSemaphore(*SharedDrawing\Semaphore) - Else - ;Clean the semaphore to avoid multiple unuseful redraws - Repeat : Until TrySemaphore(*SharedDrawing\Semaphore) = 0 + Procedure DrawDebugInfos() + ; Display how many images in cache + VectorFont(FontID(PBMap\Font), 30) + VectorSourceColor(RGBA(0, 0, 0, 80)) + MovePathCursor(50,50) + DrawVectorText(Str(MapSize(PBMap\MemCache\Images()))) + MovePathCursor(50,80) + Protected ThreadCounter = 0 + ForEach PBMap\MemCache\Images() + If PBMap\MemCache\Images()\Tile <> 0 + If IsThread(PBMap\MemCache\Images()\Tile\GetImageThread) + ThreadCounter + 1 + EndIf EndIf - UnlockMutex(*SharedDrawing\Mutex) - Until Drawing\End + Next + DrawVectorText(Str(ThreadCounter)) + MovePathCursor(50,110) + DrawVectorText(Str(PBMap\Zoom)) + EndProcedure + + ;-*** Main drawing + Procedure Drawing() + Protected *Drawing.DrawingParameters = @PBMap\Drawing + Protected Px.d, Py.d,a, ts = PBMap\TileSize + PBMap\Dirty = #False + PBMap\Redraw = #False + ; Precalc some values + *Drawing\CenterX = GadgetWidth(PBMap\Gadget) / 2 + *Drawing\CenterY = GadgetHeight(PBMap\Gadget) / 2 + *Drawing\GeographicCoordinates\Latitude = PBMap\GeographicCoordinates\Latitude + *Drawing\GeographicCoordinates\Longitude = PBMap\GeographicCoordinates\Longitude + LatLon2TileXY(*Drawing\GeographicCoordinates, *Drawing\TileCoordinates, PBMap\Zoom) + ; 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\DeltaY = Py * ts - (Int(Py) * ts) + ; Main drawing stuff + StartVectorDrawing(CanvasVectorOutput(PBMap\Gadget)) + ;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())) + Next + If PBMap\Options\ShowTrack + DrawTracks(*Drawing) + EndIf + If PBMap\Options\ShowMarkers + DrawMarkers() + EndIf + If PBMap\Options\ShowPointer + DrawPointer(*Drawing) + EndIf + If PBMap\Options\ShowDebugInfos + DrawDebugInfos() + EndIf + If PBMap\Options\ShowDegrees + DrawDegrees(*Drawing, 192) + EndIf + If PBMap\Options\ShowScale + DrawScale(*Drawing, 10, GadgetHeight(PBMAP\Gadget) - 20, 192) + EndIf + StopVectorDrawing() EndProcedure Procedure Refresh() - SignalSemaphore(PBMap\Drawing\Semaphore) + PBMap\Redraw = #True + ;Drawing() EndProcedure - Procedure SetLocation(latitude.d, longitude.d, zoom = 15, Mode.i = #PB_Absolute) + Procedure.d Pixel2Lon(x) + Protected NewX.d = (PBMap\PixelCoordinates\x - GadgetWidth(PBMap\Gadget) / 2 + 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 - GadgetHeight(PBMap\Gadget) / 2 + 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() + Protected MouseX.d = (PBMap\PixelCoordinates\x - GadgetWidth(PBMap\Gadget) / 2 + 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[ + ProcedureReturn Mod(Mod(MouseX / n * 360.0, 360.0) + 360.0, 360.0) - 180 + EndProcedure + + Procedure.d MouseLatitude() + Protected MouseY.d = (PBMap\PixelCoordinates\y - GadgetHeight(PBMap\Gadget) / 2 + 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)))) + EndProcedure + + Procedure SetLocation(latitude.d, longitude.d, Zoom = -1, Mode.i = #PB_Absolute) Select Mode Case #PB_Absolute - PBMap\TargetLocation\Latitude = latitude - PBMap\TargetLocation\Longitude = longitude - PBMap\Zoom = zoom + PBMap\GeographicCoordinates\Latitude = latitude + PBMap\GeographicCoordinates\Longitude = longitude + If Zoom <> -1 + PBMap\Zoom = Zoom + EndIf Case #PB_Relative - PBMap\TargetLocation\Latitude + latitude - PBMap\TargetLocation\Longitude + longitude - PBMap\Zoom + zoom + PBMap\GeographicCoordinates\Latitude + latitude + PBMap\GeographicCoordinates\Longitude + longitude + If Zoom <> -1 + PBMap\Zoom + Zoom + EndIf EndSelect If PBMap\Zoom > PBMap\ZoomMax : PBMap\Zoom = PBMap\ZoomMax : EndIf If PBMap\Zoom < PBMap\ZoomMin : PBMap\Zoom = PBMap\ZoomMin : EndIf - LatLon2XY(@PBMap\TargetLocation, @PBMap\Drawing) - ;Convert X, Y in tile.decimal into real pixels - PBMap\Position\x = PBMap\Drawing\Position\x * PBMap\TileSize - PBMap\Position\y = PBMap\Drawing\Position\y * PBMap\TileSize - PBMap\Drawing\PassNb = 1 - ;Start drawing - SignalSemaphore(PBMap\Drawing\Semaphore) - ;*** + LatLon2TileXY(@PBMap\GeographicCoordinates, @PBMap\Drawing\TileCoordinates, PBMap\Zoom) + ; Convert X, Y in tile.decimal into real pixels + PBMap\PixelCoordinates\x = PBMap\Drawing\TileCoordinates\x * PBMap\TileSize + PBMap\PixelCoordinates\y = PBMap\Drawing\TileCoordinates\y * PBMap\TileSize + PBMap\Redraw = #True If PBMap\CallBackLocation > 0 - CallFunctionFast(PBMap\CallBackLocation, @PBMap\TargetLocation) + CallFunctionFast(PBMap\CallBackLocation, @PBMap\GeographicCoordinates) EndIf EndProcedure - Procedure ZoomToArea() + 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 MinY.d,MaxY.d,MinX.d,MaxX.d - ForEach PBMap\track() - If ListIndex(PBMap\track())=0 Or PBMap\track()\LongitudeMaxX - MaxX=PBMap\track()\Longitude - EndIf - If ListIndex(PBMap\track())=0 Or PBMap\track()\LatitudeMaxY - MaxY=PBMap\track()\Latitude - EndIf - Next Protected DeltaX.d=MaxX-MinX ;assumption ! In original code DeltaX have no source Protected centerX.d=MinX+DeltaX/2 ; assumption ! In original code CenterX have no source Protected paddingFactor.f= 1.2 ;paddingFactor: this can be used to get the "120%" effect ThomM refers to. Value of 1.2 would get you the 120%. @@ -834,70 +1240,55 @@ Module PBMap Protected zoom.d = Log(360 / (resolution * PBMap\TileSize))/Log(2) Protected lon.d = centerX; Protected lat.d = centerY; - SetLocation(lat,lon, Round(zoom,#PB_Round_Down)) + SetLocation(lat, lon, Round(zoom,#PB_Round_Down)) Else - SetLocation(PBMap\TargetLocation\Latitude,PBMap\TargetLocation\Longitude, 15) + SetLocation(PBMap\GeographicCoordinates\Latitude, PBMap\GeographicCoordinates\Longitude, 15) EndIf EndProcedure + Procedure ZoomToTracks(*Tracks.Tracks) + Protected MinY.d, MaxY.d, MinX.d, MaxX.d + If ListSize(*Tracks\Track()) > 0 + With *Tracks\Track() + FirstElement(*Tracks\Track()) + MinX = \Longitude : MaxX = MinX : MinY = \Latitude : MaxY = MinY + ForEach *Tracks\Track() + If \Longitude < MinX + MinX = \Longitude + EndIf + If \Longitude > MaxX + MaxX = \Longitude + EndIf + If \Latitude < MinY + MinY = \Latitude + EndIf + If \Latitude > MaxY + MaxY = \Latitude + EndIf + Next + ZoomToArea(MinY.d, MaxY.d, MinX.d, MaxX.d) + EndWith + EndIf + EndProcedure Procedure SetZoom(Zoom.i, mode.i = #PB_Relative) Select mode Case #PB_Relative - PBMap\Zoom = PBMap\Zoom + zoom + PBMap\Zoom = PBMap\Zoom + zoom Case #PB_Absolute PBMap\Zoom = zoom EndSelect - If PBMap\Zoom > PBMap\ZoomMax : PBMap\Zoom = PBMap\ZoomMax : EndIf - If PBMap\Zoom < PBMap\ZoomMin : PBMap\Zoom = PBMap\ZoomMin : EndIf - LatLon2XY(@PBMap\TargetLocation, @PBMap\Drawing) - ;Convert X, Y in tile.decimal into real pixels - PBMap\Position\X = PBMap\Drawing\Position\x * PBMap\TileSize - PBMap\Position\Y = PBMap\Drawing\Position\y * PBMap\TileSize - ;*** Creates a drawing thread and fill parameters - PBMap\Drawing\PassNb = 1 - ;Start drawing - SignalSemaphore(PBMap\Drawing\Semaphore) - ;*** + If PBMap\Zoom > PBMap\ZoomMax : PBMap\Zoom = PBMap\ZoomMax : ProcedureReturn : EndIf + If PBMap\Zoom < PBMap\ZoomMin : PBMap\Zoom = PBMap\ZoomMin : ProcedureReturn : EndIf + LatLon2TileXY(@PBMap\GeographicCoordinates, @PBMap\Drawing\TileCoordinates, PBMap\Zoom) + ; Convert X, Y in tile.decimal into real pixels + PBMap\PixelCoordinates\X = PBMap\Drawing\TileCoordinates\x * PBMap\TileSize + PBMap\PixelCoordinates\Y = PBMap\Drawing\TileCoordinates\y * PBMap\TileSize + ; First drawing + PBMap\Redraw = #True If PBMap\CallBackLocation > 0 - CallFunctionFast(PBMap\CallBackLocation, @PBMap\TargetLocation) + CallFunctionFast(PBMap\CallBackLocation, @PBMap\GeographicCoordinates) EndIf - EndProcedure - - ;Zoom on x, y position relative to the canvas gadget - Procedure SetZoomOnPosition(x, y, zoom) - Protected MouseX.d, MouseY.d - Protected OldPx.d, OldPy.d, OldMx.d, OldMy.d - ;Fast and dirty code - OldPx = PBMap\Position\x : OldPy = PBMap\Position\y - OldMx = OldPx + GadgetWidth(PBMap\Gadget) / 2 - x - OldMy = OldPy + GadgetHeight(PBMap\Gadget) / 2 - y - PBMap\Zoom = PBMap\Zoom + zoom - If PBMap\Zoom > PBMap\ZoomMax : PBMap\Zoom = PBMap\ZoomMax : EndIf - If PBMap\Zoom < PBMap\ZoomMin : PBMap\Zoom = PBMap\ZoomMin : EndIf - ;Centered Zoom - LockMutex(PBMap\Drawing\Mutex) - LatLon2XY(@PBMap\TargetLocation, @PBMap\Drawing) - ;Convert X, Y in tile.decimal into real pixels - PBMap\Position\x = PBMap\Drawing\Position\x * PBMap\TileSize - PBMap\Position\y = PBMap\Drawing\Position\y * PBMap\TileSize - MouseX = PBMap\Position\x + GadgetWidth(PBMap\Gadget) / 2 - x - MouseY = PBMap\Position\y + GadgetHeight(PBMap\Gadget) / 2 - y - ;Cross-multiply to get the new center - PBMap\Position\x = (OldPx * MouseX) / OldMx - PBMap\Position\y = (OldPy * MouseY) / OldMy - ;PBMap tile position in tile.decimal - PBMap\Drawing\Position\x = PBMap\Position\x / PBMap\TileSize - PBMap\Drawing\Position\y = PBMap\Position\y / PBMap\TileSize - PBMap\Drawing\PassNb = 1 - XY2LatLon(@PBMap\Drawing, @PBMap\TargetLocation) - UnlockMutex(PBMap\Drawing\Mutex) - ;Start drawing - SignalSemaphore(PBMap\Drawing\Semaphore) - ;If CallBackLocation send Location to function - If PBMap\CallBackLocation > 0 - CallFunctionFast(PBMap\CallBackLocation, @PBMap\TargetLocation) - EndIf - EndProcedure + EndProcedure Procedure SetCallBackLocation(CallBackLocation.i) PBMap\CallBackLocation = CallBackLocation @@ -907,128 +1298,280 @@ Module PBMap PBMap\CallBackMainPointer = CallBackMainPointer EndProcedure + Procedure SetMapScaleUnit(ScaleUnit.i = PBMAP::#SCALE_KM) + PBMap\Options\ScaleUnit = ScaleUnit + PBMap\Redraw = #True + ;Drawing() + EndProcedure + + ; User mode + ; #MODE_DEFAULT = 0 -> "Hand" (move map) and move objects + ; #MODE_HAND = 1 -> Hand only + ; #MODE_SELECT = 2 -> Move objects only + ; #MODE_EDIT = 3 -> Create objects + Procedure SetMode(Mode = #MODE_DEFAULT) + PBMap\Mode = Mode + EndProcedure + + ;Zoom on x, y position relative to the canvas gadget + Procedure SetZoomOnPosition(x, y, zoom) + Protected MouseX.d, MouseY.d + Protected OldPx.d, OldPy.d, OldMx.d, OldMy.d, Px.d, Py.d + Protected CenterX = GadgetWidth(PBMap\Gadget) / 2 + Protected CenterY = GadgetHeight(PBMap\Gadget) / 2 + x - CenterX + y - CenterY + ;*** 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 + LatLon2Pixel(@PBMap\GeographicCoordinates, @PBMap\PixelCoordinates, PBMap\Zoom) + If Zoom = 1 + PBMap\PixelCoordinates\x + x + PBMap\PixelCoordinates\y + y + ElseIf zoom = -1 + PBMap\PixelCoordinates\x - x/2 + PBMap\PixelCoordinates\y - y/2 + EndIf + Pixel2LatLon(@PBMap\PixelCoordinates, @PBMap\GeographicCoordinates, PBMap\Zoom) + ; Start drawing + PBMap\Redraw = #True + ; If CallBackLocation send Location To function + If PBMap\CallBackLocation > 0 + CallFunctionFast(PBMap\CallBackLocation, @PBMap\GeographicCoordinates) + EndIf + EndProcedure + + ;Go to x, y position relative to the canvas gadget + Procedure GotoPixelRel(x, y) + Protected CenterX = GadgetWidth(PBMap\Gadget) / 2 + Protected CenterY = GadgetHeight(PBMap\Gadget) / 2 + x - CenterX + y - CenterY + LatLon2Pixel(@PBMap\GeographicCoordinates, @PBMap\PixelCoordinates, PBMap\Zoom) + PBMap\PixelCoordinates\x + x + PBMap\PixelCoordinates\y + y + Pixel2LatLon(@PBMap\PixelCoordinates, @PBMap\GeographicCoordinates, PBMap\Zoom) + ; Start drawing + PBMap\Redraw = #True + ; If CallBackLocation send Location to function + If PBMap\CallBackLocation > 0 + CallFunctionFast(PBMap\CallBackLocation, @PBMap\GeographicCoordinates) + EndIf + EndProcedure + Procedure.d GetLatitude() - Protected Value.d - LockMutex(PBMap\Drawing\Mutex) - Value = PBMap\TargetLocation\Latitude - UnlockMutex(PBMap\Drawing\Mutex) - ProcedureReturn Value + ProcedureReturn PBMap\GeographicCoordinates\Latitude EndProcedure Procedure.d GetLongitude() - Protected Value.d - LockMutex(PBMap\Drawing\Mutex) - Value = PBMap\TargetLocation\Longitude - UnlockMutex(PBMap\Drawing\Mutex) - ProcedureReturn Value + ProcedureReturn PBMap\GeographicCoordinates\Longitude EndProcedure Procedure.i GetZoom() Protected Value.d - LockMutex(PBMap\Drawing\Mutex) Value = PBMap\Zoom - UnlockMutex(PBMap\Drawing\Mutex) ProcedureReturn Value EndProcedure - - Procedure Event(Event.l) - Protected Gadget.i + Procedure CanvasEvents() Protected MouseX.i, MouseY.i - Protected Marker.Position - If IsGadget(PBMap\Gadget) And GadgetType(PBMap\Gadget) = #PB_GadgetType_Canvas - Select Event - Case #PB_Event_Gadget ;{ - Gadget = EventGadget() - Select Gadget - Case PBMap\Gadget - Select EventType() - Case #PB_EventType_MouseWheel - If PBMap\Options\WheelMouseRelative - ;Relative zoom (centered on the mouse) - SetZoomOnPosition(GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX), GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY), GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_WheelDelta)) - Else - ;Absolute zoom (centered on the center of the map) - SetZoom(GetGadgetAttribute(PBMap\Gadget,#PB_Canvas_WheelDelta), #PB_Relative) - EndIf - Case #PB_EventType_LeftButtonDown - ;Check if we select a marker - MouseX = PBMap\Position\x - GadgetWidth(PBMap\Gadget) / 2 + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) - MouseY = PBMap\Position\y - GadgetHeight(PBMap\Gadget) / 2 + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY) - ForEach PBMap\Marker() - LatLon2XY(@PBMap\Marker()\Location, @Marker) - Marker\x * PBMap\TileSize - Marker\y * PBMap\TileSize - If Distance(Marker\x, Marker\y, MouseX, MouseY) < 8 - PBMap\EditMarkerIndex = ListIndex(PBMap\Marker()) - Break - EndIf - Next - ;Mem cursor Coord - PBMap\MoveStartingPoint\x = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) - PBMap\MoveStartingPoint\y = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY) - Case #PB_EventType_MouseMove - ;If a move has been initiated by a left click - If PBMap\MoveStartingPoint\x <> - 1 - MouseX = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) - PBMap\MoveStartingPoint\x - MouseY = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY) - PBMap\MoveStartingPoint\y - PBMap\Moving = #True - ;If it's marker move - If PBMap\EditMarkerIndex > -1 - SelectElement(PBMap\Marker(), PBMap\EditMarkerIndex) - LatLon2XY(@PBMap\Marker()\Location, @Marker) - Marker\x + MouseX / PBMap\TileSize - Marker\y + MouseY / PBMap\TileSize - XY2LatLon(@Marker, @PBMap\Marker()\Location) - Else - ;New move values - PBMap\Position\x - MouseX - PBMap\Position\y - MouseY - ;Fill parameters and signal the drawing thread - LockMutex(PBMap\Drawing\Mutex) - ;PBMap tile position in tile.decimal - PBMap\Drawing\Position\x = PBMap\Position\x / PBMap\TileSize - PBMap\Drawing\Position\y = PBMap\Position\y / PBMap\TileSize - PBMap\Drawing\PassNb = 1 - XY2LatLon(@PBMap\Drawing, @PBMap\TargetLocation) - UnlockMutex(PBMap\Drawing\Mutex) - EndIf - ;Start drawing - SignalSemaphore(PBMap\Drawing\Semaphore) - ;If CallBackLocation send Location to function - If PBMap\CallBackLocation > 0 - CallFunctionFast(PBMap\CallBackLocation, @PBMap\TargetLocation) - EndIf - PBMap\MoveStartingPoint\x = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) - PBMap\MoveStartingPoint\y = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY) - EndIf - Case #PB_EventType_LeftButtonUp - PBMap\Moving = #False - PBMap\MoveStartingPoint\x = - 1 - ;Stop marker move - If PBMap\EditMarkerIndex > -1 - PBMap\EditMarkerIndex = -1 - Else - ;Stop map move - LockMutex(PBMap\Drawing\Mutex) - PBMap\Drawing\Position\x = PBMap\Position\x / PBMap\TileSize - PBMap\Drawing\Position\y = PBMap\Position\y / PBMap\TileSize - MyDebug("PBMap\Drawing\Position\x " + Str(PBMap\Drawing\Position\x) + " ; PBMap\Drawing\Position\y " + Str(PBMap\Drawing\Position\y) ) - XY2LatLon(@PBMap\Drawing, @PBMap\TargetLocation) - UnlockMutex(PBMap\Drawing\Mutex) - EndIf - EndSelect - EndSelect - EndSelect - Else - MessageRequester("Module PBMap", "You must use PBMapGadget before", #PB_MessageRequester_Ok ) - End - EndIf - + Protected MarkerCoords.PixelCoordinates, *Tile.Tile, MapWidth = Pow(2, PBMap\Zoom) * PBMap\TileSize + Protected key.s, Touch.i + Static CtrlKey + PBMap\Moving = #False + Select EventType() + Case #PB_EventType_KeyUp + Select GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_Key) + Case #PB_Shortcut_Delete + DeleteSelectedMarkers() + EndSelect + PBMap\Redraw = #True + If GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_Modifiers)&#PB_Canvas_Control = 0 + CtrlKey = #False + EndIf + Case #PB_EventType_KeyDown + With PBMap\Markers() + Select GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_Key) + Case #PB_Shortcut_Left + ForEach PBMap\Markers() + If \Selected + \GeographicCoordinates\Longitude = ClipLongitude( \GeographicCoordinates\Longitude - 10* 360 / Pow(2, PBMap\Zoom + 8)) + EndIf + Next + Case #PB_Shortcut_Up + ForEach PBMap\Markers() + If \Selected + \GeographicCoordinates\Latitude + 10* 360 / Pow(2, PBMap\Zoom + 8) + EndIf + Next + Case #PB_Shortcut_Right + ForEach PBMap\Markers() + If \Selected + \GeographicCoordinates\Longitude = ClipLongitude( \GeographicCoordinates\Longitude + 10* 360 / Pow(2, PBMap\Zoom + 8)) + EndIf + Next + Case #PB_Shortcut_Down + ForEach PBMap\Markers() + If \Selected + \GeographicCoordinates\Latitude - 10* 360 / Pow(2, PBMap\Zoom + 8) + EndIf + Next + EndSelect + EndWith + PBMap\Redraw = #True + If GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_Modifiers)&#PB_Canvas_Control <> 0 + CtrlKey = #True + EndIf + Case #PB_EventType_LeftDoubleClick + If PBMap\Mode = #MODE_DEFAULT Or PBMap\Mode = #MODE_SELECT + ;Check if the mouse touch a marker, if so, jump to it + LatLon2Pixel(@PBMap\GeographicCoordinates, @PBMap\PixelCoordinates, PBMap\Zoom) + MouseX = PBMap\PixelCoordinates\x - GadgetWidth(PBMap\Gadget) / 2 + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) + MouseY = PBMap\PixelCoordinates\y - GadgetHeight(PBMap\Gadget) / 2 + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY) + ;Clip MouseX to the map range (in X, the map is infinite) + MouseX = Mod(Mod(MouseX, MapWidth) + MapWidth, MapWidth) + Touch = #False + ForEach PBMap\Markers() + LatLon2Pixel(@PBMap\Markers()\GeographicCoordinates, @MarkerCoords, PBMap\Zoom) + If Distance(MarkerCoords\x, MarkerCoords\y, MouseX, MouseY) < 8 + Touch = #True + SetLocation(PBMap\Markers()\GeographicCoordinates\Latitude, PBMap\Markers()\GeographicCoordinates\Longitude) + Break + EndIf + Next + EndIf + If Not Touch + GotoPixelRel(GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX), GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY)) + EndIf + Case #PB_EventType_MouseWheel + If PBMap\Options\WheelMouseRelative + ;Relative zoom (centered on the mouse) + SetZoomOnPosition(GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX), GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY), GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_WheelDelta)) + Else + ;Absolute zoom (centered on the center of the map) + SetZoom(GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_WheelDelta), #PB_Relative) + EndIf + Case #PB_EventType_LeftButtonDown + LatLon2Pixel(@PBMap\GeographicCoordinates, @PBMap\PixelCoordinates, PBMap\Zoom) + MouseX = PBMap\PixelCoordinates\x - GadgetWidth(PBMap\Gadget) / 2 + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) + MouseY = PBMap\PixelCoordinates\y - GadgetHeight(PBMap\Gadget) / 2 + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY) + ;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 + PBMap\EditMarker = #False + ;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 + EndIf + If PBMap\Markers()\Focus + PBMap\Markers()\Selected = #True + PBMap\EditMarker = #True;ListIndex(PBMap\Markers()) + PBMap\Markers()\Focus = #False + EndIf + Next + EndIf + ;Mem cursor Coord + PBMap\MoveStartingPoint\x = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) + PBMap\MoveStartingPoint\y = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY) + Case #PB_EventType_MouseMove + PBMap\Moving = #True + If PBMap\MoveStartingPoint\x <> - 1 + MouseX = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) - PBMap\MoveStartingPoint\x + MouseY = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY) - PBMap\MoveStartingPoint\y + ;Move selected markers + If PBMap\EditMarker And (PBMap\Mode = #MODE_DEFAULT Or PBMap\Mode = #MODE_SELECT) + ForEach PBMap\Markers() + If PBMap\Markers()\Selected + LatLon2Pixel(@PBMap\Markers()\GeographicCoordinates, @MarkerCoords, PBMap\Zoom) + MarkerCoords\x + MouseX + MarkerCoords\y + MouseY + Pixel2LatLon(@MarkerCoords, @PBMap\Markers()\GeographicCoordinates, PBMap\Zoom) + 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 + PBMap\PixelCoordinates\x - MouseX + ;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 PBMap\CallBackLocation > 0 + CallFunctionFast(PBMap\CallBackLocation, @PBMap\GeographicCoordinates) + EndIf + EndIf + PBMap\Redraw = #True + PBMap\MoveStartingPoint\x = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) + PBMap\MoveStartingPoint\y = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY) + Else + LatLon2Pixel(@PBMap\GeographicCoordinates, @PBMap\PixelCoordinates, PBMap\Zoom) + MouseX = PBMap\PixelCoordinates\x - GadgetWidth(PBMap\Gadget) / 2 + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) + MouseY = PBMap\PixelCoordinates\y - GadgetHeight(PBMap\Gadget) / 2 + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY) + ;Clip MouseX to the map range (in X, the map is infinite) + MouseX = Mod(Mod(MouseX, MapWidth) + MapWidth, MapWidth) + ;Check if mouse touch markers + If PBMap\Mode = #MODE_DEFAULT Or PBMap\Mode = #MODE_SELECT + ForEach PBMap\Markers() + LatLon2Pixel(@PBMap\Markers()\GeographicCoordinates, @MarkerCoords, PBMap\Zoom) + If Distance(MarkerCoords\x, MarkerCoords\y, MouseX, MouseY) < 8 + PBMap\Markers()\Focus = #True + Else + ;If CtrlKey = #False + PBMap\Markers()\Focus = #False + ;EndIf + EndIf + Next + EndIf + PBMap\Redraw = #True + EndIf + Case #PB_EventType_LeftButtonUp + PBMap\MoveStartingPoint\x = - 1 + PBMap\Redraw = #True + Case #PB_MAP_REDRAW + Debug "Redraw" + PBMap\Redraw = #True + Case #PB_MAP_RETRY + Debug "Reload" + PBMap\Redraw = #True + 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 + PBMap\Redraw = #True + EndSelect EndProcedure + + Procedure TimerEvents() + ;Redraw at regular intervals + If EventTimer() = PBMap\Timer And (PBMap\Redraw Or PBMap\Dirty) + Drawing() + EndIf + EndProcedure + + Procedure MapGadget(Gadget.i, X.i, Y.i, Width.i, Height.i) + If Gadget = #PB_Any + PBMap\Gadget = CanvasGadget(PBMap\Gadget, X, Y, Width, Height, #PB_Canvas_Keyboard) ;#PB_Canvas_Keyboard has to be set for mousewheel to work on windows + Else + PBMap\Gadget = Gadget + CanvasGadget(PBMap\Gadget, X, Y, Width, Height, #PB_Canvas_Keyboard) + EndIf + BindGadgetEvent(PBMap\Gadget, @CanvasEvents()) + AddWindowTimer(PBMap\Window, PBMap\Timer, PBMap\Options\TimerInterval) + BindEvent(#PB_Event_Timer, @TimerEvents()) + ;AddKeyboardShortcut(#PB_Shortcut_Delete + EndProcedure + EndModule -;-Exemple +;-**** Example of application **** CompilerIf #PB_Compiler_IsMainFile InitNetwork() @@ -1047,10 +1590,12 @@ CompilerIf #PB_Compiler_IsMainFile #Text_2 #Text_3 #Text_4 - #String_0 - #String_1 + #StringLatitude + #StringLongitude #Gdt_LoadGpx #Gdt_AddMarker + #Gdt_AddOpenseaMap + #Gdt_Degrees EndEnumeration Structure Location @@ -1059,26 +1604,35 @@ CompilerIf #PB_Compiler_IsMainFile EndStructure Procedure UpdateLocation(*Location.Location) - SetGadgetText(#String_0, StrD(*Location\Latitude)) - SetGadgetText(#String_1, StrD(*Location\Longitude)) + SetGadgetText(#StringLatitude, StrD(*Location\Latitude)) + SetGadgetText(#StringLongitude, StrD(*Location\Longitude)) ProcedureReturn 0 EndProcedure - Procedure MyPointer(x.i, y.i) - Protected color.l - color=RGBA(0, 255, 0, 255) - VectorSourceColor(color) + ;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) AddPathLine(-16,-32,#PB_Path_Relative) AddPathCircle(16,0,16,180,0,#PB_Path_Relative) AddPathLine(-16,32,#PB_Path_Relative) VectorSourceColor(color) - FillPath(#PB_Path_Preserve):VectorSourceColor(RGBA(0, 0, 0, 255)):StrokePath(1) + FillPath(#PB_Path_Preserve) + If Focus + VectorSourceColor(RGBA($FF, $FF, 0, $FF)) + StrokePath(2) + ElseIf Selected + VectorSourceColor(RGBA($FF, $FF, 0, $FF)) + StrokePath(3) + Else + VectorSourceColor(RGBA(0, 0, 0, 255)) + StrokePath(1) + EndIf 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) + VectorSourceColor(RGBA(255, 255,255, 255)) : AddPathCircle(x, y,32) : StrokePath(1) + VectorSourceColor(RGBA(0, 0, 0, 255)) : AddPathCircle(x, y, 29):StrokePath(2) EndProcedure Procedure ResizeAll() @@ -1092,49 +1646,62 @@ CompilerIf #PB_Compiler_IsMainFile ResizeGadget(#Button_4,WindowWidth(#Window_0)-150,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#Button_5,WindowWidth(#Window_0)-100,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#Text_3,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore) - ResizeGadget(#String_0,WindowWidth(#Window_0)-100,#PB_Ignore,#PB_Ignore,#PB_Ignore) - ResizeGadget(#String_1,WindowWidth(#Window_0)-100,#PB_Ignore,#PB_Ignore,#PB_Ignore) + ResizeGadget(#StringLatitude,WindowWidth(#Window_0)-100,#PB_Ignore,#PB_Ignore,#PB_Ignore) + ResizeGadget(#StringLongitude,WindowWidth(#Window_0)-100,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#Text_4,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#Gdt_AddMarker,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#Gdt_LoadGpx,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore) + ResizeGadget(#Gdt_AddOpenseaMap,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore) + ResizeGadget(#Gdt_Degrees,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore) PBMap::Refresh() EndProcedure ;- MAIN TEST If OpenWindow(#Window_0, 260, 225, 700, 571, "PBMap", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered | #PB_Window_SizeGadget) - LoadFont(0, "Wingdings", 12) + LoadFont(0, "Arial", 12) LoadFont(1, "Arial", 12, #PB_Font_Bold) TextGadget(#Text_1, 530, 50, 60, 15, "Movements") - ButtonGadget(#Gdt_Left, 550, 100, 30, 30, Chr($E7)) : SetGadgetFont(#Gdt_Left, FontID(0)) - ButtonGadget(#Gdt_Right, 610, 100, 30, 30, Chr($E8)) : SetGadgetFont(#Gdt_Right, FontID(0)) - ButtonGadget(#Gdt_Up, 580, 070, 30, 30, Chr($E9)) : SetGadgetFont(#Gdt_Up, FontID(0)) - ButtonGadget(#Gdt_Down, 580, 130, 30, 30, Chr($EA)) : SetGadgetFont(#Gdt_Down, FontID(0)) + 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)) + ButtonGadget(#Button_4, 550, 180, 50, 30, " + ") : SetGadgetFont(#Button_4, FontID(1)) + ButtonGadget(#Button_5, 600, 180, 50, 30, " - ") : SetGadgetFont(#Button_5, FontID(1)) TextGadget(#Text_3, 530, 230, 60, 15, "Latitude : ") - StringGadget(#String_0, 600, 230, 90, 20, "") + StringGadget(#StringLatitude, 600, 230, 90, 20, "") TextGadget(#Text_4, 530, 250, 60, 15, "Longitude : ") - StringGadget(#String_1, 600, 250, 90, 20, "") + StringGadget(#StringLongitude, 600, 250, 90, 20, "") ButtonGadget(#Gdt_AddMarker, 530, 280, 150, 30, "Add Marker") - ButtonGadget(#Gdt_LoadGpx, 530, 310, 150, 30, "Load GPX") + ButtonGadget(#Gdt_LoadGpx, 530, 310, 150, 30, "Load GPX") + ButtonGadget(#Gdt_AddOpenseaMap, 530, 340, 150, 30, "OpenSeaMap") + ButtonGadget(#Gdt_Degrees, 530, 370, 150, 30, "Show/Hide Degrees") Define Event.i, Gadget.i, Quit.b = #False Define pfValue.d + Define OpenSeaMap = 0, Degrees = 1 ;Our main gadget - PBMap::InitPBMap() + PBMap::InitPBMap(#Window_0) + PBMap::SetOption("Proxy", "1") + ;PBMap::SetOption("ProxyUrl", "monproxy") + ;PBMap::SetOption("proxyport","0000") + PBMap::SetOption("ShowDegrees", "1") + PBMap::SetOption("ShowDebugInfos", "0") + PBMap::SetOption("ShowScale", "1") + PBMap::SetOption("ShowMarkersLegend", "1") + PBMap::SetOption("TrackShowKms", "1") PBMap::MapGadget(#Map, 10, 10, 512, 512) - PBMap::SetCallBackLocation(@UpdateLocation()) - PBMap::SetCallBackMainPointer(@MainPointer()) ;To change the Main Pointer - PBMap::SetLocation(49.04599, 2.03347, 17) - PBMap::AddMarker(49.0446828398, 2.0349812508, -1, @MyPointer()) + 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 Repeat Event = WaitWindowEvent() - PBMap::Event(Event) Select Event Case #PB_Event_CloseWindow : Quit = 1 Case #PB_Event_Gadget ;{ @@ -1153,10 +1720,27 @@ CompilerIf #PB_Compiler_IsMainFile Case #Button_5 PBMap::SetZoom( - 1) Case #Gdt_LoadGpx - PBMap::LoadGpxFile(OpenFileRequester("Choose a file to load", "", "*.gpx", 0)) - PBMap::ZoomToArea() ; <-To center the view, and zoom on the tracks + PBMap::LoadGpxFile(OpenFileRequester("Choose a file to load", "", "Gpx|*.gpx", 0)) + Case #StringLatitude, #StringLongitude + Select EventType() + Case #PB_EventType_LostFocus + PBMap::SetLocation(ValD(GetGadgetText(#StringLatitude)), ValD(GetGadgetText(#StringLongitude))) ; Change the PBMap coordinates + PBMAP::Refresh() + EndSelect Case #Gdt_AddMarker - PBMap:: AddMarker(ValD(GetGadgetText(#String_0)), ValD(GetGadgetText(#String_1)), RGBA(Random(255), Random(255), Random(255),255)) + 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 + Else + PBMap::DeleteLayer(OpenSeaMap) + OpenSeaMap = 0 + EndIf + PBMAP::Refresh() + Case #Gdt_Degrees + Degrees = 1 - Degrees + PBMap::SetOption("ShowDegrees", Str(Degrees)) + PBMap::Refresh() EndSelect Case #PB_Event_SizeWindow ResizeAll() @@ -1165,11 +1749,13 @@ CompilerIf #PB_Compiler_IsMainFile PBMap::Quit() EndIf + CompilerEndIf -; IDE Options = PureBasic 5.50 (Windows - x64) -; CursorPosition = 1132 -; FirstLine = 1123 -; Folding = --------- +; IDE Options = PureBasic 5.60 beta 5 (Windows - x86) +; CursorPosition = 1688 +; FirstLine = 1671 +; Folding = ------------- ; EnableThread ; EnableXP +; DisableDebugger ; EnableUnicode \ No newline at end of file From 5587e1cc116b7831523ac1f5b02936a5b43f8d3a Mon Sep 17 00:00:00 2001 From: thyphoonfr Date: Tue, 28 Feb 2017 10:22:26 +0100 Subject: [PATCH 2/5] Add "CleanCache" to SetOption - Add "CleanCache" to SetOption - Some minor change to proxy http download --- PBMap.pb | 79 ++++++++++++++++++++++++++++++++------------------------ 1 file changed, 45 insertions(+), 34 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index b2a4c3d..4f2ea3c 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -307,6 +307,9 @@ Module PBMap PBMap\Options\HDDCachePath = Value Case "maxmemcache" PBMap\Options\MaxMemCache = Val(Value) + Case "cleancache" + DeleteDirectory(PBMap\Options\HDDCachePath, "",#PB_FileSystem_Recursive) + MyDebug("Cache : "+PBMap\Options\HDDCachePath+" cleaned" Case "wheelmouserelative" SelBool(WheelMouseRelative) Case "showdegrees" @@ -327,6 +330,7 @@ Module PBMap SelBool(ShowMarkersLegend) Case "trackshowkms" SelBool(TrackShowKms) + EndSelect EndProcedure @@ -437,7 +441,7 @@ Module PBMap 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 cache directory : " + DirName) + Error("Can't create the following Layer cache directory : " + DirName) Else MyDebug(DirName + " successfully created", 4) EndIf @@ -654,34 +658,34 @@ Module PBMap 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) - EndIf + ;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) + ;EndIf ; **** IMPORTANT NOTICE ; I'm (djes) now using Curl 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 + *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 EndProcedure @@ -808,7 +812,14 @@ Module PBMap key = PBMap\Layers()\Name + Str(kq) ; Creates the cache tree based on the OSM tree+Layer : layer/zoom/x/y.png ; Creates the sub-directory based on the zoom - Protected DirName.s = PBMap\Options\HDDCachePath + PBMap\Layers()\Name + "\" + Str(PBMap\Zoom) + + Protected DirName.s = PBMap\Options\HDDCachePath + PBMap\Layers()\Name + If FileSize(DirName) <> -2 + If CreateDirectory(DirName) = #False + Error("Can't create the following Layer cache directory : " + DirName) + EndIf + EndIf + DirName.s = PBMap\Options\HDDCachePath + PBMap\Layers()\Name + "\" + Str(PBMap\Zoom) If FileSize(DirName) <> -2 If CreateDirectory(DirName) = #False Error("Can't create the following cache directory : " + DirName) @@ -1685,9 +1696,10 @@ CompilerIf #PB_Compiler_IsMainFile ;Our main gadget PBMap::InitPBMap(#Window_0) - PBMap::SetOption("Proxy", "1") - ;PBMap::SetOption("ProxyUrl", "monproxy") - ;PBMap::SetOption("proxyport","0000") + ;PBMap::SetOption("Proxy", "1") + ;PBMap::SetOption("ProxyUrl", "myproxy") + ;PBMap::SetOption("proxyport","3128") + PBMap::SetOption("CleanCache","1") ;Delete all files in HDD cache Directory PBMap::SetOption("ShowDegrees", "1") PBMap::SetOption("ShowDebugInfos", "0") PBMap::SetOption("ShowScale", "1") @@ -1696,7 +1708,7 @@ CompilerIf #PB_Compiler_IsMainFile 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::SetLocation(49.0446828398, 2.0349812508,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 @@ -1751,11 +1763,10 @@ CompilerIf #PB_Compiler_IsMainFile EndIf CompilerEndIf -; IDE Options = PureBasic 5.60 beta 5 (Windows - x86) -; CursorPosition = 1688 -; FirstLine = 1671 +; IDE Options = PureBasic 5.60 beta 7 (Windows - x86) +; CursorPosition = 1699 +; FirstLine = 1683 ; Folding = ------------- ; EnableThread ; EnableXP -; DisableDebugger ; EnableUnicode \ No newline at end of file From 1cc8748ddc31b724e342bccdaac323fb6d8b41ac Mon Sep 17 00:00:00 2001 From: djes Date: Wed, 1 Mar 2017 16:04:22 +0100 Subject: [PATCH 3/5] do not ignore png --- .gitignore | 2 -- 1 file changed, 2 deletions(-) delete mode 100644 .gitignore diff --git a/.gitignore b/.gitignore deleted file mode 100644 index 568e636..0000000 --- a/.gitignore +++ /dev/null @@ -1,2 +0,0 @@ -screenshot.png -*.png \ No newline at end of file From 825be77b4e13e947287f9db833ad98033086dac1 Mon Sep 17 00:00:00 2001 From: djes Date: Wed, 1 Mar 2017 16:12:58 +0100 Subject: [PATCH 4/5] To correct sync problem --- PBMap.pb | 1596 +++++++++++++++++++++++++++++++++++++----------------- 1 file changed, 1105 insertions(+), 491 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index 4f2ea3c..950d7f9 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -1,18 +1,15 @@ -;************************************************************** +;******************************************************************** ; Program: PBMap ; Description: Permits the use of tiled maps like ; OpenStreetMap in a handy PureBASIC module -; Author: Thyphoon, Djes And Idle -; Date: Februry 21, 2017 -; License: Free, unrestricted, credit appreciated -; but not required. +; Author: Thyphoon, djes And Idle +; Date: March, 2017 +; License: PBMap : Free, unrestricted, credit +; appreciated but not required. +; OSM : see http://www.openstreetmap.org/copyright ; Note: Please share improvement ! -; Thanks: Progi1984 -; Usage: Change the Proxy global variables if needed -; (see also Proxy Details) -;************************************************************** - -;#Red = 255 +; Thanks: Progi1984, yves86 +;******************************************************************** CompilerIf #PB_Compiler_Thread = #False MessageRequester("Warning !!","You must enable ThreadSafe support in compiler options",#PB_MessageRequester_Ok ) @@ -25,12 +22,22 @@ InitNetwork() UsePNGImageDecoder() UsePNGImageEncoder() -DeclareModule PBMap - #Red = 255 +DeclareModule PBMap + ;-Show debug infos + Global MyDebugLevel = 0 - ;-Show debug infos - Global Verbose = 0 - Global MyDebugLevel = 5 + 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 @@ -40,6 +47,8 @@ DeclareModule PBMap #MODE_SELECT = 2 #MODE_EDIT = 3 + #MARKER_EDIT_EVENT = #PB_Event_FirstCustomValue + ;-Declarations Declare InitPBMap(window) Declare SetOption(Option.s, Value.s) @@ -47,17 +56,23 @@ DeclareModule PBMap 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 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 SetMapScaleUnit(ScaleUnit=PBMAP::#SCALE_KM) - Declare LoadGpxFile(file.s); - Declare.i AddMarker(Latitude.d, Longitude.d, Legend.s = "", color.l=-1, CallBackPointer.i = -1) + Declare.i LoadGpxFile(file.s); + Declare ClearTracks() + Declare DeleteTrack(*Ptr) + Declare DeleteSelectedTracks() + Declare SetTrackColour(*Ptr, Colour.i) + Declare.i AddMarker(Latitude.d, Longitude.d, Identifier.s = "", Legend.s = "", color.l=-1, CallBackPointer.i = -1) Declare ClearMarkers() Declare DeleteMarker(*Ptr) Declare DeleteSelectedMarkers() @@ -68,7 +83,12 @@ DeclareModule PBMap 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() EndDeclareModule Module PBMap @@ -81,8 +101,8 @@ Module PBMap EndStructure Structure PixelCoordinates - x.i - y.i + x.d + y.d EndStructure Structure Coordinates @@ -92,32 +112,32 @@ Module PBMap ;- Tile Structure Structure Tile - Position.Coordinates - PBMapTileX.i - PBMapTileY.i - PBMapZoom.i nImage.i key.s + URL.s CacheFile.s GetImageThread.i RetryNb.i - ServerURL.s EndStructure - Structure TileBounds - NorthWest.Coordinates - SouthEast.Coordinates + Structure BoundingBox + NorthWest.GeographicCoordinates + SouthEast.GeographicCoordinates + BottomRight.PixelCoordinates + TopLeft.PixelCoordinates EndStructure Structure DrawingParameters - TileCoordinates.Coordinates - Bounds.TileBounds Canvas.i + RadiusX.d ; Canvas radius, or center in pixels + RadiusY.d + GeographicCoordinates.GeographicCoordinates ; Real center in lat/lon + TileCoordinates.Coordinates ; Center coordinates in tile.decimal + Bounds.BoundingBox ; Drawing boundaries in lat/lon + Width.d ; Drawing width in degrees + Height.d ; Drawing height in degrees PBMapZoom.i - GeographicCoordinates.GeographicCoordinates - CenterX.i - CenterY.i - DeltaX.i + DeltaX.i ; Screen relative pixels tile shift DeltaY.i Dirty.i End.i @@ -127,6 +147,7 @@ Module PBMap nImage.i *Tile.Tile TimeStackPosition.i + Alpha.i EndStructure Structure ImgMemCachKey @@ -140,13 +161,16 @@ Module PBMap 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 HDDCachePath.s ; Path where to load and save tiles downloaded from server DefaultOSMServer.s ; Base layer OSM server @@ -161,13 +185,21 @@ Module PBMap ShowDebugInfos.i ShowScale.i ShowTrack.i + ShowTrackKms.i ShowMarkers.i ShowPointer.i TimerInterval.i MaxMemCache.i ; in MiB - TrackShowKms.i + Verbose.i ; Maximum debug informations + Warning.i ; Warning requesters ShowMarkersNb.i ShowMarkersLegend.i + ;Drawing stuff + StrokeWidthTrackDefault.i + ;Colours + ColourFocus.i + ColourSelected.i + ColourTrackDefault.i EndStructure Structure Layer @@ -176,9 +208,23 @@ Module PBMap ServerURL.s ; Web URL ex: http://tile.openstreetmap.org/ EndStructure + Structure Box + x1.i + y1.i + x2.i + y2.i + EndStructure + Structure Tracks - List Track.GeographicCoordinates() + List Track.GeographicCoordinates() ; To display a GPX track + BoundingBox.Box + Visible.i + Focus.i + Selected.i + Colour.i + StrokeWidth.i EndStructure + ;-PBMap Structure Structure PBMap Window.i ; Parent Window @@ -197,6 +243,7 @@ Module PBMap List Layers.Layer() ; + Angle.d ZoomMin.i ; Min Zoom supported by server ZoomMax.i ; Max Zoom supported by server Zoom.i ; Current zoom @@ -235,12 +282,16 @@ Module PBMap ;Send debug infos to stdout (allowing mixed debug infos with curl or other libs) Procedure MyDebug(msg.s, DbgLevel = 0) - If Verbose And MyDebugLevel >= DbgLevel + If PBMap\Options\Verbose And DbgLevel >= MyDebugLevel PrintN(msg) ;Debug msg EndIf EndProcedure - + + ;- *** GetText - Translation purpose + ;TODO use this for all text + IncludeFile "gettext.pbi" + Procedure TechnicalImagesCreation() ;"Loading" image Protected LoadingText$ = "Loading" @@ -292,6 +343,27 @@ Module PBMap 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) @@ -307,9 +379,10 @@ Module PBMap PBMap\Options\HDDCachePath = Value Case "maxmemcache" PBMap\Options\MaxMemCache = Val(Value) - Case "cleancache" - DeleteDirectory(PBMap\Options\HDDCachePath, "",#PB_FileSystem_Recursive) - MyDebug("Cache : "+PBMap\Options\HDDCachePath+" cleaned" + Case "verbose" + SelBool(Verbose) + Case "warning" + SelBool(Warning) Case "wheelmouserelative" SelBool(WheelMouseRelative) Case "showdegrees" @@ -328,9 +401,16 @@ Module PBMap SelBool(ShowMarkersNb) Case "showmarkerslegend" SelBool(ShowMarkersLegend) - Case "trackshowkms" - SelBool(TrackShowKms) - + 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 @@ -341,28 +421,38 @@ Module PBMap Else CreatePreferences(PreferencesFile) EndIf - PreferenceGroup("PROXY") - WritePreferenceInteger("Proxy", PBMap\Options\Proxy) - WritePreferenceString("ProxyURL", PBMap\Options\ProxyURL) - WritePreferenceString("ProxyPort", PBMap\Options\ProxyPort) - WritePreferenceString("ProxyUser", PBMap\Options\ProxyUser) - PreferenceGroup("URL") - WritePreferenceString("DefaultOSMServer", PBMap\Options\DefaultOSMServer) - PreferenceGroup("PATHS") - WritePreferenceString("TilesCachePath", PBMap\Options\HDDCachePath) - PreferenceGroup("OPTIONS") - WritePreferenceInteger("WheelMouseRelative", PBMap\Options\WheelMouseRelative) - WritePreferenceInteger("MaxMemCache", PBMap\Options\MaxMemCache) - WritePreferenceInteger("ShowDegrees", PBMap\Options\ShowDegrees) - WritePreferenceInteger("ShowDebugInfos", PBMap\Options\ShowDebugInfos) - WritePreferenceInteger("ShowScale", PBMap\Options\ShowScale) - WritePreferenceInteger("ShowMarkers", PBMap\Options\ShowMarkers) - WritePreferenceInteger("ShowPointer", PBMap\Options\ShowPointer) - WritePreferenceInteger("ShowTrack", PBMap\Options\ShowTrack) - WritePreferenceInteger("ShowMarkersNb", PBMap\Options\ShowMarkersNb) - WritePreferenceInteger("ShowMarkersLegend", PBMap\Options\ShowMarkersLegend) - WritePreferenceInteger("TrackShowKms", PBMap\Options\TrackShowKms) - ClosePreferences() + 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") @@ -384,68 +474,47 @@ Module PBMap ; WritePreferenceString("ProxyUser", "myproxyname") ; WritePreferenceString("ProxyPass", "myproxypass") ;TODO !Warning! !not encoded! ; ClosePreferences() - PreferenceGroup("PROXY") - PBMap\Options\Proxy = ReadPreferenceInteger("Proxy", #False) - If PBMap\Options\Proxy - PBMap\Options\ProxyURL = ReadPreferenceString("ProxyURL", "") ;InputRequester("ProxyServer", "Do you use a Proxy Server? Then enter the full url:", "") - PBMap\Options\ProxyPort = ReadPreferenceString("ProxyPort", "") ;InputRequester("ProxyPort" , "Do you use a specific port? Then enter it", "") - PBMap\Options\ProxyUser = ReadPreferenceString("ProxyUser", "") ;InputRequester("ProxyUser" , "Do you use a user name? Then enter it", "") - PBMap\Options\ProxyPassword = InputRequester("ProxyPass", "Do you use a password ? Then enter it", "") ;TODO - EndIf - PreferenceGroup("URL") - PBMap\Options\DefaultOSMServer = ReadPreferenceString("DefaultOSMServer", "http://tile.openstreetmap.org/") - - PreferenceGroup("PATHS") - PBMap\Options\HDDCachePath = ReadPreferenceString("TilesCachePath", GetTemporaryDirectory()) - PreferenceGroup("OPTIONS") - PBMap\Options\WheelMouseRelative = ReadPreferenceInteger("WheelMouseRelative", #True) - PBMap\Options\MaxMemCache = ReadPreferenceInteger("MaxMemCache", 20480) ;20 MiB, about 80 tiles in memory - PBMap\Options\ShowDegrees = ReadPreferenceInteger("ShowDegrees", #False) - PBMap\Options\ShowDebugInfos = ReadPreferenceInteger("ShowDebugInfos", #False) - PBMap\Options\ShowScale = ReadPreferenceInteger("ShowScale", #False) - PBMap\Options\ShowMarkers = ReadPreferenceInteger("ShowMarkers", #True) - PBMap\Options\ShowPointer = ReadPreferenceInteger("ShowPointer", #True) - PBMap\Options\ShowTrack = ReadPreferenceInteger("ShowTrack", #True) - PBMap\Options\ShowMarkersNb = ReadPreferenceInteger("ShowMarkersNb", #True) - PBMap\Options\ShowMarkersLegend = ReadPreferenceInteger("ShowMarkersLegend", #False) - PBMap\Options\TrackShowKms = ReadPreferenceInteger("TrackShowKms", #False) - PBMap\Options\TimerInterval = 20 - ClosePreferences() - EndProcedure - - Procedure InitPBMap(Window) - Protected Result.i - If Verbose - OpenConsole() - EndIf - 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 - LoadOptions() - If PBMap\Options\DefaultOSMServer <> "" - AddMapServerLayer("OSM", 1, PBMap\Options\DefaultOSMServer) - EndIf - TechnicalImagesCreation() - SetLocation(0, 0) + 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()) - 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 cache directory : " + DirName) - Else - MyDebug(DirName + " successfully created", 4) - EndIf - EndIf If *Ptr PBMap\Layers()\Name = LayerName PBMap\Layers()\Order = Order @@ -486,7 +555,7 @@ Module PBMap EndIf Next Delay(10) - Until MapSize(PBMap\MemCache\Images()) = 0 + Until MapSize(PBMap\MemCache\Images()) = 0 EndProcedure Macro Min(a,b) @@ -521,6 +590,12 @@ Module PBMap ;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 + *Location\Latitude = -89 + EndIf + If *Location\Latitude >= 89 + *Location\Latitude = 89 + EndIf EndProcedure Procedure Pixel2LatLon(*Coords.PixelCoordinates, *Location.GeographicCoordinates, Zoom) @@ -528,6 +603,12 @@ Module PBMap ;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 + *Location\Latitude = -89 + EndIf + If *Location\Latitude >= 89 + *Location\Latitude = 89 + EndIf EndProcedure ;Ensures the longitude to be in the range [-180;180[ @@ -546,11 +627,11 @@ Module PBMap ;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\CenterX + Protected cx.d = PBMap\Drawing\RadiusX Protected dpx.d = PBMap\PixelCoordinates\x Protected LatRad.d = Radian(*Location\Latitude) - Protected px = tilemax * (Mod( *Location\Longitude + 180.0, 360) / 360.0 ) - Protected py = tilemax * ( 1.0 - Log(Tan(LatRad) + (1.0/Cos(LatRad))) / #PI ) / 2.0 + 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) If dpx - px >= tilemax / 2 ;Debug "c1" @@ -565,7 +646,7 @@ Module PBMap ;Debug "c0" *Pixel\x = cx + (px - dpx) EndIf - *Pixel\y = PBMap\Drawing\CenterY + (py - PBMap\PixelCoordinates\y) + *Pixel\y = PBMap\Drawing\RadiusY + (py - PBMap\PixelCoordinates\y) EndProcedure ; HaversineAlgorithm @@ -586,6 +667,7 @@ Module PBMap ProcedureReturn (1000 * HaversineInKM(@*posA,@*posB)); EndProcedure + ; No more used, see LatLon2PixelRel Procedure GetPixelCoordFromLocation(*Location.GeographicCoordinates, *Pixel.PixelCoordinates, Zoom) ; TODO to Optimize Protected mapWidth.l = Pow(2, Zoom + 8) Protected mapHeight.l = Pow(2, Zoom + 8) @@ -601,41 +683,47 @@ Module PBMap latRad = PBMap\GeographicCoordinates\Latitude*#PI/180; mercN = Log(Tan((#PI/4)+(latRad/2))) y2 = (mapHeight/2)-(mapWidth*mercN/(2*#PI)); - *Pixel\x=GadgetWidth(PBMap\Gadget)/2 - (x2-x1) - *Pixel\y=GadgetHeight(PBMap\Gadget)/2 - (y2-y1) + *Pixel\x=PBMap\Drawing\RadiusX - (x2-x1) + *Pixel\y=PBMap\Drawing\RadiusY - (y2-y1) EndProcedure - Procedure LoadGpxFile(file.s) - If LoadXML(0, file.s) - Protected Message.s - If XMLStatus(0) <> #PB_XML_Success - Message = "Error in the XML file:" + Chr(13) - Message + "Message: " + XMLError(0) + Chr(13) - Message + "Line: " + Str(XMLErrorLine(0)) + " Character: " + Str(XMLErrorPosition(0)) - MessageRequester("Error", Message) - EndIf - Protected *MainNode,*subNode,*child,child.l - *MainNode=MainXMLNode(0) - *MainNode=XMLNodeFromPath(*MainNode,"/gpx/trk/trkseg") - Protected *NewTrack.Tracks = AddElement(PBMap\TracksList()) - For child = 1 To XMLChildCount(*MainNode) - *child = ChildXMLNode(*MainNode, child) - AddElement(*NewTrack\Track()) - If ExamineXMLAttributes(*child) - While NextXMLAttribute(*child) - Select XMLAttributeName(*child) - Case "lat" - *NewTrack\Track()\Latitude=ValD(XMLAttributeValue(*child)) - Case "lon" - *NewTrack\Track()\Longitude=ValD(XMLAttributeValue(*child)) - EndSelect - Wend - EndIf - Next - ZoomToTracks(LastElement(PBMap\TracksList())) ; <-To center the view, and zoom on the tracks + Procedure IsInDrawingPixelBoundaries(*Drawing.DrawingParameters, *Position.GeographicCoordinates) + Protected Pixel.PixelCoordinates + LatLon2PixelRel(*Position, @Pixel, PBMap\Zoom) + If Pixel\x >= 0 And Pixel\y >= 0 And Pixel\x < *Drawing\RadiusX * 2 And Pixel\y < *Drawing\RadiusY * 2 + ProcedureReturn #True + Else + ProcedureReturn #False EndIf EndProcedure + Procedure 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 + If Lat >= LatSE And Lat <= LatNW + If *Drawing\Width >= 360 + ProcedureReturn #True + Else + If LonNW < LonSE + If Lon >= LonNW And Lon <= LonSE + ProcedureReturn #True + Else + ProcedureReturn #False + EndIf + Else + If (Lon >= -180 And Lon <= LonSE) Or (Lon >= LonNW And Lon <= 180) + ProcedureReturn #True + Else + ProcedureReturn #False + EndIf + EndIf + EndIf + Else + ProcedureReturn #False + EndIf + EndProcedure + ;-*** These are threaded Procedure.i GetTileFromHDD(CacheFile.s) Protected nImage.i @@ -656,51 +744,50 @@ Module PBMap 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) - ;EndIf - ; **** IMPORTANT NOTICE - ; I'm (djes) now using Curl only, as this original catchimage/saveimage method is a double operation (uncompress/recompress PNG) + 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) + 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 + ; *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 EndProcedure Procedure GetImageThread(*Tile.Tile) Protected nImage.i = -1 - Protected TileURL.s = *Tile\ServerURL + Str(*Tile\PBMapZoom) + "/" + Str(*Tile\PBMapTileX) + "/" + Str(*Tile\PBMapTileY) + ".png" Repeat - nImage = GetTileFromWeb(TileURL, *Tile\CacheFile) + 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(1000) + Delay(2000) *Tile\RetryNb - 1 EndIf Until *Tile\RetryNb <= 0 @@ -710,27 +797,27 @@ Module PBMap EndProcedure ;-*** - Procedure.i GetTile(key.s, CacheFile.s, px.i, py.i, tilex.i, tiley.i, ServerURL.s) + 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 timg = -1 - If FindMapElement(PBMap\MemCache\Images(), key) + Protected img.i = -1 + Protected *timg.ImgMemCach = FindMapElement(PBMap\MemCache\Images(), key) + If *timg MyDebug("Key : " + key + " found in memory cache!", 3) - timg = PBMap\MemCache\Images()\nImage - If timg <> -1 - MyDebug("Image : " + timg + " 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(), PBMap\MemCache\Images()\TimeStackPosition) + SelectElement(PBMap\MemCache\ImagesTimeStack(), *timg\TimeStackPosition) MoveElement(PBMap\MemCache\ImagesTimeStack(), #PB_List_Last) ;*** - ProcedureReturn timg + ProcedureReturn *timg EndIf Else - AddMapElement(PBMap\MemCache\Images(), key) - PushMapPosition(PBMap\MemCache\Images()) + ;PushMapPosition(PBMap\MemCache\Images()) ;*** Cache management - ; if cache size exceeds limit, try to delete the oldest tile used + ; 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) @@ -746,36 +833,38 @@ Module PBMap CacheSize = MapSize(PBMap\MemCache\Images()) * Pow(PBMap\TileSize, 2) * 4 ; Size of a tile = TileSize * TileSize * 4 bytes (RGBA) EndIf Wend - PopMapPosition(PBMap\MemCache\Images()) + 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) - PBMap\MemCache\Images()\nImage = -1 + *timg = PBMap\MemCache\Images() + *timg\nImage = -1 EndIf - If PBMap\MemCache\Images()\Tile = 0 ; Check if a loading thread is not running + If *timg\Tile = 0 ; Check if a loading thread is not running MyDebug("Trying to load from HDD " + CacheFile, 3) - timg = GetTileFromHDD(CacheFile.s) - If timg <> -1 + img = GetTileFromHDD(CacheFile.s) + If img <> -1 MyDebug("Key : " + key + " found on HDD", 3) - PBMap\MemCache\Images()\nImage = timg - ProcedureReturn timg + *timg\nImage = img + *timg\Alpha = 256 + ProcedureReturn *timg EndIf MyDebug("Key : " + key + " not found on HDD", 3) ;Launch a new thread Protected *NewTile.Tile = AllocateMemory(SizeOf(Tile)) If *NewTile With *NewTile - PBMap\MemCache\Images()\Tile = *NewTile + *timg\Tile = *NewTile + *timg\Alpha = 0 + ;*timg\nImage = -1 ;New tile parameters - \Position\x = px - \Position\y = py - \PBMapTileX = tilex - \PBMapTileY = tiley - \PBMapZoom = PBMap\Zoom \key = key + \URL = URL \CacheFile = CacheFile - \ServerURL = ServerURL \RetryNb = 5 \nImage = -1 MyDebug(" Creating get image thread nb " + Str(\GetImageThread) + " to get " + CacheFile, 3) @@ -785,23 +874,24 @@ Module PBMap MyDebug(" Error, can't create a new tile loading thread", 3) EndIf EndIf - ProcedureReturn timg + ProcedureReturn *timg EndProcedure - Procedure DrawTiles(*Drawing.DrawingParameters, Layer, alpha.i=255) + Procedure DrawTiles(*Drawing.DrawingParameters, Layer) Protected x.i, y.i,kq.q Protected tx = Int(*Drawing\TileCoordinates\x) ;Don't forget the Int() ! Protected ty = Int(*Drawing\TileCoordinates\y) - Protected nx = *Drawing\CenterX / PBMap\TileSize ;How many tiles around the point - Protected ny = *Drawing\CenterY / PBMap\TileSize - Protected px, py, img, tilex,tiley, key.s, CacheFile.s + 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< -2 - If CreateDirectory(DirName) = #False - Error("Can't create the following Layer cache directory : " + DirName) + If CreateDirectory(DirName) = #False ; Creates a directory based on the layer name + Error("Can't create the following layer directory : " + DirName) + Else + MyDebug(DirName + " successfully created", 4) EndIf - EndIf - DirName.s = PBMap\Options\HDDCachePath + PBMap\Layers()\Name + "\" + Str(PBMap\Zoom) + EndIf + ; Creates the sub-directory based on the zoom + DirName + slash + Str(PBMap\Zoom) If FileSize(DirName) <> -2 If CreateDirectory(DirName) = #False - Error("Can't create the following cache directory : " + DirName) + Error("Can't create the following zoom directory : " + DirName) + Else + MyDebug(DirName + " successfully created", 4) EndIf EndIf ; Creates the sub-directory based on x - DirName.s + "\" + Str(tilex) + DirName.s + slash + Str(tilex) If FileSize(DirName) <> -2 If CreateDirectory(DirName) = #False - Error("Can't create the following cache directory : " + DirName) + Error("Can't create the following x directory : " + DirName) + Else + MyDebug(DirName + " successfully created", 4) EndIf EndIf ; Tile cache name based on y - CacheFile = DirName + "\" + Str(tiley) + ".png" - img = GetTile(key, CacheFile, px, py, tilex, tiley, PBMap\Layers()\ServerURL) - If img <> -1 + URL = PBMap\Layers()\ServerURL + Str(PBMap\Zoom) + "/" + Str(tilex) + "/" + Str(tiley) + ".png" + CacheFile = DirName + slash + Str(tiley) + ".png" + *timg = GetTile(key, URL, CacheFile) + If *timg\nImage <> -1 MovePathCursor(px, py) - DrawVectorImage(ImageID(img), alpha) + If *timg\Alpha <= 224 + DrawVectorImage(ImageID(*timg\nImage), *timg\Alpha) + *timg\Alpha + 32 + PBMap\Redraw = #True + Else + DrawVectorImage(ImageID(*timg\nImage), 255) + *timg\Alpha = 256 + EndIf Else MovePathCursor(px, py) - DrawVectorImage(ImageID(PBMap\ImgLoading), alpha) + DrawVectorImage(ImageID(PBMap\ImgLoading), 255) EndIf Else ;If PBMap\Layers()\Name = "" MovePathCursor(px, py) - DrawVectorImage(ImageID(PBMap\ImgNothing)) + DrawVectorImage(ImageID(PBMap\ImgNothing), 255) ;EndIf EndIf If PBMap\Options\ShowDebugInfos @@ -863,10 +966,10 @@ Module PBMap Procedure DrawPointer(*Drawing.DrawingParameters) If PBMap\CallBackMainPointer > 0 ; @Procedure(X.i, Y.i) to DrawPointer (you must use VectorDrawing lib) - CallFunctionFast(PBMap\CallBackMainPointer, *Drawing\CenterX, *Drawing\CenterY) + CallFunctionFast(PBMap\CallBackMainPointer, *Drawing\RadiusX, *Drawing\RadiusY) Else VectorSourceColor(RGBA($FF, 0, 0, $FF)) - MovePathCursor(*Drawing\CenterX, *Drawing\CenterY) + MovePathCursor(*Drawing\RadiusX, *Drawing\RadiusY) AddPathLine(-8, -16, #PB_Path_Relative) AddPathCircle(8, 0, 8, 180, 0, #PB_Path_Relative) AddPathLine(-8, 16, #PB_Path_Relative) @@ -888,7 +991,7 @@ Module PBMap sunit = " Km" EndSelect VectorFont(FontID(PBMap\Font), 10) - VectorSourceColor(RGBA(0, 0, 0,alpha)) + VectorSourceColor(RGBA(0, 0, 0, alpha)) MovePathCursor(x,y) DrawVectorText(StrD(Scale,3)+sunit) MovePathCursor(x,y+12) @@ -900,17 +1003,27 @@ Module PBMap Protected tx, ty, nx,ny,nx1,ny1,x,y,n,cx,dperpixel.d Protected pos1.PixelCoordinates,pos2.PixelCoordinates,Degrees1.GeographicCoordinates,degrees2.GeographicCoordinates Protected realx - tx = Int(*Drawing\TileCoordinates\x) - ty = Int(*Drawing\TileCoordinates\y) - nx = *Drawing\CenterX / PBMap\TileSize ;How many tiles around the point - ny = *Drawing\CenterY / PBMap\TileSize - *Drawing\Bounds\NorthWest\x = tx-nx-1 - *Drawing\Bounds\NorthWest\y = ty-ny-1 - *Drawing\Bounds\SouthEast\x = tx+nx+2 - *Drawing\Bounds\SouthEast\y = ty+ny+2 - ; Debug "------------------" - TileXY2LatLon(*Drawing\Bounds\NorthWest, @Degrees1, PBMap\Zoom) - TileXY2LatLon(*Drawing\Bounds\SouthEast, @Degrees2, PBMap\Zoom) + + ;TODO to find why it doesn't work + 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 nx = Mod(Mod(Round(Degrees1\Longitude, #PB_Round_Down)-1, 360) + 360, 360) ny = Round(Degrees1\Latitude, #PB_Round_Up) +1 @@ -950,7 +1063,7 @@ Module PBMap StrokePath(1) EndProcedure - Procedure TrackPointer(x.i, y.i, dist.l) + Procedure DrawTrackPointer(x.d, y.d, dist.l) Protected color.l color=RGBA(0, 0, 0, 255) MovePathCursor(x,y) @@ -969,103 +1082,178 @@ Module PBMap DrawVectorText(Str(dist)) EndProcedure + Procedure DrawTrackPointerFirst(x.d, y.d, dist.l) + Protected color.l + color=RGBA(0, 0, 0, 255) + MovePathCursor(x,y) + AddPathLine(-9,-17,#PB_Path_Relative) + AddPathLine(17,0,#PB_Path_Relative) + AddPathLine(-9,17,#PB_Path_Relative) + VectorSourceColor(color) + AddPathCircle(x,y-24,16) + FillPath() + VectorSourceColor(RGBA(255, 0, 0, 255)) + AddPathCircle(x,y-24,14) + FillPath() + VectorFont(FontID(PBMap\Font), 14) + MovePathCursor(x-VectorTextWidth(Str(dist))/2, y-24-VectorTextHeight(Str(dist))/2) + VectorSourceColor(RGBA(0, 0, 0, 255)) + DrawVectorText(Str(dist)) + EndProcedure + + Procedure DeleteTrack(*Ptr) + If *Ptr + ChangeCurrentElement(PBMap\TracksList(), *Ptr) + DeleteElement(PBMap\TracksList()) + EndIf + EndProcedure + + Procedure DeleteSelectedTracks() + ForEach PBMap\TracksList() + If PBMap\TracksList()\Selected + DeleteElement(PBMap\TracksList()) + PBMap\Redraw = #True + EndIf + Next + EndProcedure + + Procedure ClearTracks() + ClearList(PBMap\TracksList()) + PBMap\Redraw = #True + EndProcedure + + Procedure SetTrackColour(*Ptr, Colour.i) + If *Ptr + ChangeCurrentElement(PBMap\TracksList(), *Ptr) + PBMap\TracksList()\Colour = Colour + PBMap\Redraw = #True + EndIf + EndProcedure + Procedure DrawTracks(*Drawing.DrawingParameters) Protected Pixel.PixelCoordinates Protected Location.GeographicCoordinates Protected km.f, memKm.i - ;Trace Track - If ListSize(PBMap\TracksList()) > 0 - BeginVectorLayer() - ForEach PBMap\TracksList() - If ListSize(PBMap\TracksList()\Track()) > 0 - ForEach PBMap\TracksList()\Track() - ;If *Drawing\GeographicCoordinates\Latitude<>0 And *Drawing\GeographicCoordinates\Longitude<>0 - LatLon2PixelRel(@PBMap\TracksList()\Track(), @Pixel, PBMap\Zoom) - If ListIndex(PBMap\TracksList()\Track()) = 0 - MovePathCursor(Pixel\X, Pixel\Y) - Else - AddPathLine(Pixel\X, Pixel\Y) - EndIf - ;EndIf - Next - VectorSourceColor(RGBA(0, 255, 0, 150)) - StrokePath(10, #PB_Path_RoundEnd|#PB_Path_RoundCorner) - EndIf - Next - EndVectorLayer() - EndIf - ;Draw Distance - If PBMap\Options\TrackShowKms And ListSize(PBMap\TracksList()) > 0 - BeginVectorLayer() - ForEach PBMap\TracksList() - km = 0 : memKm = -1 - ForEach PBMap\TracksList()\Track() - ;Test Distance - If ListIndex(PBMap\TracksList()\Track()) = 0 - Location\Latitude = PBMap\TracksList()\Track()\Latitude - Location\Longitude = PBMap\TracksList()\Track()\Longitude - Else - km = km + HaversineInKM(@Location, @PBMap\TracksList()\Track()) - Location\Latitude = PBMap\TracksList()\Track()\Latitude - Location\Longitude = PBMap\TracksList()\Track()\Longitude - EndIf - LatLon2PixelRel(@PBMap\TracksList()\Track(), @Pixel, PBMap\Zoom) - If Int(km) <> memKm - memKm = Int(km) - If PBMap\Zoom > 10 - TrackPointer(Pixel\X , Pixel\Y, Int(km)) - EndIf + With PBMap\TracksList() + ;Trace Track + If ListSize(PBMap\TracksList()) > 0 + BeginVectorLayer() + ForEach PBMap\TracksList() + If ListSize(\Track()) > 0 + ;Check visibility + \Visible = #False + ForEach \Track() + If IsInDrawingPixelBoundaries(*Drawing, @PBMap\TracksList()\Track()) + \Visible = #True + Break + EndIf + Next + If \Visible + ;Draw tracks + ForEach \Track() + LatLon2PixelRel(@PBMap\TracksList()\Track(), @Pixel, PBMap\Zoom) + If ListIndex(\Track()) = 0 + MovePathCursor(Pixel\x, Pixel\y) + Else + AddPathLine(Pixel\x, Pixel\y) + EndIf + Next + ; \BoundingBox\x = PathBoundsX() + ; \BoundingBox\y = PathBoundsY() + ; \BoundingBox\w = PathBoundsWidth() + ; \BoundingBox\h = PathBoundsHeight() + If \Focus + VectorSourceColor(PBMap\Options\ColourFocus) + ElseIf \Selected + VectorSourceColor(PBMap\Options\ColourSelected) + Else + VectorSourceColor(\Colour) + EndIf + StrokePath(\StrokeWidth, #PB_Path_RoundEnd|#PB_Path_RoundCorner) + EndIf EndIf Next - Next - EndVectorLayer() + EndVectorLayer() + ;Draw distances + If PBMap\Options\ShowTrackKms And PBMap\Zoom > 10 + BeginVectorLayer() + ForEach PBMap\TracksList() + If \Visible + km = 0 : memKm = -1 + ForEach PBMap\TracksList()\Track() + ;Test Distance + If ListIndex(\Track()) = 0 + Location\Latitude = \Track()\Latitude + Location\Longitude = \Track()\Longitude + Else + km = km + HaversineInKM(@Location, @PBMap\TracksList()\Track()) + Location\Latitude = \Track()\Latitude + Location\Longitude = \Track()\Longitude + EndIf + LatLon2PixelRel(@PBMap\TracksList()\Track(), @Pixel, PBMap\Zoom) + If Int(km) <> memKm + memKm = Int(km) + If Int(km) = 0 + DrawTrackPointerFirst(Pixel\x , Pixel\y, Int(km)) + Else + DrawTrackPointer(Pixel\x , Pixel\y, Int(km)) + EndIf + EndIf + Next + EndIf + Next + EndVectorLayer() + EndIf + EndIf + EndWith + EndProcedure + + Procedure.i LoadGpxFile(file.s) + If LoadXML(0, file.s) + Protected Message.s + If XMLStatus(0) <> #PB_XML_Success + Message = "Error in the XML file:" + Chr(13) + Message + "Message: " + XMLError(0) + Chr(13) + Message + "Line: " + Str(XMLErrorLine(0)) + " Character: " + Str(XMLErrorPosition(0)) + MessageRequester("Error", Message) + EndIf + Protected *MainNode,*subNode,*child,child.l + *MainNode=MainXMLNode(0) + *MainNode=XMLNodeFromPath(*MainNode,"/gpx/trk/trkseg") + Protected *NewTrack.Tracks = AddElement(PBMap\TracksList()) + PBMap\TracksList()\StrokeWidth = PBMap\Options\StrokeWidthTrackDefault + PBMap\TracksList()\Colour = PBMap\Options\ColourTrackDefault + For child = 1 To XMLChildCount(*MainNode) + *child = ChildXMLNode(*MainNode, child) + AddElement(*NewTrack\Track()) + If ExamineXMLAttributes(*child) + While NextXMLAttribute(*child) + Select XMLAttributeName(*child) + Case "lat" + *NewTrack\Track()\Latitude=ValD(XMLAttributeValue(*child)) + Case "lon" + *NewTrack\Track()\Longitude=ValD(XMLAttributeValue(*child)) + EndSelect + Wend + EndIf + Next + ZoomToTracks(LastElement(PBMap\TracksList())) ; <-To center the view, and zoom on the tracks + ProcedureReturn *NewTrack EndIf EndProcedure - Procedure DrawMarker(x.i, y.i, Nb, Color.l, Legend.s, Focus.i, Selected.i) - VectorSourceColor(color) - MovePathCursor(x, y) - AddPathLine(-8, -16, #PB_Path_Relative) - AddPathCircle(8, 0, 8, 180, 0, #PB_Path_Relative) - AddPathLine(-8, 16, #PB_Path_Relative) - ;FillPath(#PB_Path_Preserve) - ;ClipPath(#PB_Path_Preserve) - AddPathCircle(0, -16, 5, 0, 360, #PB_Path_Relative) - VectorSourceColor(Color) - FillPath(#PB_Path_Preserve) - If Focus - VectorSourceColor(RGBA(255, 255, 0, 255)) - StrokePath(3) - ElseIf Selected - VectorSourceColor(RGBA(255, 255, 0, 255)) - StrokePath(4) - Else - VectorSourceColor(Color) - StrokePath(1) - EndIf - If PBMap\Options\ShowMarkersNb - Protected Text.s = Str(Nb) - VectorFont(FontID(PBMap\Font), 13) - MovePathCursor(x - 10, y) - VectorSourceColor(RGBA(0, 0, 0, 255)) - DrawVectorParagraph(Text, 20, 20, #PB_VectorParagraph_Center) - EndIf - If PBMap\Options\ShowMarkersLegend - VectorFont(FontID(PBMap\Font), 13) - Protected Height = VectorParagraphHeight(Legend, 100, 13) - MovePathCursor(x - 50, y - 30 - Height) - VectorSourceColor(RGBA(0, 0, 0, 255)) - DrawVectorParagraph(Legend, 100, Height, #PB_VectorParagraph_Center) - EndIf - EndProcedure Procedure ClearMarkers() ClearList(PBMap\Markers()) + PBMap\Redraw = #True EndProcedure Procedure DeleteMarker(*Ptr) - ChangeCurrentElement(PBMap\Markers(), *Ptr) - DeleteElement(PBMap\Markers()) + If *Ptr + ChangeCurrentElement(PBMap\Markers(), *Ptr) + DeleteElement(PBMap\Markers()) + PBMap\Redraw = #True + EndIf EndProcedure Procedure DeleteSelectedMarkers() @@ -1077,11 +1265,12 @@ Module PBMap Next EndProcedure - Procedure.i AddMarker(Latitude.d, Longitude.d, Legend.s = "", Color.l=-1, CallBackPointer.i = -1) + Procedure.i AddMarker(Latitude.d, Longitude.d, Identifier.s = "", Legend.s = "", Color.l=-1, CallBackPointer.i = -1) Protected *Ptr = AddElement(PBMap\Markers()) If *Ptr PBMap\Markers()\GeographicCoordinates\Latitude = Latitude - PBMap\Markers()\GeographicCoordinates\Longitude = Mod(Mod(Longitude, 360) + 360, 360) + PBMap\Markers()\GeographicCoordinates\Longitude = ClipLongitude(Longitude) + PBMap\Markers()\Identifier = Identifier PBMap\Markers()\Legend = Legend PBMap\Markers()\Color = Color PBMap\Markers()\CallBackPointer = CallBackPointer @@ -1090,31 +1279,122 @@ Module PBMap EndIf EndProcedure - ; Draw all markers - Procedure DrawMarkers() - Protected Pixel.PixelCoordinates + ;-*** Marker Edit + Procedure MarkerIdentifierChange() + Protected *Marker.Marker = GetGadgetData(EventGadget()) + If GetGadgetText(EventGadget()) <> *Marker\Identifier + *Marker\Identifier = GetGadgetText(EventGadget()) + EndIf + EndProcedure + Procedure MarkerLegendChange() + Protected *Marker.Marker = GetGadgetData(EventGadget()) + If GetGadgetText(EventGadget()) <> *Marker\Legend + *Marker\Legend = GetGadgetText(EventGadget()) + EndIf + EndProcedure + Procedure MarkerEditCloseWindow() ForEach PBMap\Markers() - If PBMap\Markers()\GeographicCoordinates\Latitude <> 0 And PBMap\Markers()\GeographicCoordinates\Longitude <> 0 - ;GetPixelCoordFromLocation(PBMap\Markers()\GeographicCoordinates, @Pixel) - LatLon2PixelRel(PBMap\Markers()\GeographicCoordinates, @Pixel, PBMap\Zoom) - If Pixel\X >= 0 And Pixel\Y >= 0 And Pixel\X < GadgetWidth(PBMap\Gadget) And Pixel\Y < GadgetHeight(PBMap\Gadget) ; Only if visible ^_^ - If PBMap\Markers()\CallBackPointer > 0 - CallFunctionFast(PBMap\Markers()\CallBackPointer, Pixel\X, Pixel\Y, PBMap\Markers()\Focus, PBMap\Markers()\Selected) - Else - DrawMarker(Pixel\X, Pixel\Y, ListIndex(PBMap\Markers()), PBMap\Markers()\Color, PBMap\Markers()\Legend, PBMap\Markers()\Focus, PBMap\Markers()\Selected) - EndIf - EndIf - EndIf + If PBMap\Markers()\EditWindow = EventWindow() + PBMap\Markers()\EditWindow = 0 + EndIf Next + CloseWindow(EventWindow()) + EndProcedure + Procedure MarkerEdit(*Marker.Marker) + 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")) + TextGadget(#PB_Any, 2, 27, 80, 25, gettext("Legend")) + Protected StringIdentifier = StringGadget(#PB_Any, 84, 2, 120, 25, *Marker\Identifier) : SetGadgetData(StringIdentifier, *Marker) + Protected EditorLegend = EditorGadget(#PB_Any, 84, 27, 210, 70) : SetGadgetText(EditorLegend, *Marker\Legend) : SetGadgetData(EditorLegend, *Marker) + *Marker\EditWindow = WindowMarkerEdit + BindGadgetEvent(StringIdentifier, @MarkerIdentifierChange(), #PB_EventType_Change) + BindGadgetEvent(EditorLegend, @MarkerLegendChange(), #PB_EventType_Change) + BindEvent(#PB_Event_CloseWindow, @MarkerEditCloseWindow(), WindowMarkerEdit) + Else + SetActiveWindow(*Marker\EditWindow) + EndIf + EndProcedure + ;-*** + + Procedure DrawMarker(x.i, y.i, Nb.i, *Marker.Marker) + Protected Text.s + VectorSourceColor(*Marker\Color) + MovePathCursor(x, y) + AddPathLine(-8, -16, #PB_Path_Relative) + AddPathCircle(8, 0, 8, 180, 0, #PB_Path_Relative) + AddPathLine(-8, 16, #PB_Path_Relative) + ;FillPath(#PB_Path_Preserve) + ;ClipPath(#PB_Path_Preserve) + AddPathCircle(0, -16, 5, 0, 360, #PB_Path_Relative) + VectorSourceColor(*Marker\Color) + FillPath(#PB_Path_Preserve) + If *Marker\Focus + VectorSourceColor(PBMap\Options\ColourFocus) + StrokePath(3) + ElseIf *Marker\Selected + VectorSourceColor(PBMap\Options\ColourSelected) + StrokePath(4) + Else + VectorSourceColor(*Marker\Color) + StrokePath(1) + EndIf + If PBMap\Options\ShowMarkersNb + If *Marker\Identifier = "" + Text.s = Str(Nb) + Else + Text.s = *Marker\Identifier + EndIf + VectorFont(FontID(PBMap\Font), 13) + MovePathCursor(x - VectorTextWidth(Text) / 2, y) + VectorSourceColor(RGBA(0, 0, 0, 255)) + DrawVectorText(Text) + EndIf + If PBMap\Options\ShowMarkersLegend And *Marker\Legend <> "" + VectorFont(FontID(PBMap\Font), 13) + ;dessin d'un cadre avec fond transparent + Protected Height = VectorParagraphHeight(*Marker\Legend, 100, 100) + Protected Width.l + If Height < 20 ; une ligne + Width = VectorTextWidth(*Marker\Legend) + Else + Width = 100 + EndIf + AddPathBox(x - (Width / 2), y - 30 - Height, Width, Height) + VectorSourceColor(RGBA(168, 255, 255, 100)) + FillPath() + AddPathBox(x - (Width / 2), y - 30 - Height, Width, Height) + VectorSourceColor(RGBA(36, 36, 255, 100)) + StrokePath(2) + MovePathCursor(x - 50, y - 30 - Height) + VectorSourceColor(RGBA(0, 0, 0, 255)) + DrawVectorParagraph(*Marker\Legend, 100, Height, #PB_VectorParagraph_Center) + EndIf EndProcedure - Procedure DrawDebugInfos() + ; Draw all markers + Procedure DrawMarkers(*Drawing.DrawingParameters) + Protected Pixel.PixelCoordinates + ForEach PBMap\Markers() + If IsInDrawingPixelBoundaries(*Drawing, @PBMap\Markers()\GeographicCoordinates) + LatLon2PixelRel(@PBMap\Markers()\GeographicCoordinates, @Pixel, PBMap\Zoom) + If PBMap\Markers()\CallBackPointer > 0 + CallFunctionFast(PBMap\Markers()\CallBackPointer, Pixel\x, Pixel\y, PBMap\Markers()\Focus, PBMap\Markers()\Selected) + Else + DrawMarker(Pixel\x, Pixel\y, ListIndex(PBMap\Markers()), @PBMap\Markers()) + EndIf + EndIf + Next + EndProcedure + + Procedure DrawDebugInfos(*Drawing.DrawingParameters) ; Display how many images in cache - VectorFont(FontID(PBMap\Font), 30) + VectorFont(FontID(PBMap\Font), 16) VectorSourceColor(RGBA(0, 0, 0, 80)) - MovePathCursor(50,50) + MovePathCursor(50, 50) DrawVectorText(Str(MapSize(PBMap\MemCache\Images()))) - MovePathCursor(50,80) + MovePathCursor(50, 70) Protected ThreadCounter = 0 ForEach PBMap\MemCache\Images() If PBMap\MemCache\Images()\Tile <> 0 @@ -1123,29 +1403,60 @@ Module PBMap EndIf EndIf Next - DrawVectorText(Str(ThreadCounter)) - MovePathCursor(50,110) + DrawVectorText(Str(ThreadCounter)) + MovePathCursor(50, 90) DrawVectorText(Str(PBMap\Zoom)) + MovePathCursor(50, 110) + DrawVectorText(StrD(*Drawing\Bounds\NorthWest\Latitude) + "," + StrD(*Drawing\Bounds\NorthWest\Longitude)) + MovePathCursor(50, 130) + DrawVectorText(StrD(*Drawing\Bounds\SouthEast\Latitude) + "," + StrD(*Drawing\Bounds\SouthEast\Longitude)) + EndProcedure + + Procedure DrawOSMCopyright(*Drawing.DrawingParameters) + 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 Px.d, Py.d,a, ts = PBMap\TileSize + Protected PixelCenter.PixelCoordinates + Protected Px.d, Py.d,a, ts = PBMap\TileSize, nx, ny + Protected NW.Coordinates, SE.Coordinates PBMap\Dirty = #False PBMap\Redraw = #False - ; Precalc some values - *Drawing\CenterX = GadgetWidth(PBMap\Gadget) / 2 - *Drawing\CenterY = GadgetHeight(PBMap\Gadget) / 2 + ;*** Precalc some values + *Drawing\RadiusX = GadgetWidth(PBMap\Gadget) / 2 + *Drawing\RadiusY = GadgetHeight(PBMap\Gadget) / 2 *Drawing\GeographicCoordinates\Latitude = PBMap\GeographicCoordinates\Latitude *Drawing\GeographicCoordinates\Longitude = PBMap\GeographicCoordinates\Longitude LatLon2TileXY(*Drawing\GeographicCoordinates, *Drawing\TileCoordinates, PBMap\Zoom) + LatLon2Pixel(*Drawing\GeographicCoordinates, @PixelCenter, PBMap\Zoom) ; Pixel shift, aka position in the tile - Px = *Drawing\TileCoordinates\x : Py = *Drawing\TileCoordinates\y + Px = *Drawing\TileCoordinates\x + Py = *Drawing\TileCoordinates\y *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 + ny = *Drawing\RadiusY / ts + NW\x = Px - nx - 1 + NW\y = Py - ny - 1 + SE\x = Px + nx + 2 + 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 + ;*** ; Main drawing stuff StartVectorDrawing(CanvasVectorOutput(PBMap\Gadget)) + ;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 ; such as for openseamap tiles which are overlaid. not that efficent from here though. ForEach PBMap\Layers() @@ -1155,20 +1466,21 @@ Module PBMap DrawTracks(*Drawing) EndIf If PBMap\Options\ShowMarkers - DrawMarkers() + DrawMarkers(*Drawing) EndIf + If PBMap\Options\ShowDegrees And PBMap\Zoom > 2 + DrawDegrees(*Drawing, 192) + EndIf If PBMap\Options\ShowPointer DrawPointer(*Drawing) EndIf If PBMap\Options\ShowDebugInfos - DrawDebugInfos() - EndIf - If PBMap\Options\ShowDegrees - DrawDegrees(*Drawing, 192) + DrawDebugInfos(*Drawing) EndIf If PBMap\Options\ShowScale DrawScale(*Drawing, 10, GadgetHeight(PBMAP\Gadget) - 20, 192) - EndIf + EndIf + DrawOSMCopyright(*Drawing) StopVectorDrawing() EndProcedure @@ -1178,27 +1490,27 @@ Module PBMap EndProcedure Procedure.d Pixel2Lon(x) - Protected NewX.d = (PBMap\PixelCoordinates\x - GadgetWidth(PBMap\Gadget) / 2 + x) / PBMap\TileSize + 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 - GadgetHeight(PBMap\Gadget) / 2 + y) / PBMap\TileSize + 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() - Protected MouseX.d = (PBMap\PixelCoordinates\x - GadgetWidth(PBMap\Gadget) / 2 + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX)) / PBMap\TileSize + 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[ ProcedureReturn Mod(Mod(MouseX / n * 360.0, 360.0) + 360.0, 360.0) - 180 EndProcedure Procedure.d MouseLatitude() - Protected MouseY.d = (PBMap\PixelCoordinates\y - GadgetHeight(PBMap\Gadget) / 2 + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY)) / PBMap\TileSize + 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)))) EndProcedure @@ -1218,6 +1530,13 @@ Module PBMap PBMap\Zoom + Zoom EndIf EndSelect + PBMap\GeographicCoordinates\Longitude = ClipLongitude(PBMap\GeographicCoordinates\Longitude) + If PBMap\GeographicCoordinates\Latitude < -89 + PBMap\GeographicCoordinates\Latitude = -89 + EndIf + If PBMap\GeographicCoordinates\Latitude > 89 + PBMap\GeographicCoordinates\Latitude = 89 + EndIf If PBMap\Zoom > PBMap\ZoomMax : PBMap\Zoom = PBMap\ZoomMax : EndIf If PBMap\Zoom < PBMap\ZoomMin : PBMap\Zoom = PBMap\ZoomMin : EndIf LatLon2TileXY(@PBMap\GeographicCoordinates, @PBMap\Drawing\TileCoordinates, PBMap\Zoom) @@ -1233,17 +1552,17 @@ Module PBMap 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 - 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 DeltaX.d = MaxX - MinX ;assumption ! In original code DeltaX have no source + Protected centerX.d = MinX + DeltaX / 2 ; assumption ! In original code CenterX have no source + Protected paddingFactor.f= 1.2 ;paddingFactor: this can be used to get the "120%" effect ThomM refers to. Value of 1.2 would get you the 120%. Protected ry1.d = Log((Sin(Radian(MinY)) + 1) / Cos(Radian(MinY))) Protected ry2.d = Log((Sin(Radian(MaxY)) + 1) / Cos(Radian(MaxY))) Protected ryc.d = (ry1 + ry2) / 2 Protected centerY.d = Degree(ATan(SinH(ryc))) - Protected resolutionHorizontal.d = DeltaX / GadgetWidth(PBMap\Gadget) + Protected 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 = GadgetHeight(PBMap\Gadget)/2; + 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 @@ -1281,6 +1600,7 @@ Module PBMap EndWith EndIf EndProcedure + Procedure SetZoom(Zoom.i, mode.i = #PB_Relative) Select mode Case #PB_Relative @@ -1301,6 +1621,16 @@ Module PBMap EndIf EndProcedure + Procedure SetAngle(Angle.d, Mode = #PB_Absolute) + If Mode = #PB_Absolute + PBmap\Angle = Angle + Else + PBMap\Angle + Angle + PBMap\Angle = Mod(PBMap\Angle,360) + EndIf + PBMap\Redraw = #True + EndProcedure + Procedure SetCallBackLocation(CallBackLocation.i) PBMap\CallBackLocation = CallBackLocation EndProcedure @@ -1320,18 +1650,16 @@ Module PBMap ; #MODE_HAND = 1 -> Hand only ; #MODE_SELECT = 2 -> Move objects only ; #MODE_EDIT = 3 -> Create objects - Procedure SetMode(Mode = #MODE_DEFAULT) - PBMap\Mode = Mode - EndProcedure + Procedure SetMode(Mode.i = #MODE_DEFAULT) + PBMap\Mode = Mode + EndProcedure - ;Zoom on x, y position relative to the canvas gadget - Procedure SetZoomOnPosition(x, y, zoom) - Protected MouseX.d, MouseY.d - Protected OldPx.d, OldPy.d, OldMx.d, OldMy.d, Px.d, Py.d - Protected CenterX = GadgetWidth(PBMap\Gadget) / 2 - Protected CenterY = GadgetHeight(PBMap\Gadget) / 2 - x - CenterX - y - CenterY + Procedure.i GetMode() + ProcedureReturn PBMap\Mode + EndProcedure + + ;Zoom on x, y pixel position from the center + Procedure ZoomOnPixel(x, y, zoom) ;*** First : Zoom PBMap\Zoom + zoom If PBMap\Zoom > PBMap\ZoomMax : PBMap\Zoom = PBMap\ZoomMax : ProcedureReturn : EndIf @@ -1353,15 +1681,29 @@ Module PBMap EndIf EndProcedure - ;Go to x, y position relative to the canvas gadget + ;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) + EndProcedure + + ;Go to x, y position relative to the canvas gadget left up Procedure GotoPixelRel(x, y) - Protected CenterX = GadgetWidth(PBMap\Gadget) / 2 - Protected CenterY = GadgetHeight(PBMap\Gadget) / 2 - x - CenterX - y - CenterY LatLon2Pixel(@PBMap\GeographicCoordinates, @PBMap\PixelCoordinates, PBMap\Zoom) - PBMap\PixelCoordinates\x + x - PBMap\PixelCoordinates\y + y + PBMap\PixelCoordinates\x + x - PBMap\Drawing\RadiusX + PBMap\PixelCoordinates\y + y - PBMap\Drawing\RadiusY + Pixel2LatLon(@PBMap\PixelCoordinates, @PBMap\GeographicCoordinates, PBMap\Zoom) + ; Start drawing + PBMap\Redraw = #True + ; If CallBackLocation send Location to function + If PBMap\CallBackLocation > 0 + CallFunctionFast(PBMap\CallBackLocation, @PBMap\GeographicCoordinates) + EndIf + EndProcedure + + ;Go to x, y position relative to the canvas gadget + Procedure GotoPixel(x, y) + PBMap\PixelCoordinates\x = x + PBMap\PixelCoordinates\y = y Pixel2LatLon(@PBMap\PixelCoordinates, @PBMap\GeographicCoordinates, PBMap\Zoom) ; Start drawing PBMap\Redraw = #True @@ -1380,22 +1722,136 @@ Module PBMap EndProcedure Procedure.i GetZoom() - Protected Value.d - Value = PBMap\Zoom - ProcedureReturn Value + ProcedureReturn PBMap\Zoom + EndProcedure + + Procedure.d GetAngle() + ProcedureReturn PBMap\Angle + EndProcedure + + Procedure NominatimGeoLocationQuery(Address.s, *ReturnPosition.GeographicCoordinates = 0) + Protected Size.i + Protected Query.s = "http://nominatim.openstreetmap.org/search/" + + 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) + Size = ReceiveHTTPFile(Query, JSONFileName) + If LoadJSON(0, JSONFileName) = 0 + ;Demivec's code + MyDebug( JSONErrorMessage() + " at position " + + JSONErrorPosition() + " in line " + + JSONErrorLine() + " of JSON web Data", 1) + ElseIf JSONArraySize(JSONValue(0)) > 0 + Protected object_val = GetJSONElement(JSONValue(0), 0) + Protected object_box = GetJSONMember(object_val, "boundingbox") + Protected bbox.BoundingBox + bbox\SouthEast\Latitude = ValD(GetJSONString(GetJSONElement(object_box, 0))) + bbox\NorthWest\Latitude = ValD(GetJSONString(GetJSONElement(object_box, 1))) + bbox\NorthWest\Longitude = ValD(GetJSONString(GetJSONElement(object_box, 2))) + bbox\SouthEast\Longitude = ValD(GetJSONString(GetJSONElement(object_box, 3))) + Protected lat.s = GetJSONString(GetJSONMember(object_val, "lat")) + Protected lon.s = GetJSONString(GetJSONMember(object_val, "lon")) + If *ReturnPosition <> 0 + *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) + 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) + If Result = #PB_MessageRequester_No ; Quit if "no" selected + ProcedureReturn #False + EndIf + EndIf + If DeleteDirectory(PBMap\Options\HDDCachePath, "", #PB_FileSystem_Recursive) + MyDebug("Cache in : " + PBMap\Options\HDDCachePath + " cleared") + CreateDirectoryEx(PBMap\Options\HDDCachePath) + ProcedureReturn #True + Else + MyDebug("Can't clear cache in " + PBMap\Options\HDDCachePath) + ProcedureReturn #False + EndIf EndProcedure Procedure CanvasEvents() - Protected MouseX.i, MouseY.i + 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 + 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() Select EventType() + Case #PB_EventType_Focus + PBMap\Drawing\RadiusX = GadgetWidth(PBMap\Gadget) / 2 + PBMap\Drawing\RadiusY = GadgetHeight(PBMap\Gadget) / 2 Case #PB_EventType_KeyUp Select GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_Key) Case #PB_Shortcut_Delete DeleteSelectedMarkers() + DeleteSelectedTracks() EndSelect PBMap\Redraw = #True If GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_Modifiers)&#PB_Canvas_Control = 0 @@ -1403,72 +1859,77 @@ Module PBMap EndIf Case #PB_EventType_KeyDown With PBMap\Markers() - Select GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_Key) - Case #PB_Shortcut_Left - ForEach PBMap\Markers() - If \Selected - \GeographicCoordinates\Longitude = ClipLongitude( \GeographicCoordinates\Longitude - 10* 360 / Pow(2, PBMap\Zoom + 8)) - EndIf - Next - Case #PB_Shortcut_Up - ForEach PBMap\Markers() - If \Selected - \GeographicCoordinates\Latitude + 10* 360 / Pow(2, PBMap\Zoom + 8) - EndIf - Next - Case #PB_Shortcut_Right - ForEach PBMap\Markers() - If \Selected - \GeographicCoordinates\Longitude = ClipLongitude( \GeographicCoordinates\Longitude + 10* 360 / Pow(2, PBMap\Zoom + 8)) - EndIf - Next - Case #PB_Shortcut_Down - ForEach PBMap\Markers() - If \Selected - \GeographicCoordinates\Latitude - 10* 360 / Pow(2, PBMap\Zoom + 8) - EndIf - Next - EndSelect + Select GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_Key) + Case #PB_Shortcut_Left + ForEach PBMap\Markers() + If \Selected + \GeographicCoordinates\Longitude = ClipLongitude( \GeographicCoordinates\Longitude - 10* 360 / Pow(2, PBMap\Zoom + 8)) + EndIf + Next + Case #PB_Shortcut_Up + ForEach PBMap\Markers() + If \Selected + \GeographicCoordinates\Latitude + 10* 360 / Pow(2, PBMap\Zoom + 8) + EndIf + Next + Case #PB_Shortcut_Right + ForEach PBMap\Markers() + If \Selected + \GeographicCoordinates\Longitude = ClipLongitude( \GeographicCoordinates\Longitude + 10* 360 / Pow(2, PBMap\Zoom + 8)) + EndIf + Next + Case #PB_Shortcut_Down + ForEach PBMap\Markers() + If \Selected + \GeographicCoordinates\Latitude - 10* 360 / Pow(2, PBMap\Zoom + 8) + EndIf + Next + EndSelect EndWith PBMap\Redraw = #True If GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_Modifiers)&#PB_Canvas_Control <> 0 CtrlKey = #True EndIf Case #PB_EventType_LeftDoubleClick - If PBMap\Mode = #MODE_DEFAULT Or PBMap\Mode = #MODE_SELECT - ;Check if the mouse touch a marker, if so, jump to it - LatLon2Pixel(@PBMap\GeographicCoordinates, @PBMap\PixelCoordinates, PBMap\Zoom) - MouseX = PBMap\PixelCoordinates\x - GadgetWidth(PBMap\Gadget) / 2 + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) - MouseY = PBMap\PixelCoordinates\y - GadgetHeight(PBMap\Gadget) / 2 + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY) - ;Clip MouseX to the map range (in X, the map is infinite) - MouseX = Mod(Mod(MouseX, MapWidth) + MapWidth, MapWidth) - Touch = #False - ForEach PBMap\Markers() - LatLon2Pixel(@PBMap\Markers()\GeographicCoordinates, @MarkerCoords, PBMap\Zoom) - If Distance(MarkerCoords\x, MarkerCoords\y, MouseX, MouseY) < 8 + 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) + MouseX = Mod(Mod(MouseX, MapWidth) + MapWidth, MapWidth) + Touch = #False + ;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 Touch = #True SetLocation(PBMap\Markers()\GeographicCoordinates\Latitude, PBMap\Markers()\GeographicCoordinates\Longitude) - Break + ElseIf PBMap\Mode = #MODE_EDIT + ;Edit the legend + MarkerEdit(@PBMap\Markers()) EndIf - Next - EndIf + Break + EndIf + Next If Not Touch - GotoPixelRel(GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX), GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY)) + GotoPixel(MouseX, MouseY) EndIf Case #PB_EventType_MouseWheel If PBMap\Options\WheelMouseRelative ;Relative zoom (centered on the mouse) - SetZoomOnPosition(GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX), GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY), GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_WheelDelta)) + ZoomOnPixel(CanvasMouseX, CanvasMouseY, GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_WheelDelta)) Else ;Absolute zoom (centered on the center of the map) SetZoom(GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_WheelDelta), #PB_Relative) EndIf Case #PB_EventType_LeftButtonDown - LatLon2Pixel(@PBMap\GeographicCoordinates, @PBMap\PixelCoordinates, PBMap\Zoom) - MouseX = PBMap\PixelCoordinates\x - GadgetWidth(PBMap\Gadget) / 2 + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) - MouseY = PBMap\PixelCoordinates\y - GadgetHeight(PBMap\Gadget) / 2 + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY) + ;LatLon2Pixel(@PBMap\GeographicCoordinates, @PBMap\PixelCoordinates, PBMap\Zoom) + ;Mem cursor Coord + PBMap\MoveStartingPoint\x = CanvasMouseX + PBMap\MoveStartingPoint\y = CanvasMouseY ;Clip MouseX to the map range (in X, the map is infinite) - MouseX = Mod(Mod(MouseX, MapWidth) + MapWidth, MapWidth) + 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) @@ -1482,15 +1943,25 @@ Module PBMap PBMap\Markers()\Focus = #False EndIf Next + ;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 + EndIf + If PBMap\TracksList()\Focus + PBMap\TracksList()\Selected = #True + PBMap\TracksList()\Focus = #False + EndIf + Next EndIf - ;Mem cursor Coord - PBMap\MoveStartingPoint\x = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) - PBMap\MoveStartingPoint\y = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY) Case #PB_EventType_MouseMove PBMap\Moving = #True + ; Drag If PBMap\MoveStartingPoint\x <> - 1 - MouseX = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) - PBMap\MoveStartingPoint\x - MouseY = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY) - PBMap\MoveStartingPoint\y + MouseX = CanvasMouseX - PBMap\MoveStartingPoint\x + MouseY = CanvasMouseY - PBMap\MoveStartingPoint\y + PBMap\MoveStartingPoint\x = CanvasMouseX + PBMap\MoveStartingPoint\y = CanvasMouseY ;Move selected markers If PBMap\EditMarker And (PBMap\Mode = #MODE_DEFAULT Or PBMap\Mode = #MODE_SELECT) ForEach PBMap\Markers() @@ -1515,28 +1986,57 @@ Module PBMap EndIf EndIf PBMap\Redraw = #True - PBMap\MoveStartingPoint\x = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) - PBMap\MoveStartingPoint\y = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY) Else + ; Touch test LatLon2Pixel(@PBMap\GeographicCoordinates, @PBMap\PixelCoordinates, PBMap\Zoom) - MouseX = PBMap\PixelCoordinates\x - GadgetWidth(PBMap\Gadget) / 2 + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) - MouseY = PBMap\PixelCoordinates\y - GadgetHeight(PBMap\Gadget) / 2 + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY) + MouseX = PBMap\PixelCoordinates\x + CanvasMouseX + MouseY = PBMap\PixelCoordinates\y + CanvasMouseY ;Clip MouseX to the map range (in X, the map is infinite) MouseX = Mod(Mod(MouseX, MapWidth) + MapWidth, MapWidth) - ;Check if mouse touch markers - If PBMap\Mode = #MODE_DEFAULT Or PBMap\Mode = #MODE_SELECT + If PBMap\Mode = #MODE_DEFAULT Or PBMap\Mode = #MODE_SELECT Or PBMap\Mode = #MODE_EDIT + ;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 - Else + PBMap\Redraw = #True + ElseIf PBMap\Markers()\Focus ;If CtrlKey = #False PBMap\Markers()\Focus = #False - ;EndIf + PBMap\Redraw = #True EndIf Next + ;Check if mouse touch tracks + With PBMap\TracksList() + ;Trace Track + If ListSize(PBMap\TracksList()) > 0 + ForEach PBMap\TracksList() + If ListSize(\Track()) > 0 + If \Visible + StartVectorDrawing(CanvasVectorOutput(PBMap\Gadget)) + ;Simulate tracks drawing + ForEach \Track() + LatLon2Pixel(@PBMap\TracksList()\Track(), @Pixel, PBMap\Zoom) + If ListIndex(\Track()) = 0 + MovePathCursor(Pixel\x, Pixel\y) + Else + AddPathLine(Pixel\x, Pixel\y) + EndIf + Next + If IsInsideStroke(MouseX, MouseY, \StrokeWidth) + \Focus = #True + PBMap\Redraw = #True + ElseIf \Focus + \Focus = #False + PBMap\Redraw = #True + EndIf + StopVectorDrawing() + EndIf + EndIf + Next + EndIf + EndWith EndIf - PBMap\Redraw = #True EndIf Case #PB_EventType_LeftButtonUp PBMap\MoveStartingPoint\x = - 1 @@ -1560,29 +2060,66 @@ Module PBMap EndSelect EndProcedure + ; Redraws at regular intervals Procedure TimerEvents() - ;Redraw at regular intervals If EventTimer() = PBMap\Timer And (PBMap\Redraw Or PBMap\Dirty) Drawing() EndIf EndProcedure + ; Could be called directly to attach our map to an existing canvas + Procedure BindMapGadget(Gadget.i) + PBMap\Gadget = Gadget + BindGadgetEvent(PBMap\Gadget, @CanvasEvents()) + AddWindowTimer(PBMap\Window, PBMap\Timer, PBMap\Options\TimerInterval) + BindEvent(#PB_Event_Timer, @TimerEvents()) + PBMap\Drawing\RadiusX = GadgetWidth(PBMap\Gadget) / 2 + PBMap\Drawing\RadiusY = GadgetHeight(PBMap\Gadget) / 2 + EndProcedure + + ; 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 Else PBMap\Gadget = Gadget CanvasGadget(PBMap\Gadget, X, Y, Width, Height, #PB_Canvas_Keyboard) - EndIf - BindGadgetEvent(PBMap\Gadget, @CanvasEvents()) - AddWindowTimer(PBMap\Window, PBMap\Timer, PBMap\Options\TimerInterval) - BindEvent(#PB_Event_Timer, @TimerEvents()) - ;AddKeyboardShortcut(#PB_Shortcut_Delete + EndIf + BindMapGadget(PBMap\Gadget) + 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 + 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 **** +;**************************************************************** +; +;- Example of application +; +;**************************************************************** + CompilerIf #PB_Compiler_IsMainFile InitNetwork() @@ -1593,6 +2130,8 @@ CompilerIf #PB_Compiler_IsMainFile #Gdt_Right #Gdt_Up #Gdt_Down + ;#Gdt_RotateLeft + ;#Gdt_RotateRight #Button_4 #Button_5 #Combo_0 @@ -1607,6 +2146,16 @@ CompilerIf #PB_Compiler_IsMainFile #Gdt_AddMarker #Gdt_AddOpenseaMap #Gdt_Degrees + #Gdt_EditMode + #Gdt_ClearDiskCache + #TextGeoLocationQuery + #StringGeoLocationQuery + EndEnumeration + + ;Menu events + Enumeration + #MenuEventLonLatStringEnter + #MenuEventGeoLocationStringEnter EndEnumeration Structure Location @@ -1651,19 +2200,25 @@ 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_Up, WindowWidth(#Window_0) - 120 ,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#Gdt_Down, WindowWidth(#Window_0) - 120 ,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#Text_2,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#Button_4,WindowWidth(#Window_0)-150,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#Button_5,WindowWidth(#Window_0)-100,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#Text_3,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore) - ResizeGadget(#StringLatitude,WindowWidth(#Window_0)-100,#PB_Ignore,#PB_Ignore,#PB_Ignore) - ResizeGadget(#StringLongitude,WindowWidth(#Window_0)-100,#PB_Ignore,#PB_Ignore,#PB_Ignore) + ResizeGadget(#StringLatitude,WindowWidth(#Window_0)-120,#PB_Ignore,#PB_Ignore,#PB_Ignore) + ResizeGadget(#StringLongitude,WindowWidth(#Window_0)-120,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#Text_4,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#Gdt_AddMarker,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#Gdt_LoadGpx,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore) ResizeGadget(#Gdt_AddOpenseaMap,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) + ResizeGadget(#TextGeoLocationQuery,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore) + ResizeGadget(#StringGeoLocationQuery,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore) PBMap::Refresh() EndProcedure @@ -1672,8 +2227,11 @@ CompilerIf #PB_Compiler_IsMainFile LoadFont(0, "Arial", 12) 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)) @@ -1681,36 +2239,48 @@ CompilerIf #PB_Compiler_IsMainFile TextGadget(#Text_2, 530, 160, 60, 15, "Zoom") ButtonGadget(#Button_4, 550, 180, 50, 30, " + ") : SetGadgetFont(#Button_4, FontID(1)) ButtonGadget(#Button_5, 600, 180, 50, 30, " - ") : SetGadgetFont(#Button_5, FontID(1)) - TextGadget(#Text_3, 530, 230, 60, 15, "Latitude : ") - StringGadget(#StringLatitude, 600, 230, 90, 20, "") - TextGadget(#Text_4, 530, 250, 60, 15, "Longitude : ") - StringGadget(#StringLongitude, 600, 250, 90, 20, "") + 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, "OpenSeaMap") - ButtonGadget(#Gdt_Degrees, 530, 370, 150, 30, "Show/Hide Degrees") - + 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, "") + SetActiveGadget(#StringGeoLocationQuery) + AddKeyboardShortcut(#Window_0, #PB_Shortcut_Return, #MenuEventGeoLocationStringEnter) + ;*** 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 *Track ;Our main gadget PBMap::InitPBMap(#Window_0) - ;PBMap::SetOption("Proxy", "1") - ;PBMap::SetOption("ProxyUrl", "myproxy") - ;PBMap::SetOption("proxyport","3128") - PBMap::SetOption("CleanCache","1") ;Delete all files in HDD cache Directory - PBMap::SetOption("ShowDegrees", "1") + PBMap::SetOption("ShowDegrees", "0") : Degrees = 0 PBMap::SetOption("ShowDebugInfos", "0") - PBMap::SetOption("ShowScale", "1") + PBMap::SetOption("ShowScale", "1") + PBMap::SetOption("Warning", "1") PBMap::SetOption("ShowMarkersLegend", "1") - PBMap::SetOption("TrackShowKms", "1") + PBMap::SetOption("ShowTrackKms", "1") + 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(49.0446828398, 2.0349812508,12) ; Change the PBMap 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::AddMarker(49.0446828398, 2.0349812508, "", "", -1, @MyMarker()) ; To add a marker with a customised GFX Repeat Event = WaitWindowEvent() @@ -1727,35 +2297,78 @@ 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 #Button_4 PBMap::SetZoom(1) Case #Button_5 PBMap::SetZoom( - 1) Case #Gdt_LoadGpx - PBMap::LoadGpxFile(OpenFileRequester("Choose a file to load", "", "Gpx|*.gpx", 0)) + *Track = PBMap::LoadGpxFile(OpenFileRequester("Choose a file to load", "", "Gpx|*.gpx", 0)) + PBMap::SetTrackColour(*Track, RGBA(Random(255), Random(255), Random(255), 128)) Case #StringLatitude, #StringLongitude Select EventType() + Case #PB_EventType_Focus + AddKeyboardShortcut(#Window_0, #PB_Shortcut_Return, #MenuEventLonLatStringEnter) Case #PB_EventType_LostFocus - PBMap::SetLocation(ValD(GetGadgetText(#StringLatitude)), ValD(GetGadgetText(#StringLongitude))) ; Change the PBMap coordinates - PBMAP::Refresh() + RemoveKeyboardShortcut(#Window_0, #PB_Shortcut_Return) EndSelect Case #Gdt_AddMarker - PBMap::AddMarker(ValD(GetGadgetText(#StringLatitude)), ValD(GetGadgetText(#StringLongitude)), "Test", RGBA(Random(255), Random(255), Random(255), 255)) + 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 + SetGadgetState(#Gdt_AddOpenseaMap, 0) EndIf PBMAP::Refresh() Case #Gdt_Degrees Degrees = 1 - Degrees PBMap::SetOption("ShowDegrees", Str(Degrees)) PBMap::Refresh() + SetGadgetState(#Gdt_Degrees, Degrees) + Case #Gdt_EditMode + If PBMap::GetMode() <> PBMap::#MODE_EDIT + PBMap::SetMode(PBMap::#MODE_EDIT) + SetGadgetState(#Gdt_EditMode, 1) + Else + PBMap::SetMode(PBMap::#MODE_DEFAULT) + SetGadgetState(#Gdt_EditMode, 0) + EndIf + Case #Gdt_ClearDiskCache + PBMap::ClearDiskCache() + Case #StringGeoLocationQuery + Select EventType() + Case #PB_EventType_Focus + AddKeyboardShortcut(#Window_0, #PB_Shortcut_Return, #MenuEventGeoLocationStringEnter) + Case #PB_EventType_LostFocus + RemoveKeyboardShortcut(#Window_0, #PB_Shortcut_Return) + EndSelect EndSelect Case #PB_Event_SizeWindow ResizeAll() + Case #PB_Event_Menu + ;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 + SetActiveGadget(Dummy) + ;*** + Case #MenuEventLonLatStringEnter + PBMap::SetLocation(ValD(GetGadgetText(#StringLatitude)), ValD(GetGadgetText(#StringLongitude))) ; Change the PBMap coordinates + PBMap::Refresh() + EndSelect EndSelect Until Quit = #True @@ -1763,10 +2376,11 @@ CompilerIf #PB_Compiler_IsMainFile EndIf CompilerEndIf -; IDE Options = PureBasic 5.60 beta 7 (Windows - x86) -; CursorPosition = 1699 -; FirstLine = 1683 -; Folding = ------------- + + +; IDE Options = PureBasic 5.60 beta 7 (Windows - x64) +; CursorPosition = 33 +; Folding = ----------------- ; EnableThread ; EnableXP ; EnableUnicode \ No newline at end of file From 60647f49282e5d9c5dbda193c5e87628329a30e6 Mon Sep 17 00:00:00 2001 From: thyphoonfr Date: Mon, 3 Jul 2017 23:41:25 +0200 Subject: [PATCH 5/5] 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