From 8cb400f1a9d62fdaabd4e9ed0369fff75d421d1d Mon Sep 17 00:00:00 2001 From: djes Date: Fri, 3 Mar 2017 17:23:42 +0100 Subject: [PATCH 01/60] Code makeup --- PBMap.pb | 655 ++++++++++++++++++++++++++++--------------------------- 1 file changed, 336 insertions(+), 319 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index 91c0c67..d76d39c 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -12,7 +12,7 @@ ;******************************************************************** 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 @@ -22,23 +22,14 @@ InitNetwork() UsePNGImageDecoder() UsePNGImageEncoder() +;- 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,7 +40,10 @@ 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 + Declare InitPBMap(window) Declare SetOption(Option.s, Value.s) Declare LoadOptions(PreferencesFile.s = "PBMap.prefs") @@ -57,16 +51,24 @@ DeclareModule PBMap 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 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 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(file.s); Declare ClearTracks() Declare DeleteTrack(*Ptr) @@ -76,18 +78,10 @@ DeclareModule PBMap Declare ClearMarkers() Declare DeleteMarker(*Ptr) Declare DeleteSelectedMarkers() + Declare Drawing() Declare Quit() 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() EndDeclareModule @@ -95,6 +89,8 @@ Module PBMap EnableExplicit + ;-*** Structures + Structure GeographicCoordinates Longitude.d Latitude.d @@ -110,7 +106,6 @@ Module PBMap y.d EndStructure - ;- Tile Structure Structure Tile nImage.i key.s @@ -225,7 +220,7 @@ Module PBMap StrokeWidth.i EndStructure - ;-PBMap Structure + ;- PBMap Structure PBMap Window.i ; Parent Window Gadget.i ; Canvas Gadget Id @@ -267,14 +262,37 @@ 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 + + ;-Show debug infos + Global MyDebugLevel = 0 - ;-Global variables Global PBMap.PBMap, Null.i + Global slash.s - ;Shows an error msg and terminates the program + 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 + + ;Shows an error msg and terminates the program Procedure Error(msg.s) MessageRequester("PBMap", msg, #PB_MessageRequester_Ok) End @@ -288,9 +306,49 @@ Module PBMap EndIf EndProcedure - ;- *** GetText - Translation purpose - ;TODO use this for all text - IncludeFile "gettext.pbi" + ;(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 TechnicalImagesCreation() ;"Loading" image @@ -329,20 +387,182 @@ Module PBMap EndIf EndProcedure + 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 + 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) + EndProcedure + + ;*** 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[ + *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) + 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)))) + 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[ + 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\RadiusX + Protected dpx.d = PBMap\PixelCoordinates\x + 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) + 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\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 alpha.d=dlat/2 + Protected beta.d=dlong/2 + Protected a.d = Sin(Radian(alpha)) * Sin(Radian(alpha)) + Cos(Radian(*posA\Latitude)) * Cos(Radian(*posB\Latitude)) * Sin(Radian(beta)) * Sin(Radian(beta)) + Protected c.d = ASin(Min(1,Sqr(a))); + Protected distance.d = 2*eQuatorialEarthRadius * c + ProcedureReturn distance ; + EndProcedure + + Procedure.d HaversineInM(*posA.GeographicCoordinates, *posB.GeographicCoordinates) + 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) + 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 x2.l, y2.l + x2 = (PBMap\GeographicCoordinates\Longitude+180)*(mapWidth/360) + ; convert from degrees To radians + latRad = PBMap\GeographicCoordinates\Latitude*#PI/180; + mercN = Log(Tan((#PI/4)+(latRad/2))) + y2 = (mapHeight/2)-(mapWidth*mercN/(2*#PI)); + *Pixel\x=PBMap\Drawing\RadiusX - (x2-x1) + *Pixel\y=PBMap\Drawing\RadiusY - (y2-y1) + EndProcedure + + 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 + ;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, " ") @@ -364,6 +584,17 @@ Module PBMap EndIf EndProcedure + ;-*** Options + + 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) @@ -513,6 +744,8 @@ Module PBMap EndWith EndProcedure + ;-*** Layers + 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 @@ -532,199 +765,9 @@ Module PBMap 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 - 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) - EndProcedure - - ;*** 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[ - *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) - 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)))) - 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[ - 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\RadiusX - Protected dpx.d = PBMap\PixelCoordinates\x - 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) - 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\RadiusY + (py - PBMap\PixelCoordinates\y) - 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 alpha.d=dlat/2 - Protected beta.d=dlong/2 - Protected a.d = Sin(Radian(alpha)) * Sin(Radian(alpha)) + Cos(Radian(*posA\Latitude)) * Cos(Radian(*posB\Latitude)) * Sin(Radian(beta)) * Sin(Radian(beta)) - Protected c.d = ASin(Min(1,Sqr(a))); - Protected distance.d = 2*eQuatorialEarthRadius * c - ProcedureReturn distance ; - EndProcedure - - Procedure.d HaversineInM(*posA.GeographicCoordinates, *posB.GeographicCoordinates) - 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) - 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 x2.l, y2.l - x2 = (PBMap\GeographicCoordinates\Longitude+180)*(mapWidth/360) - ; convert from degrees To radians - latRad = PBMap\GeographicCoordinates\Latitude*#PI/180; - mercN = Log(Tan((#PI/4)+(latRad/2))) - y2 = (mapHeight/2)-(mapWidth*mercN/(2*#PI)); - *Pixel\x=PBMap\Drawing\RadiusX - (x2-x1) - *Pixel\y=PBMap\Drawing\RadiusY - (y2-y1) - EndProcedure - - 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 If FileSize(CacheFile) > 0 @@ -803,10 +846,10 @@ Module PBMap Protected img.i = -1 Protected *timg.ImgMemCach = FindMapElement(PBMap\MemCache\Images(), key) If *timg - MyDebug("Key : " + key + " found in memory cache!", 3) + MyDebug("Key : " + key + " found in memory cache", 3) img = *timg\nImage If img <> -1 - MyDebug("Image : " + img + " found in memory cache!", 3) + 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) @@ -840,7 +883,7 @@ Module PBMap ;MoveElement(PBMap\MemCache\ImagesTimeStack(), #PB_List_Last) PBMap\MemCache\ImagesTimeStack()\MapKey = MapKey(PBMap\MemCache\Images()) ;*** - MyDebug("Key : " + key + " added in memory cache!", 3) + MyDebug("Key : " + key + " added in memory cache", 3) *timg = PBMap\MemCache\Images() *timg\nImage = -1 EndIf @@ -1063,6 +1106,8 @@ Module PBMap StrokePath(1) EndProcedure + ;-*** Tracks + Procedure DrawTrackPointer(x.d, y.d, dist.l) Protected color.l color=RGBA(0, 0, 0, 255) @@ -1237,11 +1282,12 @@ Module PBMap 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 + ;-*** Markers Procedure ClearMarkers() ClearList(PBMap\Markers()) @@ -1279,7 +1325,6 @@ Module PBMap EndIf EndProcedure - ;-*** Marker Edit Procedure MarkerIdentifierChange() Protected *Marker.Marker = GetGadgetData(EventGadget()) If GetGadgetText(EventGadget()) <> *Marker\Identifier @@ -1316,7 +1361,6 @@ Module PBMap SetActiveWindow(*Marker\EditWindow) EndIf EndProcedure - ;-*** Procedure DrawMarker(x.i, y.i, Nb.i, *Marker.Marker) Protected Text.s @@ -1388,6 +1432,8 @@ Module PBMap Next EndProcedure + ;-*** Main drawing stuff + Procedure DrawDebugInfos(*Drawing.DrawingParameters) ; Display how many images in cache VectorFont(FontID(PBMap\Font), 16) @@ -1419,8 +1465,7 @@ Module PBMap 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 @@ -1489,27 +1534,16 @@ Module PBMap ;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 - - 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() + ;-*** Misc functions + + 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[ 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,7 +1583,7 @@ Module PBMap EndIf EndProcedure - Procedure ZoomToArea(MinY.d, MaxY.d, MinX.d, MaxX.d) + 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 @@ -1576,7 +1610,7 @@ Module PBMap 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 +1630,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 @@ -1659,7 +1693,7 @@ Module PBMap EndProcedure ;Zoom on x, y pixel position from the center - Procedure ZoomOnPixel(x, y, zoom) + Procedure SetZoomOnPixel(x, y, zoom) ;*** First : Zoom PBMap\Zoom + zoom If PBMap\Zoom > PBMap\ZoomMax : PBMap\Zoom = PBMap\ZoomMax : ProcedureReturn : EndIf @@ -1682,8 +1716,8 @@ Module PBMap 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) + 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 @@ -1760,57 +1794,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) + 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) @@ -1828,6 +1818,8 @@ Module PBMap 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 @@ -1918,7 +1910,7 @@ Module PBMap Case #PB_EventType_MouseWheel If PBMap\Options\WheelMouseRelative ;Relative zoom (centered on the mouse) - ZoomOnPixel(CanvasMouseX, CanvasMouseY, GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_WheelDelta)) + SetZoomOnPixel(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) @@ -2088,6 +2080,31 @@ 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) + 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 + Procedure InitPBMap(Window) Protected Result.i PBMap\ZoomMin = 0 @@ -2379,8 +2396,8 @@ CompilerEndIf ; IDE Options = PureBasic 5.60 beta 7 (Windows - x64) -; CursorPosition = 2250 -; FirstLine = 2260 +; CursorPosition = 267 +; FirstLine = 1960 ; Folding = ----------------- ; EnableThread ; EnableXP From 0c1287e66ffd3a91ecded4cb3de18b2448e17532 Mon Sep 17 00:00:00 2001 From: djes Date: Wed, 15 Mar 2017 12:47:33 +0100 Subject: [PATCH 02/60] Dragging release bug fixed + here wip --- PBMap.pb | 84 +++++++++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 71 insertions(+), 13 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index d76d39c..de583d5 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -48,7 +48,8 @@ DeclareModule PBMap 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.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 DeleteLayer(Nb.i) Declare BindMapGadget(Gadget.i) Declare SetCallBackLocation(*CallBackLocation) @@ -201,6 +202,19 @@ Module PBMap Order.i ; Layer nb Name.s ServerURL.s ; Web URL ex: http://tile.openstreetmap.org/ + LayerType.i ; OSM : 0 ; Here : 1 + ;> HERE specific params + APP_ID.s + APP_CODE.s + path.s + ressource.s + param.s + id.s + scheme.s + format.s + lg.s + lg2.s + ;< EndStructure Structure Box @@ -248,7 +262,7 @@ Module PBMap 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 List TracksList.Tracks() ; To display a GPX track @@ -746,12 +760,42 @@ Module PBMap ;-*** Layers - Procedure.i AddMapServerLayer(LayerName.s, Order.i, ServerURL.s = "http://tile.openstreetmap.org/", TileSize = 256, ZoomMin = 0, ZoomMax = 18) + Procedure.i AddOSMServerLayer(LayerName.s, Order.i, ServerURL.s = "http://tile.openstreetmap.org/") Protected *Ptr = AddElement(PBMap\Layers()) If *Ptr PBMap\Layers()\Name = LayerName PBMap\Layers()\Order = Order PBMap\Layers()\ServerURL = ServerURL + PBMap\Layers()\LayerType = 0 + SortStructuredList(PBMap\Layers(), #PB_Sort_Ascending, OffsetOf(Layer\Order),TypeOf(Layer\Order)) + ProcedureReturn *Ptr + Else + ProcedureReturn #False + EndIf + EndProcedure + + ;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 = AddElement(PBMap\Layers()) + If *Ptr + With PBMap\Layers() + \Name = LayerName + \Order = Order + \ServerURL = ServerURL + \path = path + \ressource = ressource + \LayerType = 1 + \APP_CODE = APP_CODE + \APP_ID = APP_ID + \format = format + \id = id + \lg = lg + \lg2 = lg2 + \param = param + \scheme = scheme + EndWith SortStructuredList(PBMap\Layers(), #PB_Sort_Ascending, OffsetOf(Layer\Order),TypeOf(Layer\Order)) ProcedureReturn *Ptr Else @@ -929,6 +973,7 @@ Module PBMap Protected px, py, *timg.ImgMemCach, tilex, tiley, key.s Protected URL.s, CacheFile.s Protected tilemax = 1< -1 @@ -1826,7 +1883,6 @@ Module PBMap 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 @@ -1917,6 +1973,7 @@ Module PBMap EndIf Case #PB_EventType_LeftButtonDown ;LatLon2Pixel(@PBMap\GeographicCoordinates, @PBMap\PixelCoordinates, PBMap\Zoom) + PBMap\Dragging = #True ;Mem cursor Coord PBMap\MoveStartingPoint\x = CanvasMouseX PBMap\MoveStartingPoint\y = CanvasMouseY @@ -1947,9 +2004,9 @@ Module PBMap Next 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 @@ -2031,7 +2088,8 @@ Module PBMap EndIf EndIf Case #PB_EventType_LeftButtonUp - PBMap\MoveStartingPoint\x = - 1 +; PBMap\MoveStartingPoint\x = - 1 + PBMap\Dragging = #False PBMap\Redraw = #True Case #PB_MAP_REDRAW Debug "Redraw" @@ -2109,7 +2167,7 @@ Module PBMap Protected Result.i PBMap\ZoomMin = 0 PBMap\ZoomMax = 18 - PBMap\MoveStartingPoint\x = - 1 + PBMap\Dragging = #False PBMap\TileSize = 256 PBMap\Dirty = #False PBMap\EditMarker = #False @@ -2123,7 +2181,7 @@ Module PBMap EndIf CreateDirectoryEx(PBMap\Options\HDDCachePath) If PBMap\Options\DefaultOSMServer <> "" - AddMapServerLayer("OSM", 1, PBMap\Options\DefaultOSMServer) + AddOSMServerLayer("OSM", 1, PBMap\Options\DefaultOSMServer) EndIf TechnicalImagesCreation() SetLocation(0, 0) @@ -2338,7 +2396,7 @@ CompilerIf #PB_Compiler_IsMainFile 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 + OpenSeaMap = PBMap::AddOSMServerLayer("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) @@ -2396,8 +2454,8 @@ CompilerEndIf ; IDE Options = PureBasic 5.60 beta 7 (Windows - x64) -; CursorPosition = 267 -; FirstLine = 1960 +; CursorPosition = 1037 +; FirstLine = 1000 ; Folding = ----------------- ; EnableThread ; EnableXP From c1b55ef8c3f6c08eee13150bd0c111bc1bff5ee1 Mon Sep 17 00:00:00 2001 From: djes Date: Wed, 15 Mar 2017 15:33:37 +0100 Subject: [PATCH 03/60] "HERE" update --- PBMap.pb | 105 ++++++++++++++++++++++++++++++++++++++----------------- 1 file changed, 73 insertions(+), 32 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index de583d5..28a3441 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -20,7 +20,9 @@ EnableExplicit InitNetwork() UsePNGImageDecoder() +UseJPEGImageDecoder() UsePNGImageEncoder() +UseJPEGImageEncoder() ;- Module declaration @@ -50,7 +52,9 @@ DeclareModule PBMap Declare SaveOptions(PreferencesFile.s = "PBMap.prefs") 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 DeleteLayer(Nb.i) + Declare DeleteLayer(*Ptr) + Declare EnableLayer(*Ptr) + Declare DisableLayer(*Ptr) Declare BindMapGadget(Gadget.i) Declare SetCallBackLocation(*CallBackLocation) Declare SetCallBackMainPointer(CallBackMainPointer.i) @@ -203,6 +207,7 @@ Module PBMap Name.s ServerURL.s ; Web URL ex: http://tile.openstreetmap.org/ LayerType.i ; OSM : 0 ; Here : 1 + Enabled.i ;> HERE specific params APP_ID.s APP_CODE.s @@ -760,13 +765,15 @@ Module PBMap ;-*** Layers + ; "OpenStreetMap" layer Procedure.i AddOSMServerLayer(LayerName.s, Order.i, ServerURL.s = "http://tile.openstreetmap.org/") Protected *Ptr = AddElement(PBMap\Layers()) If *Ptr PBMap\Layers()\Name = LayerName PBMap\Layers()\Order = Order PBMap\Layers()\ServerURL = ServerURL - PBMap\Layers()\LayerType = 0 + PBMap\Layers()\LayerType = 0 ; OSM + PBMap\Layers()\Enabled = #True SortStructuredList(PBMap\Layers(), #PB_Sort_Ascending, OffsetOf(Layer\Order),TypeOf(Layer\Order)) ProcedureReturn *Ptr Else @@ -774,6 +781,7 @@ Module PBMap 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) @@ -786,7 +794,8 @@ Module PBMap \ServerURL = ServerURL \path = path \ressource = ressource - \LayerType = 1 + \LayerType = 1 ; HERE + \Enabled = #True \APP_CODE = APP_CODE \APP_ID = APP_ID \format = format @@ -806,10 +815,24 @@ Module PBMap 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)) + FirstElement(PBMap\Layers()) EndProcedure - + + Procedure EnableLayer(*Ptr) + PushListPosition(PBMap\Layers()) + ChangeCurrentElement(PBMap\Layers(), *Ptr) + PBMap\Layers()\Enabled = #True + PopListPosition(PBMap\Layers()) + EndProcedure + + Procedure DisableLayer(*Ptr) + PushListPosition(PBMap\Layers()) + ChangeCurrentElement(PBMap\Layers(), *Ptr) + PBMap\Layers()\Enabled = #False + PopListPosition(PBMap\Layers()) + EndProcedure + ;-*** These are threaded Procedure.i GetTileFromHDD(CacheFile.s) @@ -1016,20 +1039,22 @@ Module PBMap EndIf EndIf With PBMap\Layers() - Select \LayerType - Case 0 ;OSM - URL = \ServerURL + Str(PBMap\Zoom) + "/" + Str(tilex) + "/" + Str(tiley) + ".png" - Case 1 ;Here - 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 - EndSelect + Select \LayerType + Case 0 ;OSM + URL = \ServerURL + Str(PBMap\Zoom) + "/" + Str(tilex) + "/" + Str(tiley) + ".png" + ; Tile cache name based on y + CacheFile = DirName + slash + Str(tiley) + ".png" + Case 1 ;Here + 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 + EndSelect EndWith - ; Tile cache name based on y - CacheFile = DirName + slash + Str(tiley) + ".png" *timg = GetTile(key, URL, CacheFile) If *timg\nImage <> -1 MovePathCursor(px, py) @@ -1562,7 +1587,9 @@ Module PBMap ;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())) + If PBMap\Layers()\Enabled + DrawTiles(*Drawing, ListIndex(PBMap\Layers())) + EndIf Next If PBMap\Options\ShowTrack DrawTracks(*Drawing) @@ -2220,6 +2247,7 @@ CompilerIf #PB_Compiler_IsMainFile #Gdt_LoadGpx #Gdt_AddMarker #Gdt_AddOpenseaMap + #Gdt_AddHereMap #Gdt_Degrees #Gdt_EditMode #Gdt_ClearDiskCache @@ -2289,6 +2317,7 @@ CompilerIf #PB_Compiler_IsMainFile 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_AddHereMap,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) @@ -2321,11 +2350,12 @@ CompilerIf #PB_Compiler_IsMainFile 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, "") + ButtonGadget(#Gdt_AddHereMap, 530, 370, 150, 30, "Show/Hide HERE Aerial", #PB_Button_Toggle) + ButtonGadget(#Gdt_Degrees, 530, 400, 150, 30, "Show/Hide Degrees", #PB_Button_Toggle) + ButtonGadget(#Gdt_EditMode, 530, 430, 150, 30, "Edit mode ON/OFF", #PB_Button_Toggle) + ButtonGadget(#Gdt_ClearDiskCache, 530, 460, 150, 30, "Clear disk cache", #PB_Button_Toggle) + TextGadget(#TextGeoLocationQuery, 530, 495, 150, 15, "Enter an address") + StringGadget(#StringGeoLocationQuery, 530, 510, 150, 20, "") SetActiveGadget(#StringGeoLocationQuery) AddKeyboardShortcut(#Window_0, #PB_Shortcut_Return, #MenuEventGeoLocationStringEnter) ;*** TODO : code to remove when the SetActiveGadget(-1) will be fixed @@ -2338,7 +2368,7 @@ CompilerIf #PB_Compiler_IsMainFile ;*** Define Event.i, Gadget.i, Quit.b = #False Define pfValue.d - Define OpenSeaMap = 0, Degrees = 1 + Define OpenSeaMap = 0, HereMap = 0, Degrees = 1 Define *Track ;Our main gadget @@ -2349,13 +2379,14 @@ CompilerIf #PB_Compiler_IsMainFile 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::AddHereServerLayer("Here", 3, "2WbegPQlhdWwkwF6rtBP", "Js2e6a82ovHndsSOu5vziw") Repeat Event = WaitWindowEvent() @@ -2396,14 +2427,24 @@ CompilerIf #PB_Compiler_IsMainFile 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::AddOSMServerLayer("OpenSeaMap", 2, "http://t1.openseamap.org/seamark/") ; Add a special osm overlay map on layer nb 2 + OpenSeaMap = PBMap::AddOSMServerLayer("OpenSeaMap", 3, "http://t1.openseamap.org/seamark/") ; Add a special osm overlay map on layer nb 3 SetGadgetState(#Gdt_AddOpenseaMap, 1) Else PBMap::DeleteLayer(OpenSeaMap) OpenSeaMap = 0 SetGadgetState(#Gdt_AddOpenseaMap, 0) EndIf - PBMAP::Refresh() + PBMap::Refresh() + Case #Gdt_AddHereMap + If HereMap = 0 + HereMap = PBMap::AddHereServerLayer("Here", 2, "2WbegPQlhdWwkwF6rtBP", "Js2e6a82ovHndsSOu5vziw") ; Add a here overlay map on layer nb 2 + SetGadgetState(#Gdt_AddHereMap, 1) + Else + PBMap::DeleteLayer(HereMap) + HereMap = 0 + SetGadgetState(#Gdt_AddHereMap, 0) + EndIf + PBMap::Refresh() Case #Gdt_Degrees Degrees = 1 - Degrees PBMap::SetOption("ShowDegrees", Str(Degrees)) @@ -2452,11 +2493,11 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf - ; IDE Options = PureBasic 5.60 beta 7 (Windows - x64) -; CursorPosition = 1037 -; FirstLine = 1000 -; Folding = ----------------- +; CursorPosition = 769 +; FirstLine = 751 +; Folding = ------------------ ; EnableThread ; EnableXP +; DisableDebugger ; EnableUnicode \ No newline at end of file From 2346bf3b335154d1df5ce01866f428e3e0f10f5f Mon Sep 17 00:00:00 2001 From: djes Date: Wed, 15 Mar 2017 18:17:51 +0100 Subject: [PATCH 04/60] "HERE" addons and layer modifications Layers are now map and list based to facilitate ordering and deletion --- PBMap.pb | 157 ++++++++++++++++++++++++++++++++++--------------------- 1 file changed, 96 insertions(+), 61 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index 28a3441..e195f75 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -51,10 +51,11 @@ DeclareModule PBMap Declare LoadOptions(PreferencesFile.s = "PBMap.prefs") Declare SaveOptions(PreferencesFile.s = "PBMap.prefs") Declare.i AddOSMServerLayer(LayerName.s, Order.i, ServerURL.s = "http://tile.openstreetmap.org/") - Declare.i 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 DeleteLayer(*Ptr) - Declare EnableLayer(*Ptr) - Declare DisableLayer(*Ptr) + 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 IsLayer(Name.s) + Declare DeleteLayer(Name.s) + Declare EnableLayer(Name.s) + Declare DisableLayer(Name.s) Declare BindMapGadget(Gadget.i) Declare SetCallBackLocation(*CallBackLocation) Declare SetCallBackMainPointer(CallBackMainPointer.i) @@ -200,6 +201,9 @@ Module PBMap ColourFocus.i ColourSelected.i ColourTrackDefault.i + ;HERE specific + appid.s + appcode.s EndStructure Structure Layer @@ -221,7 +225,7 @@ Module PBMap lg2.s ;< EndStructure - + Structure Box x1.i y1.i @@ -255,7 +259,8 @@ Module PBMap 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 @@ -284,7 +289,7 @@ Module PBMap ;-*** Global variables ;-Show debug infos - Global MyDebugLevel = 0 + Global MyDebugLevel = 2 Global PBMap.PBMap, Null.i Global slash.s @@ -625,6 +630,10 @@ Module PBMap 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" @@ -677,6 +686,9 @@ Module PBMap 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") @@ -723,6 +735,9 @@ Module PBMap ; 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") @@ -731,8 +746,11 @@ Module PBMap \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 + \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/") @@ -765,16 +783,31 @@ Module PBMap ;-*** 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) + 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 + 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 = AddElement(PBMap\Layers()) + Protected *Ptr.Layer = AddLayer(LayerName, Order) If *Ptr - PBMap\Layers()\Name = LayerName - PBMap\Layers()\Order = Order - PBMap\Layers()\ServerURL = ServerURL - PBMap\Layers()\LayerType = 0 ; OSM - PBMap\Layers()\Enabled = #True - SortStructuredList(PBMap\Layers(), #PB_Sort_Ascending, OffsetOf(Layer\Order),TypeOf(Layer\Order)) + *Ptr\ServerURL = ServerURL + *Ptr\LayerType = 0 ; OSM + *Ptr\Enabled = #True + SortStructuredList(PBMap\LayersList(), #PB_Sort_Ascending, OffsetOf(Layer\Order),TypeOf(Layer\Order)) ProcedureReturn *Ptr Else ProcedureReturn #False @@ -785,17 +818,21 @@ Module PBMap ;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 = AddElement(PBMap\Layers()) + 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) If *Ptr - With PBMap\Layers() - \Name = LayerName - \Order = Order + 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 @@ -805,32 +842,33 @@ Module PBMap \param = param \scheme = scheme EndWith - SortStructuredList(PBMap\Layers(), #PB_Sort_Ascending, OffsetOf(Layer\Order),TypeOf(Layer\Order)) + SortStructuredList(PBMap\LayersList(), #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()) - SortStructuredList(PBMap\Layers(), #PB_Sort_Ascending, OffsetOf(Layer\Order),TypeOf(Layer\Order)) - FirstElement(PBMap\Layers()) + Procedure.i IsLayer(Name.s) + ProcedureReturn FindMapElement(PBMap\Layers(), Name) EndProcedure - Procedure EnableLayer(*Ptr) - PushListPosition(PBMap\Layers()) - ChangeCurrentElement(PBMap\Layers(), *Ptr) - PBMap\Layers()\Enabled = #True - PopListPosition(PBMap\Layers()) + 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()) EndProcedure - Procedure DisableLayer(*Ptr) - PushListPosition(PBMap\Layers()) - ChangeCurrentElement(PBMap\Layers(), *Ptr) - PBMap\Layers()\Enabled = #False - PopListPosition(PBMap\Layers()) + Procedure EnableLayer(Name.s) + PBMap\Layers(Name)\Enabled = #True + EndProcedure + + Procedure DisableLayer(Name.s) + PBMap\Layers(Name)\Enabled = #False EndProcedure ;-*** These are threaded @@ -987,7 +1025,7 @@ Module PBMap ProcedureReturn *timg 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 ty = Int(*Drawing\TileCoordinates\y) @@ -997,7 +1035,7 @@ Module PBMap 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) @@ -1038,7 +1076,7 @@ Module PBMap MyDebug(DirName + " successfully created", 4) EndIf EndIf - With PBMap\Layers() + With PBMap\LayersList() Select \LayerType Case 0 ;OSM URL = \ServerURL + Str(PBMap\Zoom) + "/" + Str(tilex) + "/" + Str(tiley) + ".png" @@ -1552,6 +1590,7 @@ Module PBMap 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 @@ -1586,9 +1625,9 @@ Module PBMap 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() - If PBMap\Layers()\Enabled - DrawTiles(*Drawing, ListIndex(PBMap\Layers())) + ForEach PBMap\LayersList() + If PBMap\LayersList()\Enabled + DrawTiles(*Drawing, PBMap\LayersList()\Name) EndIf Next If PBMap\Options\ShowTrack @@ -2368,7 +2407,7 @@ CompilerIf #PB_Compiler_IsMainFile ;*** Define Event.i, Gadget.i, Quit.b = #False Define pfValue.d - Define OpenSeaMap = 0, HereMap = 0, Degrees = 1 + Define Degrees = 1 Define *Track ;Our main gadget @@ -2386,7 +2425,6 @@ CompilerIf #PB_Compiler_IsMainFile 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::AddHereServerLayer("Here", 3, "2WbegPQlhdWwkwF6rtBP", "Js2e6a82ovHndsSOu5vziw") Repeat Event = WaitWindowEvent() @@ -2426,23 +2464,21 @@ 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::AddOSMServerLayer("OpenSeaMap", 3, "http://t1.openseamap.org/seamark/") ; Add a special osm overlay map on layer nb 3 - 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() Case #Gdt_AddHereMap - If HereMap = 0 - HereMap = PBMap::AddHereServerLayer("Here", 2, "2WbegPQlhdWwkwF6rtBP", "Js2e6a82ovHndsSOu5vziw") ; Add a here overlay map on layer nb 2 - SetGadgetState(#Gdt_AddHereMap, 1) - Else - PBMap::DeleteLayer(HereMap) - HereMap = 0 + If PBMap::IsLayer("Here") + PBMap::DeleteLayer("Here") SetGadgetState(#Gdt_AddHereMap, 0) + Else + PBMap::AddHereServerLayer("Here", 2) ; Add a here overlay map on layer nb 2 + SetGadgetState(#Gdt_AddHereMap, 1) EndIf PBMap::Refresh() Case #Gdt_Degrees @@ -2494,10 +2530,9 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.60 beta 7 (Windows - x64) -; CursorPosition = 769 -; FirstLine = 751 +; CursorPosition = 57 +; FirstLine = 32 ; Folding = ------------------ ; EnableThread ; EnableXP -; DisableDebugger ; EnableUnicode \ No newline at end of file From 799e61ce4ee8b259e7a5f1aaee24abd10a994e63 Mon Sep 17 00:00:00 2001 From: djes Date: Wed, 15 Mar 2017 19:47:45 +0100 Subject: [PATCH 05/60] Here update with options and new layer system based on map and list --- PBMap.pb | 206 +++++++++++++++++++++++++++++++++++++------------------ 1 file changed, 141 insertions(+), 65 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index de583d5..dfc2fb8 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -20,7 +20,9 @@ EnableExplicit InitNetwork() UsePNGImageDecoder() +UseJPEGImageDecoder() UsePNGImageEncoder() +UseJPEGImageEncoder() ;- Module declaration @@ -49,8 +51,11 @@ DeclareModule PBMap Declare LoadOptions(PreferencesFile.s = "PBMap.prefs") Declare SaveOptions(PreferencesFile.s = "PBMap.prefs") Declare.i AddOSMServerLayer(LayerName.s, Order.i, ServerURL.s = "http://tile.openstreetmap.org/") - Declare.i 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 DeleteLayer(Nb.i) + 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 IsLayer(Name.s) + Declare DeleteLayer(Name.s) + Declare EnableLayer(Name.s) + Declare DisableLayer(Name.s) Declare BindMapGadget(Gadget.i) Declare SetCallBackLocation(*CallBackLocation) Declare SetCallBackMainPointer(CallBackMainPointer.i) @@ -196,6 +201,9 @@ Module PBMap ColourFocus.i ColourSelected.i ColourTrackDefault.i + ;HERE specific + appid.s + appcode.s EndStructure Structure Layer @@ -203,6 +211,7 @@ Module PBMap Name.s ServerURL.s ; Web URL ex: http://tile.openstreetmap.org/ LayerType.i ; OSM : 0 ; Here : 1 + Enabled.i ;> HERE specific params APP_ID.s APP_CODE.s @@ -216,7 +225,7 @@ Module PBMap lg2.s ;< EndStructure - + Structure Box x1.i y1.i @@ -250,7 +259,8 @@ Module PBMap 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 @@ -279,7 +289,7 @@ Module PBMap ;-*** Global variables ;-Show debug infos - Global MyDebugLevel = 0 + Global MyDebugLevel = 2 Global PBMap.PBMap, Null.i Global slash.s @@ -620,6 +630,10 @@ Module PBMap 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" @@ -672,6 +686,9 @@ Module PBMap 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") @@ -718,6 +735,9 @@ Module PBMap ; 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") @@ -726,8 +746,11 @@ Module PBMap \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 + \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/") @@ -760,33 +783,56 @@ Module PBMap ;-*** Layers - Procedure.i AddOSMServerLayer(LayerName.s, Order.i, ServerURL.s = "http://tile.openstreetmap.org/") - Protected *Ptr = AddElement(PBMap\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) + Protected *Ptr = 0 + *Ptr = AddMapElement(PBMap\Layers(), Name) If *Ptr - PBMap\Layers()\Name = LayerName - PBMap\Layers()\Order = Order - PBMap\Layers()\ServerURL = ServerURL - PBMap\Layers()\LayerType = 0 - SortStructuredList(PBMap\Layers(), #PB_Sort_Ascending, OffsetOf(Layer\Order),TypeOf(Layer\Order)) + 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 + 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) + If *Ptr + *Ptr\ServerURL = ServerURL + *Ptr\LayerType = 0 ; OSM + *Ptr\Enabled = #True + SortStructuredList(PBMap\LayersList(), #PB_Sort_Ascending, OffsetOf(Layer\Order),TypeOf(Layer\Order)) 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 = AddElement(PBMap\Layers()) + 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) If *Ptr - With PBMap\Layers() - \Name = LayerName - \Order = Order + With *Ptr;PBMap\Layers() \ServerURL = ServerURL \path = path \ressource = ressource - \LayerType = 1 + \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 @@ -796,20 +842,35 @@ Module PBMap \param = param \scheme = scheme EndWith - SortStructuredList(PBMap\Layers(), #PB_Sort_Ascending, OffsetOf(Layer\Order),TypeOf(Layer\Order)) + SortStructuredList(PBMap\LayersList(), #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)) + 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()) + EndProcedure + + Procedure EnableLayer(Name.s) + PBMap\Layers(Name)\Enabled = #True + EndProcedure + + Procedure DisableLayer(Name.s) + PBMap\Layers(Name)\Enabled = #False + EndProcedure + ;-*** These are threaded Procedure.i GetTileFromHDD(CacheFile.s) @@ -964,7 +1025,7 @@ Module PBMap ProcedureReturn *timg 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 ty = Int(*Drawing\TileCoordinates\y) @@ -974,7 +1035,7 @@ Module PBMap 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) @@ -1015,21 +1076,23 @@ Module PBMap MyDebug(DirName + " successfully created", 4) EndIf EndIf - With PBMap\Layers() - Select \LayerType - Case 0 ;OSM - URL = \ServerURL + Str(PBMap\Zoom) + "/" + Str(tilex) + "/" + Str(tiley) + ".png" - Case 1 ;Here - 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 - EndSelect + With PBMap\LayersList() + Select \LayerType + Case 0 ;OSM + URL = \ServerURL + Str(PBMap\Zoom) + "/" + Str(tilex) + "/" + Str(tiley) + ".png" + ; Tile cache name based on y + CacheFile = DirName + slash + Str(tiley) + ".png" + Case 1 ;Here + 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 + EndSelect EndWith - ; Tile cache name based on y - CacheFile = DirName + slash + Str(tiley) + ".png" *timg = GetTile(key, URL, CacheFile) If *timg\nImage <> -1 MovePathCursor(px, py) @@ -1527,6 +1590,7 @@ Module PBMap 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 @@ -1561,8 +1625,10 @@ Module PBMap 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() - DrawTiles(*Drawing, ListIndex(PBMap\Layers())) + ForEach PBMap\LayersList() + If PBMap\LayersList()\Enabled + DrawTiles(*Drawing, PBMap\LayersList()\Name) + EndIf Next If PBMap\Options\ShowTrack DrawTracks(*Drawing) @@ -2220,6 +2286,7 @@ CompilerIf #PB_Compiler_IsMainFile #Gdt_LoadGpx #Gdt_AddMarker #Gdt_AddOpenseaMap + #Gdt_AddHereMap #Gdt_Degrees #Gdt_EditMode #Gdt_ClearDiskCache @@ -2289,6 +2356,7 @@ CompilerIf #PB_Compiler_IsMainFile 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_AddHereMap,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) @@ -2321,11 +2389,12 @@ CompilerIf #PB_Compiler_IsMainFile 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, "") + ButtonGadget(#Gdt_AddHereMap, 530, 370, 150, 30, "Show/Hide HERE Aerial", #PB_Button_Toggle) + ButtonGadget(#Gdt_Degrees, 530, 400, 150, 30, "Show/Hide Degrees", #PB_Button_Toggle) + ButtonGadget(#Gdt_EditMode, 530, 430, 150, 30, "Edit mode ON/OFF", #PB_Button_Toggle) + ButtonGadget(#Gdt_ClearDiskCache, 530, 460, 150, 30, "Clear disk cache", #PB_Button_Toggle) + TextGadget(#TextGeoLocationQuery, 530, 495, 150, 15, "Enter an address") + StringGadget(#StringGeoLocationQuery, 530, 510, 150, 20, "") SetActiveGadget(#StringGeoLocationQuery) AddKeyboardShortcut(#Window_0, #PB_Shortcut_Return, #MenuEventGeoLocationStringEnter) ;*** TODO : code to remove when the SetActiveGadget(-1) will be fixed @@ -2338,7 +2407,7 @@ CompilerIf #PB_Compiler_IsMainFile ;*** Define Event.i, Gadget.i, Quit.b = #False Define pfValue.d - Define OpenSeaMap = 0, Degrees = 1 + Define Degrees = 1 Define *Track ;Our main gadget @@ -2349,7 +2418,7 @@ CompilerIf #PB_Compiler_IsMainFile 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 @@ -2395,15 +2464,23 @@ 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::AddOSMServerLayer("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 + PBMap::AddHereServerLayer("Here", 2) ; Add a here overlay map on layer nb 2 + SetGadgetState(#Gdt_AddHereMap, 1) + EndIf + PBMap::Refresh() Case #Gdt_Degrees Degrees = 1 - Degrees PBMap::SetOption("ShowDegrees", Str(Degrees)) @@ -2452,11 +2529,10 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf - -; IDE Options = PureBasic 5.60 beta 7 (Windows - x64) -; CursorPosition = 1037 -; FirstLine = 1000 -; Folding = ----------------- +; IDE Options = PureBasic 5.50 (Windows - x64) +; CursorPosition = 2530 +; FirstLine = 2476 +; Folding = ------------------ ; EnableThread ; EnableXP ; EnableUnicode \ No newline at end of file From f2cb4f08e9d23b1a388b334d00e8c36d9a2fb44d Mon Sep 17 00:00:00 2001 From: djes Date: Wed, 15 Mar 2017 20:17:27 +0100 Subject: [PATCH 06/60] Latest HERE and proxy fixes --- PBMap.pb | 24 +++++++++++++++--------- 1 file changed, 15 insertions(+), 9 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index dfc2fb8..7538119 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -289,7 +289,7 @@ Module PBMap ;-*** Global variables ;-Show debug infos - Global MyDebugLevel = 2 + Global MyDebugLevel = 0 Global PBMap.PBMap, Null.i Global slash.s @@ -759,7 +759,7 @@ Module PBMap PreferenceGroup("OPTIONS") \WheelMouseRelative = ReadPreferenceInteger("WheelMouseRelative", #True) \MaxMemCache = ReadPreferenceInteger("MaxMemCache", 20480) ;20 MiB, about 80 tiles in memory - \Verbose = ReadPreferenceInteger("Verbose", #True) + \Verbose = ReadPreferenceInteger("Verbose", #False) \Warning = ReadPreferenceInteger("Warning", #False) \ShowDegrees = ReadPreferenceInteger("ShowDegrees", #False) \ShowDebugInfos = ReadPreferenceInteger("ShowDebugInfos", #False) @@ -893,13 +893,15 @@ Module PBMap Protected *Buffer Protected nImage.i = -1 Protected FileSize.i, timg - HTTPProxy(PBMap\Options\ProxyURL + ":" + PBMap\Options\ProxyPort, PBMap\Options\ProxyUser, PBMap\Options\ProxyPassword) + If PBMap\Options\Proxy + HTTPProxy(PBMap\Options\ProxyURL + ":" + PBMap\Options\ProxyPort, PBMap\Options\ProxyUser, PBMap\Options\ProxyPassword) + 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) + MyDebug("Problem loading from web " + TileURL + " as CacheFile " + CacheFile, 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) @@ -1896,7 +1898,9 @@ Module PBMap ; 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) + 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 @@ -2477,7 +2481,8 @@ CompilerIf #PB_Compiler_IsMainFile PBMap::DeleteLayer("Here") SetGadgetState(#Gdt_AddHereMap, 0) Else - PBMap::AddHereServerLayer("Here", 2) ; Add a here overlay map on layer nb 2 + MessageRequester("Info", "Don't forget to register on HERE and change the line 2485 or edit options file") + PBMap::AddHereServerLayer("Here", 2, "my_id", "my_code") ; Add a here overlay map on layer nb 2 SetGadgetState(#Gdt_AddHereMap, 1) EndIf PBMap::Refresh() @@ -2529,10 +2534,11 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf -; IDE Options = PureBasic 5.50 (Windows - x64) -; CursorPosition = 2530 -; FirstLine = 2476 +; IDE Options = PureBasic 5.60 (Windows - x64) +; CursorPosition = 2475 +; FirstLine = 2453 ; Folding = ------------------ ; EnableThread ; EnableXP +; DisableDebugger ; EnableUnicode \ No newline at end of file From 6bdb4880b672252523ce93215b4d252a0ec0f5c7 Mon Sep 17 00:00:00 2001 From: djes Date: Mon, 20 Mar 2017 11:48:40 +0100 Subject: [PATCH 07/60] Not threadable HTTPProxy bugfixing, plus the not threadable httpproxy() fix --- PBMap.pb | 72 +++++++++++++++++++++++++++++--------------------------- 1 file changed, 37 insertions(+), 35 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index 33d7d95..aed1312 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -289,7 +289,7 @@ Module PBMap ;-*** Global variables ;-Show debug infos - Global MyDebugLevel = 2 + Global MyDebugLevel = 3 Global PBMap.PBMap, Null.i Global slash.s @@ -743,14 +743,14 @@ Module PBMap 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 + \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 + \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/") @@ -875,13 +875,15 @@ Module PBMap Procedure.i GetTileFromHDD(CacheFile.s) Protected nImage.i - If FileSize(CacheFile) > 0 + If FileSize(CacheFile) <> -1 nImage = LoadImage(#PB_Any, CacheFile) If IsImage(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("Deleting faulty image file " + CacheFile, 3) + DeleteFile(CacheFile) EndIf Else MyDebug("Failed loading " + CacheFile + " -> Size <= 0", 3) @@ -893,9 +895,6 @@ Module PBMap Protected *Buffer Protected nImage.i = -1 Protected FileSize.i, timg - If PBMap\Options\Proxy - HTTPProxy(PBMap\Options\ProxyURL + ":" + PBMap\Options\ProxyPort, PBMap\Options\ProxyUser, PBMap\Options\ProxyPassword) - EndIf FileSize = ReceiveHTTPFile(TileURL, CacheFile) If FileSize > 0 MyDebug("Loaded from web " + TileURL + " as CacheFile " + CacheFile, 3) @@ -936,7 +935,7 @@ Module PBMap MyDebug("Image key : " + *Tile\key + " web image loaded", 3) *Tile\RetryNb = 0 Else - MyDebug("Image key : " + *Tile\key + " web image not correctly loaded", 3) + MyDebug("Image key : " + *Tile\key + " web image not correctly loaded, will retry in 2 secs", 3) Delay(2000) *Tile\RetryNb - 1 EndIf @@ -2189,6 +2188,16 @@ Module PBMap ; Could be called directly to attach our map to an existing canvas Procedure BindMapGadget(Gadget.i) + If PBMap\Options\Verbose + OpenConsole() + EndIf + If PBMap\Options\Proxy + HTTPProxy(PBMap\Options\ProxyURL + ":" + PBMap\Options\ProxyPort, PBMap\Options\ProxyUser, PBMap\Options\ProxyPassword) + EndIf + CreateDirectoryEx(PBMap\Options\HDDCachePath) + If PBMap\Options\DefaultOSMServer <> "" + AddOSMServerLayer("OSM", 1, PBMap\Options\DefaultOSMServer) + EndIf PBMap\Gadget = Gadget BindGadgetEvent(PBMap\Gadget, @CanvasEvents()) AddWindowTimer(PBMap\Window, PBMap\Timer, PBMap\Options\TimerInterval) @@ -2199,6 +2208,16 @@ Module PBMap ; Creates a canvas and attach our map Procedure MapGadget(Gadget.i, X.i, Y.i, Width.i, Height.i) + If PBMap\Options\Verbose + OpenConsole() + EndIf + If PBMap\Options\Proxy + HTTPProxy(PBMap\Options\ProxyURL + ":" + PBMap\Options\ProxyPort, PBMap\Options\ProxyUser, PBMap\Options\ProxyPassword) + EndIf + CreateDirectoryEx(PBMap\Options\HDDCachePath) + If PBMap\Options\DefaultOSMServer <> "" + AddOSMServerLayer("OSM", 1, PBMap\Options\DefaultOSMServer) + EndIf 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 @@ -2235,7 +2254,7 @@ Module PBMap Procedure InitPBMap(Window) Protected Result.i - PBMap\ZoomMin = 0 + PBMap\ZoomMin = 1 PBMap\ZoomMax = 18 PBMap\Dragging = #False PBMap\TileSize = 256 @@ -2246,13 +2265,6 @@ Module PBMap PBMap\Timer = 1 PBMap\Mode = #MODE_DEFAULT LoadOptions() - If PBMap\Options\Verbose - OpenConsole() - EndIf - CreateDirectoryEx(PBMap\Options\HDDCachePath) - If PBMap\Options\DefaultOSMServer <> "" - AddOSMServerLayer("OSM", 1, PBMap\Options\DefaultOSMServer) - EndIf TechnicalImagesCreation() SetLocation(0, 0) EndProcedure @@ -2418,6 +2430,7 @@ CompilerIf #PB_Compiler_IsMainFile PBMap::InitPBMap(#Window_0) PBMap::SetOption("ShowDegrees", "0") : Degrees = 0 PBMap::SetOption("ShowDebugInfos", "0") + PBMap::SetOption("Verbose", "0") PBMap::SetOption("ShowScale", "1") PBMap::SetOption("Warning", "1") PBMap::SetOption("ShowMarkersLegend", "1") @@ -2481,12 +2494,9 @@ CompilerIf #PB_Compiler_IsMainFile PBMap::DeleteLayer("Here") SetGadgetState(#Gdt_AddHereMap, 0) Else -<<<<<<< HEAD - PBMap::AddHereServerLayer("Here", 2) ; Add a here overlay map on layer nb 2 -======= +; PBMap::AddHereServerLayer("Here", 2) ; Add a "HERE" overlay map on layer nb 2 MessageRequester("Info", "Don't forget to register on HERE and change the line 2485 or edit options file") PBMap::AddHereServerLayer("Here", 2, "my_id", "my_code") ; Add a here overlay map on layer nb 2 ->>>>>>> origin/djes SetGadgetState(#Gdt_AddHereMap, 1) EndIf PBMap::Refresh() @@ -2538,17 +2548,9 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf -<<<<<<< HEAD -; IDE Options = PureBasic 5.60 beta 7 (Windows - x64) -; CursorPosition = 57 -; FirstLine = 32 -======= ; IDE Options = PureBasic 5.60 (Windows - x64) -; CursorPosition = 2475 -; FirstLine = 2453 ->>>>>>> origin/djes +; CursorPosition = 2432 +; FirstLine = 2413 ; Folding = ------------------ ; EnableThread -; EnableXP -; DisableDebugger -; EnableUnicode \ No newline at end of file +; EnableXP \ No newline at end of file From ae1c031ea09a487ceca8a4f9287e6716caf50dd2 Mon Sep 17 00:00:00 2001 From: djes Date: Mon, 20 Mar 2017 12:38:40 +0100 Subject: [PATCH 08/60] Options improvements --- PBMap.pb | 156 ++++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 114 insertions(+), 42 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index aed1312..2dc4d6d 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -27,7 +27,7 @@ UseJPEGImageEncoder() ;- Module declaration DeclareModule PBMap - + CompilerIf #PB_Compiler_OS = #PB_OS_Linux #Red = 255 CompilerEndIf @@ -45,9 +45,10 @@ DeclareModule PBMap #PB_MAP_REDRAW = #PB_EventType_FirstCustomValue + 1 #PB_MAP_RETRY = #PB_EventType_FirstCustomValue + 2 #PB_MAP_TILE_CLEANUP = #PB_EventType_FirstCustomValue + 3 - + Declare InitPBMap(window) 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 AddOSMServerLayer(LayerName.s, Order.i, ServerURL.s = "http://tile.openstreetmap.org/") @@ -75,7 +76,7 @@ DeclareModule PBMap 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(file.s); + Declare.i LoadGpxFile(file.s) ; Declare ClearTracks() Declare DeleteTrack(*Ptr) Declare DeleteSelectedTracks() @@ -225,7 +226,7 @@ Module PBMap lg2.s ;< EndStructure - + Structure Box x1.i y1.i @@ -305,7 +306,7 @@ Module PBMap ;TODO use this for all text IncludeFile "gettext.pbi" - + ;-*** Misc tools Macro Min(a, b) @@ -316,7 +317,7 @@ Module PBMap (Bool((a) >= (b)) * (a) + Bool((b) > (a)) * (b)) EndMacro - ;Shows an error msg and terminates the program + ;Shows an error msg and terminates the program Procedure Error(msg.s) MessageRequester("PBMap", msg, #PB_MessageRequester_Ok) End @@ -353,6 +354,8 @@ Module PBMap EndMacro CompilerEndSelect + ;Creates a full tree + ;by Thomas (ts-soft) Schulz Procedure CreateDirectoryEx(DirectoryName.s, FileAttribute = #PB_Default) Protected i, c, tmp.s If Right(DirectoryName, 1) = slash @@ -555,7 +558,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 @@ -606,10 +609,29 @@ Module PBMap Else ProcedureReturn Val(Value) EndIf - EndProcedure + EndProcedure + + Procedure.s Value2ColourString(Value.i) + ProcedureReturn "$" + StrU(Red(Value), #PB_Byte) + StrU(Green(Value), #PB_Byte) + StrU(Blue(Value), #PB_Byte) + EndProcedure ;-*** Options + 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" @@ -671,6 +693,72 @@ Module PBMap 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 "verbose" + ProcedureReturn GetBoolString(\Verbose) + Case "warning" + ProcedureReturn GetBoolString(\Warning) + Case "wheelmouserelative" + ProcedureReturn GetBoolString(\WheelMouseRelative) + Case "showdegrees" + ProcedureReturn GetBoolString(\ShowDegrees) + Case "showdebuginfos" + ProcedureReturn GetBoolString(\ShowDebugInfos) + Case "showscale" + ProcedureReturn GetBoolString(\ShowScale) + Case "showmarkers" + ProcedureReturn GetBoolString(\ShowMarkers) + Case "showpointer" + ProcedureReturn GetBoolString(\ShowPointer) + Case "showtrack" + ProcedureReturn GetBoolString(\ShowTrack) + Case "showmarkersnb" + ProcedureReturn GetBoolString(\ShowMarkersNb) + Case "showmarkerslegend" + ProcedureReturn GetBoolString(\ShowMarkersLegend) + Case "showtrackkms" + ProcedureReturn GetBoolString(\ShowTrackKms) + Case "strokewidthtrackdefault" + ProcedureReturn GetBoolString(\StrokeWidthTrackDefault) + Case "colourfocus" + ProcedureReturn Value2ColourString(\ColourFocus) + Case "colourselected" + ProcedureReturn Value2ColourString(\ColourSelected) + Case "colourtrackdefault" + ProcedureReturn Value2ColourString(\ColourTrackDefault) + EndSelect + EndWith EndProcedure ;By default, save options in the user's home directory @@ -749,8 +837,8 @@ Module PBMap \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 + \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/") @@ -777,8 +865,9 @@ Module PBMap \ColourSelected = ReadPreferenceInteger("ColourSelected", RGBA(225, 225, 0, 255)) \ColourTrackDefault = ReadPreferenceInteger("ColourTrackDefault", RGBA(0, 255, 0, 150)) \TimerInterval = 20 - ClosePreferences() - EndWith + ClosePreferences() + EndWith + SetOptions() EndProcedure ;-*** Layers @@ -1586,7 +1675,7 @@ Module PBMap MovePathCursor(GadgetWidth(PBMAP\Gadget) - VectorTextWidth(Text), GadgetHeight(PBMAP\Gadget) - 20) DrawVectorText(Text) EndProcedure - + Procedure Drawing() Protected *Drawing.DrawingParameters = @PBMap\Drawing Protected PixelCenter.PixelCoordinates @@ -1659,7 +1748,7 @@ Module PBMap EndProcedure ;-*** Misc functions - + 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) @@ -2075,7 +2164,7 @@ Module PBMap Case #PB_EventType_MouseMove ; Drag If PBMap\Dragging -; If PBMap\MoveStartingPoint\x <> - 1 + ; If PBMap\MoveStartingPoint\x <> - 1 MouseX = CanvasMouseX - PBMap\MoveStartingPoint\x MouseY = CanvasMouseY - PBMap\MoveStartingPoint\y PBMap\MoveStartingPoint\x = CanvasMouseX @@ -2157,7 +2246,7 @@ Module PBMap EndIf EndIf Case #PB_EventType_LeftButtonUp -; PBMap\MoveStartingPoint\x = - 1 + ; PBMap\MoveStartingPoint\x = - 1 PBMap\Dragging = #False PBMap\Redraw = #True Case #PB_MAP_REDRAW @@ -2188,16 +2277,6 @@ Module PBMap ; Could be called directly to attach our map to an existing canvas Procedure BindMapGadget(Gadget.i) - If PBMap\Options\Verbose - OpenConsole() - EndIf - If PBMap\Options\Proxy - HTTPProxy(PBMap\Options\ProxyURL + ":" + PBMap\Options\ProxyPort, PBMap\Options\ProxyUser, PBMap\Options\ProxyPassword) - EndIf - CreateDirectoryEx(PBMap\Options\HDDCachePath) - If PBMap\Options\DefaultOSMServer <> "" - AddOSMServerLayer("OSM", 1, PBMap\Options\DefaultOSMServer) - EndIf PBMap\Gadget = Gadget BindGadgetEvent(PBMap\Gadget, @CanvasEvents()) AddWindowTimer(PBMap\Window, PBMap\Timer, PBMap\Options\TimerInterval) @@ -2208,16 +2287,6 @@ Module PBMap ; Creates a canvas and attach our map Procedure MapGadget(Gadget.i, X.i, Y.i, Width.i, Height.i) - If PBMap\Options\Verbose - OpenConsole() - EndIf - If PBMap\Options\Proxy - HTTPProxy(PBMap\Options\ProxyURL + ":" + PBMap\Options\ProxyPort, PBMap\Options\ProxyUser, PBMap\Options\ProxyPassword) - EndIf - CreateDirectoryEx(PBMap\Options\HDDCachePath) - If PBMap\Options\DefaultOSMServer <> "" - AddOSMServerLayer("OSM", 1, PBMap\Options\DefaultOSMServer) - EndIf 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 @@ -2494,9 +2563,12 @@ CompilerIf #PB_Compiler_IsMainFile PBMap::DeleteLayer("Here") SetGadgetState(#Gdt_AddHereMap, 0) Else -; PBMap::AddHereServerLayer("Here", 2) ; Add a "HERE" overlay map on layer nb 2 - MessageRequester("Info", "Don't forget to register on HERE and change the line 2485 or edit options file") - PBMap::AddHereServerLayer("Here", 2, "my_id", "my_code") ; Add a here overlay map on layer nb 2 + If PBMap::GetOption("appid") <> "" And PBMap::GetOption("appcode") <> "" + PBMap::AddHereServerLayer("Here", 2) ; Add a "HERE" overlay map on layer nb 2 + Else + MessageRequester("Info", "Don't forget to register on HERE and change the following line or edit options file") + PBMap::AddHereServerLayer("Here", 2, "my_id", "my_code") ; Add a here overlay map on layer nb 2 + EndIf SetGadgetState(#Gdt_AddHereMap, 1) EndIf PBMap::Refresh() @@ -2549,8 +2621,8 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.60 (Windows - x64) -; CursorPosition = 2432 -; FirstLine = 2413 -; Folding = ------------------ +; CursorPosition = 758 +; FirstLine = 733 +; Folding = ------------------- ; EnableThread ; EnableXP \ No newline at end of file From 7746b88731cc55787dfe1b458a043e278d7639af Mon Sep 17 00:00:00 2001 From: djes Date: Tue, 21 Mar 2017 18:01:21 +0100 Subject: [PATCH 09/60] Tile file lifetime management --- PBMap.pb | 23 ++++++++++++++++++++--- 1 file changed, 20 insertions(+), 3 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index 2dc4d6d..dc20f68 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -192,6 +192,7 @@ Module PBMap ShowPointer.i TimerInterval.i MaxMemCache.i ; in MiB + TileLifetime.i Verbose.i ; Maximum debug informations Warning.i ; Warning requesters ShowMarkersNb.i @@ -660,6 +661,8 @@ Module PBMap PBMap\Options\HDDCachePath = Value Case "maxmemcache" PBMap\Options\MaxMemCache = Val(Value) + Case "tilelifetime" + PBMap\Options\TileLifetime = Val(Value) Case "verbose" SelBool(Verbose) Case "warning" @@ -725,6 +728,8 @@ Module PBMap ProcedureReturn \HDDCachePath Case "maxmemcache" ProcedureReturn StrU(\MaxMemCache) + Case "tilelifetime" + ProcedureReturn StrU(\TileLifetime) Case "verbose" ProcedureReturn GetBoolString(\Verbose) Case "warning" @@ -784,6 +789,7 @@ Module PBMap PreferenceGroup("OPTIONS") WritePreferenceInteger("WheelMouseRelative", \WheelMouseRelative) WritePreferenceInteger("MaxMemCache", \MaxMemCache) + WritePreferenceInteger("TileLifetime", \TileLifetime) WritePreferenceInteger("Verbose", \Verbose) WritePreferenceInteger("Warning", \Warning) WritePreferenceInteger("ShowDegrees", \ShowDegrees) @@ -847,6 +853,7 @@ Module PBMap PreferenceGroup("OPTIONS") \WheelMouseRelative = ReadPreferenceInteger("WheelMouseRelative", #True) \MaxMemCache = ReadPreferenceInteger("MaxMemCache", 20480) ;20 MiB, about 80 tiles in memory + \TileLifetime = ReadPreferenceInteger("TileLifetime", 1209600) ;about 2 weeks ; -1 = unlimited \Verbose = ReadPreferenceInteger("Verbose", #False) \Warning = ReadPreferenceInteger("Warning", #False) \ShowDegrees = ReadPreferenceInteger("ShowDegrees", #False) @@ -963,8 +970,18 @@ Module PBMap ;-*** These are threaded Procedure.i GetTileFromHDD(CacheFile.s) - Protected nImage.i + Protected nImage.i, LifeTime.i, MaxLifeTime.i = PBMap\Options\TileLifetime If FileSize(CacheFile) <> -1 + ;Manage tile file lifetime + If MaxLifeTime <> -1 + LifeTime = Date() - GetFileDate(CacheFile, #PB_Date_Modified) ;There's a bug with #PB_Date_Created + If LifeTime > MaxLifeTime + MyDebug("Deleting too old (" + StrU(LifeTime) + " secs) " + CacheFile, 3) + DeleteFile(CacheFile) + ProcedureReturn -1 + EndIf + EndIf + ;Everything is OK, load the file nImage = LoadImage(#PB_Any, CacheFile) If IsImage(nImage) MyDebug("Success loading " + CacheFile + " as nImage " + Str(nImage), 3) @@ -2621,8 +2638,8 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.60 (Windows - x64) -; CursorPosition = 758 -; FirstLine = 733 +; CursorPosition = 2518 +; FirstLine = 2487 ; Folding = ------------------- ; EnableThread ; EnableXP \ No newline at end of file From 544750f74ec5a4d2d140fca9692d96d297c0fc71 Mon Sep 17 00:00:00 2001 From: djes Date: Wed, 29 Mar 2017 12:15:33 +0200 Subject: [PATCH 10/60] Layer alpha and some cleaning as usual --- PBMap.pb | 96 +++++++++++++++++++++++++++++--------------------------- 1 file changed, 49 insertions(+), 47 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index dc20f68..bd4c83c 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -57,6 +57,8 @@ DeclareModule PBMap 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 SetCallBackLocation(*CallBackLocation) Declare SetCallBackMainPointer(CallBackMainPointer.i) @@ -75,7 +77,7 @@ DeclareModule PBMap 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 NominatimGeoLocationQuery(Address.s, *ReturnPosition = 0) ;Send back the position *ptr.GeographicCoordinates Declare.i LoadGpxFile(file.s) ; Declare ClearTracks() Declare DeleteTrack(*Ptr) @@ -214,6 +216,7 @@ Module PBMap ServerURL.s ; Web URL ex: http://tile.openstreetmap.org/ LayerType.i ; OSM : 0 ; Here : 1 Enabled.i + Alpha.d ; 1 : opaque ; 0 : transparent ;> HERE specific params APP_ID.s APP_CODE.s @@ -293,7 +296,7 @@ Module PBMap ;-Show debug infos Global MyDebugLevel = 3 - Global PBMap.PBMap, Null.i + Global PBMap.PBMap, Null.i, NullPtrMem.i, *NullPtr = @NullPtrMem Global slash.s CompilerSelect #PB_Compiler_OS @@ -332,7 +335,9 @@ Module PBMap EndIf EndProcedure - ;(c) ts-soft http://www.purebasic.fr/english/viewtopic.php?f=12&t=58657&hilit=createdirectory&view=unread#unread + ;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) @@ -354,9 +359,7 @@ Module PBMap SetFileAttributes(Name, Attribs) EndMacro CompilerEndSelect - - ;Creates a full tree - ;by Thomas (ts-soft) Schulz + Procedure CreateDirectoryEx(DirectoryName.s, FileAttribute = #PB_Default) Protected i, c, tmp.s If Right(DirectoryName, 1) = slash @@ -880,7 +883,7 @@ Module PBMap ;-*** 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) + Procedure.i AddLayer(Name.s, Order.i, Alpha.d) Protected *Ptr = 0 *Ptr = AddMapElement(PBMap\Layers(), Name) If *Ptr @@ -888,6 +891,8 @@ Module PBMap 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 @@ -898,12 +903,12 @@ Module PBMap ; "OpenStreetMap" layer Procedure.i AddOSMServerLayer(LayerName.s, Order.i, ServerURL.s = "http://tile.openstreetmap.org/") - Protected *Ptr.Layer = AddLayer(LayerName, Order) + Protected *Ptr.Layer = AddLayer(LayerName, Order, 1) If *Ptr *Ptr\ServerURL = ServerURL *Ptr\LayerType = 0 ; OSM *Ptr\Enabled = #True - SortStructuredList(PBMap\LayersList(), #PB_Sort_Ascending, OffsetOf(Layer\Order),TypeOf(Layer\Order)) + PBMap\Redraw = #True ProcedureReturn *Ptr Else ProcedureReturn #False @@ -915,7 +920,7 @@ Module PBMap ;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) + Protected *Ptr.Layer = AddLayer(LayerName, Order, 1) If *Ptr With *Ptr;PBMap\Layers() \ServerURL = ServerURL @@ -938,7 +943,7 @@ Module PBMap \param = param \scheme = scheme EndWith - SortStructuredList(PBMap\LayersList(), #PB_Sort_Ascending, OffsetOf(Layer\Order),TypeOf(Layer\Order)) + PBMap\Redraw = #True ProcedureReturn *Ptr Else ProcedureReturn #False @@ -957,14 +962,26 @@ Module PBMap 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 ;-*** These are threaded @@ -1053,7 +1070,7 @@ Module PBMap ;-*** 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 + ; 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 Protected *timg.ImgMemCach = FindMapElement(PBMap\MemCache\Images(), key) @@ -1183,7 +1200,7 @@ Module PBMap MyDebug(DirName + " successfully created", 4) EndIf EndIf - With PBMap\LayersList() + With PBMap\Layers() Select \LayerType Case 0 ;OSM URL = \ServerURL + Str(PBMap\Zoom) + "/" + Str(tilex) + "/" + Str(tiley) + ".png" @@ -1204,21 +1221,21 @@ Module PBMap If *timg\nImage <> -1 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 = "" MovePathCursor(px, py) - DrawVectorImage(ImageID(PBMap\ImgNothing), 255) + DrawVectorImage(ImageID(PBMap\ImgNothing), 255 * PBMap\Layers()\Alpha) ;EndIf EndIf If PBMap\Options\ShowDebugInfos @@ -1270,30 +1287,10 @@ 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 nx = Mod(Mod(Round(Degrees1\Longitude, #PB_Round_Down)-1, 360) + 360, 360) ny = Round(Degrees1\Latitude, #PB_Round_Up) +1 @@ -1490,8 +1487,8 @@ Module PBMap MessageRequester("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 @@ -1502,9 +1499,9 @@ 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 @@ -1557,13 +1554,15 @@ Module PBMap 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() @@ -1572,6 +1571,7 @@ Module PBMap 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) @@ -1732,6 +1732,7 @@ Module PBMap 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. + ;Draws layers based on their number ForEach PBMap\LayersList() If PBMap\LayersList()\Enabled DrawTiles(*Drawing, PBMap\LayersList()\Name) @@ -2582,6 +2583,7 @@ CompilerIf #PB_Compiler_IsMainFile 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 @@ -2638,8 +2640,8 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.60 (Windows - x64) -; CursorPosition = 2518 -; FirstLine = 2487 +; CursorPosition = 2492 +; FirstLine = 2475 ; Folding = ------------------- ; EnableThread ; EnableXP \ No newline at end of file From d5cd0cd6f3a286f90b30139034d5a4b70ac9fc2b Mon Sep 17 00:00:00 2001 From: djes Date: Wed, 29 Mar 2017 16:46:55 +0200 Subject: [PATCH 11/60] Basic save GPX file function --- PBMap.pb | 114 ++++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 83 insertions(+), 31 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index bd4c83c..e952d89 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -78,7 +78,8 @@ DeclareModule PBMap 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(file.s) ; + Declare.i LoadGpxFile(FileName.s) ; + Declare.i SaveGpxFile(FileName.s, *Track) ; Declare ClearTracks() Declare DeleteTrack(*Ptr) Declare DeleteSelectedTracks() @@ -89,6 +90,7 @@ DeclareModule PBMap Declare DeleteSelectedMarkers() Declare Drawing() Declare Quit() + Declare FatalError(msg.s) Declare Error(msg.s) Declare Refresh() Declare.i ClearDiskCache() @@ -321,12 +323,23 @@ Module PBMap (Bool((a) >= (b)) * (a) + Bool((b) > (a)) * (b)) EndMacro + ;-Error management + ;Shows an error msg and terminates the program - Procedure Error(msg.s) - MessageRequester("PBMap", msg, #PB_MessageRequester_Ok) + Procedure FatalError(msg.s) + If PBMap\Options\Warning + MessageRequester("PBMap", msg, #PB_MessageRequester_Ok) + EndIf End EndProcedure + ;Shows an error msg + Procedure Error(msg.s) + If PBMap\Options\Warning + MessageRequester("PBMap", msg, #PB_MessageRequester_Ok) + EndIf + 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 @@ -1477,14 +1490,14 @@ 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) @@ -1511,6 +1524,32 @@ Module PBMap 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() @@ -2239,7 +2278,7 @@ Module PBMap 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 @@ -2387,6 +2426,7 @@ CompilerIf #PB_Compiler_IsMainFile #StringLatitude #StringLongitude #Gdt_LoadGpx + #Gdt_SaveGpx #Gdt_AddMarker #Gdt_AddOpenseaMap #Gdt_AddHereMap @@ -2458,6 +2498,7 @@ 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_Degrees,WindowWidth(#Window_0)-170,#PB_Ignore,#PB_Ignore,#PB_Ignore) @@ -2475,29 +2516,30 @@ CompilerIf #PB_Compiler_IsMainFile LoadFont(1, "Arial", 12, #PB_Font_Bold) LoadFont(2, "Arial", 8) - TextGadget(#Text_1, 530, 50, 60, 15, "Movements") + 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, 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_AddHereMap, 530, 370, 150, 30, "Show/Hide HERE Aerial", #PB_Button_Toggle) - ButtonGadget(#Gdt_Degrees, 530, 400, 150, 30, "Show/Hide Degrees", #PB_Button_Toggle) - ButtonGadget(#Gdt_EditMode, 530, 430, 150, 30, "Edit mode ON/OFF", #PB_Button_Toggle) - ButtonGadget(#Gdt_ClearDiskCache, 530, 460, 150, 30, "Clear disk cache", #PB_Button_Toggle) - TextGadget(#TextGeoLocationQuery, 530, 495, 150, 15, "Enter an address") - StringGadget(#StringGeoLocationQuery, 530, 510, 150, 20, "") + 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_Degrees, 530, 390, 150, 30, "Show/Hide Degrees", #PB_Button_Toggle) + ButtonGadget(#Gdt_EditMode, 530, 420, 150, 30, "Edit mode ON/OFF", #PB_Button_Toggle) + ButtonGadget(#Gdt_ClearDiskCache, 530, 450, 150, 30, "Clear disk cache", #PB_Button_Toggle) + TextGadget(#TextGeoLocationQuery, 530, 485, 150, 15, "Enter an address") + StringGadget(#StringGeoLocationQuery, 530, 500, 150, 20, "") SetActiveGadget(#StringGeoLocationQuery) AddKeyboardShortcut(#Window_0, #PB_Shortcut_Return, #MenuEventGeoLocationStringEnter) ;*** TODO : code to remove when the SetActiveGadget(-1) will be fixed @@ -2558,7 +2600,17 @@ 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 #StringLatitude, #StringLongitude + 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 AddKeyboardShortcut(#Window_0, #PB_Shortcut_Return, #MenuEventLonLatStringEnter) @@ -2640,8 +2692,8 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.60 (Windows - x64) -; CursorPosition = 2492 -; FirstLine = 2475 +; CursorPosition = 1503 +; FirstLine = 1488 ; Folding = ------------------- ; EnableThread ; EnableXP \ No newline at end of file From c1a650bce507a2443068c46d54f09258ddce8f19 Mon Sep 17 00:00:00 2001 From: djes Date: Mon, 3 Apr 2017 11:32:08 +0200 Subject: [PATCH 12/60] Geoserver layers support Basic geoserver support (google maps services only by now) --- PBMap.pb | 71 +++++++++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 58 insertions(+), 13 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index e952d89..2dfe868 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -53,6 +53,7 @@ DeclareModule PBMap Declare SaveOptions(PreferencesFile.s = "PBMap.prefs") 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) @@ -216,21 +217,24 @@ Module PBMap 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 - path.s ressource.s param.s id.s scheme.s - format.s lg.s lg2.s ;< + ;> GeoServer specific params + ServerLayerName.s + ;< EndStructure Structure Box @@ -935,7 +939,7 @@ Module PBMap 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() + With *Ptr ;PBMap\Layers() \ServerURL = ServerURL \path = path \ressource = ressource @@ -963,6 +967,26 @@ Module PBMap 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 @@ -1215,19 +1239,27 @@ Module PBMap EndIf With PBMap\Layers() Select \LayerType - Case 0 ;OSM + ;---- 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" - Case 1 ;Here + ;---- 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} + ; {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) @@ -2430,6 +2462,7 @@ CompilerIf #PB_Compiler_IsMainFile #Gdt_AddMarker #Gdt_AddOpenseaMap #Gdt_AddHereMap + #Gdt_AddGeoServerMap #Gdt_Degrees #Gdt_EditMode #Gdt_ClearDiskCache @@ -2501,6 +2534,7 @@ CompilerIf #PB_Compiler_IsMainFile 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) @@ -2535,11 +2569,12 @@ CompilerIf #PB_Compiler_IsMainFile 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_Degrees, 530, 390, 150, 30, "Show/Hide Degrees", #PB_Button_Toggle) - ButtonGadget(#Gdt_EditMode, 530, 420, 150, 30, "Edit mode ON/OFF", #PB_Button_Toggle) - ButtonGadget(#Gdt_ClearDiskCache, 530, 450, 150, 30, "Clear disk cache", #PB_Button_Toggle) - TextGadget(#TextGeoLocationQuery, 530, 485, 150, 15, "Enter an address") - StringGadget(#StringGeoLocationQuery, 530, 500, 150, 20, "") + 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 @@ -2643,6 +2678,16 @@ CompilerIf #PB_Compiler_IsMainFile 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)) @@ -2692,8 +2737,8 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.60 (Windows - x64) -; CursorPosition = 1503 -; FirstLine = 1488 +; CursorPosition = 2691 +; FirstLine = 2684 ; Folding = ------------------- ; EnableThread ; EnableXP \ No newline at end of file From aef23aa03b689127a0f598ee8b70ff576ea2c24e Mon Sep 17 00:00:00 2001 From: djes Date: Fri, 2 Jun 2017 12:50:54 +0200 Subject: [PATCH 13/60] Little tile loading bugfix --- PBMap.pb | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index 2dfe868..cd05231 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -1025,7 +1025,7 @@ Module PBMap Procedure.i GetTileFromHDD(CacheFile.s) Protected nImage.i, LifeTime.i, MaxLifeTime.i = PBMap\Options\TileLifetime - If FileSize(CacheFile) <> -1 + If FileSize(CacheFile) > 0 ;Manage tile file lifetime If MaxLifeTime <> -1 LifeTime = Date() - GetFileDate(CacheFile, #PB_Date_Modified) ;There's a bug with #PB_Date_Created @@ -1054,9 +1054,8 @@ Module PBMap Procedure.i GetTileFromWeb(TileURL.s, CacheFile.s) Protected *Buffer Protected nImage.i = -1 - Protected FileSize.i, timg - FileSize = ReceiveHTTPFile(TileURL, CacheFile) - If FileSize > 0 + Protected timg + If ReceiveHTTPFile(TileURL, CacheFile) MyDebug("Loaded from web " + TileURL + " as CacheFile " + CacheFile, 3) nImage = GetTileFromHDD(CacheFile) Else @@ -2737,8 +2736,8 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.60 (Windows - x64) -; CursorPosition = 2691 -; FirstLine = 2684 +; CursorPosition = 1037 +; FirstLine = 1020 ; Folding = ------------------- ; EnableThread ; EnableXP \ No newline at end of file From 246d56a008f6b608640d7d265c61eca1ba19b3c0 Mon Sep 17 00:00:00 2001 From: djes Date: Fri, 2 Jun 2017 12:51:38 +0200 Subject: [PATCH 14/60] Revert "Little tile loading bugfix" This reverts commit aef23aa03b689127a0f598ee8b70ff576ea2c24e. --- PBMap.pb | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index cd05231..2dfe868 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -1025,7 +1025,7 @@ Module PBMap Procedure.i GetTileFromHDD(CacheFile.s) Protected nImage.i, LifeTime.i, MaxLifeTime.i = PBMap\Options\TileLifetime - If FileSize(CacheFile) > 0 + If FileSize(CacheFile) <> -1 ;Manage tile file lifetime If MaxLifeTime <> -1 LifeTime = Date() - GetFileDate(CacheFile, #PB_Date_Modified) ;There's a bug with #PB_Date_Created @@ -1054,8 +1054,9 @@ Module PBMap Procedure.i GetTileFromWeb(TileURL.s, CacheFile.s) Protected *Buffer Protected nImage.i = -1 - Protected timg - If ReceiveHTTPFile(TileURL, CacheFile) + Protected FileSize.i, timg + FileSize = ReceiveHTTPFile(TileURL, CacheFile) + If FileSize > 0 MyDebug("Loaded from web " + TileURL + " as CacheFile " + CacheFile, 3) nImage = GetTileFromHDD(CacheFile) Else @@ -2736,8 +2737,8 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.60 (Windows - x64) -; CursorPosition = 1037 -; FirstLine = 1020 +; CursorPosition = 2691 +; FirstLine = 2684 ; Folding = ------------------- ; EnableThread ; EnableXP \ No newline at end of file From 74fe157b47e4c5d74e045936a9acaf589b43fc3a Mon Sep 17 00:00:00 2001 From: djes Date: Fri, 2 Jun 2017 12:53:29 +0200 Subject: [PATCH 15/60] Little tile loading bugfix --- PBMap.pb | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index 2dfe868..32b2e6a 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -1025,7 +1025,7 @@ Module PBMap Procedure.i GetTileFromHDD(CacheFile.s) Protected nImage.i, LifeTime.i, MaxLifeTime.i = PBMap\Options\TileLifetime - If FileSize(CacheFile) <> -1 + If FileSize(CacheFile) > 0 ;Manage tile file lifetime If MaxLifeTime <> -1 LifeTime = Date() - GetFileDate(CacheFile, #PB_Date_Modified) ;There's a bug with #PB_Date_Created @@ -1054,9 +1054,8 @@ Module PBMap Procedure.i GetTileFromWeb(TileURL.s, CacheFile.s) Protected *Buffer Protected nImage.i = -1 - Protected FileSize.i, timg - FileSize = ReceiveHTTPFile(TileURL, CacheFile) - If FileSize > 0 + Protected timg + If ReceiveHTTPFile(TileURL, CacheFile) MyDebug("Loaded from web " + TileURL + " as CacheFile " + CacheFile, 3) nImage = GetTileFromHDD(CacheFile) Else @@ -2737,8 +2736,8 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.60 (Windows - x64) -; CursorPosition = 2691 -; FirstLine = 2684 +; CursorPosition = 1031 +; FirstLine = 1020 ; Folding = ------------------- ; EnableThread ; EnableXP \ No newline at end of file From 280e4faba66119e4f14842c0f64799e73c997f4f Mon Sep 17 00:00:00 2001 From: djes Date: Tue, 6 Jun 2017 16:45:45 +0200 Subject: [PATCH 16/60] Revert "Little tile loading bugfix" This reverts commit 74fe157b47e4c5d74e045936a9acaf589b43fc3a. --- PBMap.pb | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index 32b2e6a..2dfe868 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -1025,7 +1025,7 @@ Module PBMap Procedure.i GetTileFromHDD(CacheFile.s) Protected nImage.i, LifeTime.i, MaxLifeTime.i = PBMap\Options\TileLifetime - If FileSize(CacheFile) > 0 + If FileSize(CacheFile) <> -1 ;Manage tile file lifetime If MaxLifeTime <> -1 LifeTime = Date() - GetFileDate(CacheFile, #PB_Date_Modified) ;There's a bug with #PB_Date_Created @@ -1054,8 +1054,9 @@ Module PBMap Procedure.i GetTileFromWeb(TileURL.s, CacheFile.s) Protected *Buffer Protected nImage.i = -1 - Protected timg - If ReceiveHTTPFile(TileURL, CacheFile) + Protected FileSize.i, timg + FileSize = ReceiveHTTPFile(TileURL, CacheFile) + If FileSize > 0 MyDebug("Loaded from web " + TileURL + " as CacheFile " + CacheFile, 3) nImage = GetTileFromHDD(CacheFile) Else @@ -2736,8 +2737,8 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.60 (Windows - x64) -; CursorPosition = 1031 -; FirstLine = 1020 +; CursorPosition = 2691 +; FirstLine = 2684 ; Folding = ------------------- ; EnableThread ; EnableXP \ No newline at end of file From 4cb1f57bbcf1ef62facb88a227196e6657b2f65a Mon Sep 17 00:00:00 2001 From: djes Date: Wed, 7 Jun 2017 17:15:04 +0200 Subject: [PATCH 17/60] Cache bugfix in progress And better web loading by thread limit --- .gitignore | 3 +- PBMap.pb | 326 +++++++++++++++++++++++++++++------------------------ 2 files changed, 181 insertions(+), 148 deletions(-) diff --git a/.gitignore b/.gitignore index 9a024d7..c2404a1 100644 --- a/.gitignore +++ b/.gitignore @@ -1 +1,2 @@ -PBMap.pb.bak \ No newline at end of file +PBMap.pb.bak +*.exe diff --git a/PBMap.pb b/PBMap.pb index 2dfe868..facf566 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -79,8 +79,8 @@ DeclareModule PBMap 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.i LoadGpxFile(FileName.s) ; + Declare.i SaveGpxFile(FileName.s, *Track) ; Declare ClearTracks() Declare DeleteTrack(*Ptr) Declare DeleteSelectedTracks() @@ -153,7 +153,7 @@ Module PBMap Structure ImgMemCach nImage.i *Tile.Tile - TimeStackPosition.i + *TimeStackPtr Alpha.i EndStructure @@ -197,6 +197,7 @@ Module PBMap ShowPointer.i TimerInterval.i MaxMemCache.i ; in MiB + MaxThreads.i ; Maximum simultaneous web loading threads TileLifetime.i Verbose.i ; Maximum debug informations Warning.i ; Warning requesters @@ -281,6 +282,8 @@ 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 Dragging.i @@ -376,7 +379,7 @@ Module PBMap SetFileAttributes(Name, Attribs) EndMacro CompilerEndSelect - + Procedure CreateDirectoryEx(DirectoryName.s, FileAttribute = #PB_Default) Protected i, c, tmp.s If Right(DirectoryName, 1) = slash @@ -681,6 +684,8 @@ Module PBMap PBMap\Options\HDDCachePath = Value Case "maxmemcache" PBMap\Options\MaxMemCache = Val(Value) + Case "maxthreads" + PBMap\Options\MaxThreads = Val(Value) Case "tilelifetime" PBMap\Options\TileLifetime = Val(Value) Case "verbose" @@ -732,57 +737,59 @@ Module PBMap 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 "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 "showmarkers" - ProcedureReturn GetBoolString(\ShowMarkers) - Case "showpointer" - ProcedureReturn GetBoolString(\ShowPointer) - Case "showtrack" - ProcedureReturn GetBoolString(\ShowTrack) - Case "showmarkersnb" - ProcedureReturn GetBoolString(\ShowMarkersNb) - Case "showmarkerslegend" - ProcedureReturn GetBoolString(\ShowMarkersLegend) - Case "showtrackkms" - ProcedureReturn GetBoolString(\ShowTrackKms) - Case "strokewidthtrackdefault" - ProcedureReturn GetBoolString(\StrokeWidthTrackDefault) - Case "colourfocus" - ProcedureReturn Value2ColourString(\ColourFocus) - Case "colourselected" - ProcedureReturn Value2ColourString(\ColourSelected) - Case "colourtrackdefault" - ProcedureReturn Value2ColourString(\ColourTrackDefault) - EndSelect + 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 "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 "showmarkers" + ProcedureReturn GetBoolString(\ShowMarkers) + Case "showpointer" + ProcedureReturn GetBoolString(\ShowPointer) + Case "showtrack" + ProcedureReturn GetBoolString(\ShowTrack) + Case "showmarkersnb" + ProcedureReturn GetBoolString(\ShowMarkersNb) + Case "showmarkerslegend" + ProcedureReturn GetBoolString(\ShowMarkersLegend) + Case "showtrackkms" + ProcedureReturn GetBoolString(\ShowTrackKms) + Case "strokewidthtrackdefault" + ProcedureReturn GetBoolString(\StrokeWidthTrackDefault) + Case "colourfocus" + ProcedureReturn Value2ColourString(\ColourFocus) + Case "colourselected" + ProcedureReturn Value2ColourString(\ColourSelected) + Case "colourtrackdefault" + ProcedureReturn Value2ColourString(\ColourTrackDefault) + EndSelect EndWith EndProcedure @@ -809,6 +816,7 @@ Module PBMap PreferenceGroup("OPTIONS") WritePreferenceInteger("WheelMouseRelative", \WheelMouseRelative) WritePreferenceInteger("MaxMemCache", \MaxMemCache) + WritePreferenceInteger("MaxThreads", \MaxThreads) WritePreferenceInteger("TileLifetime", \TileLifetime) WritePreferenceInteger("Verbose", \Verbose) WritePreferenceInteger("Warning", \Warning) @@ -873,6 +881,7 @@ Module PBMap PreferenceGroup("OPTIONS") \WheelMouseRelative = ReadPreferenceInteger("WheelMouseRelative", #True) \MaxMemCache = ReadPreferenceInteger("MaxMemCache", 20480) ;20 MiB, about 80 tiles in memory + \MaxThreads = ReadPreferenceInteger("MaxThreads", 20) \TileLifetime = ReadPreferenceInteger("TileLifetime", 1209600) ;about 2 weeks ; -1 = unlimited \Verbose = ReadPreferenceInteger("Verbose", #False) \Warning = ReadPreferenceInteger("Warning", #False) @@ -973,12 +982,12 @@ Module PBMap 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 + \ServerURL = ServerURL + \path = path + \LayerType = 2 ; GeoServer + \format = format + \Enabled = #True + \ServerLayerName = ServerLayerName EndWith PBMap\Redraw = #True ProcedureReturn *Ptr @@ -1030,23 +1039,26 @@ Module PBMap If MaxLifeTime <> -1 LifeTime = Date() - GetFileDate(CacheFile, #PB_Date_Modified) ;There's a bug with #PB_Date_Created If LifeTime > MaxLifeTime - MyDebug("Deleting too old (" + StrU(LifeTime) + " secs) " + CacheFile, 3) + MyDebug(" Deleting too old (" + StrU(LifeTime) + " secs) " + CacheFile, 3) DeleteFile(CacheFile) ProcedureReturn -1 EndIf EndIf ;Everything is OK, load the file nImage = LoadImage(#PB_Any, CacheFile) - If IsImage(nImage) - MyDebug("Success loading " + CacheFile + " as nImage " + Str(nImage), 3) + If nImage And IsImage(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("Deleting faulty image file " + CacheFile, 3) - DeleteFile(CacheFile) + 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) + MyDebug(" Failed loading " + CacheFile + " -> Filesize = " + FileSize(CacheFile), 3) EndIf ProcedureReturn -1 EndProcedure @@ -1054,13 +1066,12 @@ Module PBMap Procedure.i GetTileFromWeb(TileURL.s, CacheFile.s) Protected *Buffer Protected nImage.i = -1 - Protected FileSize.i, timg - FileSize = ReceiveHTTPFile(TileURL, CacheFile) - If FileSize > 0 - MyDebug("Loaded from web " + TileURL + " as CacheFile " + CacheFile, 3) + Protected timg + If ReceiveHTTPFile(TileURL, CacheFile) + MyDebug(" Loaded from web " + TileURL + " as CacheFile " + CacheFile, 3) nImage = GetTileFromHDD(CacheFile) Else - MyDebug("Problem loading from web " + TileURL + " as CacheFile " + CacheFile, 3) + MyDebug(" Problem receving from web " + TileURL + " as CacheFile " + CacheFile, 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) @@ -1089,17 +1100,17 @@ Module PBMap Procedure GetImageThread(*Tile.Tile) Protected nImage.i = -1 + MyDebug("Thread for image key " + *Tile\key, 3) 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, will retry in 2 secs", 3) Delay(2000) *Tile\RetryNb - 1 EndIf Until *Tile\RetryNb <= 0 + MyDebug(" Thread for image key " + *Tile\key + " finished", 3) *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 @@ -1107,81 +1118,100 @@ Module PBMap ;-*** 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. + ; Try to find the tile in memory cache. If not found, add it if there's enough room in the cache, try to load the picture from the + ; HDD, or launch a web loading thread, and try again on the next drawing loop. Protected img.i = -1 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) + MyDebug(" as image " + img, 3) ;*** Cache management - ; Move the newly used element to the last position of the time stack - SelectElement(PBMap\MemCache\ImagesTimeStack(), *timg\TimeStackPosition) + ; 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()) ;*** ProcedureReturn *timg EndIf Else - ;PushMapPosition(PBMap\MemCache\Images()) ;*** Cache management - ; if cache size exceeds limit, try to delete the oldest tile used (first in the list) + ; if cache size exceeds limit, try to delete the oldest tiles used (first in the time stack) 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()) + If CacheSize > CacheLimit + MyDebug(" Cache full. Trying cache cleaning", 4) + 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 + Protected Image = PBMap\MemCache\Images(CacheMapKey)\nImage + If IsImage(Image) ; Check if the image is valid (is a loading thread running ?) + FreeImage(Image) + DeleteMapElement(PBMap\MemCache\Images(), CacheMapKey) + DeleteElement(PBMap\MemCache\ImagesTimeStack()) + MyDebug(" Delete " + CacheMapKey + " as image nb " + Str(Image), 4) + 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), 4) + If CacheSize > CacheLimit + MyDebug(" Cache cleaning unsuccessfull, can't add new tiles.", 4) + ProcedureReturn 0 EndIf - Wend - LastElement(PBMap\MemCache\ImagesTimeStack()) - ;PopMapPosition(PBMap\MemCache\Images()) + EndIf + ; Creates a new cache element 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 + ; Add a new time stack element at the end + LastElement(PBMap\MemCache\ImagesTimeStack()) + ; Stores the time stack ptr + *timg\TimeStackPtr = AddElement(PBMap\MemCache\ImagesTimeStack()) + ; Associates the time stack element to the cache element + PBMap\MemCache\ImagesTimeStack()\MapKey = MapKey(PBMap\MemCache\Images()) + *timg\nImage = -1 + MyDebug("Key : " + key + " added in memory cache", 3) + ;*** EndIf - If *timg\Tile = 0 ; Check if a loading thread is not running - MyDebug("Trying to load from HDD " + CacheFile, 3) + If *timg\Tile = 0 ; Check if a loading thread is not already running img = GetTileFromHDD(CacheFile.s) If img <> -1 - MyDebug("Key : " + key + " found on HDD", 3) + ; Image found and loaded from HDD *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 - *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 + ; Image not found on HDD, launch a new web loading thread + If PBMap\ThreadsNB < PBMap\Options\MaxThreads + 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 + \GetImageThread = CreateThread(@GetImageThread(), *NewTile) + If \GetImageThread + MyDebug(" Creating get image thread nb " + Str(\GetImageThread) + " to get " + CacheFile, 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(" Error, can't create a new tile loading thread", 3) - EndIf + MyDebug(" Error, maximum threads nb reached", 3) + EndIf EndIf ProcedureReturn *timg EndProcedure @@ -1239,12 +1269,12 @@ Module PBMap EndIf With PBMap\Layers() Select \LayerType - ;---- OSM tiles + ;---- 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 + ;---- 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} @@ -1254,7 +1284,7 @@ Module PBMap EndIf ; Tile cache name based on y CacheFile = DirName + slash + Str(tiley) + "." + \format - ;---- GeoServer / geowebcache - google maps service tiles + ;---- 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 @@ -1263,7 +1293,7 @@ Module PBMap EndSelect EndWith *timg = GetTile(key, URL, CacheFile) - If *timg\nImage <> -1 + If *timg And *timg\nImage <> -1 MovePathCursor(px, py) If *timg\Alpha <= 224 DrawVectorImage(ImageID(*timg\nImage), *timg\Alpha * PBMap\Layers()\Alpha) @@ -1737,7 +1767,7 @@ Module PBMap 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() @@ -1747,13 +1777,13 @@ Module PBMap 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) @@ -2113,11 +2143,11 @@ 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 @@ -2347,12 +2377,13 @@ Module PBMap 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 + ; 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 ; Stores it in the cache using the key + FreeMemory(PBMap\MemCache\Images(key)\Tile) ; Frees the data needed for the thread + PBMap\MemCache\Images(key)\Tile = 0 ; Clears the data ptr + PBMap\ThreadsNB - 1 ; The web loading thread is finished PBMap\Redraw = #True EndSelect EndProcedure @@ -2592,9 +2623,9 @@ CompilerIf #PB_Compiler_IsMainFile ;Our main gadget PBMap::InitPBMap(#Window_0) - PBMap::SetOption("ShowDegrees", "0") : Degrees = 0 - PBMap::SetOption("ShowDebugInfos", "0") - PBMap::SetOption("Verbose", "0") + PBMap::SetOption("ShowDegrees", "1") : Degrees = 0 + PBMap::SetOption("ShowDebugInfos", "3") + PBMap::SetOption("Verbose", "1") PBMap::SetOption("ShowScale", "1") PBMap::SetOption("Warning", "1") PBMap::SetOption("ShowMarkersLegend", "1") @@ -2643,9 +2674,9 @@ CompilerIf #PB_Compiler_IsMainFile MessageRequester("PBMap", "Problem while saving.", #PB_MessageRequester_Ok) EndIf Else - MessageRequester("PBMap", "No track to save.", #PB_MessageRequester_Ok) + MessageRequester("PBMap", "No track to save.", #PB_MessageRequester_Ok) EndIf - Case #StringLatitude, #StringLongitude + Case #StringLatitude, #StringLongitude Select EventType() Case #PB_EventType_Focus AddKeyboardShortcut(#Window_0, #PB_Shortcut_Return, #MenuEventLonLatStringEnter) @@ -2737,8 +2768,9 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.60 (Windows - x64) -; CursorPosition = 2691 -; FirstLine = 2684 +; CursorPosition = 1123 +; FirstLine = 1130 ; Folding = ------------------- ; EnableThread -; EnableXP \ No newline at end of file +; EnableXP +; CompileSourceDirectory \ No newline at end of file From c862f9099ea9c294bbdf487c9d013ecf24dc7ce0 Mon Sep 17 00:00:00 2001 From: djes Date: Thu, 8 Jun 2017 12:27:56 +0200 Subject: [PATCH 18/60] Overload bugfix in progress When several threads are launched and the web server doesn't respond, a form of overload appears. --- PBMap.pb | 88 ++++++++++++++++++++++++++++++-------------------------- 1 file changed, 47 insertions(+), 41 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index facf566..2f2dd01 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -303,7 +303,7 @@ Module PBMap ;-*** Global variables ;-Show debug infos - Global MyDebugLevel = 3 + Global MyDebugLevel = 0 Global PBMap.PBMap, Null.i, NullPtrMem.i, *NullPtr = @NullPtrMem Global slash.s @@ -881,7 +881,7 @@ Module PBMap PreferenceGroup("OPTIONS") \WheelMouseRelative = ReadPreferenceInteger("WheelMouseRelative", #True) \MaxMemCache = ReadPreferenceInteger("MaxMemCache", 20480) ;20 MiB, about 80 tiles in memory - \MaxThreads = ReadPreferenceInteger("MaxThreads", 20) + \MaxThreads = ReadPreferenceInteger("MaxThreads", 40) \TileLifetime = ReadPreferenceInteger("TileLifetime", 1209600) ;about 2 weeks ; -1 = unlimited \Verbose = ReadPreferenceInteger("Verbose", #False) \Warning = ReadPreferenceInteger("Warning", #False) @@ -1034,17 +1034,17 @@ Module PBMap Procedure.i GetTileFromHDD(CacheFile.s) Protected nImage.i, LifeTime.i, MaxLifeTime.i = PBMap\Options\TileLifetime - If FileSize(CacheFile) <> -1 + If FileSize(CacheFile) > 0 ;<> -1 ;Manage tile file lifetime If MaxLifeTime <> -1 LifeTime = Date() - GetFileDate(CacheFile, #PB_Date_Modified) ;There's a bug with #PB_Date_Created If LifeTime > MaxLifeTime MyDebug(" Deleting too old (" + StrU(LifeTime) + " secs) " + CacheFile, 3) DeleteFile(CacheFile) - ProcedureReturn -1 + ProcedureReturn 0 EndIf EndIf - ;Everything is OK, load the file + ;Everything is OK, loads the file nImage = LoadImage(#PB_Any, CacheFile) If nImage And IsImage(nImage) MyDebug(" Success loading " + CacheFile + " as nImage " + Str(nImage), 3) @@ -1060,23 +1060,27 @@ Module PBMap Else MyDebug(" Failed loading " + CacheFile + " -> Filesize = " + FileSize(CacheFile), 3) EndIf - ProcedureReturn -1 + ProcedureReturn 0 EndProcedure Procedure.i GetTileFromWeb(TileURL.s, CacheFile.s) - Protected *Buffer - Protected nImage.i = -1 - Protected timg + ;Debug TileURL If ReceiveHTTPFile(TileURL, CacheFile) MyDebug(" Loaded from web " + TileURL + " as CacheFile " + CacheFile, 3) - nImage = GetTileFromHDD(CacheFile) + ; Debug TileURL + " OK" + ProcedureReturn GetTileFromHDD(CacheFile) Else MyDebug(" Problem receving from web " + TileURL + " as CacheFile " + CacheFile, 3) + ; Debug TileURL + " NOT OK" + ProcedureReturn -1 EndIf - ; **** IMPORTANT NOTICE (please not remove) + ; **** (OLD) 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. + ; More than that, the original Purebasic Receive library is still not Proxy enabled. + ;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)) @@ -1095,15 +1099,13 @@ Module PBMap ; MyDebug(" Problem loading from web " + TileURL, 3) ; EndIf ; **** - ProcedureReturn nImage EndProcedure Procedure GetImageThread(*Tile.Tile) - Protected nImage.i = -1 MyDebug("Thread for image key " + *Tile\key, 3) Repeat - nImage = GetTileFromWeb(*Tile\URL, *Tile\CacheFile) - If nImage <> -1 + *Tile\nImage = GetTileFromWeb(*Tile\URL, *Tile\CacheFile) + If *Tile\nImage <> -1 *Tile\RetryNb = 0 Else Delay(2000) @@ -1111,7 +1113,6 @@ Module PBMap EndIf Until *Tile\RetryNb <= 0 MyDebug(" Thread for image key " + *Tile\key + " finished", 3) - *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 @@ -1120,13 +1121,11 @@ Module PBMap Procedure.i GetTile(key.s, URL.s, CacheFile.s) ; Try to find the tile in memory cache. If not found, add it if there's enough room in the cache, try to load the picture from the ; HDD, or launch a web loading thread, and try again on the next drawing loop. - Protected img.i = -1 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(" as image " + img, 3) + If *timg\nImage + MyDebug(" as image " + *timg\nImage, 3) ;*** 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) @@ -1140,9 +1139,9 @@ Module PBMap ; if cache size exceeds limit, try to delete the oldest tiles used (first in the time stack) 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) + MyDebug("Cache size : " + Str(CacheSize/1024) + " / CacheLimit : " + Str(CacheLimit/1024), 3) If CacheSize > CacheLimit - MyDebug(" Cache full. Trying cache cleaning", 4) + MyDebug(" Cache full. Trying cache cleaning", 3) ResetList(PBMap\MemCache\ImagesTimeStack()) ; Try to free half the cache memory (one pass) While NextElement(PBMap\MemCache\ImagesTimeStack()) And CacheSize > (CacheLimit / 2) ; /2 = half @@ -1152,34 +1151,41 @@ Module PBMap FreeImage(Image) DeleteMapElement(PBMap\MemCache\Images(), CacheMapKey) DeleteElement(PBMap\MemCache\ImagesTimeStack()) - MyDebug(" Delete " + CacheMapKey + " as image nb " + Str(Image), 4) + MyDebug(" Delete " + CacheMapKey + " as image nb " + Str(Image), 3) 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), 4) + MyDebug(" New cache size : " + Str(CacheSize/1024) + " / CacheLimit : " + Str(CacheLimit/1024), 3) If CacheSize > CacheLimit - MyDebug(" Cache cleaning unsuccessfull, can't add new tiles.", 4) + MyDebug(" Cache cleaning unsuccessfull, can't add new tiles.", 3) ProcedureReturn 0 EndIf EndIf ; Creates a new cache element - AddMapElement(PBMap\MemCache\Images(), key) - *timg = PBMap\MemCache\Images() - ; Add a new time stack element at the end + *timg = AddMapElement(PBMap\MemCache\Images(), key) + If *timg = 0 + MyDebug(" Can't add a new cache element.", 3) + ProcedureReturn 0 + 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.", 3) + DeleteMapElement(PBMap\MemCache\Images()) + ProcedureReturn 0 + EndIf ; Associates the time stack element to the cache element - PBMap\MemCache\ImagesTimeStack()\MapKey = MapKey(PBMap\MemCache\Images()) - *timg\nImage = -1 + PBMap\MemCache\ImagesTimeStack()\MapKey = MapKey(PBMap\MemCache\Images()) MyDebug("Key : " + key + " added in memory cache", 3) ;*** EndIf If *timg\Tile = 0 ; Check if a loading thread is not already running - img = GetTileFromHDD(CacheFile.s) - If img <> -1 + ; Is the file image on HDD ? + *timg\nImage = GetTileFromHDD(CacheFile.s) + If *timg\nImage ; Image found and loaded from HDD - *timg\nImage = img *timg\Alpha = 256 ProcedureReturn *timg EndIf @@ -1188,7 +1194,7 @@ Module PBMap Protected *NewTile.Tile = AllocateMemory(SizeOf(Tile)) If *NewTile With *NewTile - *timg\Tile = *NewTile + *timg\Tile = *NewTile ; There's now a loading thread *timg\Alpha = 0 ;*timg\nImage = -1 ;New tile parameters @@ -1293,7 +1299,7 @@ Module PBMap EndSelect EndWith *timg = GetTile(key, URL, CacheFile) - If *timg And *timg\nImage <> -1 + If *timg And *timg\nImage MovePathCursor(px, py) If *timg\Alpha <= 224 DrawVectorImage(ImageID(*timg\nImage), *timg\Alpha * PBMap\Layers()\Alpha) @@ -2382,8 +2388,8 @@ Module PBMap Protected timg = PBMap\MemCache\Images(key)\Tile\nImage ; Get this new tile image nb PBMap\MemCache\Images(key)\nImage = timg ; Stores it in the cache using the key FreeMemory(PBMap\MemCache\Images(key)\Tile) ; Frees the data needed for the thread - PBMap\MemCache\Images(key)\Tile = 0 ; Clears the data ptr - PBMap\ThreadsNB - 1 ; The web loading thread is finished + PBMap\MemCache\Images(key)\Tile = 0 ; Clears the data ptr, the web loading thread is finished + PBMap\ThreadsNB - 1 PBMap\Redraw = #True EndSelect EndProcedure @@ -2624,7 +2630,7 @@ CompilerIf #PB_Compiler_IsMainFile ;Our main gadget PBMap::InitPBMap(#Window_0) PBMap::SetOption("ShowDegrees", "1") : Degrees = 0 - PBMap::SetOption("ShowDebugInfos", "3") + PBMap::SetOption("ShowDebugInfos", "1") PBMap::SetOption("Verbose", "1") PBMap::SetOption("ShowScale", "1") PBMap::SetOption("Warning", "1") @@ -2768,8 +2774,8 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.60 (Windows - x64) -; CursorPosition = 1123 -; FirstLine = 1130 +; CursorPosition = 1067 +; FirstLine = 1055 ; Folding = ------------------- ; EnableThread ; EnableXP From bbf5be2efdc066645f0e82330f15d7f9dcf64fd1 Mon Sep 17 00:00:00 2001 From: djes Date: Thu, 8 Jun 2017 15:02:34 +0200 Subject: [PATCH 19/60] New cache mechanism and thread overload fixed --- PBMap.pb | 145 +++++++++++++++++++++++++++++++++---------------------- 1 file changed, 86 insertions(+), 59 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index 2f2dd01..f214443 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -303,7 +303,7 @@ Module PBMap ;-*** Global variables ;-Show debug infos - Global MyDebugLevel = 0 + Global MyDebugLevel = 5 Global PBMap.PBMap, Null.i, NullPtrMem.i, *NullPtr = @NullPtrMem Global slash.s @@ -1063,17 +1063,17 @@ Module PBMap ProcedureReturn 0 EndProcedure - Procedure.i GetTileFromWeb(TileURL.s, CacheFile.s) - ;Debug TileURL - If ReceiveHTTPFile(TileURL, CacheFile) - MyDebug(" Loaded from web " + TileURL + " as CacheFile " + CacheFile, 3) - ; Debug TileURL + " OK" - ProcedureReturn GetTileFromHDD(CacheFile) - Else - MyDebug(" Problem receving from web " + TileURL + " as CacheFile " + CacheFile, 3) - ; Debug TileURL + " NOT OK" - ProcedureReturn -1 - EndIf +; Procedure.i GetTileFromWeb(TileURL.s, CacheFile.s) +; ;Debug TileURL +; If ReceiveHTTPFile(TileURL, CacheFile, #PB_HTTP_Asynchronous) +; MyDebug(" Loaded from web " + TileURL + " as CacheFile " + CacheFile, 3) +; ; Debug TileURL + " OK" +; ProcedureReturn GetTileFromHDD(CacheFile) +; Else +; MyDebug(" Problem receving from web " + TileURL + " as CacheFile " + CacheFile, 3) +; ; Debug TileURL + " NOT OK" +; ProcedureReturn -1 +; EndIf ; **** (OLD) 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) @@ -1099,22 +1099,47 @@ Module PBMap ; MyDebug(" Problem loading from web " + TileURL, 3) ; EndIf ; **** - EndProcedure +; EndProcedure Procedure GetImageThread(*Tile.Tile) - MyDebug("Thread for image key " + *Tile\key, 3) - Repeat - *Tile\nImage = GetTileFromWeb(*Tile\URL, *Tile\CacheFile) - If *Tile\nImage <> -1 - *Tile\RetryNb = 0 - Else - Delay(2000) - *Tile\RetryNb - 1 - EndIf - Until *Tile\RetryNb <= 0 - MyDebug(" Thread for image key " + *Tile\key + " finished", 3) - *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 + Protected Download, Progress, Size + MyDebug("Thread starting for image " + *Tile\CacheFile + "(" + *Tile\key + ")", 3) + Download = ReceiveHTTPFile(*Tile\URL, *Tile\CacheFile, #PB_HTTP_Asynchronous) + If Download + Repeat + Progress = HTTPProgress(Download) + Select Progress + Case #PB_Http_Success + Size = FinishHTTP(Download) + MyDebug(" Thread for image " + *Tile\CacheFile + " finished. Size : " + Str(Size), 3) + PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ;To free memory outside the thread + ProcedureReturn + Case #PB_Http_Failed + MyDebug(" Thread for image " + *Tile\CacheFile + " failed.", 3) + PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ;To free memory outside the thread + ProcedureReturn + Case #PB_Http_Aborted + MyDebug(" Thread for image " + *Tile\CacheFile + " aborted.", 3) + PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ;To free memory outside the thread + ProcedureReturn + Default + MyDebug(" Thread for image " + *Tile\CacheFile + " downloading " + Str(Progress) + " bytes", 3) + EndSelect + Delay(500) ; Frees CPU + ForEver + EndIf +; Repeat +; *Tile\nImage = GetTileFromWeb(*Tile\URL, *Tile\CacheFile) +; If *Tile\nImage <> -1 +; *Tile\RetryNb = 0 +; Else +; Delay(2000) +; *Tile\RetryNb - 1 +; EndIf +; Until *Tile\RetryNb <= 0 +; MyDebug(" Thread for image key " + *Tile\key + " finished", 3) +; *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 ;-*** @@ -1136,35 +1161,37 @@ Module PBMap EndIf Else ;*** Cache management - ; if cache size exceeds limit, try to delete the oldest tiles used (first in the time stack) - 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), 3) - If CacheSize > CacheLimit - MyDebug(" Cache full. Trying cache cleaning", 3) - 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 - Protected Image = PBMap\MemCache\Images(CacheMapKey)\nImage - If IsImage(Image) ; Check if the image is valid (is a loading thread running ?) - FreeImage(Image) - DeleteMapElement(PBMap\MemCache\Images(), CacheMapKey) - DeleteElement(PBMap\MemCache\ImagesTimeStack()) - MyDebug(" Delete " + CacheMapKey + " as image nb " + Str(Image), 3) - 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), 3) - If CacheSize > CacheLimit - MyDebug(" Cache cleaning unsuccessfull, can't add new tiles.", 3) - ProcedureReturn 0 - EndIf + ; If cache size exceeds limit, try to delete the oldest tiles used (first in the time stack) + Protected CacheSize = MapSize(PBMap\MemCache\Images()) * Pow(PBMap\TileSize, 2) * 5 ; 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 + Protected Image = PBMap\MemCache\Images(CacheMapKey)\nImage + If PBMap\MemCache\Images(CacheMapKey)\Tile = 0 ; Check if a loading thread is not already running + If IsImage(Image) ; Check if the image is valid + FreeImage(Image) + EndIf + DeleteMapElement(PBMap\MemCache\Images(), CacheMapKey) + DeleteElement(PBMap\MemCache\ImagesTimeStack()) + MyDebug(" Delete " + CacheMapKey + " as image nb " + Str(Image), 5) + 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) + ProcedureReturn 0 + EndIf EndIf ; Creates a new cache element *timg = AddMapElement(PBMap\MemCache\Images(), key) If *timg = 0 - MyDebug(" Can't add a new cache element.", 3) + MyDebug(" Can't add a new cache element.", 5) ProcedureReturn 0 EndIf ; add a new time stack element at the End @@ -1172,16 +1199,16 @@ Module PBMap ; Stores the time stack ptr *timg\TimeStackPtr = AddElement(PBMap\MemCache\ImagesTimeStack()) If *timg\TimeStackPtr = 0 - MyDebug(" Can't add a new time stack element.", 3) + MyDebug(" Can't add a new time stack element.", 5) DeleteMapElement(PBMap\MemCache\Images()) ProcedureReturn 0 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", 3) + MyDebug("Key : " + key + " added in memory cache", 5) ;*** EndIf - If *timg\Tile = 0 ; Check if a loading thread is not already running + If *timg\Tile = 0 ; Checks if a loading thread is not already running ; Is the file image on HDD ? *timg\nImage = GetTileFromHDD(CacheFile.s) If *timg\nImage @@ -1202,7 +1229,7 @@ Module PBMap \URL = URL \CacheFile = CacheFile \RetryNb = 5 - \nImage = -1 + \nImage = 0 \GetImageThread = CreateThread(@GetImageThread(), *NewTile) If \GetImageThread MyDebug(" Creating get image thread nb " + Str(\GetImageThread) + " to get " + CacheFile, 3) @@ -2630,8 +2657,8 @@ CompilerIf #PB_Compiler_IsMainFile ;Our main gadget PBMap::InitPBMap(#Window_0) PBMap::SetOption("ShowDegrees", "1") : Degrees = 0 - PBMap::SetOption("ShowDebugInfos", "1") - PBMap::SetOption("Verbose", "1") + PBMap::SetOption("ShowDebugInfos", "0") + PBMap::SetOption("Verbose", "0") PBMap::SetOption("ShowScale", "1") PBMap::SetOption("Warning", "1") PBMap::SetOption("ShowMarkersLegend", "1") @@ -2774,8 +2801,8 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.60 (Windows - x64) -; CursorPosition = 1067 -; FirstLine = 1055 +; CursorPosition = 871 +; FirstLine = 858 ; Folding = ------------------- ; EnableThread ; EnableXP From 1de62dfb1698c9d76af81b63aeba6ed988bb7f75 Mon Sep 17 00:00:00 2001 From: djes Date: Fri, 9 Jun 2017 13:49:29 +0200 Subject: [PATCH 20/60] Caching mechanism enhanced + better downloading wip --- PBMap.pb | 222 +++++++++++++++++++++++++++---------------------------- 1 file changed, 110 insertions(+), 112 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index f214443..4d258e3 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -124,7 +124,7 @@ Module PBMap URL.s CacheFile.s GetImageThread.i - RetryNb.i + Download.i EndStructure Structure BoundingBox @@ -288,6 +288,7 @@ Module PBMap Redraw.i Dragging.i Dirty.i ; To signal that drawing need a refresh + MemoryCacheManagement.i ; To pause web loading threads List TracksList.Tracks() ; To display a GPX track List Markers.Marker() ; To diplay marker @@ -881,7 +882,7 @@ Module PBMap PreferenceGroup("OPTIONS") \WheelMouseRelative = ReadPreferenceInteger("WheelMouseRelative", #True) \MaxMemCache = ReadPreferenceInteger("MaxMemCache", 20480) ;20 MiB, about 80 tiles in memory - \MaxThreads = ReadPreferenceInteger("MaxThreads", 40) + \MaxThreads = ReadPreferenceInteger("MaxThreads", 10) \TileLifetime = ReadPreferenceInteger("TileLifetime", 1209600) ;about 2 weeks ; -1 = unlimited \Verbose = ReadPreferenceInteger("Verbose", #False) \Warning = ReadPreferenceInteger("Warning", #False) @@ -900,7 +901,7 @@ Module PBMap \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 + \TimerInterval = 12 ClosePreferences() EndWith SetOptions() @@ -1030,12 +1031,52 @@ Module PBMap ProcedureReturn PBMap\Layers(Name)\Alpha EndProcedure + Procedure MemoryCacheManagement() + ; If cache size exceeds limit, try to delete the oldest tiles used (first in the time stack) + Protected CacheSize = MapSize(PBMap\MemCache\Images()) * Pow(PBMap\TileSize, 2) * 5 ; 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 + PBMap\MemoryCacheManagement = #True + 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 + Protected Image = PBMap\MemCache\Images(CacheMapKey)\nImage + If PBMap\MemCache\Images(CacheMapKey)\Tile = 0 ; Check if a loading thread is not already running + MyDebug(" Delete " + CacheMapKey, 5) + If IsImage(Image) ; Check if the image is valid + FreeImage(Image) + MyDebug(" and free image nb " + Str(Image), 5) + EndIf + DeleteMapElement(PBMap\MemCache\Images(), CacheMapKey) + DeleteElement(PBMap\MemCache\ImagesTimeStack()) + Else + ; If the thread is running, try to abort the download + If PBMap\MemCache\Images(CacheMapKey)\Tile\Download + AbortHTTP(PBMap\MemCache\Images(CacheMapKey)\Tile\Download) + EndIf + EndIf + CacheSize = MapSize(PBMap\MemCache\Images()) * Pow(PBMap\TileSize, 2) * 4 ; Size of a tile = TileSize * TileSize * 4 bytes (RGBA) + Wend + PBMap\MemoryCacheManagement = #False + 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) + ProcedureReturn 0 + EndIf + EndIf + EndProcedure + ;-*** These are threaded + Threaded nImage.i, LifeTime.i, MaxLifeTime.i + Procedure.i GetTileFromHDD(CacheFile.s) - Protected nImage.i, LifeTime.i, MaxLifeTime.i = PBMap\Options\TileLifetime + MaxLifeTime.i = PBMap\Options\TileLifetime If FileSize(CacheFile) > 0 ;<> -1 - ;Manage tile file lifetime + ; Manage tile file lifetime If MaxLifeTime <> -1 LifeTime = Date() - GetFileDate(CacheFile, #PB_Date_Modified) ;There's a bug with #PB_Date_Created If LifeTime > MaxLifeTime @@ -1063,83 +1104,66 @@ Module PBMap ProcedureReturn 0 EndProcedure -; Procedure.i GetTileFromWeb(TileURL.s, CacheFile.s) -; ;Debug TileURL -; If ReceiveHTTPFile(TileURL, CacheFile, #PB_HTTP_Asynchronous) -; MyDebug(" Loaded from web " + TileURL + " as CacheFile " + CacheFile, 3) -; ; Debug TileURL + " OK" -; ProcedureReturn GetTileFromHDD(CacheFile) -; Else -; MyDebug(" Problem receving from web " + TileURL + " as CacheFile " + CacheFile, 3) -; ; Debug TileURL + " NOT OK" -; ProcedureReturn -1 -; EndIf - ; **** (OLD) 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. - ;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 - ; **** -; EndProcedure + ; **** 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 + ; **** + + Threaded Progress = 0, Size = 0 Procedure GetImageThread(*Tile.Tile) - Protected Download, Progress, Size - MyDebug("Thread starting for image " + *Tile\CacheFile + "(" + *Tile\key + ")", 3) - Download = ReceiveHTTPFile(*Tile\URL, *Tile\CacheFile, #PB_HTTP_Asynchronous) - If Download + MyDebug("Thread starting for image " + *Tile\CacheFile + "(" + *Tile\key + ")", 5) + *Tile\Download = ReceiveHTTPFile(*Tile\URL, *Tile\CacheFile, #PB_HTTP_Asynchronous) + If *Tile\Download Repeat - Progress = HTTPProgress(Download) - Select Progress - Case #PB_Http_Success - Size = FinishHTTP(Download) - MyDebug(" Thread for image " + *Tile\CacheFile + " finished. Size : " + Str(Size), 3) - PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ;To free memory outside the thread - ProcedureReturn - Case #PB_Http_Failed - MyDebug(" Thread for image " + *Tile\CacheFile + " failed.", 3) - PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ;To free memory outside the thread - ProcedureReturn - Case #PB_Http_Aborted - MyDebug(" Thread for image " + *Tile\CacheFile + " aborted.", 3) - PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ;To free memory outside the thread - ProcedureReturn - Default - MyDebug(" Thread for image " + *Tile\CacheFile + " downloading " + Str(Progress) + " bytes", 3) - EndSelect + If PBMap\MemoryCacheManagement = #False ; Wait until cache cleaning is done + Progress = HTTPProgress(*Tile\Download) + Select Progress + Case #PB_Http_Success + Size = FinishHTTP(*Tile\Download) + MyDebug(" Thread for image " + *Tile\CacheFile + " finished. Size : " + Str(Size), 5) + PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ;To free memory outside the thread + *Tile\Download = 0 + ProcedureReturn #True + Case #PB_Http_Failed + FinishHTTP(*Tile\Download) + MyDebug(" Thread for image " + *Tile\CacheFile + " failed.", 5) + PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ;To free memory outside the thread + *Tile\Download = 0 + ProcedureReturn #False + Case #PB_Http_Aborted + FinishHTTP(*Tile\Download) + MyDebug(" Thread for image " + *Tile\CacheFile + " aborted.", 5) + PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ;To free memory outside the thread + *Tile\Download = 0 + ProcedureReturn #False + Default + MyDebug(" Thread for image " + *Tile\CacheFile + " downloading " + Str(Progress) + " bytes", 5) + EndSelect + EndIf Delay(500) ; Frees CPU ForEver EndIf -; Repeat -; *Tile\nImage = GetTileFromWeb(*Tile\URL, *Tile\CacheFile) -; If *Tile\nImage <> -1 -; *Tile\RetryNb = 0 -; Else -; Delay(2000) -; *Tile\RetryNb - 1 -; EndIf -; Until *Tile\RetryNb <= 0 -; MyDebug(" Thread for image key " + *Tile\key + " finished", 3) -; *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 ;-*** @@ -1148,9 +1172,9 @@ Module PBMap ; HDD, or launch a web loading thread, and try again on the next drawing loop. Protected *timg.ImgMemCach = FindMapElement(PBMap\MemCache\Images(), key) If *timg - MyDebug("Key : " + key + " found in memory cache", 3) + MyDebug("Key : " + key + " found in memory cache", 5) If *timg\nImage - MyDebug(" as image " + *timg\nImage, 3) + MyDebug(" as image " + *timg\nImage, 5) ;*** 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) @@ -1158,36 +1182,10 @@ Module PBMap ;*timg\TimeStackPtr = LastElement(PBMap\MemCache\ImagesTimeStack()) ;*** ProcedureReturn *timg + Else + MyDebug(" but not the image.", 5) EndIf Else - ;*** Cache management - ; If cache size exceeds limit, try to delete the oldest tiles used (first in the time stack) - Protected CacheSize = MapSize(PBMap\MemCache\Images()) * Pow(PBMap\TileSize, 2) * 5 ; 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 - Protected Image = PBMap\MemCache\Images(CacheMapKey)\nImage - If PBMap\MemCache\Images(CacheMapKey)\Tile = 0 ; Check if a loading thread is not already running - If IsImage(Image) ; Check if the image is valid - FreeImage(Image) - EndIf - DeleteMapElement(PBMap\MemCache\Images(), CacheMapKey) - DeleteElement(PBMap\MemCache\ImagesTimeStack()) - MyDebug(" Delete " + CacheMapKey + " as image nb " + Str(Image), 5) - 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) - ProcedureReturn 0 - EndIf - EndIf ; Creates a new cache element *timg = AddMapElement(PBMap\MemCache\Images(), key) If *timg = 0 @@ -1228,7 +1226,6 @@ Module PBMap \key = key \URL = URL \CacheFile = CacheFile - \RetryNb = 5 \nImage = 0 \GetImageThread = CreateThread(@GetImageThread(), *NewTile) If \GetImageThread @@ -2424,6 +2421,7 @@ Module PBMap ; Redraws at regular intervals Procedure TimerEvents() If EventTimer() = PBMap\Timer And (PBMap\Redraw Or PBMap\Dirty) + MemoryCacheManagement() Drawing() EndIf EndProcedure @@ -2451,13 +2449,13 @@ Module PBMap Procedure Quit() PBMap\Drawing\End = #True + PBMap\MemoryCacheManagement = #True ; Tells web loading threads to pause ;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) @@ -2657,8 +2655,8 @@ CompilerIf #PB_Compiler_IsMainFile ;Our main gadget PBMap::InitPBMap(#Window_0) PBMap::SetOption("ShowDegrees", "1") : Degrees = 0 - PBMap::SetOption("ShowDebugInfos", "0") - PBMap::SetOption("Verbose", "0") + PBMap::SetOption("ShowDebugInfos", "1") + PBMap::SetOption("Verbose", "1") PBMap::SetOption("ShowScale", "1") PBMap::SetOption("Warning", "1") PBMap::SetOption("ShowMarkersLegend", "1") @@ -2801,8 +2799,8 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.60 (Windows - x64) -; CursorPosition = 871 -; FirstLine = 858 +; CursorPosition = 893 +; FirstLine = 894 ; Folding = ------------------- ; EnableThread ; EnableXP From 530273a93457fbfb9ca5c10dcdf81f3211bb604b Mon Sep 17 00:00:00 2001 From: djes Date: Fri, 9 Jun 2017 15:16:08 +0200 Subject: [PATCH 21/60] Added download slots and automatic download cancellation after a delay --- PBMap.pb | 560 +++++++++++++++++++++++++++++-------------------------- 1 file changed, 299 insertions(+), 261 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index 4d258e3..d2fb5a2 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -1,15 +1,15 @@ -;******************************************************************** +; ******************************************************************** ; Program: PBMap ; Description: Permits the use of tiled maps like ; OpenStreetMap in a handy PureBASIC module ; Author: Thyphoon, djes And Idle ; Date: March, 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 -;******************************************************************** +; ******************************************************************** CompilerIf #PB_Compiler_Thread = #False MessageRequester("Warning !", "You must enable ThreadSafe support in compiler options", #PB_MessageRequester_Ok ) @@ -78,9 +78,9 @@ DeclareModule PBMap 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 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() @@ -125,6 +125,7 @@ Module PBMap CacheFile.s GetImageThread.i Download.i + Time.i EndStructure Structure BoundingBox @@ -198,18 +199,19 @@ Module PBMap 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 + ; Drawing stuff StrokeWidthTrackDefault.i - ;Colours + ; Colours ColourFocus.i ColourSelected.i ColourTrackDefault.i - ;HERE specific + ; HERE specific appid.s appcode.s EndStructure @@ -223,7 +225,7 @@ Module PBMap Enabled.i Alpha.d ; 1 : opaque ; 0 : transparent format.s - ;> HERE specific params + ; > HERE specific params APP_ID.s APP_CODE.s ressource.s @@ -232,10 +234,10 @@ Module PBMap scheme.s lg.s lg2.s - ;< - ;> GeoServer specific params + ; < + ; > GeoServer specific params ServerLayerName.s - ;< + ; < EndStructure Structure Box @@ -288,8 +290,11 @@ Module PBMap Redraw.i Dragging.i Dirty.i ; To signal that drawing need a refresh - MemoryCacheManagement.i ; To pause web loading threads + MemoryCacheManagement.i ; To pause web loading threads + DownloadSlots.i ; Actual nb of used download slots + DownloadSlotsMutex.i ; To be sure that only one thread at a time can access to the DownloadSlots var + List TracksList.Tracks() ; To display a GPX track List Markers.Marker() ; To diplay marker EditMarker.l @@ -318,7 +323,7 @@ Module PBMap ;- *** GetText - Translation purpose - ;TODO use this for all text + ; TODO use this for all text IncludeFile "gettext.pbi" ;-*** Misc tools @@ -333,7 +338,7 @@ Module PBMap ;-Error management - ;Shows an error msg and terminates the program + ; Shows an error msg and terminates the program Procedure FatalError(msg.s) If PBMap\Options\Warning MessageRequester("PBMap", msg, #PB_MessageRequester_Ok) @@ -341,31 +346,31 @@ Module PBMap End EndProcedure - ;Shows an error msg + ; Shows an error msg Procedure Error(msg.s) If PBMap\Options\Warning MessageRequester("PBMap", msg, #PB_MessageRequester_Ok) EndIf EndProcedure - ;Send debug infos to stdout (allowing mixed debug infos with curl or other libs) + ; 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 PrintN(msg) - ;Debug msg + ; Debug msg EndIf EndProcedure - ;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 + ; 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_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| @@ -403,7 +408,7 @@ Module PBMap EndProcedure Procedure TechnicalImagesCreation() - ;"Loading" image + ; "Loading" image Protected LoadingText$ = "Loading" Protected NothingText$ = "Nothing" PBmap\ImgLoading = CreateImage(#PB_Any, 256, 256) @@ -421,20 +426,20 @@ 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 @@ -445,22 +450,22 @@ Module PBMap 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 @@ -473,7 +478,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 @@ -484,12 +489,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) @@ -497,7 +502,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 @@ -505,18 +510,18 @@ 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) @@ -525,7 +530,7 @@ Module PBMap 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[ + ; 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 @@ -538,19 +543,19 @@ Module PBMap ; 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 @@ -560,15 +565,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 @@ -610,24 +615,24 @@ Module PBMap EndIf EndProcedure - ;TODO : best cleaning of the string from bad behaviour + ; 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 + ; 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" + 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") + 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") + 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") + 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) @@ -651,7 +656,7 @@ Module PBMap OpenConsole() EndIf CreateDirectoryEx(\HDDCachePath) - If \DefaultOSMServer <> "" And IsLayer("OSM") = #False ;First time creation of the basis OSM layer + If \DefaultOSMServer <> "" And IsLayer("OSM") = #False ; First time creation of the basis OSM layer AddOSMServerLayer("OSM", 1, \DefaultOSMServer) EndIf EndWith @@ -687,6 +692,8 @@ Module PBMap 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" @@ -756,6 +763,8 @@ Module PBMap ProcedureReturn StrU(\MaxMemCache) Case "maxthreads" ProcedureReturn StrU(\MaxThreads) + Case "maxdownloadslots" + ProcedureReturn StrU(\MaxDownloadSlots) Case "tilelifetime" ProcedureReturn StrU(\TileLifetime) Case "verbose" @@ -794,7 +803,7 @@ Module PBMap EndWith EndProcedure - ;By default, save options in the user's home directory + ; By default, save options in the user's home directory Procedure SaveOptions(PreferencesFile.s = "PBMap.prefs") If PreferencesFile = "PBMap.prefs" CreatePreferences(GetHomeDirectory() + "PBMap.prefs") @@ -818,6 +827,7 @@ Module PBMap WritePreferenceInteger("WheelMouseRelative", \WheelMouseRelative) WritePreferenceInteger("MaxMemCache", \MaxMemCache) WritePreferenceInteger("MaxThreads", \MaxThreads) + WritePreferenceInteger("MaxDownloadSlots", \MaxDownloadSlots) WritePreferenceInteger("TileLifetime", \TileLifetime) WritePreferenceInteger("Verbose", \Verbose) WritePreferenceInteger("Warning", \Warning) @@ -832,7 +842,7 @@ Module PBMap WritePreferenceInteger("ShowMarkersLegend", \ShowMarkersLegend) PreferenceGroup("DRAWING") WritePreferenceInteger("StrokeWidthTrackDefault", \StrokeWidthTrackDefault) - ;Colours; + ; Colours; WritePreferenceInteger("ColourFocus", \ColourFocus) WritePreferenceInteger("ColourSelected", \ColourSelected) WritePreferenceInteger("ColourTrackDefault", \ColourTrackDefault) @@ -846,22 +856,22 @@ Module PBMap 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() + ; 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) @@ -869,11 +879,11 @@ Module PBMap \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 + \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 + \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/") @@ -881,9 +891,10 @@ Module PBMap \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", 10) - \TileLifetime = ReadPreferenceInteger("TileLifetime", 1209600) ;about 2 weeks ; -1 = unlimited + \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) @@ -909,7 +920,7 @@ Module PBMap ;-*** Layers - ;Add a layer to a list (to get things ordered) and to a map (to access things easily) + ; 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) @@ -943,13 +954,13 @@ Module PBMap 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) + ; 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() + With *Ptr ; PBMap\Layers() \ServerURL = ServerURL \path = path \ressource = ressource @@ -977,12 +988,12 @@ Module PBMap 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' + ; 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() + With *Ptr ; PBMap\Layers() \ServerURL = ServerURL \path = path \LayerType = 2 ; GeoServer @@ -1004,10 +1015,10 @@ Module PBMap Procedure DeleteLayer(Name.s) FindMapElement(PBMap\Layers(), Name) Protected *Ptr = PBMap\Layers() - ;Free the list element + ; Free the list element ChangeCurrentElement(PBMap\LayersList(), *Ptr) DeleteElement(PBMap\LayersList()) - ;Free the map element + ; Free the map element DeleteMapElement(PBMap\Layers()) PBMap\Redraw = #True EndProcedure @@ -1031,6 +1042,8 @@ Module PBMap ProcedureReturn PBMap\Layers(Name)\Alpha EndProcedure + ;-*** + Procedure MemoryCacheManagement() ; If cache size exceeds limit, try to delete the oldest tiles used (first in the time stack) Protected CacheSize = MapSize(PBMap\MemCache\Images()) * Pow(PBMap\TileSize, 2) * 5 ; Size of a tile = TileSize * TileSize * 4 bytes (RGBA) @@ -1075,17 +1088,17 @@ Module PBMap Procedure.i GetTileFromHDD(CacheFile.s) MaxLifeTime.i = PBMap\Options\TileLifetime - If FileSize(CacheFile) > 0 ;<> -1 + If FileSize(CacheFile) > 0 ; <> -1 ; Manage tile file lifetime If MaxLifeTime <> -1 - LifeTime = Date() - GetFileDate(CacheFile, #PB_Date_Modified) ;There's a bug with #PB_Date_Created + LifeTime = Date() - GetFileDate(CacheFile, #PB_Date_Modified) ; There's a bug with #PB_Date_Created If LifeTime > MaxLifeTime MyDebug(" Deleting too old (" + StrU(LifeTime) + " secs) " + CacheFile, 3) DeleteFile(CacheFile) ProcedureReturn 0 EndIf EndIf - ;Everything is OK, loads the file + ; Everything is OK, loads the file nImage = LoadImage(#PB_Any, CacheFile) If nImage And IsImage(nImage) MyDebug(" Success loading " + CacheFile + " as nImage " + Str(nImage), 3) @@ -1107,32 +1120,46 @@ Module PBMap ; **** 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 + ; 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 ; **** Threaded Progress = 0, Size = 0 Procedure GetImageThread(*Tile.Tile) MyDebug("Thread starting for image " + *Tile\CacheFile + "(" + *Tile\key + ")", 5) + ; Waits for a free download slot + LockMutex(PBMap\DownloadSlotsMutex) + While PBMap\DownloadSlots >= PBMap\Options\MaxDownloadSlots + UnlockMutex(PBMap\DownloadSlotsMutex) + If ElapsedMilliseconds() - *Tile\Time > 10000 + MyDebug(" Thread for image " + *Tile\CacheFile + " canceled after 10 seconds waiting for a slot.", 5) + PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ; To free memory outside the thread + ProcedureReturn #False + EndIf + Delay(500) + LockMutex(PBMap\DownloadSlotsMutex) + Wend + PBMap\DownloadSlots + 1 + UnlockMutex(PBMap\DownloadSlotsMutex) *Tile\Download = ReceiveHTTPFile(*Tile\URL, *Tile\CacheFile, #PB_HTTP_Asynchronous) If *Tile\Download Repeat @@ -1142,23 +1169,24 @@ Module PBMap Case #PB_Http_Success Size = FinishHTTP(*Tile\Download) MyDebug(" Thread for image " + *Tile\CacheFile + " finished. Size : " + Str(Size), 5) - PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ;To free memory outside the thread - *Tile\Download = 0 + PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ; To free memory outside the thread ProcedureReturn #True Case #PB_Http_Failed FinishHTTP(*Tile\Download) MyDebug(" Thread for image " + *Tile\CacheFile + " failed.", 5) - PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ;To free memory outside the thread - *Tile\Download = 0 + PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ; To free memory outside the thread ProcedureReturn #False Case #PB_Http_Aborted FinishHTTP(*Tile\Download) MyDebug(" Thread for image " + *Tile\CacheFile + " aborted.", 5) - PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ;To free memory outside the thread - *Tile\Download = 0 + PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ; To free memory outside the thread ProcedureReturn #False Default MyDebug(" Thread for image " + *Tile\CacheFile + " downloading " + Str(Progress) + " bytes", 5) + If ElapsedMilliseconds() - *Tile\Time > 60000 + MyDebug(" Thread for image " + *Tile\CacheFile + " canceled after 60 seconds.", 5) + AbortHTTP(*Tile\Download) + EndIf EndSelect EndIf Delay(500) ; Frees CPU @@ -1175,12 +1203,12 @@ Module PBMap MyDebug("Key : " + key + " found in memory cache", 5) If *timg\nImage MyDebug(" as image " + *timg\nImage, 5) - ;*** Cache management + ; *** 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()) - ;*** + ; *timg\TimeStackPtr = LastElement(PBMap\MemCache\ImagesTimeStack()) + ; *** ProcedureReturn *timg Else MyDebug(" but not the image.", 5) @@ -1204,7 +1232,7 @@ Module PBMap ; Associates the time stack element to the cache element PBMap\MemCache\ImagesTimeStack()\MapKey = MapKey(PBMap\MemCache\Images()) MyDebug("Key : " + key + " added in memory cache", 5) - ;*** + ; *** EndIf If *timg\Tile = 0 ; Checks if a loading thread is not already running ; Is the file image on HDD ? @@ -1221,12 +1249,13 @@ Module PBMap With *NewTile *timg\Tile = *NewTile ; There's now a loading thread *timg\Alpha = 0 - ;*timg\nImage = -1 - ;New tile parameters + ; *timg\nImage = -1 + ; New tile parameters \key = key \URL = URL \CacheFile = CacheFile - \nImage = 0 + \nImage = 0 + \Time = ElapsedMilliseconds() \GetImageThread = CreateThread(@GetImageThread(), *NewTile) If \GetImageThread MyDebug(" Creating get image thread nb " + Str(\GetImageThread) + " to get " + CacheFile, 3) @@ -1248,14 +1277,14 @@ Module PBMap 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 BeginVectorLayer() ForEach PBMap\TracksList() If ListSize(\Track()) > 0 - ;Check visibility + ; Check visibility \Visible = #False ForEach \Track() If IsInDrawingPixelBoundaries(*Drawing, @PBMap\TracksList()\Track()) @@ -1523,7 +1552,7 @@ Module PBMap EndIf Next If \Visible - ;Draw tracks + ; Draw tracks ForEach \Track() LatLon2PixelRel(@PBMap\TracksList()\Track(), @Pixel, PBMap\Zoom) If ListIndex(\Track()) = 0 @@ -1532,10 +1561,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 @@ -1548,14 +1577,14 @@ Module PBMap EndIf Next EndVectorLayer() - ;Draw distances + ; 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 + ; Test Distance If ListIndex(\Track()) = 0 Location\Latitude = \Track()\Latitude Location\Longitude = \Track()\Longitude @@ -1704,7 +1733,7 @@ Module PBMap 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")) @@ -1727,8 +1756,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) @@ -1755,7 +1784,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 @@ -1832,7 +1861,7 @@ Module PBMap 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 @@ -1842,10 +1871,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 @@ -1853,17 +1882,17 @@ 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. - ;Draws layers based on their number + ; Draws layers based on their number ForEach PBMap\LayersList() If PBMap\LayersList()\Enabled DrawTiles(*Drawing, PBMap\LayersList()\Name) @@ -1893,7 +1922,7 @@ Module PBMap Procedure Refresh() PBMap\Redraw = #True - ;Drawing() + ; Drawing() EndProcedure ;-*** Misc functions @@ -1901,7 +1930,7 @@ Module PBMap 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 @@ -1946,26 +1975,26 @@ Module PBMap EndProcedure 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 + ; 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) @@ -2038,7 +2067,7 @@ Module PBMap Procedure SetMapScaleUnit(ScaleUnit.i = PBMAP::#SCALE_KM) PBMap\Options\ScaleUnit = ScaleUnit PBMap\Redraw = #True - ;Drawing() + ; Drawing() EndProcedure ; User mode @@ -2054,9 +2083,9 @@ Module PBMap ProcedureReturn PBMap\Mode EndProcedure - ;Zoom on x, y pixel position from the center + ; Zoom on x, y pixel position from the center Procedure SetZoomOnPixel(x, y, zoom) - ;*** First : 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 @@ -2077,12 +2106,12 @@ Module PBMap EndIf EndProcedure - ;Zoom on x, y position relative to the canvas gadget + ; 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 @@ -2096,7 +2125,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 @@ -2131,16 +2160,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) + ; 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) @@ -2160,7 +2189,7 @@ Module PBMap EndIf If lat <> "" And lon <> "" SetZoomToArea(bbox\SouthEast\Latitude, bbox\NorthWest\Latitude, bbox\NorthWest\Longitude, bbox\SouthEast\Longitude) - ;SetLocation(Position\Latitude, Position\Longitude) + ; SetLocation(Position\Latitude, Position\Longitude) EndIf EndIf EndProcedure @@ -2193,11 +2222,11 @@ Module PBMap 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 @@ -2249,19 +2278,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 @@ -2272,37 +2301,37 @@ Module PBMap EndIf Case #PB_EventType_MouseWheel If PBMap\Options\WheelMouseRelative - ;Relative zoom (centered on the mouse) + ; 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) + ; LatLon2Pixel(@PBMap\GeographicCoordinates, @PBMap\PixelCoordinates, PBMap\Zoom) PBMap\Dragging = #True - ;Mem cursor Coord + ; 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 @@ -2313,12 +2342,12 @@ Module PBMap Case #PB_EventType_MouseMove ; Drag If PBMap\Dragging - ; If PBMap\MoveStartingPoint\x <> - 1 + ; 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 @@ -2329,14 +2358,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 @@ -2347,30 +2376,30 @@ 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 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)) - ;Simulates track drawing + ; Simulates track drawing ForEach \Track() LatLon2Pixel(@PBMap\TracksList()\Track(), @Pixel, PBMap\Zoom) If ListIndex(\Track()) = 0 @@ -2395,7 +2424,7 @@ Module PBMap EndIf EndIf Case #PB_EventType_LeftButtonUp - ; PBMap\MoveStartingPoint\x = - 1 + ; PBMap\MoveStartingPoint\x = - 1 PBMap\Dragging = #False PBMap\Redraw = #True Case #PB_MAP_REDRAW @@ -2408,7 +2437,11 @@ Module PBMap *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() + ; avoid to have threads accessing vars (and avoid some mutex), see GetImageThread() + *Tile\Download = 0 + LockMutex(PBMap\DownloadSlotsMutex) + PBMap\DownloadSlots - 1 + UnlockMutex(PBMap\DownloadSlotsMutex) Protected timg = PBMap\MemCache\Images(key)\Tile\nImage ; Get this new tile image nb PBMap\MemCache\Images(key)\nImage = timg ; Stores it in the cache using the key FreeMemory(PBMap\MemCache\Images(key)\Tile) ; Frees the data needed for the thread @@ -2421,7 +2454,7 @@ Module PBMap ; Redraws at regular intervals Procedure TimerEvents() If EventTimer() = PBMap\Timer And (PBMap\Redraw Or PBMap\Dirty) - MemoryCacheManagement() + ; MemoryCacheManagement() Drawing() EndIf EndProcedure @@ -2439,7 +2472,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) @@ -2450,14 +2483,14 @@ Module PBMap Procedure Quit() PBMap\Drawing\End = #True PBMap\MemoryCacheManagement = #True ; Tells web loading threads to pause - ;Wait for loading threads to finish nicely. Passed 2 seconds, kills them. + ; 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 + ; Should not occur KillThread(PBMap\MemCache\Images()\Tile\GetImageThread) EndIf Else @@ -2484,6 +2517,11 @@ Module PBMap PBMap\Window = Window PBMap\Timer = 1 PBMap\Mode = #MODE_DEFAULT + PBMap\DownloadSlotsMutex = CreateMutex() + If PBMap\DownloadSlotsMutex = #False + MyDebug("Cannot create a mutex", 0) + End + EndIf LoadOptions() TechnicalImagesCreation() SetLocation(0, 0) @@ -2491,11 +2529,11 @@ Module PBMap EndModule -;**************************************************************** -; +; **************************************************************** +; ;- Example of application -; -;**************************************************************** +; +; **************************************************************** CompilerIf #PB_Compiler_IsMainFile InitNetwork() @@ -2507,8 +2545,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 @@ -2532,7 +2570,7 @@ CompilerIf #PB_Compiler_IsMainFile #StringGeoLocationQuery EndEnumeration - ;Menu events + ; Menu events Enumeration #MenuEventLonLatStringEnter #MenuEventGeoLocationStringEnter @@ -2549,7 +2587,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) @@ -2580,8 +2618,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) @@ -2613,8 +2651,8 @@ CompilerIf #PB_Compiler_IsMainFile LoadFont(2, "Arial", 8) 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_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)) @@ -2639,20 +2677,20 @@ CompilerIf #PB_Compiler_IsMainFile 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 Degrees = 1 Define *Track - ;Our main gadget + ; Our main gadget PBMap::InitPBMap(#Window_0) PBMap::SetOption("ShowDegrees", "1") : Degrees = 0 PBMap::SetOption("ShowDebugInfos", "1") @@ -2673,7 +2711,7 @@ CompilerIf #PB_Compiler_IsMainFile 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 @@ -2684,12 +2722,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 @@ -2776,16 +2814,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() @@ -2799,8 +2837,8 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.60 (Windows - x64) -; CursorPosition = 893 -; FirstLine = 894 +; CursorPosition = 1162 +; FirstLine = 1143 ; Folding = ------------------- ; EnableThread ; EnableXP From bbb66d20b6330b335a99b9968addfd06d19a0ecf Mon Sep 17 00:00:00 2001 From: djes Date: Fri, 9 Jun 2017 16:08:39 +0200 Subject: [PATCH 22/60] Little bugfix --- PBMap.pb | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index d2fb5a2..5cd659d 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -1272,7 +1272,7 @@ Module PBMap MyDebug(" Error, maximum threads nb reached", 3) EndIf EndIf - ProcedureReturn *timg + ProcedureReturn 0 EndProcedure Procedure DrawTiles(*Drawing.DrawingParameters, LayerName.s) @@ -2837,8 +2837,8 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.60 (Windows - x64) -; CursorPosition = 1162 -; FirstLine = 1143 +; CursorPosition = 1241 +; FirstLine = 1233 ; Folding = ------------------- ; EnableThread ; EnableXP From 1b903ffdc6cfcb2719ea25dfb6b8943bcbecb9db Mon Sep 17 00:00:00 2001 From: djes Date: Fri, 9 Jun 2017 16:58:58 +0200 Subject: [PATCH 23/60] One more lil bugfix --- PBMap.pb | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index 5cd659d..3e1b8d8 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -1246,10 +1246,7 @@ Module PBMap If PBMap\ThreadsNB < PBMap\Options\MaxThreads Protected *NewTile.Tile = AllocateMemory(SizeOf(Tile)) If *NewTile - With *NewTile - *timg\Tile = *NewTile ; There's now a loading thread - *timg\Alpha = 0 - ; *timg\nImage = -1 + With *NewTile ; New tile parameters \key = key \URL = URL @@ -1258,6 +1255,9 @@ Module PBMap \Time = ElapsedMilliseconds() \GetImageThread = CreateThread(@GetImageThread(), *NewTile) If \GetImageThread + *timg\Tile = *NewTile ; There's now a loading thread + *timg\Alpha = 0 + ; *timg\nImage = 0 MyDebug(" Creating get image thread nb " + Str(\GetImageThread) + " to get " + CacheFile, 3) PBMap\ThreadsNB + 1 Else @@ -2837,8 +2837,8 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.60 (Windows - x64) -; CursorPosition = 1241 -; FirstLine = 1233 +; CursorPosition = 1259 +; FirstLine = 1229 ; Folding = ------------------- ; EnableThread ; EnableXP From bb405afca97b57c8d05e64d47d32a42b19aab2d7 Mon Sep 17 00:00:00 2001 From: djes Date: Mon, 12 Jun 2017 12:32:51 +0200 Subject: [PATCH 24/60] Download slots bugfix --- PBMap.pb | 42 +++++++++++++++++++++++++----------------- 1 file changed, 25 insertions(+), 17 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index 3e1b8d8..931101b 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -294,7 +294,7 @@ Module PBMap MemoryCacheManagement.i ; To pause web loading threads DownloadSlots.i ; Actual nb of used download slots DownloadSlotsMutex.i ; To be sure that only one thread at a time can access to the DownloadSlots var - + List TracksList.Tracks() ; To display a GPX track List Markers.Marker() ; To diplay marker EditMarker.l @@ -1089,13 +1089,13 @@ Module PBMap Procedure.i GetTileFromHDD(CacheFile.s) MaxLifeTime.i = PBMap\Options\TileLifetime If FileSize(CacheFile) > 0 ; <> -1 - ; Manage tile file lifetime + ; Manage tile file lifetime If MaxLifeTime <> -1 LifeTime = Date() - GetFileDate(CacheFile, #PB_Date_Modified) ; There's a bug with #PB_Date_Created If LifeTime > MaxLifeTime MyDebug(" Deleting too old (" + StrU(LifeTime) + " secs) " + CacheFile, 3) DeleteFile(CacheFile) - ProcedureReturn 0 + ProcedureReturn #False EndIf EndIf ; Everything is OK, loads the file @@ -1155,6 +1155,7 @@ Module PBMap PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ; To free memory outside the thread ProcedureReturn #False EndIf + MyDebug(" Thread for image " + *Tile\CacheFile + " waiting a download slot", 5) Delay(500) LockMutex(PBMap\DownloadSlotsMutex) Wend @@ -1169,16 +1170,25 @@ Module PBMap Case #PB_Http_Success Size = FinishHTTP(*Tile\Download) MyDebug(" Thread for image " + *Tile\CacheFile + " finished. Size : " + Str(Size), 5) + LockMutex(PBMap\DownloadSlotsMutex) + PBMap\DownloadSlots - 1 + UnlockMutex(PBMap\DownloadSlotsMutex) PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ; To free memory outside the thread ProcedureReturn #True Case #PB_Http_Failed FinishHTTP(*Tile\Download) MyDebug(" Thread for image " + *Tile\CacheFile + " failed.", 5) + LockMutex(PBMap\DownloadSlotsMutex) + PBMap\DownloadSlots - 1 + UnlockMutex(PBMap\DownloadSlotsMutex) PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ; To free memory outside the thread ProcedureReturn #False Case #PB_Http_Aborted FinishHTTP(*Tile\Download) MyDebug(" Thread for image " + *Tile\CacheFile + " aborted.", 5) + LockMutex(PBMap\DownloadSlotsMutex) + PBMap\DownloadSlots - 1 + UnlockMutex(PBMap\DownloadSlotsMutex) PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ; To free memory outside the thread ProcedureReturn #False Default @@ -1200,9 +1210,9 @@ Module PBMap ; HDD, or launch a web loading thread, and try again on the next drawing loop. Protected *timg.ImgMemCach = FindMapElement(PBMap\MemCache\Images(), key) If *timg - MyDebug("Key : " + key + " found in memory cache", 5) + MyDebug("Key : " + key + " found in memory cache", 4) If *timg\nImage - MyDebug(" as image " + *timg\nImage, 5) + 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) @@ -1211,13 +1221,13 @@ Module PBMap ; *** ProcedureReturn *timg Else - MyDebug(" but not the image.", 5) + MyDebug(" but not the image.", 4) EndIf Else ; Creates a new cache element *timg = AddMapElement(PBMap\MemCache\Images(), key) If *timg = 0 - MyDebug(" Can't add a new cache element.", 5) + MyDebug(" Can't add a new cache element.", 4) ProcedureReturn 0 EndIf ; add a new time stack element at the End @@ -1225,17 +1235,17 @@ Module PBMap ; Stores the time stack ptr *timg\TimeStackPtr = AddElement(PBMap\MemCache\ImagesTimeStack()) If *timg\TimeStackPtr = 0 - MyDebug(" Can't add a new time stack element.", 5) + MyDebug(" Can't add a new time stack element.", 4) DeleteMapElement(PBMap\MemCache\Images()) ProcedureReturn 0 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", 5) + MyDebug("Key : " + key + " added in memory cache", 4) ; *** EndIf If *timg\Tile = 0 ; Checks if a loading thread is not already running - ; Is the file image on HDD ? + ; Is the file image on HDD ? *timg\nImage = GetTileFromHDD(CacheFile.s) If *timg\nImage ; Image found and loaded from HDD @@ -2439,9 +2449,6 @@ Module PBMap ; 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 some mutex), see GetImageThread() *Tile\Download = 0 - LockMutex(PBMap\DownloadSlotsMutex) - PBMap\DownloadSlots - 1 - UnlockMutex(PBMap\DownloadSlotsMutex) Protected timg = PBMap\MemCache\Images(key)\Tile\nImage ; Get this new tile image nb PBMap\MemCache\Images(key)\nImage = timg ; Stores it in the cache using the key FreeMemory(PBMap\MemCache\Images(key)\Tile) ; Frees the data needed for the thread @@ -2483,7 +2490,7 @@ Module PBMap Procedure Quit() PBMap\Drawing\End = #True PBMap\MemoryCacheManagement = #True ; Tells web loading threads to pause - ; Wait for loading threads to finish nicely. Passed 2 seconds, kills them. + ; Wait for loading threads to finish nicely. Passed 2 seconds, kills them. Protected TimeCounter = ElapsedMilliseconds() Repeat ForEach PBMap\MemCache\Images() @@ -2837,9 +2844,10 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.60 (Windows - x64) -; CursorPosition = 1259 -; FirstLine = 1229 +; CursorPosition = 1107 +; FirstLine = 1104 ; Folding = ------------------- ; EnableThread ; EnableXP -; CompileSourceDirectory \ No newline at end of file +; CompileSourceDirectory +; Watchlist = PBMap::PBMap\DownloadSlots \ No newline at end of file From 61503c3e98a2ce5a7522bef3d41f2829c192dc63 Mon Sep 17 00:00:00 2001 From: djes Date: Mon, 12 Jun 2017 20:37:08 +0200 Subject: [PATCH 25/60] Several bugfix --- PBMap.pb | 114 ++++++++++++++++++++++++++++++++----------------------- 1 file changed, 66 insertions(+), 48 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index 931101b..d88e8aa 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -126,6 +126,7 @@ Module PBMap GetImageThread.i Download.i Time.i + Size.i EndStructure Structure BoundingBox @@ -309,7 +310,7 @@ Module PBMap ;-*** Global variables ;-Show debug infos - Global MyDebugLevel = 5 + Global MyDebugLevel = 3 Global PBMap.PBMap, Null.i, NullPtrMem.i, *NullPtr = @NullPtrMem Global slash.s @@ -1046,7 +1047,7 @@ Module PBMap Procedure MemoryCacheManagement() ; If cache size exceeds limit, try to delete the oldest tiles used (first in the time stack) - Protected CacheSize = MapSize(PBMap\MemCache\Images()) * Pow(PBMap\TileSize, 2) * 5 ; Size of a tile = TileSize * TileSize * 4 bytes (RGBA) + 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 @@ -1056,16 +1057,21 @@ Module PBMap ; 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 - Protected Image = PBMap\MemCache\Images(CacheMapKey)\nImage - If PBMap\MemCache\Images(CacheMapKey)\Tile = 0 ; Check if a loading thread is not already running + ;Protected Image = PBMap\MemCache\Images(CacheMapKey)\nImage + ; Is the loading over + If PBMap\MemCache\Images(CacheMapKey)\Tile = -1 MyDebug(" Delete " + CacheMapKey, 5) - If IsImage(Image) ; Check if the image is valid - FreeImage(Image) - MyDebug(" and free image nb " + Str(Image), 5) + If IsImage(PBMap\MemCache\Images(CacheMapKey)\nImage) + FreeImage(PBMap\MemCache\Images(CacheMapKey)\nImage) + MyDebug(" and free image nb " + Str(PBMap\MemCache\Images(CacheMapKey)\nImage), 5) EndIf DeleteMapElement(PBMap\MemCache\Images(), CacheMapKey) - DeleteElement(PBMap\MemCache\ImagesTimeStack()) - Else + 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) @@ -1077,19 +1083,17 @@ Module PBMap 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) - ProcedureReturn 0 + ProcedureReturn #False EndIf EndIf + ProcedureReturn #True EndProcedure - - ;-*** These are threaded - - Threaded nImage.i, LifeTime.i, MaxLifeTime.i - + Procedure.i GetTileFromHDD(CacheFile.s) + Protected nImage.i, LifeTime.i, MaxLifeTime.i MaxLifeTime.i = PBMap\Options\TileLifetime If FileSize(CacheFile) > 0 ; <> -1 - ; Manage tile file lifetime + ; Manage tile file lifetime If MaxLifeTime <> -1 LifeTime = Date() - GetFileDate(CacheFile, #PB_Date_Modified) ; There's a bug with #PB_Date_Created If LifeTime > MaxLifeTime @@ -1114,7 +1118,7 @@ Module PBMap Else MyDebug(" Failed loading " + CacheFile + " -> Filesize = " + FileSize(CacheFile), 3) EndIf - ProcedureReturn 0 + ProcedureReturn #False EndProcedure ; **** OLD IMPORTANT NOTICE (please not remove) @@ -1142,6 +1146,8 @@ Module PBMap ; EndIf ; **** + ;-*** These are threaded + Threaded Progress = 0, Size = 0 Procedure GetImageThread(*Tile.Tile) @@ -1164,11 +1170,11 @@ Module PBMap *Tile\Download = ReceiveHTTPFile(*Tile\URL, *Tile\CacheFile, #PB_HTTP_Asynchronous) If *Tile\Download Repeat - If PBMap\MemoryCacheManagement = #False ; Wait until cache cleaning is done + ;If PBMap\MemoryCacheManagement = #False ; Wait until cache cleaning is done Progress = HTTPProgress(*Tile\Download) Select Progress Case #PB_Http_Success - Size = FinishHTTP(*Tile\Download) + *Tile\Size = FinishHTTP(*Tile\Download) ; \Size signals that the download is OK MyDebug(" Thread for image " + *Tile\CacheFile + " finished. Size : " + Str(Size), 5) LockMutex(PBMap\DownloadSlotsMutex) PBMap\DownloadSlots - 1 @@ -1177,6 +1183,7 @@ Module PBMap ProcedureReturn #True Case #PB_Http_Failed FinishHTTP(*Tile\Download) + *Tile\Size = 0 ; \Size = 0 signals that the download has failed MyDebug(" Thread for image " + *Tile\CacheFile + " failed.", 5) LockMutex(PBMap\DownloadSlotsMutex) PBMap\DownloadSlots - 1 @@ -1185,6 +1192,7 @@ Module PBMap ProcedureReturn #False Case #PB_Http_Aborted FinishHTTP(*Tile\Download) + *Tile\Size = 0 ; \Size = 0 signals that the download has failed MyDebug(" Thread for image " + *Tile\CacheFile + " aborted.", 5) LockMutex(PBMap\DownloadSlotsMutex) PBMap\DownloadSlots - 1 @@ -1193,26 +1201,29 @@ Module PBMap ProcedureReturn #False Default MyDebug(" Thread for image " + *Tile\CacheFile + " downloading " + Str(Progress) + " bytes", 5) - If ElapsedMilliseconds() - *Tile\Time > 60000 - MyDebug(" Thread for image " + *Tile\CacheFile + " canceled after 60 seconds.", 5) + If ElapsedMilliseconds() - *Tile\Time > 10000 + MyDebug(" Thread for image " + *Tile\CacheFile + " canceled after 10 seconds.", 5) AbortHTTP(*Tile\Download) EndIf EndSelect - EndIf + ;EndIf Delay(500) ; Frees CPU ForEver EndIf EndProcedure + ;-*** Procedure.i GetTile(key.s, URL.s, CacheFile.s) - ; Try to find the tile in memory cache. If not found, add it if there's enough room in the cache, try to load the picture from the - ; HDD, or launch a web loading thread, and try again on the next drawing loop. + ; 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", 4) - If *timg\nImage + ; Is the associated image already been loaded in memory ? + If *timg\nImage And IsImage(*timg\nImage) + ; Yes, returns the image's nb MyDebug(" as image " + *timg\nImage, 4) + *timg\Tile = -1 ; *** 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) @@ -1221,14 +1232,15 @@ Module PBMap ; *** ProcedureReturn *timg Else + ; No, will load it below MyDebug(" but not the image.", 4) EndIf Else - ; Creates a new cache element + ; 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) - ProcedureReturn 0 + ProcedureReturn #False EndIf ; add a new time stack element at the End LastElement(PBMap\MemCache\ImagesTimeStack()) @@ -1237,22 +1249,27 @@ Module PBMap If *timg\TimeStackPtr = 0 MyDebug(" Can't add a new time stack element.", 4) DeleteMapElement(PBMap\MemCache\Images()) - ProcedureReturn 0 + 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 - If *timg\Tile = 0 ; Checks if a loading thread is not already running - ; Is the file image on HDD ? + ; Is this tile not loading ? + If *timg\Tile <= 0 + ; Is the file image on HDD ? *timg\nImage = GetTileFromHDD(CacheFile.s) If *timg\nImage ; Image found and loaded from HDD *timg\Alpha = 256 + *timg\Tile = -1 ProcedureReturn *timg EndIf - ; Image not found on HDD, launch a new web loading thread + EndIf + ; If there's not this tile in memory and no web loading thread + If *timg\Tile = 0 + ; Launch a new one If PBMap\ThreadsNB < PBMap\Options\MaxThreads Protected *NewTile.Tile = AllocateMemory(SizeOf(Tile)) If *NewTile @@ -1267,7 +1284,6 @@ Module PBMap If \GetImageThread *timg\Tile = *NewTile ; There's now a loading thread *timg\Alpha = 0 - ; *timg\nImage = 0 MyDebug(" Creating get image thread nb " + Str(\GetImageThread) + " to get " + CacheFile, 3) PBMap\ThreadsNB + 1 Else @@ -1282,7 +1298,7 @@ Module PBMap MyDebug(" Error, maximum threads nb reached", 3) EndIf EndIf - ProcedureReturn 0 + ProcedureReturn #False EndProcedure Procedure DrawTiles(*Drawing.DrawingParameters, LayerName.s) @@ -1362,7 +1378,7 @@ Module PBMap EndSelect EndWith *timg = GetTile(key, URL, CacheFile) - If *timg And *timg\nImage + If *timg And *timg\nImage And IsImage(*timg\nImage) MovePathCursor(px, py) If *timg\Alpha <= 224 DrawVectorImage(ImageID(*timg\nImage), *timg\Alpha * PBMap\Layers()\Alpha) @@ -1840,7 +1856,7 @@ Module PBMap 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 @@ -2438,21 +2454,23 @@ Module PBMap PBMap\Dragging = #False 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 some mutex), see GetImageThread() + ; After a Web tile loading thread, clean the tile structure memory, see GetImageThread() *Tile\Download = 0 - Protected timg = PBMap\MemCache\Images(key)\Tile\nImage ; Get this new tile image nb - PBMap\MemCache\Images(key)\nImage = timg ; Stores it in the cache using the key - FreeMemory(PBMap\MemCache\Images(key)\Tile) ; Frees the data needed for the thread - PBMap\MemCache\Images(key)\Tile = 0 ; Clears the data ptr, the web loading thread is finished + If *Tile\Size ; <> 0 + FreeMemory(PBMap\MemCache\Images(key)\Tile) ; Frees the data needed for the thread + PBMap\MemCache\Images(key)\Tile = -1 ; Clears the data ptr, and says that the web loading thread has finished successfully + Else + FreeMemory(PBMap\MemCache\Images(key)\Tile) ; Frees the data needed for the thread + PBMap\MemCache\Images(key)\Tile = 0 ; Clears the data ptr, and says that the web loading thread has finished unsuccessfully + EndIf + ;Protected timg = PBMap\MemCache\Images(key)\Tile\nImage ; Get this new tile image nb + ;PBMap\MemCache\Images(key)\nImage = timg ; Stores it in the cache using the key PBMap\ThreadsNB - 1 PBMap\Redraw = #True EndSelect @@ -2461,7 +2479,7 @@ Module PBMap ; Redraws at regular intervals Procedure TimerEvents() If EventTimer() = PBMap\Timer And (PBMap\Redraw Or PBMap\Dirty) - ; MemoryCacheManagement() + MemoryCacheManagement() Drawing() EndIf EndProcedure @@ -2490,11 +2508,11 @@ Module PBMap Procedure Quit() PBMap\Drawing\End = #True PBMap\MemoryCacheManagement = #True ; Tells web loading threads to pause - ; Wait for loading threads to finish nicely. Passed 2 seconds, kills them. + ; 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 PBMap\MemCache\Images()\Tile > 0 If IsThread(PBMap\MemCache\Images()\Tile\GetImageThread) If ElapsedMilliseconds() - TimeCounter > 2000 ; Should not occur @@ -2844,8 +2862,8 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.60 (Windows - x64) -; CursorPosition = 1107 -; FirstLine = 1104 +; CursorPosition = 1047 +; FirstLine = 1047 ; Folding = ------------------- ; EnableThread ; EnableXP From da8c3e90011f9befcd2e8203b69aa8699a64cd5b Mon Sep 17 00:00:00 2001 From: djes Date: Tue, 13 Jun 2017 21:04:59 +0200 Subject: [PATCH 26/60] semaphores test --- PBMap.pb | 138 +++++++++++++++++++++++++++++++++---------------------- 1 file changed, 83 insertions(+), 55 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index d88e8aa..4fe9cae 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -123,7 +123,7 @@ Module PBMap key.s URL.s CacheFile.s - GetImageThread.i + *GetImageThread Download.i Time.i Size.i @@ -292,7 +292,12 @@ Module PBMap Dragging.i Dirty.i ; To signal that drawing need a refresh - MemoryCacheManagement.i ; To pause web loading threads + *MemoryCacheManagementThread + ResourceAccessSemaphore.i ; To pause web loading threads + ReadCountAccessSemaphore.i + ServiceQueueSemaphore.i + ReadCount.i + DownloadSlots.i ; Actual nb of used download slots DownloadSlotsMutex.i ; To be sure that only one thread at a time can access to the DownloadSlots var @@ -1045,13 +1050,18 @@ Module PBMap ;-*** - Procedure MemoryCacheManagement() + Procedure MemoryCacheManagement(*Void) + With PBMap + WaitSemaphore(\ServiceQueueSemaphore) ;serviceQueue.P(); // wait in line to be serviced + WaitSemaphore(\ResourceAccessSemaphore) ;resourceAccess.P(); // request exclusive access to resource + SignalSemaphore(\ServiceQueueSemaphore) ;serviceQueue.V(); // let next in line be serviced + EndWith ; If cache size exceeds limit, try to delete the oldest tiles used (first in the time stack) 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 - PBMap\MemoryCacheManagement = #True + If CacheSize > CacheLimit + ;PBMap\MemoryCacheManagement = #True MyDebug(" Cache full. Trying cache cleaning", 5) ResetList(PBMap\MemCache\ImagesTimeStack()) ; Try to free half the cache memory (one pass) @@ -1061,9 +1071,10 @@ Module PBMap ; Is the loading over If PBMap\MemCache\Images(CacheMapKey)\Tile = -1 MyDebug(" Delete " + CacheMapKey, 5) - If IsImage(PBMap\MemCache\Images(CacheMapKey)\nImage) + 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) @@ -1079,14 +1090,13 @@ Module PBMap EndIf CacheSize = MapSize(PBMap\MemCache\Images()) * Pow(PBMap\TileSize, 2) * 4 ; Size of a tile = TileSize * TileSize * 4 bytes (RGBA) Wend - PBMap\MemoryCacheManagement = #False + ;PBMap\MemoryCacheManagement = #False 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) - ProcedureReturn #False EndIf EndIf - ProcedureReturn #True + SignalSemaphore(PBMap\ResourceAccessSemaphore) ; resourceAccess.V(); // release resource access for next reader/writer EndProcedure Procedure.i GetTileFromHDD(CacheFile.s) @@ -1104,7 +1114,7 @@ Module PBMap EndIf ; Everything is OK, loads the file nImage = LoadImage(#PB_Any, CacheFile) - If nImage And IsImage(nImage) + If nImage MyDebug(" Success loading " + CacheFile + " as nImage " + Str(nImage), 3) ProcedureReturn nImage Else @@ -1148,15 +1158,26 @@ Module PBMap ;-*** These are threaded - Threaded Progress = 0, Size = 0 + Threaded Progress = 0, Size = 0, Quit.i = #False Procedure GetImageThread(*Tile.Tile) + With PBMap + WaitSemaphore(\ServiceQueueSemaphore) ;serviceQueue.P(); // wait in line to be serviced + WaitSemaphore(\ReadCountAccessSemaphore) ;readCountAccess.P(); // request exclusive access to readCount + If \ReadCount = 0 ;If (readCount == 0) // If there are no readers already reading: + WaitSemaphore(\ResourceAccessSemaphore) ; resourceAccess.P(); // request resource access for readers (writers blocked) + EndIf + \ReadCount + 1 ;readCount++; // update count of active readers + SignalSemaphore(\ServiceQueueSemaphore) ;serviceQueue.V(); // let next in line be serviced + SignalSemaphore(\ReadCountAccessSemaphore) ;readCountAccess.V(); // release access to readCount + EndWith MyDebug("Thread starting for image " + *Tile\CacheFile + "(" + *Tile\key + ")", 5) ; Waits for a free download slot LockMutex(PBMap\DownloadSlotsMutex) While PBMap\DownloadSlots >= PBMap\Options\MaxDownloadSlots UnlockMutex(PBMap\DownloadSlotsMutex) If ElapsedMilliseconds() - *Tile\Time > 10000 + *Tile\Size = 0 ; \Size = 0 signals that the download has failed MyDebug(" Thread for image " + *Tile\CacheFile + " canceled after 10 seconds waiting for a slot.", 5) PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ; To free memory outside the thread ProcedureReturn #False @@ -1170,57 +1191,57 @@ Module PBMap *Tile\Download = ReceiveHTTPFile(*Tile\URL, *Tile\CacheFile, #PB_HTTP_Asynchronous) If *Tile\Download Repeat - ;If PBMap\MemoryCacheManagement = #False ; Wait until cache cleaning is done - Progress = HTTPProgress(*Tile\Download) - Select Progress - Case #PB_Http_Success - *Tile\Size = FinishHTTP(*Tile\Download) ; \Size signals that the download is OK - MyDebug(" Thread for image " + *Tile\CacheFile + " finished. Size : " + Str(Size), 5) - LockMutex(PBMap\DownloadSlotsMutex) - PBMap\DownloadSlots - 1 - UnlockMutex(PBMap\DownloadSlotsMutex) - PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ; To free memory outside the thread - ProcedureReturn #True - Case #PB_Http_Failed - FinishHTTP(*Tile\Download) - *Tile\Size = 0 ; \Size = 0 signals that the download has failed - MyDebug(" Thread for image " + *Tile\CacheFile + " failed.", 5) - LockMutex(PBMap\DownloadSlotsMutex) - PBMap\DownloadSlots - 1 - UnlockMutex(PBMap\DownloadSlotsMutex) - PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ; To free memory outside the thread - ProcedureReturn #False - Case #PB_Http_Aborted - FinishHTTP(*Tile\Download) - *Tile\Size = 0 ; \Size = 0 signals that the download has failed - MyDebug(" Thread for image " + *Tile\CacheFile + " aborted.", 5) - LockMutex(PBMap\DownloadSlotsMutex) - PBMap\DownloadSlots - 1 - UnlockMutex(PBMap\DownloadSlotsMutex) - PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ; To free memory outside the thread - ProcedureReturn #False - Default - MyDebug(" Thread for image " + *Tile\CacheFile + " downloading " + Str(Progress) + " bytes", 5) - If ElapsedMilliseconds() - *Tile\Time > 10000 - MyDebug(" Thread for image " + *Tile\CacheFile + " canceled after 10 seconds.", 5) - AbortHTTP(*Tile\Download) - EndIf - EndSelect + ;If PBMap\MemoryCacheManagement = #False ; Wait until cache cleaning is done ;TODO + Progress = HTTPProgress(*Tile\Download) + Select Progress + Case #PB_Http_Success + *Tile\Size = FinishHTTP(*Tile\Download) ; \Size signals that the download is OK + MyDebug(" Thread for image " + *Tile\CacheFile + " finished. Size : " + Str(Size), 5) + Quit = #True + Case #PB_Http_Failed + FinishHTTP(*Tile\Download) + *Tile\Size = 0 ; \Size = 0 signals that the download has failed + MyDebug(" Thread 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 for image " + *Tile\CacheFile + " aborted.", 5) + Quit = #True + Default + MyDebug(" Thread for image " + *Tile\CacheFile + " downloading " + Str(Progress) + " bytes", 5) + If ElapsedMilliseconds() - *Tile\Time > 10000 + MyDebug(" Thread for image " + *Tile\CacheFile + " canceled after 10 seconds.", 5) + AbortHTTP(*Tile\Download) + EndIf + EndSelect ;EndIf Delay(500) ; Frees CPU - ForEver + Until Quit + LockMutex(PBMap\DownloadSlotsMutex) + PBMap\DownloadSlots - 1 + UnlockMutex(PBMap\DownloadSlotsMutex) + PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ; To free memory outside the thread EndIf + With PBMap + WaitSemaphore(\ReadCountAccessSemaphore) ;readCountAccess.P(); // request exclusive access to readCount + \ReadCount - 1 ;readCount--; // update count of active readers + If \ReadCount = 0 ;If (readCount == 0) // If there are no readers left: + SignalSemaphore(\ResourceAccessSemaphore) ; resourceAccess.V(); // release resource access for all + EndIf + SignalSemaphore(\ReadCountAccessSemaphore) ;readCountAccess.V(); + EndWith EndProcedure ;-*** - Procedure.i GetTile(key.s, URL.s, CacheFile.s) + Procedure.i GetTile(key.s, URL.s, CacheFile.s) ; 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", 4) ; Is the associated image already been loaded in memory ? - If *timg\nImage And IsImage(*timg\nImage) + If *timg\nImage ; Yes, returns the image's nb MyDebug(" as image " + *timg\nImage, 4) *timg\Tile = -1 @@ -1378,7 +1399,7 @@ Module PBMap EndSelect EndWith *timg = GetTile(key, URL, CacheFile) - If *timg And *timg\nImage And IsImage(*timg\nImage) + If *timg And *timg\nImage MovePathCursor(px, py) If *timg\Alpha <= 224 DrawVectorImage(ImageID(*timg\nImage), *timg\Alpha * PBMap\Layers()\Alpha) @@ -2457,11 +2478,14 @@ Module PBMap PBMap\Redraw = #True Case #PB_MAP_RETRY PBMap\Redraw = #True + ;- Tile cleanup Case #PB_MAP_TILE_CLEANUP *Tile = EventData() key = *Tile\key ; After a Web tile loading thread, clean the tile structure memory, see GetImageThread() *Tile\Download = 0 + ;Debug key + " cleanup event" + If *Tile\Size ; <> 0 FreeMemory(PBMap\MemCache\Images(key)\Tile) ; Frees the data needed for the thread PBMap\MemCache\Images(key)\Tile = -1 ; Clears the data ptr, and says that the web loading thread has finished successfully @@ -2469,6 +2493,7 @@ Module PBMap FreeMemory(PBMap\MemCache\Images(key)\Tile) ; Frees the data needed for the thread PBMap\MemCache\Images(key)\Tile = 0 ; Clears the data ptr, and says that the web loading thread has finished unsuccessfully EndIf + ;Debug "=" + Str(PBMap\MemCache\Images(key)\Tile) ;Protected timg = PBMap\MemCache\Images(key)\Tile\nImage ; Get this new tile image nb ;PBMap\MemCache\Images(key)\nImage = timg ; Stores it in the cache using the key PBMap\ThreadsNB - 1 @@ -2479,8 +2504,8 @@ Module PBMap ; Redraws at regular intervals Procedure TimerEvents() If EventTimer() = PBMap\Timer And (PBMap\Redraw Or PBMap\Dirty) - MemoryCacheManagement() Drawing() + PBMap\MemoryCacheManagementThread = CreateThread(@MemoryCacheManagement(), Null) EndIf EndProcedure @@ -2507,7 +2532,7 @@ Module PBMap Procedure Quit() PBMap\Drawing\End = #True - PBMap\MemoryCacheManagement = #True ; Tells web loading threads to pause + ;PBMap\MemoryCacheManagement = #True ; Tells web loading threads to pause ; Wait for loading threads to finish nicely. Passed 2 seconds, kills them. Protected TimeCounter = ElapsedMilliseconds() Repeat @@ -2543,6 +2568,9 @@ Module PBMap PBMap\Timer = 1 PBMap\Mode = #MODE_DEFAULT PBMap\DownloadSlotsMutex = CreateMutex() + PBMap\ResourceAccessSemaphore = CreateSemaphore(1) + PBMap\ReadCountAccessSemaphore = CreateSemaphore(1) + PBMap\ServiceQueueSemaphore = CreateSemaphore(1) If PBMap\DownloadSlotsMutex = #False MyDebug("Cannot create a mutex", 0) End @@ -2862,8 +2890,8 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.60 (Windows - x64) -; CursorPosition = 1047 -; FirstLine = 1047 +; CursorPosition = 1231 +; FirstLine = 1151 ; Folding = ------------------- ; EnableThread ; EnableXP From 7d351f4f92d5e7576dc4f15f970d63e387625606 Mon Sep 17 00:00:00 2001 From: djes Date: Wed, 14 Jun 2017 10:39:03 +0200 Subject: [PATCH 27/60] Threads and cache cleaning now mutually excluded --- PBMap.pb | 240 ++++++++++++++++++++++++++++--------------------------- 1 file changed, 122 insertions(+), 118 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index 4fe9cae..e81b9f5 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -47,6 +47,7 @@ DeclareModule PBMap #PB_MAP_TILE_CLEANUP = #PB_EventType_FirstCustomValue + 3 Declare InitPBMap(window) + Declare SetDebugLevel(level.i) Declare SetOption(Option.s, Value.s) Declare.s GetOption(Option.s) Declare LoadOptions(PreferencesFile.s = "PBMap.prefs") @@ -123,7 +124,7 @@ Module PBMap key.s URL.s CacheFile.s - *GetImageThread + GetImageThread.i Download.i Time.i Size.i @@ -292,15 +293,12 @@ Module PBMap Dragging.i Dirty.i ; To signal that drawing need a refresh - *MemoryCacheManagementThread - ResourceAccessSemaphore.i ; To pause web loading threads - ReadCountAccessSemaphore.i - ServiceQueueSemaphore.i - ReadCount.i - + MemoryCacheAccessNB.i ; Count the access to the memory cache. =0 no access ; >0 download threads ; -1 cleaning + MemoryCacheAccessNBMutex.i ; Memorycache access variable mutual exclusion DownloadSlots.i ; Actual nb of used download slots DownloadSlotsMutex.i ; To be sure that only one thread at a time can access to the DownloadSlots var + List TracksList.Tracks() ; To display a GPX track List Markers.Marker() ; To diplay marker EditMarker.l @@ -315,7 +313,7 @@ Module PBMap ;-*** Global variables ;-Show debug infos - Global MyDebugLevel = 3 + Global MyDebugLevel = 5 Global PBMap.PBMap, Null.i, NullPtrMem.i, *NullPtr = @NullPtrMem Global slash.s @@ -358,10 +356,15 @@ Module PBMap 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 EndIf @@ -1050,60 +1053,63 @@ Module PBMap ;-*** - Procedure MemoryCacheManagement(*Void) - With PBMap - WaitSemaphore(\ServiceQueueSemaphore) ;serviceQueue.P(); // wait in line to be serviced - WaitSemaphore(\ResourceAccessSemaphore) ;resourceAccess.P(); // request exclusive access to resource - SignalSemaphore(\ServiceQueueSemaphore) ;serviceQueue.V(); // let next in line be serviced - EndWith - ; If cache size exceeds limit, try to delete the oldest tiles used (first in the time stack) - 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 - ;PBMap\MemoryCacheManagement = #True - 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 - ;Protected Image = PBMap\MemCache\Images(CacheMapKey)\nImage - ; Is the loading over - If PBMap\MemCache\Images(CacheMapKey)\Tile = -1 - 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) + Procedure MemoryCacheManagement() + ; MemoryCache access management + LockMutex(PBMap\MemoryCacheAccessNBMutex) + ; If MemoryCache is not being used by a download thread + If PBMap\MemoryCacheAccessNB = 0 + PBMap\MemoryCacheAccessNB = -1 ; Not really useful as the download thread are now blocked by the mutex, and this procedure is synchronous + UnlockMutex(PBMap\MemoryCacheAccessNBMutex) + ; If cache size exceeds limit, try to delete the oldest tiles used (first in the time stack) + 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 + ;Protected Image = PBMap\MemCache\Images(CacheMapKey)\nImage + ; Is the loading over + If PBMap\MemCache\Images(CacheMapKey)\Tile = -1 + 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) + 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 - CacheSize = MapSize(PBMap\MemCache\Images()) * Pow(PBMap\TileSize, 2) * 4 ; Size of a tile = TileSize * TileSize * 4 bytes (RGBA) - Wend - ;PBMap\MemoryCacheManagement = #False - 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 + ; We're no more accessing MemoryCache + LockMutex(PBMap\MemoryCacheAccessNBMutex) + PBMap\MemoryCacheAccessNB = 0 ; Not really useful as the download thread are now blocked EndIf - SignalSemaphore(PBMap\ResourceAccessSemaphore) ; resourceAccess.V(); // release resource access for next reader/writer + UnlockMutex(PBMap\MemoryCacheAccessNBMutex) EndProcedure - + Procedure.i GetTileFromHDD(CacheFile.s) Protected nImage.i, LifeTime.i, MaxLifeTime.i MaxLifeTime.i = PBMap\Options\TileLifetime If FileSize(CacheFile) > 0 ; <> -1 - ; Manage tile file lifetime + ; Manage tile file lifetime If MaxLifeTime <> -1 LifeTime = Date() - GetFileDate(CacheFile, #PB_Date_Modified) ; There's a bug with #PB_Date_Created If LifeTime > MaxLifeTime @@ -1156,23 +1162,13 @@ Module PBMap ; EndIf ; **** - ;-*** These are threaded + ;-*** These are threaded - Threaded Progress = 0, Size = 0, Quit.i = #False + Threaded Progress = 0, Size = 0, Quit = #False Procedure GetImageThread(*Tile.Tile) - With PBMap - WaitSemaphore(\ServiceQueueSemaphore) ;serviceQueue.P(); // wait in line to be serviced - WaitSemaphore(\ReadCountAccessSemaphore) ;readCountAccess.P(); // request exclusive access to readCount - If \ReadCount = 0 ;If (readCount == 0) // If there are no readers already reading: - WaitSemaphore(\ResourceAccessSemaphore) ; resourceAccess.P(); // request resource access for readers (writers blocked) - EndIf - \ReadCount + 1 ;readCount++; // update count of active readers - SignalSemaphore(\ServiceQueueSemaphore) ;serviceQueue.V(); // let next in line be serviced - SignalSemaphore(\ReadCountAccessSemaphore) ;readCountAccess.V(); // release access to readCount - EndWith MyDebug("Thread starting for image " + *Tile\CacheFile + "(" + *Tile\key + ")", 5) - ; Waits for a free download slot + ;*** Waits for a free download slot LockMutex(PBMap\DownloadSlotsMutex) While PBMap\DownloadSlots >= PBMap\Options\MaxDownloadSlots UnlockMutex(PBMap\DownloadSlotsMutex) @@ -1183,11 +1179,23 @@ Module PBMap ProcedureReturn #False EndIf MyDebug(" Thread for image " + *Tile\CacheFile + " waiting a download slot", 5) - Delay(500) + Delay(20) LockMutex(PBMap\DownloadSlotsMutex) Wend PBMap\DownloadSlots + 1 UnlockMutex(PBMap\DownloadSlotsMutex) + ;*** + ; MemoryCache access management + LockMutex(PBMap\MemoryCacheAccessNBMutex) + ; If MemoryCache is currently being cleaned, wait + While PBMap\MemoryCacheAccessNB = -1 + UnlockMutex(PBMap\MemoryCacheAccessNBMutex) + Delay(20) + LockMutex(PBMap\MemoryCacheAccessNBMutex) + Wend + ; We're accessing MemoryCache + PBMap\MemoryCacheAccessNB + 1 + UnlockMutex(PBMap\MemoryCacheAccessNBMutex) *Tile\Download = ReceiveHTTPFile(*Tile\URL, *Tile\CacheFile, #PB_HTTP_Asynchronous) If *Tile\Download Repeat @@ -1215,27 +1223,23 @@ Module PBMap AbortHTTP(*Tile\Download) EndIf EndSelect - ;EndIf - Delay(500) ; Frees CPU + Delay(200) ; Frees CPU Until Quit - LockMutex(PBMap\DownloadSlotsMutex) - PBMap\DownloadSlots - 1 - UnlockMutex(PBMap\DownloadSlotsMutex) - PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ; To free memory outside the thread EndIf - With PBMap - WaitSemaphore(\ReadCountAccessSemaphore) ;readCountAccess.P(); // request exclusive access to readCount - \ReadCount - 1 ;readCount--; // update count of active readers - If \ReadCount = 0 ;If (readCount == 0) // If there are no readers left: - SignalSemaphore(\ResourceAccessSemaphore) ; resourceAccess.V(); // release resource access for all - EndIf - SignalSemaphore(\ReadCountAccessSemaphore) ;readCountAccess.V(); - EndWith + ; End of the memory cache access + LockMutex(PBMap\MemoryCacheAccessNBMutex) + PBMap\MemoryCacheAccessNB - 1 + UnlockMutex(PBMap\MemoryCacheAccessNBMutex) + ; Frees a download slot + LockMutex(PBMap\DownloadSlotsMutex) + PBMap\DownloadSlots - 1 + UnlockMutex(PBMap\DownloadSlotsMutex) + 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) + Procedure.i GetTile(key.s, URL.s, CacheFile.s) ; Try to find the tile in memory cache Protected *timg.ImgMemCach = FindMapElement(PBMap\MemCache\Images(), key) If *timg @@ -2478,24 +2482,19 @@ Module PBMap PBMap\Redraw = #True Case #PB_MAP_RETRY PBMap\Redraw = #True - ;- Tile cleanup + ;- 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, see GetImageThread() + key = *Tile\key *Tile\Download = 0 - ;Debug key + " cleanup event" - If *Tile\Size ; <> 0 - FreeMemory(PBMap\MemCache\Images(key)\Tile) ; Frees the data needed for the thread + FreeMemory(*Tile) ; Frees the data needed for the thread (*tile=PBMap\MemCache\Images(key)\Tile) PBMap\MemCache\Images(key)\Tile = -1 ; Clears the data ptr, and says that the web loading thread has finished successfully Else - FreeMemory(PBMap\MemCache\Images(key)\Tile) ; Frees the data needed for the thread + FreeMemory(*Tile) ; Frees the data needed for the thread (*tile=PBMap\MemCache\Images(key)\Tile) PBMap\MemCache\Images(key)\Tile = 0 ; Clears the data ptr, and says that the web loading thread has finished unsuccessfully EndIf - ;Debug "=" + Str(PBMap\MemCache\Images(key)\Tile) - ;Protected timg = PBMap\MemCache\Images(key)\Tile\nImage ; Get this new tile image nb - ;PBMap\MemCache\Images(key)\nImage = timg ; Stores it in the cache using the key PBMap\ThreadsNB - 1 PBMap\Redraw = #True EndSelect @@ -2504,8 +2503,8 @@ Module PBMap ; Redraws at regular intervals Procedure TimerEvents() If EventTimer() = PBMap\Timer And (PBMap\Redraw Or PBMap\Dirty) + MemoryCacheManagement() Drawing() - PBMap\MemoryCacheManagementThread = CreateThread(@MemoryCacheManagement(), Null) EndIf EndProcedure @@ -2532,12 +2531,11 @@ Module PBMap Procedure Quit() PBMap\Drawing\End = #True - ;PBMap\MemoryCacheManagement = #True ; Tells web loading threads to pause ; 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 PBMap\MemCache\Images()\Tile > 0 If IsThread(PBMap\MemCache\Images()\Tile\GetImageThread) If ElapsedMilliseconds() - TimeCounter > 2000 ; Should not occur @@ -2556,25 +2554,30 @@ Module PBMap EndProcedure Procedure InitPBMap(Window) - Protected Result.i - PBMap\ZoomMin = 1 - PBMap\ZoomMax = 18 - PBMap\Dragging = #False - 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 - PBMap\DownloadSlotsMutex = CreateMutex() - PBMap\ResourceAccessSemaphore = CreateSemaphore(1) - PBMap\ReadCountAccessSemaphore = CreateSemaphore(1) - PBMap\ServiceQueueSemaphore = CreateSemaphore(1) - If PBMap\DownloadSlotsMutex = #False - MyDebug("Cannot create a mutex", 0) - End - EndIf + 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 + \DownloadSlotsMutex = CreateMutex() + If \DownloadSlotsMutex = #False + MyDebug("Cannot create a mutex", 0) + End + EndIf + \MemoryCacheAccessNB = 0 + \MemoryCacheAccessNBMutex = CreateMutex() + If \MemoryCacheAccessNBMutex = #False + MyDebug("Cannot create a mutex", 0) + End + EndIf + EndWith LoadOptions() TechnicalImagesCreation() SetLocation(0, 0) @@ -2747,7 +2750,8 @@ CompilerIf #PB_Compiler_IsMainFile PBMap::InitPBMap(#Window_0) PBMap::SetOption("ShowDegrees", "1") : Degrees = 0 PBMap::SetOption("ShowDebugInfos", "1") - PBMap::SetOption("Verbose", "1") + PBMap::SetDebugLevel(4) + PBMap::SetOption("Verbose", "0") PBMap::SetOption("ShowScale", "1") PBMap::SetOption("Warning", "1") PBMap::SetOption("ShowMarkersLegend", "1") @@ -2890,8 +2894,8 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.60 (Windows - x64) -; CursorPosition = 1231 -; FirstLine = 1151 +; CursorPosition = 2751 +; FirstLine = 2738 ; Folding = ------------------- ; EnableThread ; EnableXP From b11176a46fa06432c15c6f97b678c5ea79fd4e9a Mon Sep 17 00:00:00 2001 From: djes Date: Wed, 14 Jun 2017 10:58:48 +0200 Subject: [PATCH 28/60] Ensures that there's no loading threads while cleaning Should be changed, as the feeling is less good, memory consumption could get huge, and unuseful threads may continue instead of being stopped. --- PBMap.pb | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index e81b9f5..ddbfd0f 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -1059,7 +1059,7 @@ Module PBMap ; If MemoryCache is not being used by a download thread If PBMap\MemoryCacheAccessNB = 0 PBMap\MemoryCacheAccessNB = -1 ; Not really useful as the download thread are now blocked by the mutex, and this procedure is synchronous - UnlockMutex(PBMap\MemoryCacheAccessNBMutex) + ;UnlockMutex(PBMap\MemoryCacheAccessNBMutex) ; If cache size exceeds limit, try to delete the oldest tiles used (first in the time stack) 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 @@ -1099,7 +1099,7 @@ Module PBMap EndIf EndIf ; We're no more accessing MemoryCache - LockMutex(PBMap\MemoryCacheAccessNBMutex) + ;LockMutex(PBMap\MemoryCacheAccessNBMutex) PBMap\MemoryCacheAccessNB = 0 ; Not really useful as the download thread are now blocked EndIf UnlockMutex(PBMap\MemoryCacheAccessNBMutex) @@ -1287,7 +1287,7 @@ Module PBMap *timg\nImage = GetTileFromHDD(CacheFile.s) If *timg\nImage ; Image found and loaded from HDD - *timg\Alpha = 256 + *timg\Alpha = 0 *timg\Tile = -1 ProcedureReturn *timg EndIf @@ -2894,8 +2894,8 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.60 (Windows - x64) -; CursorPosition = 2751 -; FirstLine = 2738 +; CursorPosition = 2510 +; FirstLine = 2503 ; Folding = ------------------- ; EnableThread ; EnableXP From 55bbe10378d0a223310662422641cb78e5c8e037 Mon Sep 17 00:00:00 2001 From: djes Date: Thu, 15 Jun 2017 12:24:23 +0200 Subject: [PATCH 29/60] Better thread/download management --- PBMap.pb | 159 +++++++++++++++++++++++++++++++------------------------ 1 file changed, 89 insertions(+), 70 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index ddbfd0f..8a2805b 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -128,6 +128,7 @@ Module PBMap Download.i Time.i Size.i + Mutex.i EndStructure Structure BoundingBox @@ -155,6 +156,7 @@ Module PBMap Structure ImgMemCach nImage.i + Size.i *Tile.Tile *TimeStackPtr Alpha.i @@ -298,7 +300,6 @@ Module PBMap DownloadSlots.i ; Actual nb of used download slots DownloadSlotsMutex.i ; To be sure that only one thread at a time can access to the DownloadSlots var - List TracksList.Tracks() ; To display a GPX track List Markers.Marker() ; To diplay marker EditMarker.l @@ -1056,7 +1057,7 @@ Module PBMap Procedure MemoryCacheManagement() ; MemoryCache access management LockMutex(PBMap\MemoryCacheAccessNBMutex) - ; If MemoryCache is not being used by a download thread + ; If MemoryCache is not being used by any download thread If PBMap\MemoryCacheAccessNB = 0 PBMap\MemoryCacheAccessNB = -1 ; Not really useful as the download thread are now blocked by the mutex, and this procedure is synchronous ;UnlockMutex(PBMap\MemoryCacheAccessNBMutex) @@ -1109,7 +1110,7 @@ Module PBMap Protected nImage.i, LifeTime.i, MaxLifeTime.i MaxLifeTime.i = PBMap\Options\TileLifetime If FileSize(CacheFile) > 0 ; <> -1 - ; Manage tile file lifetime + ; Manage tile file lifetime If MaxLifeTime <> -1 LifeTime = Date() - GetFileDate(CacheFile, #PB_Date_Modified) ; There's a bug with #PB_Date_Created If LifeTime > MaxLifeTime @@ -1164,62 +1165,74 @@ Module PBMap ;-*** These are threaded - Threaded Progress = 0, Size = 0, Quit = #False + Threaded Progress = 0, Quit = #False Procedure GetImageThread(*Tile.Tile) - MyDebug("Thread starting for image " + *Tile\CacheFile + "(" + *Tile\key + ")", 5) - ;*** Waits for a free download slot + MyDebug("Thread nb " + Str(*Tile\GetImageThread) + " " + *Tile\key + " starting for image " + *Tile\CacheFile, 5) LockMutex(PBMap\DownloadSlotsMutex) - While PBMap\DownloadSlots >= PBMap\Options\MaxDownloadSlots + ; Is there's no free download slot, abort + If PBMap\DownloadSlots >= PBMap\Options\MaxDownloadSlots + MyDebug(" Thread nb " + Str(*Tile\GetImageThread) + " " + *Tile\key + " for image " + *Tile\CacheFile + " canceled because no free download slot.", 5) + *Tile\Size = 0 ; \Size = 0 signals that the download has failed UnlockMutex(PBMap\DownloadSlotsMutex) - If ElapsedMilliseconds() - *Tile\Time > 10000 - *Tile\Size = 0 ; \Size = 0 signals that the download has failed - MyDebug(" Thread for image " + *Tile\CacheFile + " canceled after 10 seconds waiting for a slot.", 5) - PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ; To free memory outside the thread - ProcedureReturn #False - EndIf - MyDebug(" Thread for image " + *Tile\CacheFile + " waiting a download slot", 5) - Delay(20) - LockMutex(PBMap\DownloadSlotsMutex) - Wend + PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ; To free memory outside the thread + ProcedureReturn + EndIf PBMap\DownloadSlots + 1 UnlockMutex(PBMap\DownloadSlotsMutex) - ;*** + ; *** Waits for a free download slot + ; LockMutex(PBMap\DownloadSlotsMutex) + ; While PBMap\DownloadSlots >= PBMap\Options\MaxDownloadSlots + ; UnlockMutex(PBMap\DownloadSlotsMutex) + ; If ElapsedMilliseconds() - *Tile\Time > 10000 + ; *Tile\Size = 0 ; \Size = 0 signals that the download has failed + ; MyDebug(" Thread for image " + *Tile\CacheFile + " canceled after 10 seconds waiting for a slot.", 5) + ; PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ; To free memory outside the thread + ; ProcedureReturn #False + ; EndIf + ; MyDebug(" Thread for image " + *Tile\CacheFile + " waiting a download slot", 5) + ; Delay(20) + ; LockMutex(PBMap\DownloadSlotsMutex) + ; Wend + ; PBMap\DownloadSlots + 1 + ; UnlockMutex(PBMap\DownloadSlotsMutex) + ; *** ; MemoryCache access management LockMutex(PBMap\MemoryCacheAccessNBMutex) - ; If MemoryCache is currently being cleaned, wait - While PBMap\MemoryCacheAccessNB = -1 + ; 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 UnlockMutex(PBMap\MemoryCacheAccessNBMutex) - Delay(20) - LockMutex(PBMap\MemoryCacheAccessNBMutex) - Wend + PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ; To free memory outside the thread + ProcedureReturn + EndIf ; We're accessing MemoryCache PBMap\MemoryCacheAccessNB + 1 UnlockMutex(PBMap\MemoryCacheAccessNBMutex) *Tile\Download = ReceiveHTTPFile(*Tile\URL, *Tile\CacheFile, #PB_HTTP_Asynchronous) If *Tile\Download Repeat - ;If PBMap\MemoryCacheManagement = #False ; Wait until cache cleaning is done ;TODO Progress = HTTPProgress(*Tile\Download) Select Progress Case #PB_Http_Success *Tile\Size = FinishHTTP(*Tile\Download) ; \Size signals that the download is OK - MyDebug(" Thread for image " + *Tile\CacheFile + " finished. Size : " + Str(Size), 5) + 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 for image " + *Tile\CacheFile + " failed.", 5) + 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 for image " + *Tile\CacheFile + " aborted.", 5) + MyDebug(" Thread nb " + Str(*Tile\GetImageThread) + " " + *Tile\key + " for image " + *Tile\CacheFile + " aborted.", 5) Quit = #True Default - MyDebug(" Thread for image " + *Tile\CacheFile + " downloading " + Str(Progress) + " bytes", 5) + MyDebug(" Thread nb " + Str(*Tile\GetImageThread) + " " + *Tile\key + " for image " + *Tile\CacheFile + " downloading " + Str(Progress) + " bytes", 5) If ElapsedMilliseconds() - *Tile\Time > 10000 - MyDebug(" Thread for image " + *Tile\CacheFile + " canceled after 10 seconds.", 5) + MyDebug(" Thread nb " + Str(*Tile\GetImageThread) + " " + *Tile\key + " for image " + *Tile\CacheFile + " canceled after 10 seconds.", 5) AbortHTTP(*Tile\Download) EndIf EndSelect @@ -1240,6 +1253,8 @@ Module PBMap ;-*** Procedure.i GetTile(key.s, URL.s, CacheFile.s) + ; MemoryCache access management + LockMutex(PBMap\MemoryCacheAccessNBMutex) ; Try to find the tile in memory cache Protected *timg.ImgMemCach = FindMapElement(PBMap\MemCache\Images(), key) If *timg @@ -1248,16 +1263,16 @@ Module PBMap If *timg\nImage ; Yes, returns the image's nb MyDebug(" as image " + *timg\nImage, 4) - *timg\Tile = -1 ; *** 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\MemoryCacheAccessNBMutex) ProcedureReturn *timg Else - ; No, will load it below + ; No, try to load it from HD (see below) MyDebug(" but not the image.", 4) EndIf Else @@ -1265,6 +1280,7 @@ Module PBMap *timg = AddMapElement(PBMap\MemCache\Images(), key) If *timg = 0 MyDebug(" Can't add a new cache element.", 4) + UnlockMutex(PBMap\MemoryCacheAccessNBMutex) ProcedureReturn #False EndIf ; add a new time stack element at the End @@ -1274,55 +1290,56 @@ Module PBMap If *timg\TimeStackPtr = 0 MyDebug(" Can't add a new time stack element.", 4) DeleteMapElement(PBMap\MemCache\Images()) + UnlockMutex(PBMap\MemoryCacheAccessNBMutex) 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 - ; Is this tile not loading ? + ; If there's no active download thread for this tile If *timg\Tile <= 0 - ; Is the file image on HDD ? + ; Try To load it from HD *timg\nImage = GetTileFromHDD(CacheFile.s) If *timg\nImage ; Image found and loaded from HDD *timg\Alpha = 0 - *timg\Tile = -1 + UnlockMutex(PBMap\MemoryCacheAccessNBMutex) ProcedureReturn *timg EndIf - EndIf - ; If there's not this tile in memory and no web loading thread - If *timg\Tile = 0 - ; Launch a new one - If PBMap\ThreadsNB < PBMap\Options\MaxThreads - 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, 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) + ; If GetTileFromHDD failed, will load it (again?) from the web (see below) + If *timg\nImage = 0 + ; Launch a new web loading thread + If PBMap\ThreadsNB < PBMap\Options\MaxThreads + 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(" Error, maximum threads nb reached", 3) EndIf - Else - MyDebug(" Error, maximum threads nb reached", 3) EndIf EndIf + UnlockMutex(PBMap\MemoryCacheAccessNBMutex) ProcedureReturn #False EndProcedure @@ -2488,12 +2505,14 @@ Module PBMap *Tile = EventData() key = *Tile\key *Tile\Download = 0 + PBMap\MemCache\Images(key)\Tile = *Tile\Size If *Tile\Size ; <> 0 + ; Web loading thread has finished successfully FreeMemory(*Tile) ; Frees the data needed for the thread (*tile=PBMap\MemCache\Images(key)\Tile) - PBMap\MemCache\Images(key)\Tile = -1 ; Clears the data ptr, and says that the web loading thread has finished successfully + PBMap\MemCache\Images(key)\Tile = -1 Else FreeMemory(*Tile) ; Frees the data needed for the thread (*tile=PBMap\MemCache\Images(key)\Tile) - PBMap\MemCache\Images(key)\Tile = 0 ; Clears the data ptr, and says that the web loading thread has finished unsuccessfully + PBMap\MemCache\Images(key)\Tile = 0 EndIf PBMap\ThreadsNB - 1 PBMap\Redraw = #True @@ -2750,8 +2769,8 @@ CompilerIf #PB_Compiler_IsMainFile PBMap::InitPBMap(#Window_0) PBMap::SetOption("ShowDegrees", "1") : Degrees = 0 PBMap::SetOption("ShowDebugInfos", "1") - PBMap::SetDebugLevel(4) - PBMap::SetOption("Verbose", "0") + PBMap::SetDebugLevel(5) + PBMap::SetOption("Verbose", "1") PBMap::SetOption("ShowScale", "1") PBMap::SetOption("Warning", "1") PBMap::SetOption("ShowMarkersLegend", "1") @@ -2894,8 +2913,8 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.60 (Windows - x64) -; CursorPosition = 2510 -; FirstLine = 2503 +; CursorPosition = 1181 +; FirstLine = 1156 ; Folding = ------------------- ; EnableThread ; EnableXP From e67076802b85db1e71da9ba4375a0b027122c8a1 Mon Sep 17 00:00:00 2001 From: djes Date: Thu, 15 Jun 2017 15:15:02 +0200 Subject: [PATCH 30/60] Latest strange image drawing bugs killed --- PBMap.pb | 254 +++++++++++++++++++++++-------------------------------- 1 file changed, 105 insertions(+), 149 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index 8a2805b..b90bf51 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -298,7 +298,6 @@ Module PBMap MemoryCacheAccessNB.i ; Count the access to the memory cache. =0 no access ; >0 download threads ; -1 cleaning MemoryCacheAccessNBMutex.i ; Memorycache access variable mutual exclusion DownloadSlots.i ; Actual nb of used download slots - DownloadSlotsMutex.i ; To be sure that only one thread at a time can access to the DownloadSlots var List TracksList.Tracks() ; To display a GPX track List Markers.Marker() ; To diplay marker @@ -1053,72 +1052,50 @@ Module PBMap EndProcedure ;-*** - + ; If cache size exceeds limit, try to delete the oldest tiles used (first in the time stack) Procedure MemoryCacheManagement() - ; MemoryCache access management - LockMutex(PBMap\MemoryCacheAccessNBMutex) - ; If MemoryCache is not being used by any download thread - If PBMap\MemoryCacheAccessNB = 0 - PBMap\MemoryCacheAccessNB = -1 ; Not really useful as the download thread are now blocked by the mutex, and this procedure is synchronous - ;UnlockMutex(PBMap\MemoryCacheAccessNBMutex) - ; If cache size exceeds limit, try to delete the oldest tiles used (first in the time stack) - 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 - ;Protected Image = PBMap\MemCache\Images(CacheMapKey)\nImage - ; Is the loading over - If PBMap\MemCache\Images(CacheMapKey)\Tile = -1 - 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) - EndIf + LockMutex(PBMap\MemoryCacheAccessNBMutex) ; 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 - 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) + 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 - ; We're no more accessing MemoryCache - ;LockMutex(PBMap\MemoryCacheAccessNBMutex) - PBMap\MemoryCacheAccessNB = 0 ; Not really useful as the download thread are now blocked EndIf UnlockMutex(PBMap\MemoryCacheAccessNBMutex) EndProcedure Procedure.i GetTileFromHDD(CacheFile.s) Protected nImage.i, LifeTime.i, MaxLifeTime.i - MaxLifeTime.i = PBMap\Options\TileLifetime - If FileSize(CacheFile) > 0 ; <> -1 - ; Manage tile file lifetime - If MaxLifeTime <> -1 - LifeTime = Date() - GetFileDate(CacheFile, #PB_Date_Modified) ; There's a bug with #PB_Date_Created - If LifeTime > MaxLifeTime - MyDebug(" Deleting too old (" + StrU(LifeTime) + " secs) " + CacheFile, 3) - DeleteFile(CacheFile) - ProcedureReturn #False - EndIf - EndIf ; Everything is OK, loads the file nImage = LoadImage(#PB_Any, CacheFile) If nImage @@ -1132,9 +1109,6 @@ Module PBMap MyDebug(" Can't delete faulty image file " + CacheFile, 3) EndIf EndIf - Else - MyDebug(" Failed loading " + CacheFile + " -> Filesize = " + FileSize(CacheFile), 3) - EndIf ProcedureReturn #False EndProcedure @@ -1167,49 +1141,21 @@ Module PBMap Threaded Progress = 0, Quit = #False - Procedure GetImageThread(*Tile.Tile) - MyDebug("Thread nb " + Str(*Tile\GetImageThread) + " " + *Tile\key + " starting for image " + *Tile\CacheFile, 5) - LockMutex(PBMap\DownloadSlotsMutex) - ; Is there's no free download slot, abort - If PBMap\DownloadSlots >= PBMap\Options\MaxDownloadSlots - MyDebug(" Thread nb " + Str(*Tile\GetImageThread) + " " + *Tile\key + " for image " + *Tile\CacheFile + " canceled because no free download slot.", 5) - *Tile\Size = 0 ; \Size = 0 signals that the download has failed - UnlockMutex(PBMap\DownloadSlotsMutex) - PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ; To free memory outside the thread - ProcedureReturn - EndIf - PBMap\DownloadSlots + 1 - UnlockMutex(PBMap\DownloadSlotsMutex) - ; *** Waits for a free download slot - ; LockMutex(PBMap\DownloadSlotsMutex) - ; While PBMap\DownloadSlots >= PBMap\Options\MaxDownloadSlots - ; UnlockMutex(PBMap\DownloadSlotsMutex) - ; If ElapsedMilliseconds() - *Tile\Time > 10000 - ; *Tile\Size = 0 ; \Size = 0 signals that the download has failed - ; MyDebug(" Thread for image " + *Tile\CacheFile + " canceled after 10 seconds waiting for a slot.", 5) - ; PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ; To free memory outside the thread - ; ProcedureReturn #False - ; EndIf - ; MyDebug(" Thread for image " + *Tile\CacheFile + " waiting a download slot", 5) - ; Delay(20) - ; LockMutex(PBMap\DownloadSlotsMutex) - ; Wend - ; PBMap\DownloadSlots + 1 - ; UnlockMutex(PBMap\DownloadSlotsMutex) - ; *** - ; MemoryCache access management + Procedure GetImageThread(*Tile.Tile) LockMutex(PBMap\MemoryCacheAccessNBMutex) + 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 - UnlockMutex(PBMap\MemoryCacheAccessNBMutex) - PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ; To free memory outside the thread - ProcedureReturn - EndIf +; 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\MemoryCacheAccessNBMutex) +; ProcedureReturn +; EndIf ; We're accessing MemoryCache PBMap\MemoryCacheAccessNB + 1 UnlockMutex(PBMap\MemoryCacheAccessNBMutex) + *Tile\Size = 0 *Tile\Download = ReceiveHTTPFile(*Tile\URL, *Tile\CacheFile, #PB_HTTP_Asynchronous) If *Tile\Download Repeat @@ -1242,12 +1188,8 @@ Module PBMap ; End of the memory cache access LockMutex(PBMap\MemoryCacheAccessNBMutex) PBMap\MemoryCacheAccessNB - 1 - UnlockMutex(PBMap\MemoryCacheAccessNBMutex) - ; Frees a download slot - LockMutex(PBMap\DownloadSlotsMutex) - PBMap\DownloadSlots - 1 - UnlockMutex(PBMap\DownloadSlotsMutex) PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ; To free memory outside the thread + UnlockMutex(PBMap\MemoryCacheAccessNBMutex) EndProcedure ;-*** @@ -1298,41 +1240,58 @@ Module PBMap MyDebug("Key : " + key + " added in memory cache", 4) EndIf ; If there's no active download thread for this tile - If *timg\Tile <= 0 - ; Try To load it from HD - *timg\nImage = GetTileFromHDD(CacheFile.s) + If *timg\Tile <= 0 + ; Manage tile file lifetime, delete if too old + If PBMap\Options\TileLifetime <> -1 + If Date() - GetFileDate(CacheFile, #PB_Date_Modified) > PBMap\Options\TileLifetime ; If Lifetime > MaxLifeTime ; There's a bug with #PB_Date_Created + MyDebug(" Deleting too old " + CacheFile, 3) + DeleteFile(CacheFile) + 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\MemoryCacheAccessNBMutex) ProcedureReturn *timg - EndIf - ; If GetTileFromHDD failed, will load it (again?) from the web (see below) - If *timg\nImage = 0 - ; Launch a new web loading thread - If PBMap\ThreadsNB < PBMap\Options\MaxThreads - 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) + 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) @@ -2505,16 +2464,18 @@ Module PBMap *Tile = EventData() key = *Tile\key *Tile\Download = 0 - PBMap\MemCache\Images(key)\Tile = *Tile\Size - If *Tile\Size ; <> 0 - ; Web loading thread has finished successfully - FreeMemory(*Tile) ; Frees the data needed for the thread (*tile=PBMap\MemCache\Images(key)\Tile) - PBMap\MemCache\Images(key)\Tile = -1 - Else - FreeMemory(*Tile) ; Frees the data needed for the thread (*tile=PBMap\MemCache\Images(key)\Tile) - PBMap\MemCache\Images(key)\Tile = 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 @@ -2585,11 +2546,6 @@ Module PBMap \Window = Window \Timer = 1 \Mode = #MODE_DEFAULT - \DownloadSlotsMutex = CreateMutex() - If \DownloadSlotsMutex = #False - MyDebug("Cannot create a mutex", 0) - End - EndIf \MemoryCacheAccessNB = 0 \MemoryCacheAccessNBMutex = CreateMutex() If \MemoryCacheAccessNBMutex = #False @@ -2913,10 +2869,10 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.60 (Windows - x64) -; CursorPosition = 1181 -; FirstLine = 1156 +; CursorPosition = 1066 +; FirstLine = 1384 ; Folding = ------------------- ; EnableThread ; EnableXP ; CompileSourceDirectory -; Watchlist = PBMap::PBMap\DownloadSlots \ No newline at end of file +; DisablePurifier = 1,1,1,1 \ No newline at end of file From d3e277937ebdd1f8c3b4fb3d1cbeb614dc3494de Mon Sep 17 00:00:00 2001 From: djes Date: Thu, 15 Jun 2017 15:30:19 +0200 Subject: [PATCH 31/60] Old files cleaning bug fixed --- PBMap.pb | 55 +++++++++++++++++++++++++++++-------------------------- 1 file changed, 29 insertions(+), 26 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index b90bf51..89a8d16 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -295,8 +295,7 @@ Module PBMap Dragging.i Dirty.i ; To signal that drawing need a refresh - MemoryCacheAccessNB.i ; Count the access to the memory cache. =0 no access ; >0 download threads ; -1 cleaning - MemoryCacheAccessNBMutex.i ; Memorycache access variable mutual exclusion + MemoryCacheAccessMutex.i ; Memorycache access variable mutual exclusion DownloadSlots.i ; Actual nb of used download slots List TracksList.Tracks() ; To display a GPX track @@ -1054,7 +1053,7 @@ Module PBMap ;-*** ; If cache size exceeds limit, try to delete the oldest tiles used (first in the time stack) Procedure MemoryCacheManagement() - LockMutex(PBMap\MemoryCacheAccessNBMutex) ; Prevents thread to start or finish + 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) @@ -1091,7 +1090,7 @@ Module PBMap MyDebug(" Cache cleaning unsuccessfull, can't add new tiles.", 5) EndIf EndIf - UnlockMutex(PBMap\MemoryCacheAccessNBMutex) + UnlockMutex(PBMap\MemoryCacheAccessMutex) EndProcedure Procedure.i GetTileFromHDD(CacheFile.s) @@ -1142,19 +1141,18 @@ Module PBMap Threaded Progress = 0, Quit = #False Procedure GetImageThread(*Tile.Tile) - LockMutex(PBMap\MemoryCacheAccessNBMutex) + 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\MemoryCacheAccessNBMutex) +; UnlockMutex(PBMap\MemoryCacheAccessMutex) ; ProcedureReturn ; EndIf ; We're accessing MemoryCache - PBMap\MemoryCacheAccessNB + 1 - UnlockMutex(PBMap\MemoryCacheAccessNBMutex) + UnlockMutex(PBMap\MemoryCacheAccessMutex) *Tile\Size = 0 *Tile\Download = ReceiveHTTPFile(*Tile\URL, *Tile\CacheFile, #PB_HTTP_Asynchronous) If *Tile\Download @@ -1186,17 +1184,16 @@ Module PBMap Until Quit EndIf ; End of the memory cache access - LockMutex(PBMap\MemoryCacheAccessNBMutex) - PBMap\MemoryCacheAccessNB - 1 + LockMutex(PBMap\MemoryCacheAccessMutex) PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ; To free memory outside the thread - UnlockMutex(PBMap\MemoryCacheAccessNBMutex) + UnlockMutex(PBMap\MemoryCacheAccessMutex) EndProcedure ;-*** Procedure.i GetTile(key.s, URL.s, CacheFile.s) ; MemoryCache access management - LockMutex(PBMap\MemoryCacheAccessNBMutex) + LockMutex(PBMap\MemoryCacheAccessMutex) ; Try to find the tile in memory cache Protected *timg.ImgMemCach = FindMapElement(PBMap\MemCache\Images(), key) If *timg @@ -1211,7 +1208,7 @@ Module PBMap MoveElement(PBMap\MemCache\ImagesTimeStack(), #PB_List_Last) ; *timg\TimeStackPtr = LastElement(PBMap\MemCache\ImagesTimeStack()) ; *** - UnlockMutex(PBMap\MemoryCacheAccessNBMutex) + UnlockMutex(PBMap\MemoryCacheAccessMutex) ProcedureReturn *timg Else ; No, try to load it from HD (see below) @@ -1222,7 +1219,7 @@ Module PBMap *timg = AddMapElement(PBMap\MemCache\Images(), key) If *timg = 0 MyDebug(" Can't add a new cache element.", 4) - UnlockMutex(PBMap\MemoryCacheAccessNBMutex) + UnlockMutex(PBMap\MemoryCacheAccessMutex) ProcedureReturn #False EndIf ; add a new time stack element at the End @@ -1232,7 +1229,7 @@ Module PBMap If *timg\TimeStackPtr = 0 MyDebug(" Can't add a new time stack element.", 4) DeleteMapElement(PBMap\MemCache\Images()) - UnlockMutex(PBMap\MemoryCacheAccessNBMutex) + UnlockMutex(PBMap\MemoryCacheAccessMutex) ProcedureReturn #False EndIf ; Associates the time stack element to the cache element @@ -1242,10 +1239,17 @@ Module PBMap ; 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 Date() - GetFileDate(CacheFile, #PB_Date_Modified) > PBMap\Options\TileLifetime ; If Lifetime > MaxLifeTime ; There's a bug with #PB_Date_Created - MyDebug(" Deleting too old " + CacheFile, 3) - DeleteFile(CacheFile) + 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 @@ -1259,7 +1263,7 @@ Module PBMap If *timg\nImage ; Image found and loaded from HDD *timg\Alpha = 0 - UnlockMutex(PBMap\MemoryCacheAccessNBMutex) + UnlockMutex(PBMap\MemoryCacheAccessMutex) ProcedureReturn *timg Else ; If GetTileFromHDD failed, will load it (again?) from the web @@ -1298,7 +1302,7 @@ Module PBMap EndIf EndIf EndIf - UnlockMutex(PBMap\MemoryCacheAccessNBMutex) + UnlockMutex(PBMap\MemoryCacheAccessMutex) ProcedureReturn #False EndProcedure @@ -2546,9 +2550,8 @@ Module PBMap \Window = Window \Timer = 1 \Mode = #MODE_DEFAULT - \MemoryCacheAccessNB = 0 - \MemoryCacheAccessNBMutex = CreateMutex() - If \MemoryCacheAccessNBMutex = #False + \MemoryCacheAccessMutex = CreateMutex() + If \MemoryCacheAccessMutex = #False MyDebug("Cannot create a mutex", 0) End EndIf @@ -2869,8 +2872,8 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.60 (Windows - x64) -; CursorPosition = 1066 -; FirstLine = 1384 +; CursorPosition = 2552 +; FirstLine = 2548 ; Folding = ------------------- ; EnableThread ; EnableXP From 4183dcd59bdb9ada7ea66f503cc74e94a1c8b0c1 Mon Sep 17 00:00:00 2001 From: djes Date: Thu, 15 Jun 2017 15:32:33 +0200 Subject: [PATCH 32/60] Create README.md --- README.md | 1 + 1 file changed, 1 insertion(+) diff --git a/README.md b/README.md index a86b00e..32d63bb 100644 --- a/README.md +++ b/README.md @@ -17,3 +17,4 @@ Thyphoon djes Idle Progi1984 +yves86 From 552763d346877d63cb95c8565eace46e043fafe9 Mon Sep 17 00:00:00 2001 From: djes Date: Thu, 15 Jun 2017 17:08:14 +0200 Subject: [PATCH 33/60] (djes) implemented the new functions by Yves86 --- PBMap.pb | 84 ++++++++++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 76 insertions(+), 8 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index 89a8d16..b9135f2 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -96,6 +96,9 @@ DeclareModule PBMap Declare Error(msg.s) Declare Refresh() Declare.i ClearDiskCache() + Declare SetCallBackMarker(*CallBackLocation) + Declare SetCallBackLeftClic(*CallBackLocation) + EndDeclareModule Module PBMap @@ -128,7 +131,6 @@ Module PBMap Download.i Time.i Size.i - Mutex.i EndStructure Structure BoundingBox @@ -193,7 +195,8 @@ Module PBMap ProxyPort.s ProxyUser.s ProxyPassword.s - ShowDegrees.i + ShowDegrees.i + ShowZoom.i ShowDebugInfos.i ShowScale.i ShowTrack.i @@ -209,6 +212,7 @@ Module PBMap Warning.i ; Warning requesters ShowMarkersNb.i ShowMarkersLegend.i + ShowTrackSelection.i ; YA to show or not track selection ; Drawing stuff StrokeWidthTrackDefault.i ; Colours @@ -273,6 +277,8 @@ 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 @@ -712,6 +718,8 @@ Module PBMap SelBool(WheelMouseRelative) Case "showdegrees" SelBool(ShowDegrees) + Case "showzoom" + SelBool(ShowZoom) Case "showdebuginfos" SelBool(ShowDebugInfos) Case "showscale" @@ -722,6 +730,8 @@ Module PBMap SelBool(ShowPointer) Case "showtrack" SelBool(ShowTrack) + Case "showtrackselection" + SelBool(ShowTrackSelection) Case "showmarkersnb" SelBool(ShowMarkersNb) Case "showmarkerslegend" @@ -787,12 +797,16 @@ Module PBMap 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" @@ -842,9 +856,11 @@ Module PBMap 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) @@ -908,9 +924,11 @@ Module PBMap \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) @@ -1495,6 +1513,12 @@ 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) @@ -1604,11 +1628,20 @@ 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 EndVectorLayer() - ; Draw distances + ;Draw distances If PBMap\Options\ShowTrackKms And PBMap\Zoom > 10 BeginVectorLayer() ForEach PBMap\TracksList() @@ -1947,6 +1980,9 @@ 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 @@ -2095,6 +2131,14 @@ 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 @@ -2250,6 +2294,7 @@ Module PBMap Protected key.s, Touch.i Protected Pixel.PixelCoordinates Static CtrlKey + 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 @@ -2370,6 +2415,18 @@ 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 ; Drag If PBMap\Dragging @@ -2423,6 +2480,7 @@ Module PBMap EndIf Next ; Check if mouse touch tracks + If PBMap\Options\ShowTrackSelection ; YA ajout pour éviter la sélection de la trace With PBMap\TracksList() ; Trace Track If ListSize(PBMap\TracksList()) > 0 @@ -2454,10 +2512,20 @@ Module PBMap EndWith EndIf EndIf + EndIf Case #PB_EventType_LeftButtonUp + 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) + EndIf + EndIf + Next Case #PB_MAP_REDRAW PBMap\Redraw = #True Case #PB_MAP_RETRY @@ -2727,9 +2795,9 @@ CompilerIf #PB_Compiler_IsMainFile ; Our main gadget PBMap::InitPBMap(#Window_0) PBMap::SetOption("ShowDegrees", "1") : Degrees = 0 - PBMap::SetOption("ShowDebugInfos", "1") + PBMap::SetOption("ShowDebugInfos", "0") PBMap::SetDebugLevel(5) - PBMap::SetOption("Verbose", "1") + PBMap::SetOption("Verbose", "0") PBMap::SetOption("ShowScale", "1") PBMap::SetOption("Warning", "1") PBMap::SetOption("ShowMarkersLegend", "1") @@ -2872,9 +2940,9 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.60 (Windows - x64) -; CursorPosition = 2552 -; FirstLine = 2548 -; Folding = ------------------- +; CursorPosition = 2797 +; FirstLine = 2794 +; Folding = -------------------- ; EnableThread ; EnableXP ; CompileSourceDirectory From 596733f49bc36df23ea30c10099b009a9e056193 Mon Sep 17 00:00:00 2001 From: djes Date: Thu, 15 Jun 2017 17:19:59 +0200 Subject: [PATCH 34/60] Header slight modifications --- PBMap.pb | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index b9135f2..8ac5f4b 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -2,13 +2,13 @@ ; 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 ; Note: Please share improvement ! -; Thanks: Progi1984, yves86 +; Thanks: Progi1984 ; ******************************************************************** CompilerIf #PB_Compiler_Thread = #False @@ -1910,7 +1910,7 @@ Module PBMap 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) @@ -2415,14 +2415,14 @@ Module PBMap EndIf Next EndIf - ; YA pour sélectionner un point de la trace avec le clic gauche + ; 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 + ; 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 @@ -2480,7 +2480,7 @@ Module PBMap EndIf Next ; Check if mouse touch tracks - If PBMap\Options\ShowTrackSelection ; YA ajout pour éviter la sélection de la trace + If PBMap\Options\ShowTrackSelection ; YA ajout pour éviter la sélection de la trace With PBMap\TracksList() ; Trace Track If ListSize(PBMap\TracksList()) > 0 @@ -2518,7 +2518,7 @@ Module PBMap ; PBMap\MoveStartingPoint\x = - 1 PBMap\Dragging = #False PBMap\Redraw = #True - ;YA pour connaitre les coordonnées d'un marqueur après déplacement + ;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 @@ -2946,4 +2946,4 @@ CompilerEndIf ; EnableThread ; EnableXP ; CompileSourceDirectory -; DisablePurifier = 1,1,1,1 \ No newline at end of file +; DisablePurifier = 1,1,1,1 From 95d78f0590078b8db8bedf7e523430aed57db0dc Mon Sep 17 00:00:00 2001 From: djes Date: Thu, 15 Jun 2017 17:21:52 +0200 Subject: [PATCH 35/60] Header --- PBMap.pb | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index b9135f2..aa6ac2b 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -2,13 +2,13 @@ ; 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 ; Note: Please share improvement ! -; Thanks: Progi1984, yves86 +; Thanks: Progi1984 ; ******************************************************************** CompilerIf #PB_Compiler_Thread = #False @@ -2940,8 +2940,7 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.60 (Windows - x64) -; CursorPosition = 2797 -; FirstLine = 2794 +; CursorPosition = 16 ; Folding = -------------------- ; EnableThread ; EnableXP From eb8e73a245ab5ff75a396b373d548dd1d2ac3f0c Mon Sep 17 00:00:00 2001 From: djes Date: Mon, 3 Jul 2017 12:32:00 +0200 Subject: [PATCH 36/60] Updating from yves86 branch --- PBMap.pb | 45 +++++++++++++++++++++++++++------------------ 1 file changed, 27 insertions(+), 18 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index aa6ac2b..897b2ff 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -269,7 +269,8 @@ Module PBMap Structure PBMap Window.i ; Parent Window Gadget.i ; Canvas Gadget Id - Font.i ; Font to uses when write on the map + StandardFont.i ; Font to use when writing on the map + UnderlineFont.i Timer.i ; Redraw/update timer GeographicCoordinates.GeographicCoordinates ; Latitude and Longitude from focus point @@ -433,7 +434,7 @@ Module PBMap AddPathBox(0, 0, 256, 256) FillPath() MovePathCursor(0, 0) - VectorFont(FontID(PBMap\Font), 256 / 20) + VectorFont(FontID(PBMap\StandardFont), 256 / 20) VectorSourceColor(RGBA(150, 150, 150, 255)) MovePathCursor(0 + (256 - VectorTextWidth(LoadingText$)) / 2, 0 + (256 - VectorTextHeight(LoadingText$)) / 2) DrawVectorText(LoadingText$) @@ -449,7 +450,7 @@ Module PBMap AddPathBox(0, 0, 256, 256) FillPath() ; MovePathCursor(0, 0) - ; VectorFont(FontID(PBMap\Font), 256 / 20) + ; VectorFont(FontID(PBMap\StandardFont), 256 / 20) ; VectorSourceColor(RGBA(150, 150, 150, 255)) ; MovePathCursor(0 + (256 - VectorTextWidth(NothingText$)) / 2, 0 + (256 - VectorTextHeight(NothingText$)) / 2) ; DrawVectorText(NothingText$) @@ -1422,7 +1423,7 @@ Module PBMap ; EndIf EndIf If PBMap\Options\ShowDebugInfos - VectorFont(FontID(PBMap\Font), 16) + VectorFont(FontID(PBMap\StandardFont), 16) VectorSourceColor(RGBA(0, 0, 0, 80)) MovePathCursor(px, py) DrawVectorText("x:" + Str(tilex)) @@ -1460,7 +1461,7 @@ Module PBMap Case #SCALE_KM; sunit = " Km" EndSelect - VectorFont(FontID(PBMap\Font), 10) + VectorFont(FontID(PBMap\StandardFont), 10) VectorSourceColor(RGBA(0, 0, 0, alpha)) MovePathCursor(x,y) DrawVectorText(StrD(Scale,3)+sunit) @@ -1486,7 +1487,7 @@ Module PBMap ; Debug "NW : " + StrD(Degrees1\Longitude) + " ; NE : " + StrD(Degrees2\Longitude) LatLon2PixelRel(@Degrees1, @pos1, PBMap\Zoom) LatLon2PixelRel(@Degrees2, @pos2, PBMap\Zoom) - VectorFont(FontID(PBMap\Font), 10) + VectorFont(FontID(PBMap\StandardFont), 10) VectorSourceColor(RGBA(0, 0, 0, alpha)) ; draw latitudes For y = ny1 To ny @@ -1514,7 +1515,7 @@ Module PBMap EndProcedure Procedure DrawZoom(x.i, y.i) - VectorFont(FontID(PBMap\Font), 20) + VectorFont(FontID(PBMap\StandardFont), 20) VectorSourceColor(RGBA(0, 0, 0,150)) MovePathCursor(x,y) DrawVectorText(Str(GetZoom())) @@ -1534,7 +1535,7 @@ Module PBMap VectorSourceColor(RGBA(255, 255, 255, 255)) AddPathCircle(x,y-20,12) FillPath() - VectorFont(FontID(PBMap\Font), 13) + VectorFont(FontID(PBMap\StandardFont), 13) MovePathCursor(x-VectorTextWidth(Str(dist))/2, y-20-VectorTextHeight(Str(dist))/2) VectorSourceColor(RGBA(0, 0, 0, 255)) DrawVectorText(Str(dist)) @@ -1553,7 +1554,7 @@ Module PBMap VectorSourceColor(RGBA(255, 0, 0, 255)) AddPathCircle(x,y-24,14) FillPath() - VectorFont(FontID(PBMap\Font), 14) + VectorFont(FontID(PBMap\StandardFont), 14) MovePathCursor(x-VectorTextWidth(Str(dist))/2, y-24-VectorTextHeight(Str(dist))/2) VectorSourceColor(RGBA(0, 0, 0, 255)) DrawVectorText(Str(dist)) @@ -1841,13 +1842,13 @@ Module PBMap Else Text.s = *Marker\Identifier EndIf - VectorFont(FontID(PBMap\Font), 13) + VectorFont(FontID(PBMap\StandardFont), 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) + VectorFont(FontID(PBMap\StandardFont), 13) ; dessin d'un cadre avec fond transparent Protected Height = VectorParagraphHeight(*Marker\Legend, 100, 100) Protected Width.l @@ -1887,7 +1888,7 @@ Module PBMap Procedure DrawDebugInfos(*Drawing.DrawingParameters) ; Display how many images in cache - VectorFont(FontID(PBMap\Font), 16) + VectorFont(FontID(PBMap\StandardFont), 16) VectorSourceColor(RGBA(0, 0, 0, 80)) MovePathCursor(50, 50) DrawVectorText("Images in cache : " + Str(MapSize(PBMap\MemCache\Images()))) @@ -1911,7 +1912,7 @@ Module PBMap Procedure DrawOSMCopyright(*Drawing.DrawingParameters) Protected Text.s = "© OpenStreetMap contributors" - VectorFont(FontID(PBMap\Font), 12) + VectorFont(FontID(PBMap\StandardFont), 12) VectorSourceColor(RGBA(0, 0, 0, 80)) MovePathCursor(GadgetWidth(PBMAP\Gadget) - VectorTextWidth(Text), GadgetHeight(PBMAP\Gadget) - 20) DrawVectorText(Text) @@ -1923,6 +1924,7 @@ Module PBMap Protected Px.d, Py.d,a, ts = PBMap\TileSize, nx, ny Protected LayerOrder.i = 0 Protected NW.Coordinates, SE.Coordinates + Protected OSMCopyright.i = #False PBMap\Dirty = #False PBMap\Redraw = #False ; *** Precalc some values @@ -1961,6 +1963,9 @@ Module PBMap If PBMap\LayersList()\Enabled DrawTiles(*Drawing, PBMap\LayersList()\Name) EndIf + If PBMap\LayersList()\LayerType = 0 ; OSM + OSMCopyright = #True + EndIf Next If PBMap\Options\ShowTrack DrawTracks(*Drawing) @@ -1983,7 +1988,9 @@ Module PBMap If PBMap\Options\ShowZoom DrawZoom(GadgetWidth(PBMap\Gadget) - 30, 5) ; ajout YA - affiche le niveau de zoom EndIf - DrawOSMCopyright(*Drawing) + If OSMCopyright + DrawOSMCopyright(*Drawing) + EndIf StopVectorDrawing() EndProcedure @@ -2423,9 +2430,9 @@ Module PBMap 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) + 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 + SetGadgetAttribute(PBMap\Gadget, #PB_Canvas_Cursor, #PB_Cursor_Default) ; ajout YA pour remettre le pointeur souris en normal EndIf Case #PB_EventType_MouseMove ; Drag @@ -2614,7 +2621,8 @@ Module PBMap \TileSize = 256 \Dirty = #False \EditMarker = #False - \Font = LoadFont(#PB_Any, "Arial", 20, #PB_Font_Bold) + \StandardFont = LoadFont(#PB_Any, "Arial", 20, #PB_Font_Bold) + \UnderlineFont = LoadFont(#PB_Any, "Arial", 20, #PB_Font_Underline) \Window = Window \Timer = 1 \Mode = #MODE_DEFAULT @@ -2940,7 +2948,8 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.60 (Windows - x64) -; CursorPosition = 16 +; CursorPosition = 2456 +; FirstLine = 2435 ; Folding = -------------------- ; EnableThread ; EnableXP From e87435c892b0eb6974761855974803ba446b43d8 Mon Sep 17 00:00:00 2001 From: djes Date: Tue, 4 Jul 2017 08:52:01 +0200 Subject: [PATCH 37/60] Cache file delete if size = 0 --- PBMap.pb | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index 897b2ff..caad5e8 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -1256,15 +1256,18 @@ Module PBMap MyDebug("Key : " + key + " added in memory cache", 4) EndIf ; If there's no active download thread for this tile - If *timg\Tile <= 0 - ; Manage tile file lifetime, delete if too old + If *timg\Tile <= 0 + *timg\nImage = 0 + *timg\Size = FileSize(CacheFile) + ; Manage tile file lifetime, delete if too old, or if size = 0 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 *timg\Size >= 0 ; Does the file exists ? + If *timg\Size = 0 Or (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) + MyDebug(" Deleting image file " + CacheFile, 3) + *timg\Size = 0 Else - MyDebug(" Can't delete too old image file " + CacheFile, 3) + MyDebug(" Can't delete image file " + CacheFile, 3) UnlockMutex(PBMap\MemoryCacheAccessMutex) ProcedureReturn #False EndIf @@ -1272,8 +1275,6 @@ Module PBMap 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 @@ -2948,8 +2949,8 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.60 (Windows - x64) -; CursorPosition = 2456 -; FirstLine = 2435 +; CursorPosition = 1404 +; FirstLine = 1249 ; Folding = -------------------- ; EnableThread ; EnableXP From afc271278a6375ee8fafe62ad4c01781844833cf Mon Sep 17 00:00:00 2001 From: djes Date: Tue, 4 Jul 2017 12:20:07 +0200 Subject: [PATCH 38/60] CallBackDrawTile + misc cleaning + useragent Allows a customised tile drawing --- PBMap.pb | 138 +++++++++++++++++++++++++++++++++---------------------- 1 file changed, 84 insertions(+), 54 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index 92330a1..a07fcde 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -28,6 +28,10 @@ UseJPEGImageEncoder() DeclareModule PBMap + #PBMAPNAME = "PBMap" + #PBMAPVERSION = "0.9" + #USERAGENT = #PBMAPNAME + "/" + #PBMAPVERSION + " (https://github.com/djes/PBMap)" + CompilerIf #PB_Compiler_OS = #PB_OS_Linux #Red = 255 CompilerEndIf @@ -81,7 +85,10 @@ DeclareModule PBMap Declare.d GetLayerAlpha(Name.s) Declare BindMapGadget(Gadget.i) Declare SetCallBackLocation(*CallBackLocation) - Declare SetCallBackMainPointer(CallBackMainPointer.i) + Declare SetCallBackMainPointer(CallBackMainPointer.i) + Declare SetCallBackDrawTile(*CallBackLocation) + Declare SetCallBackMarker(*CallBackLocation) + Declare SetCallBackLeftClic(*CallBackLocation) Declare MapGadget(Gadget.i, X.i, Y.i, Width.i, Height.i) Declare.d GetLatitude() Declare.d GetLongitude() @@ -113,9 +120,8 @@ DeclareModule PBMap Declare FatalError(msg.s) Declare Error(msg.s) Declare Refresh() - Declare.i ClearDiskCache() - Declare SetCallBackMarker(*CallBackLocation) - Declare SetCallBackLeftClic(*CallBackLocation) + Declare.i ClearDiskCache() + EndDeclareModule @@ -123,6 +129,10 @@ Module PBMap EnableExplicit + ;-*** Callback Prototypes + + Prototype ProtoDrawTile(x.i, y.i, image.i, alpha.d = 1) + ;-*** Internal Structures Structure PixelCoordinates @@ -278,10 +288,11 @@ Module PBMap GeographicCoordinates.GeographicCoordinates ; Latitude and Longitude from focus point Drawing.DrawingParameters ; Drawing parameters based on focus point - CallBackLocation.i ; @Procedure(latitude.d,lontitude.d) + CallBackLocation.i ; @Procedure(latitude.d, longitude.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) + CallBackMarker.i ; @Procedure (latitude.d, lontitude.d) to know the marker position (YA) + CallBackLeftClic.i ; @Procedure (latitude.d, lontitude.d) to know the position on left click (YA) + CallBackDrawTile.ProtoDrawTile ; @Procedure (x.i, y.i, nImage.i) to customise tile drawing PixelCoordinates.PixelCoordinates ; Actual focus point coords in pixels (global) MoveStartingPoint.PixelCoordinates ; Start mouse position coords when dragging the map @@ -904,8 +915,8 @@ Module PBMap \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", "") + \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") @@ -1174,7 +1185,7 @@ Module PBMap ; We're accessing MemoryCache UnlockMutex(PBMap\MemoryCacheAccessMutex) *Tile\Size = 0 - *Tile\Download = ReceiveHTTPFile(*Tile\URL, *Tile\CacheFile, #PB_HTTP_Asynchronous) + *Tile\Download = ReceiveHTTPFile(*Tile\URL, *Tile\CacheFile, #PB_HTTP_Asynchronous, #USERAGENT) If *Tile\Download Repeat Progress = HTTPProgress(*Tile\Download) @@ -1328,14 +1339,14 @@ Module PBMap EndProcedure 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 ty = Int(*Drawing\TileCoordinates\y) - 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 x.i, y.i, kq.q + Protected tx.i = Int(*Drawing\TileCoordinates\x) ; Don't forget the Int() ! + Protected ty.i = Int(*Drawing\TileCoordinates\y) + Protected nx.i = *Drawing\RadiusX / PBMap\TileSize ; How many tiles around the point + Protected ny.i = *Drawing\RadiusY / PBMap\TileSize + Protected px.i, py.i, *timg.ImgMemCach, tilex.i, tiley.i, key.s Protected URL.s, CacheFile.s - Protected tilemax = 1< Date: Tue, 4 Jul 2017 16:50:18 +0200 Subject: [PATCH 39/60] Two new callbacks to alter tile rendering, and to work on tile file after loading Prototype.i ProtoDrawTile(x.i, y.i, image.i, alpha.d = 1) Prototype.s ProtoModifyTileFile(Filename.s, OriginalURL.s) --- PBMap.pb | 52 ++++++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 44 insertions(+), 8 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index a07fcde..d64640f 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -89,6 +89,7 @@ DeclareModule PBMap Declare SetCallBackDrawTile(*CallBackLocation) Declare SetCallBackMarker(*CallBackLocation) Declare SetCallBackLeftClic(*CallBackLocation) + Declare SetCallBackModifyTileFile(*CallBackLocation) Declare MapGadget(Gadget.i, X.i, Y.i, Width.i, Height.i) Declare.d GetLatitude() Declare.d GetLongitude() @@ -129,9 +130,10 @@ Module PBMap EnableExplicit - ;-*** Callback Prototypes + ;-*** Prototypes - Prototype ProtoDrawTile(x.i, y.i, image.i, alpha.d = 1) + Prototype.i ProtoDrawTile(x.i, y.i, image.i, alpha.d = 1) + Prototype.s ProtoModifyTileFile(Filename.s, OriginalURL.s) ;-*** Internal Structures @@ -293,6 +295,7 @@ Module PBMap CallBackMarker.i ; @Procedure (latitude.d, lontitude.d) to know the marker position (YA) CallBackLeftClic.i ; @Procedure (latitude.d, lontitude.d) to know the position on left click (YA) CallBackDrawTile.ProtoDrawTile ; @Procedure (x.i, y.i, nImage.i) to customise tile drawing + CallBackModifyTileFile.ProtoModifyTileFile ; @Procedure (Filename.s, Original URL) to customise image file => New Filename PixelCoordinates.PixelCoordinates ; Actual focus point coords in pixels (global) MoveStartingPoint.PixelCoordinates ; Start mouse position coords when dragging the map @@ -2150,6 +2153,7 @@ Module PBMap EndProcedure ;-*** Callbacks + Procedure SetCallBackLocation(CallBackLocation.i) PBMap\CallBackLocation = CallBackLocation EndProcedure @@ -2170,6 +2174,12 @@ Module PBMap PBMap\CallBackDrawTile = CallBackLocation EndProcedure + Procedure SetCallBackModifyTileFile(CallBackLocation.i) + PBMap\CallBackModifyTileFile = CallBackLocation + EndProcedure + + ;*** + Procedure SetMapScaleUnit(ScaleUnit.i = PBMAP::#SCALE_KM) PBMap\Options\ScaleUnit = ScaleUnit PBMap\Redraw = #True @@ -2324,6 +2334,7 @@ Module PBMap Protected MarkerCoords.PixelCoordinates, *Tile.Tile, MapWidth = Pow(2, PBMap\Zoom) * PBMap\TileSize Protected key.s, Touch.i Protected Pixel.PixelCoordinates + Protected ImgNB.i, TileNewFilename.s Static CtrlKey Protected Location.GeographicCoordinates CanvasMouseX = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) - PBMap\Drawing\RadiusX @@ -2572,8 +2583,14 @@ Module PBMap PBMap\MemCache\Images(key)\Tile = *Tile\Size If *Tile\Size PBMap\MemCache\Images(key)\Tile = -1 ; Web loading thread has finished successfully - ;n = LoadImage(#PB_Any, *Tile\CacheFile) - + ;- Allows to post edit the tile image file with a customised code + If PBMap\CallBackModifyTileFile + TileNewFilename = PBMap\CallBackModifyTileFile(*Tile\CacheFile, *Tile\URL) + If TileNewFilename + ;TODO : Not used by now, a new filename is sent back + *Tile\CacheFile = TileNewFilename + EndIf + EndIf Else PBMap\MemCache\Images(key)\Tile = 0 EndIf @@ -2748,11 +2765,29 @@ CompilerIf #PB_Compiler_IsMainFile Debug "Identifier : " + *Marker\Identifier + "(" + StrD(*Marker\GeographicCoordinates\Latitude) + ", " + StrD(*Marker\GeographicCoordinates\Longitude) + ")" EndProcedure + ; Example of a custom procedure to alter tile rendering Procedure DrawTileCallBack(x.i, y.i, image.i, alpha.d) MovePathCursor(x, y) DrawVectorImage(ImageID(image), 255 * alpha) EndProcedure + ; Example of a custom procedure to alter tile file just after loading + Procedure.s ModifyTileFileCallback(CacheFile.s, OrgURL.s) + Protected ImgNB = LoadImage(#PB_Any, CacheFile) + If ImgNB + StartDrawing(ImageOutput(ImgNB)) + DrawText(0, 0,"PUREBASIC", RGB(255, 255, 0)) + StopDrawing() + ;*** Could be used to create new files + ; Cachefile = ReplaceString(Cachefile, ".png", "_PB.png") + ;*** + If SaveImage(ImgNB, CacheFile, #PB_ImagePlugin_PNG, 0, 32) ;Warning, the 32 is mandatory as some tiles aren't correctly rendered + ; Send back the new name (not functional by now) + ProcedureReturn CacheFile + EndIf + 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) @@ -2853,7 +2888,8 @@ CompilerIf #PB_Compiler_IsMainFile 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()) - PBMap::SetCallBackDrawTile(@DrawTileCallBack()) + ;PBMap::SetCallBackDrawTile(@DrawTileCallBack()) + ;PBMap::SetCallBackModifyTileFile(@ModifyTileFileCallback()) Repeat Event = WaitWindowEvent() @@ -2986,9 +3022,9 @@ CompilerEndIf ; IDE Options = PureBasic 5.60 (Windows - x64) -; CursorPosition = 291 -; FirstLine = 279 -; Folding = -------------------- +; CursorPosition = 2888 +; FirstLine = 2781 +; Folding = --------------------- ; EnableThread ; EnableXP ; CompileSourceDirectory \ No newline at end of file From ba26af24e178e26f1c7fc2f6700d47d6f2eb44bd Mon Sep 17 00:00:00 2001 From: djes Date: Sun, 25 Feb 2018 19:32:34 +0100 Subject: [PATCH 40/60] GetImageThread() not anymore mutex excluded Andre and DarkSoul bug tracking. This mutex doesn't seem to have any real utility in this function, as the memory management is already protected by mutex outside, and the tile data has been copied to a private memory area. --- PBMap.pb | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index d64640f..c05c70e 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -292,8 +292,8 @@ Module PBMap CallBackLocation.i ; @Procedure(latitude.d, longitude.d) CallBackMainPointer.i ; @Procedure(X.i, Y.i) to DrawPointer (you must use VectorDrawing lib) - CallBackMarker.i ; @Procedure (latitude.d, lontitude.d) to know the marker position (YA) - CallBackLeftClic.i ; @Procedure (latitude.d, lontitude.d) to know the position on left click (YA) + CallBackMarker.i ; @Procedure (latitude.d, longitude.d) to know the marker position (YA) + CallBackLeftClic.i ; @Procedure (latitude.d, longitude.d) to know the position on left click (YA) CallBackDrawTile.ProtoDrawTile ; @Procedure (x.i, y.i, nImage.i) to customise tile drawing CallBackModifyTileFile.ProtoModifyTileFile ; @Procedure (Filename.s, Original URL) to customise image file => New Filename @@ -337,7 +337,7 @@ Module PBMap ;-Show debug infos Global MyDebugLevel = 5 - Global PBMap.PBMap, Null.i, NullPtrMem.i, *NullPtr = @NullPtrMem + Global PBMap.PBMap Global slash.s CompilerSelect #PB_Compiler_OS @@ -1175,7 +1175,7 @@ Module PBMap Threaded Progress = 0, Quit = #False Procedure GetImageThread(*Tile.Tile) - LockMutex(PBMap\MemoryCacheAccessMutex) + ;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 @@ -1186,7 +1186,7 @@ Module PBMap ; ProcedureReturn ; EndIf ; We're accessing MemoryCache - UnlockMutex(PBMap\MemoryCacheAccessMutex) + ;UnlockMutex(PBMap\MemoryCacheAccessMutex) *Tile\Size = 0 *Tile\Download = ReceiveHTTPFile(*Tile\URL, *Tile\CacheFile, #PB_HTTP_Asynchronous, #USERAGENT) If *Tile\Download @@ -1218,9 +1218,9 @@ Module PBMap Until Quit EndIf ; End of the memory cache access - LockMutex(PBMap\MemoryCacheAccessMutex) + ;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) + ;UnlockMutex(PBMap\MemoryCacheAccessMutex) EndProcedure ;-*** @@ -2572,7 +2572,7 @@ Module PBMap PBMap\Redraw = #True Case #PB_MAP_RETRY PBMap\Redraw = #True - ;- Tile web loading thread cleanup + ;- #PB_MAP_TILE_CLEANUP : 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() @@ -2873,7 +2873,7 @@ CompilerIf #PB_Compiler_IsMainFile ; Our main gadget PBMap::InitPBMap(#Window_0) PBMap::SetOption("ShowDegrees", "1") : Degrees = 0 - PBMap::SetOption("ShowDebugInfos", "0") + PBMap::SetOption("ShowDebugInfos", "1") PBMap::SetDebugLevel(5) PBMap::SetOption("Verbose", "0") PBMap::SetOption("ShowScale", "1") @@ -3021,9 +3021,9 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf -; IDE Options = PureBasic 5.60 (Windows - x64) -; CursorPosition = 2888 -; FirstLine = 2781 +; IDE Options = PureBasic 5.61 (Windows - x64) +; CursorPosition = 1222 +; FirstLine = 1194 ; Folding = --------------------- ; EnableThread ; EnableXP From dfcf0e9f5e495f8b617459e2ce6677e956914620 Mon Sep 17 00:00:00 2001 From: djes Date: Thu, 1 Mar 2018 09:33:52 +0100 Subject: [PATCH 41/60] Multiple PBMap handling The internal pbmap structure was unique and shared. Now it is dynamically allocated and returned by the InitPBMap() function. It allows to have multiple PBMap in the same window. Switch is done by the new SelectPBMap() function. Quit() function must be called for each PBMap. --- PBMap.pb | 1019 +++++++++++++++++++++++++++--------------------------- 1 file changed, 515 insertions(+), 504 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index c05c70e..6091b75 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -68,8 +68,9 @@ DeclareModule PBMap EndStructure ;*** - Declare InitPBMap(window) - Declare SetDebugLevel(level.i) + Declare.i InitPBMap(Window, TimerNB = 1) ; Returns *PBMap structure pointer + Declare SelectPBMap(*NewPBMap) ; Could be used to have multiple PBMaps in one window + Declare SetDebugLevel(Level.i) Declare SetOption(Option.s, Value.s) Declare.s GetOption(Option.s) Declare LoadOptions(PreferencesFile.s = "PBMap.prefs") @@ -102,7 +103,7 @@ DeclareModule PBMap Declare SetMapScaleUnit(ScaleUnit=PBMAP::#SCALE_KM) 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 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 @@ -123,7 +124,6 @@ DeclareModule PBMap Declare Refresh() Declare.i ClearDiskCache() - EndDeclareModule Module PBMap @@ -337,7 +337,7 @@ Module PBMap ;-Show debug infos Global MyDebugLevel = 5 - Global PBMap.PBMap + Global *PBMap.PBMap Global slash.s CompilerSelect #PB_Compiler_OS @@ -366,7 +366,7 @@ Module PBMap ; Shows an error msg and terminates the program Procedure FatalError(msg.s) - If PBMap\Options\Warning + If *PBMap\Options\Warning MessageRequester("PBMap", msg, #PB_MessageRequester_Ok) EndIf End @@ -374,7 +374,7 @@ Module PBMap ; Shows an error msg Procedure Error(msg.s) - If PBMap\Options\Warning + If *PBMap\Options\Warning MessageRequester("PBMap", msg, #PB_MessageRequester_Ok) EndIf EndProcedure @@ -386,7 +386,7 @@ Module PBMap ; 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 EndIf @@ -442,15 +442,15 @@ Module PBMap ; "Loading" image Protected LoadingText$ = "Loading" Protected NothingText$ = "Nothing" - PBmap\ImgLoading = CreateImage(#PB_Any, 256, 256) - If PBmap\ImgLoading - StartVectorDrawing(ImageVectorOutput(PBMap\Imgloading)) + *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\StandardFont), 256 / 20) + VectorFont(FontID(*PBMap\StandardFont), 256 / 20) VectorSourceColor(RGBA(150, 150, 150, 255)) MovePathCursor(0 + (256 - VectorTextWidth(LoadingText$)) / 2, 0 + (256 - VectorTextHeight(LoadingText$)) / 2) DrawVectorText(LoadingText$) @@ -458,15 +458,15 @@ Module PBMap StopVectorDrawing() EndIf ; "Nothing" tile - PBmap\ImgNothing = CreateImage(#PB_Any, 256, 256) - If PBmap\ImgNothing - StartVectorDrawing(ImageVectorOutput(PBMap\ImgNothing)) + *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\StandardFont), 256 / 20) + ; VectorFont(FontID(*PBMap\StandardFont), 256 / 20) ; VectorSourceColor(RGBA(150, 150, 150, 255)) ; MovePathCursor(0 + (256 - VectorTextWidth(NothingText$)) / 2, 0 + (256 - VectorTextHeight(NothingText$)) / 2) ; DrawVectorText(NothingText$) @@ -508,7 +508,7 @@ Module PBMap EndProcedure Procedure Pixel2LatLon(*Coords.PixelCoordinates, *Location.GeographicCoordinates, Zoom) - Protected n.d = PBMap\TileSize * Pow(2.0, 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)))) @@ -527,7 +527,7 @@ Module PBMap ; 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 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 @@ -535,9 +535,9 @@ 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\RadiusX - Protected dpx.d = PBMap\PixelCoordinates\x + Protected tilemax = Pow(2.0, Zoom) * *PBMap\TileSize + Protected cx.d = *PBMap\Drawing\RadiusX + Protected dpx.d = *PBMap\PixelCoordinates\x 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 @@ -555,19 +555,19 @@ Module PBMap ; Debug "c0" *Pixel\x = cx + (px - dpx) EndIf - *Pixel\y = PBMap\Drawing\RadiusY + (py - PBMap\PixelCoordinates\y) + *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) + 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) + 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 @@ -600,18 +600,18 @@ Module PBMap 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) + 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)); - *Pixel\x=PBMap\Drawing\RadiusX - (x2-x1) - *Pixel\y=PBMap\Drawing\RadiusY - (y2-y1) + *Pixel\x=*PBMap\Drawing\RadiusX - (x2-x1) + *Pixel\y=*PBMap\Drawing\RadiusY - (y2-y1) EndProcedure Procedure IsInDrawingPixelBoundaries(*Drawing.DrawingParameters, *Position.GeographicCoordinates) Protected Pixel.PixelCoordinates - LatLon2PixelRel(*Position, @Pixel, PBMap\Zoom) + 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 @@ -679,9 +679,9 @@ Module PBMap ;-*** Options Procedure SetOptions() - With PBMap\Options + With *PBMap\Options If \Proxy - HTTPProxy(PBMap\Options\ProxyURL + ":" + PBMap\Options\ProxyPort, PBMap\Options\ProxyUser, PBMap\Options\ProxyPassword) + HTTPProxy(*PBMap\Options\ProxyURL + ":" + *PBMap\Options\ProxyPort, *PBMap\Options\ProxyUser, *PBMap\Options\ProxyPassword) EndIf If \Verbose OpenConsole() @@ -696,9 +696,9 @@ Module PBMap Macro SelBool(Name) Select UCase(Value) Case "0", "FALSE", "DISABLE" - PBMap\Options\Name = #False + *PBMap\Options\Name = #False Default - PBMap\Options\Name = #True + *PBMap\Options\Name = #True EndSelect EndMacro @@ -708,25 +708,25 @@ Module PBMap Case "proxy" SelBool(Proxy) Case "proxyurl" - PBMap\Options\ProxyURL = Value + *PBMap\Options\ProxyURL = Value Case "proxyport" - PBMap\Options\ProxyPort = Value + *PBMap\Options\ProxyPort = Value Case "proxyuser" - PBMap\Options\ProxyUser = Value + *PBMap\Options\ProxyUser = Value Case "appid" - PBMap\Options\appid = Value + *PBMap\Options\appid = Value Case "appcode" - PBMap\Options\appcode = Value + *PBMap\Options\appcode = Value Case "tilescachepath" - PBMap\Options\HDDCachePath = Value + *PBMap\Options\HDDCachePath = Value Case "maxmemcache" - PBMap\Options\MaxMemCache = Val(Value) + *PBMap\Options\MaxMemCache = Val(Value) Case "maxthreads" - PBMap\Options\MaxThreads = Val(Value) + *PBMap\Options\MaxThreads = Val(Value) Case "maxdownloadslots" - PBMap\Options\MaxDownloadSlots = Val(Value) + *PBMap\Options\MaxDownloadSlots = Val(Value) Case "tilelifetime" - PBMap\Options\TileLifetime = Val(Value) + *PBMap\Options\TileLifetime = Val(Value) Case "verbose" SelBool(Verbose) Case "warning" @@ -758,11 +758,11 @@ Module PBMap Case "strokewidthtrackdefault" SelBool(StrokeWidthTrackDefault) Case "colourfocus" - PBMap\Options\ColourFocus = ColourString2Value(Value) + *PBMap\Options\ColourFocus = ColourString2Value(Value) Case "colourselected" - PBMap\Options\ColourSelected = ColourString2Value(Value) + *PBMap\Options\ColourSelected = ColourString2Value(Value) Case "colourtrackdefault" - PBMap\Options\ColourTrackDefault = ColourString2Value(Value) + *PBMap\Options\ColourTrackDefault = ColourString2Value(Value) EndSelect SetOptions() EndProcedure @@ -778,7 +778,7 @@ Module PBMap Procedure.s GetOption(Option.s) Option = StringCheck(Option) - With PBMap\Options + With *PBMap\Options Select LCase(Option) Case "proxy" ProcedureReturn GetBoolString(\Proxy) @@ -849,7 +849,7 @@ Module PBMap Else CreatePreferences(PreferencesFile) EndIf - With PBMap\Options + With *PBMap\Options PreferenceGroup("PROXY") WritePreferenceInteger("Proxy", \Proxy) WritePreferenceString("ProxyURL", \ProxyURL) @@ -913,7 +913,7 @@ Module PBMap ; WritePreferenceString("APP_ID", "myhereid") ; TODO !Warning! !not encoded! ; WritePreferenceString("APP_CODE", "myherecode") ; TODO !Warning! !not encoded! ; ClosePreferences() - With PBMap\Options + With *PBMap\Options PreferenceGroup("PROXY") \Proxy = ReadPreferenceInteger("Proxy", #False) If \Proxy @@ -965,15 +965,15 @@ Module PBMap ; 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) + *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() + *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 @@ -988,7 +988,7 @@ Module PBMap *Ptr\ServerURL = ServerURL *Ptr\LayerType = 0 ; OSM *Ptr\Enabled = #True - PBMap\Redraw = #True + *PBMap\Redraw = #True ProcedureReturn *Ptr Else ProcedureReturn #False @@ -1002,17 +1002,17 @@ Module PBMap 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() + With *Ptr ; *PBMap\Layers() \ServerURL = ServerURL \path = path \ressource = ressource \LayerType = 1 ; HERE \Enabled = #True If APP_ID = "" - APP_ID = PBMap\Options\appid + APP_ID = *PBMap\Options\appid EndIf If APP_CODE = "" - APP_CODE = PBMap\Options\appcode + APP_CODE = *PBMap\Options\appcode EndIf \APP_CODE = APP_CODE \APP_ID = APP_ID @@ -1023,7 +1023,7 @@ Module PBMap \param = param \scheme = scheme EndWith - PBMap\Redraw = #True + *PBMap\Redraw = #True ProcedureReturn *Ptr Else ProcedureReturn #False @@ -1035,7 +1035,7 @@ Module PBMap 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() + With *Ptr ; *PBMap\Layers() \ServerURL = ServerURL \path = path \LayerType = 2 ; GeoServer @@ -1043,7 +1043,7 @@ Module PBMap \Enabled = #True \ServerLayerName = ServerLayerName EndWith - PBMap\Redraw = #True + *PBMap\Redraw = #True ProcedureReturn *Ptr Else ProcedureReturn #False @@ -1051,80 +1051,80 @@ Module PBMap EndProcedure Procedure.i IsLayer(Name.s) - ProcedureReturn FindMapElement(PBMap\Layers(), Name) + ProcedureReturn FindMapElement(*PBMap\Layers(), Name) EndProcedure Procedure DeleteLayer(Name.s) - FindMapElement(PBMap\Layers(), Name) - Protected *Ptr = PBMap\Layers() + FindMapElement(*PBMap\Layers(), Name) + Protected *Ptr = *PBMap\Layers() ; Free the list element - ChangeCurrentElement(PBMap\LayersList(), *Ptr) - DeleteElement(PBMap\LayersList()) + ChangeCurrentElement(*PBMap\LayersList(), *Ptr) + DeleteElement(*PBMap\LayersList()) ; Free the map element - DeleteMapElement(PBMap\Layers()) - PBMap\Redraw = #True + DeleteMapElement(*PBMap\Layers()) + *PBMap\Redraw = #True EndProcedure Procedure EnableLayer(Name.s) - PBMap\Layers(Name)\Enabled = #True - PBMap\Redraw = #True + *PBMap\Layers(Name)\Enabled = #True + *PBMap\Redraw = #True EndProcedure Procedure DisableLayer(Name.s) - PBMap\Layers(Name)\Enabled = #False - PBMap\Redraw = #True + *PBMap\Layers(Name)\Enabled = #False + *PBMap\Redraw = #True EndProcedure Procedure SetLayerAlpha(Name.s, Alpha.d) - PBMap\Layers(Name)\Alpha = Alpha - PBMap\Redraw = #True + *PBMap\Layers(Name)\Alpha = Alpha + *PBMap\Redraw = #True EndProcedure Procedure.d GetLayerAlpha(Name.s) - ProcedureReturn PBMap\Layers(Name)\Alpha + 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 + 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()) + 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 + 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 + 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 + 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 + 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 + ; 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 + ; 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) + 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) + UnlockMutex(*PBMap\MemoryCacheAccessMutex) EndProcedure Procedure.i GetTileFromHDD(CacheFile.s) @@ -1175,18 +1175,18 @@ Module PBMap Threaded Progress = 0, Quit = #False Procedure GetImageThread(*Tile.Tile) - ;LockMutex(PBMap\MemoryCacheAccessMutex) + ;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 +; 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) +; 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) + ;UnlockMutex(*PBMap\MemoryCacheAccessMutex) *Tile\Size = 0 *Tile\Download = ReceiveHTTPFile(*Tile\URL, *Tile\CacheFile, #PB_HTTP_Asynchronous, #USERAGENT) If *Tile\Download @@ -1218,18 +1218,18 @@ Module PBMap Until Quit EndIf ; 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) + ;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.i GetTile(key.s, URL.s, CacheFile.s) ; MemoryCache access management - LockMutex(PBMap\MemoryCacheAccessMutex) + LockMutex(*PBMap\MemoryCacheAccessMutex) ; Try to find the tile in memory cache - Protected *timg.ImgMemCach = FindMapElement(PBMap\MemCache\Images(), key) + Protected *timg.ImgMemCach = FindMapElement(*PBMap\MemCache\Images(), key) If *timg MyDebug("Key : " + key + " found in memory cache", 4) ; Is the associated image already been loaded in memory ? @@ -1238,11 +1238,11 @@ Module PBMap 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()) + ChangeCurrentElement(*PBMap\MemCache\ImagesTimeStack(), *timg\TimeStackPtr) + MoveElement(*PBMap\MemCache\ImagesTimeStack(), #PB_List_Last) + ; *timg\TimeStackPtr = LastElement(*PBMap\MemCache\ImagesTimeStack()) ; *** - UnlockMutex(PBMap\MemoryCacheAccessMutex) + UnlockMutex(*PBMap\MemoryCacheAccessMutex) ProcedureReturn *timg Else ; No, try to load it from HD (see below) @@ -1250,24 +1250,24 @@ Module PBMap EndIf Else ; The tile has not been found in the cache, so creates a new cache element - *timg = AddMapElement(PBMap\MemCache\Images(), key) + *timg = AddMapElement(*PBMap\MemCache\Images(), key) If *timg = 0 MyDebug(" Can't add a new cache element.", 4) - UnlockMutex(PBMap\MemoryCacheAccessMutex) + UnlockMutex(*PBMap\MemoryCacheAccessMutex) ProcedureReturn #False EndIf ; add a new time stack element at the End - LastElement(PBMap\MemCache\ImagesTimeStack()) + LastElement(*PBMap\MemCache\ImagesTimeStack()) ; Stores the time stack ptr - *timg\TimeStackPtr = AddElement(PBMap\MemCache\ImagesTimeStack()) + *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) + 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()) + *PBMap\MemCache\ImagesTimeStack()\MapKey = MapKey(*PBMap\MemCache\Images()) MyDebug("Key : " + key + " added in memory cache", 4) EndIf ; If there's no active download thread for this tile @@ -1275,15 +1275,15 @@ Module PBMap *timg\nImage = 0 *timg\Size = FileSize(CacheFile) ; Manage tile file lifetime, delete if too old, or if size = 0 - If PBMap\Options\TileLifetime <> -1 + If *PBMap\Options\TileLifetime <> -1 If *timg\Size >= 0 ; Does the file exists ? - If *timg\Size = 0 Or (Date() - GetFileDate(CacheFile, #PB_Date_Modified) > PBMap\Options\TileLifetime) ; If Lifetime > MaxLifeTime ; There's a bug with #PB_Date_Created + If *timg\Size = 0 Or (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 image file " + CacheFile, 3) *timg\Size = 0 Else MyDebug(" Can't delete image file " + CacheFile, 3) - UnlockMutex(PBMap\MemoryCacheAccessMutex) + UnlockMutex(*PBMap\MemoryCacheAccessMutex) ProcedureReturn #False EndIf EndIf @@ -1298,14 +1298,14 @@ Module PBMap If *timg\nImage ; Image found and loaded from HDD *timg\Alpha = 0 - UnlockMutex(PBMap\MemoryCacheAccessMutex) + 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 + If *PBMap\ThreadsNB < *PBMap\Options\MaxThreads + If *PBMap\DownloadSlots < *PBMap\Options\MaxDownloadSlots ; Launch a new web loading thread - PBMap\DownloadSlots + 1 + *PBMap\DownloadSlots + 1 Protected *NewTile.Tile = AllocateMemory(SizeOf(Tile)) If *NewTile With *NewTile @@ -1320,7 +1320,7 @@ Module PBMap *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 + *PBMap\ThreadsNB + 1 Else MyDebug(" Can't create get image thread to get " + CacheFile, 3) FreeMemory(*NewTile) @@ -1337,7 +1337,7 @@ Module PBMap EndIf EndIf EndIf - UnlockMutex(PBMap\MemoryCacheAccessMutex) + UnlockMutex(*PBMap\MemoryCacheAccessMutex) ProcedureReturn #False EndProcedure @@ -1345,28 +1345,28 @@ Module PBMap Protected x.i, y.i, kq.q Protected tx.i = Int(*Drawing\TileCoordinates\x) ; Don't forget the Int() ! Protected ty.i = Int(*Drawing\TileCoordinates\y) - Protected nx.i = *Drawing\RadiusX / PBMap\TileSize ; How many tiles around the point - Protected ny.i = *Drawing\RadiusY / PBMap\TileSize + Protected nx.i = *Drawing\RadiusX / *PBMap\TileSize ; How many tiles around the point + Protected ny.i = *Drawing\RadiusY / *PBMap\TileSize Protected px.i, py.i, *timg.ImgMemCach, tilex.i, tiley.i, key.s Protected URL.s, CacheFile.s - Protected tilemax.i = 1<= 0 And tiley < tilemax - kq = (PBMap\Zoom << 8) | (tilex << 16) | (tiley << 36) + kq = (*PBMap\Zoom << 8) | (tilex << 16) | (tiley << 36) 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 + LayerName + 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) @@ -1375,7 +1375,7 @@ Module PBMap EndIf EndIf ; Creates the sub-directory based on the zoom - DirName + slash + Str(PBMap\Zoom) + DirName + slash + Str(*PBMap\Zoom) If FileSize(DirName) <> -2 If CreateDirectory(DirName) = #False Error("Can't create the following zoom directory : " + DirName) @@ -1392,18 +1392,18 @@ Module PBMap MyDebug(DirName + " successfully created", 4) EndIf EndIf - With PBMap\Layers() + With *PBMap\Layers() Select \LayerType ;---- OSM tiles Case 0 - URL = \ServerURL + Str(PBMap\Zoom) + "/" + Str(tilex) + "/" + Str(tiley) + ".png" + 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 + 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 @@ -1412,40 +1412,40 @@ Module PBMap ;---- 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 + 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 And *timg\nImage - If PBMap\CallBackDrawTile - ;CallFunctionFast(PBMap\CallBackDrawTile, px, py, *timg\nImage) - PBMap\CallBackDrawTile(px, py, *timg\nImage, PBMap\Layers()\Alpha) - PBMap\Redraw = #True + If *PBMap\CallBackDrawTile + ;CallFunctionFast(*PBMap\CallBackDrawTile, px, py, *timg\nImage) + *PBMap\CallBackDrawTile(px, py, *timg\nImage, *PBMap\Layers()\Alpha) + *PBMap\Redraw = #True Else MovePathCursor(px, py) If *timg\Alpha <= 224 - DrawVectorImage(ImageID(*timg\nImage), *timg\Alpha * PBMap\Layers()\Alpha) + DrawVectorImage(ImageID(*timg\nImage), *timg\Alpha * *PBMap\Layers()\Alpha) *timg\Alpha + 32 - PBMap\Redraw = #True + *PBMap\Redraw = #True Else - DrawVectorImage(ImageID(*timg\nImage), 255 * PBMap\Layers()\Alpha) + DrawVectorImage(ImageID(*timg\nImage), 255 * *PBMap\Layers()\Alpha) *timg\Alpha = 256 EndIf EndIf Else MovePathCursor(px, py) - DrawVectorImage(ImageID(PBMap\ImgLoading), 255 * PBMap\Layers()\Alpha) + 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 * PBMap\Layers()\Alpha) + DrawVectorImage(ImageID(*PBMap\ImgNothing), 255 * *PBMap\Layers()\Alpha) ; EndIf EndIf - If PBMap\Options\ShowDebugInfos - VectorFont(FontID(PBMap\StandardFont), 16) + If *PBMap\Options\ShowDebugInfos + VectorFont(FontID(*PBMap\StandardFont), 16) VectorSourceColor(RGBA(0, 0, 0, 80)) MovePathCursor(px, py) DrawVectorText("x:" + Str(tilex)) @@ -1457,9 +1457,9 @@ Module PBMap EndProcedure Procedure DrawPointer(*Drawing.DrawingParameters) - If PBMap\CallBackMainPointer > 0 + If *PBMap\CallBackMainPointer > 0 ; @Procedure(X.i, Y.i) to DrawPointer (you must use VectorDrawing lib) - CallFunctionFast(PBMap\CallBackMainPointer, *Drawing\RadiusX, *Drawing\RadiusY) + CallFunctionFast(*PBMap\CallBackMainPointer, *Drawing\RadiusX, *Drawing\RadiusY) Else VectorSourceColor(RGBA($FF, 0, 0, $FF)) MovePathCursor(*Drawing\RadiusX, *Drawing\RadiusY) @@ -1475,15 +1475,15 @@ Module PBMap 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 + 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\StandardFont), 10) + VectorFont(FontID(*PBMap\StandardFont), 10) VectorSourceColor(RGBA(0, 0, 0, alpha)) MovePathCursor(x,y) DrawVectorText(StrD(Scale,3)+sunit) @@ -1507,15 +1507,15 @@ Module PBMap 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\StandardFont), 10) + LatLon2PixelRel(@Degrees1, @pos1, *PBMap\Zoom) + LatLon2PixelRel(@Degrees2, @pos2, *PBMap\Zoom) + VectorFont(FontID(*PBMap\StandardFont), 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) + LatLon2PixelRel(@Degrees1, @pos1, *PBMap\Zoom) MovePathCursor(pos1\x, pos1\y) AddPathLine( pos2\x, pos1\y) MovePathCursor(10, pos1\y) @@ -1526,7 +1526,7 @@ Module PBMap Repeat Degrees1\Longitude = x Degrees1\Latitude = ny - LatLon2PixelRel(@Degrees1, @pos1, PBMap\Zoom) + LatLon2PixelRel(@Degrees1, @pos1, *PBMap\Zoom) MovePathCursor(pos1\x, pos1\y) AddPathLine( pos1\x, pos2\y) MovePathCursor(pos1\x,10) @@ -1537,7 +1537,7 @@ Module PBMap EndProcedure Procedure DrawZoom(x.i, y.i) - VectorFont(FontID(PBMap\StandardFont), 20) + VectorFont(FontID(*PBMap\StandardFont), 20) VectorSourceColor(RGBA(0, 0, 0,150)) MovePathCursor(x,y) DrawVectorText(Str(GetZoom())) @@ -1557,7 +1557,7 @@ Module PBMap VectorSourceColor(RGBA(255, 255, 255, 255)) AddPathCircle(x,y-20,12) FillPath() - VectorFont(FontID(PBMap\StandardFont), 13) + VectorFont(FontID(*PBMap\StandardFont), 13) MovePathCursor(x-VectorTextWidth(Str(dist))/2, y-20-VectorTextHeight(Str(dist))/2) VectorSourceColor(RGBA(0, 0, 0, 255)) DrawVectorText(Str(dist)) @@ -1576,7 +1576,7 @@ Module PBMap VectorSourceColor(RGBA(255, 0, 0, 255)) AddPathCircle(x,y-24,14) FillPath() - VectorFont(FontID(PBMap\StandardFont), 14) + VectorFont(FontID(*PBMap\StandardFont), 14) MovePathCursor(x-VectorTextWidth(Str(dist))/2, y-24-VectorTextHeight(Str(dist))/2) VectorSourceColor(RGBA(0, 0, 0, 255)) DrawVectorText(Str(dist)) @@ -1584,30 +1584,30 @@ Module PBMap Procedure DeleteTrack(*Ptr) If *Ptr - ChangeCurrentElement(PBMap\TracksList(), *Ptr) - DeleteElement(PBMap\TracksList()) + ChangeCurrentElement(*PBMap\TracksList(), *Ptr) + DeleteElement(*PBMap\TracksList()) EndIf EndProcedure Procedure DeleteSelectedTracks() - ForEach PBMap\TracksList() - If PBMap\TracksList()\Selected - DeleteElement(PBMap\TracksList()) - PBMap\Redraw = #True + ForEach *PBMap\TracksList() + If *PBMap\TracksList()\Selected + DeleteElement(*PBMap\TracksList()) + *PBMap\Redraw = #True EndIf Next EndProcedure Procedure ClearTracks() - ClearList(PBMap\TracksList()) - PBMap\Redraw = #True + 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 + ChangeCurrentElement(*PBMap\TracksList(), *Ptr) + *PBMap\TracksList()\Colour = Colour + *PBMap\Redraw = #True EndIf EndProcedure @@ -1615,16 +1615,16 @@ Module PBMap Protected Pixel.PixelCoordinates Protected Location.GeographicCoordinates Protected km.f, memKm.i - With PBMap\TracksList() + With *PBMap\TracksList() ; Trace Track - If ListSize(PBMap\TracksList()) > 0 + If ListSize(*PBMap\TracksList()) > 0 BeginVectorLayer() - ForEach PBMap\TracksList() + ForEach *PBMap\TracksList() If ListSize(\Track()) > 0 ; Check visibility \Visible = #False ForEach \Track() - If IsInDrawingPixelBoundaries(*Drawing, @PBMap\TracksList()\Track()) + If IsInDrawingPixelBoundaries(*Drawing, @*PBMap\TracksList()\Track()) \Visible = #True Break EndIf @@ -1632,7 +1632,7 @@ Module PBMap If \Visible ; Draw tracks ForEach \Track() - LatLon2PixelRel(@PBMap\TracksList()\Track(), @Pixel, PBMap\Zoom) + LatLon2PixelRel(@*PBMap\TracksList()\Track(), @Pixel, *PBMap\Zoom) If ListIndex(\Track()) = 0 MovePathCursor(Pixel\x, Pixel\y) Else @@ -1644,9 +1644,9 @@ Module PBMap ; \BoundingBox\w = PathBoundsWidth() ; \BoundingBox\h = PathBoundsHeight() If \Focus - VectorSourceColor(PBMap\Options\ColourFocus) + VectorSourceColor(*PBMap\Options\ColourFocus) ElseIf \Selected - VectorSourceColor(PBMap\Options\ColourSelected) + VectorSourceColor(*PBMap\Options\ColourSelected) Else VectorSourceColor(\Colour) EndIf @@ -1654,7 +1654,7 @@ Module PBMap ; YA pour marquer chaque point d'un rond ForEach \Track() - LatLon2PixelRel(@PBMap\TracksList()\Track(), @Pixel, PBMap\Zoom) + LatLon2PixelRel(@*PBMap\TracksList()\Track(), @Pixel, *PBMap\Zoom) AddPathCircle(Pixel\x,Pixel\y,(\StrokeWidth / 4)) Next VectorSourceColor(RGBA(255, 255, 0, 255)) @@ -1665,22 +1665,22 @@ Module PBMap Next EndVectorLayer() ;Draw distances - If PBMap\Options\ShowTrackKms And PBMap\Zoom > 10 + If *PBMap\Options\ShowTrackKms And *PBMap\Zoom > 10 BeginVectorLayer() - ForEach PBMap\TracksList() + ForEach *PBMap\TracksList() If \Visible km = 0 : memKm = -1 - ForEach PBMap\TracksList()\Track() + 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()) + km = km + HaversineInKM(@Location, @*PBMap\TracksList()\Track()) Location\Latitude = \Track()\Latitude Location\Longitude = \Track()\Longitude EndIf - LatLon2PixelRel(@PBMap\TracksList()\Track(), @Pixel, PBMap\Zoom) + LatLon2PixelRel(@*PBMap\TracksList()\Track(), @Pixel, *PBMap\Zoom) If Int(km) <> memKm memKm = Int(km) If Int(km) = 0 @@ -1710,9 +1710,9 @@ Module PBMap 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 + 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()) @@ -1727,7 +1727,7 @@ Module PBMap Wend EndIf Next - SetZoomToTracks(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 @@ -1761,37 +1761,37 @@ Module PBMap ;-*** Markers Procedure ClearMarkers() - ClearList(PBMap\Markers()) - PBMap\Redraw = #True + ClearList(*PBMap\Markers()) + *PBMap\Redraw = #True EndProcedure Procedure DeleteMarker(*Ptr) If *Ptr - ChangeCurrentElement(PBMap\Markers(), *Ptr) - DeleteElement(PBMap\Markers()) - PBMap\Redraw = #True + ChangeCurrentElement(*PBMap\Markers(), *Ptr) + DeleteElement(*PBMap\Markers()) + *PBMap\Redraw = #True EndIf EndProcedure Procedure DeleteSelectedMarkers() - ForEach PBMap\Markers() - If PBMap\Markers()\Selected - DeleteElement(PBMap\Markers()) - PBMap\Redraw = #True + ForEach *PBMap\Markers() + If *PBMap\Markers()\Selected + DeleteElement(*PBMap\Markers()) + *PBMap\Redraw = #True EndIf Next EndProcedure Procedure.i AddMarker(Latitude.d, Longitude.d, Identifier.s = "", Legend.s = "", Color.l=-1, CallBackPointer.i = -1) - Protected *Ptr = AddElement(PBMap\Markers()) + Protected *Ptr = AddElement(*PBMap\Markers()) If *Ptr - PBMap\Markers()\GeographicCoordinates\Latitude = Latitude - PBMap\Markers()\GeographicCoordinates\Longitude = ClipLongitude(Longitude) - PBMap\Markers()\Identifier = Identifier - PBMap\Markers()\Legend = Legend - PBMap\Markers()\Color = Color - PBMap\Markers()\CallBackPointer = CallBackPointer - PBMap\Redraw = #True + *PBMap\Markers()\GeographicCoordinates\Latitude = Latitude + *PBMap\Markers()\GeographicCoordinates\Longitude = ClipLongitude(Longitude) + *PBMap\Markers()\Identifier = Identifier + *PBMap\Markers()\Legend = Legend + *PBMap\Markers()\Color = Color + *PBMap\Markers()\CallBackPointer = CallBackPointer + *PBMap\Redraw = #True ProcedureReturn *Ptr EndIf EndProcedure @@ -1811,9 +1811,9 @@ Module PBMap EndProcedure Procedure MarkerEditCloseWindow() - ForEach PBMap\Markers() - If PBMap\Markers()\EditWindow = EventWindow() - PBMap\Markers()\EditWindow = 0 + ForEach *PBMap\Markers() + If *PBMap\Markers()\EditWindow = EventWindow() + *PBMap\Markers()\EditWindow = 0 EndIf Next CloseWindow(EventWindow()) @@ -1821,7 +1821,7 @@ Module PBMap 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) + 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")) @@ -1849,28 +1849,28 @@ Module PBMap VectorSourceColor(*Marker\Color) FillPath(#PB_Path_Preserve) If *Marker\Focus - VectorSourceColor(PBMap\Options\ColourFocus) + VectorSourceColor(*PBMap\Options\ColourFocus) StrokePath(3) ElseIf *Marker\Selected - VectorSourceColor(PBMap\Options\ColourSelected) + VectorSourceColor(*PBMap\Options\ColourSelected) StrokePath(4) Else VectorSourceColor(*Marker\Color) StrokePath(1) EndIf - If PBMap\Options\ShowMarkersNb + If *PBMap\Options\ShowMarkersNb If *Marker\Identifier = "" Text.s = Str(Nb) Else Text.s = *Marker\Identifier EndIf - VectorFont(FontID(PBMap\StandardFont), 13) + VectorFont(FontID(*PBMap\StandardFont), 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\StandardFont), 13) + If *PBMap\Options\ShowMarkersLegend And *Marker\Legend <> "" + VectorFont(FontID(*PBMap\StandardFont), 13) ; dessin d'un cadre avec fond transparent Protected Height = VectorParagraphHeight(*Marker\Legend, 100, 100) Protected Width.l @@ -1894,13 +1894,13 @@ Module PBMap ; 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) + 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()) + DrawMarker(Pixel\x, Pixel\y, ListIndex(*PBMap\Markers()), @*PBMap\Markers()) EndIf EndIf Next @@ -1910,22 +1910,22 @@ Module PBMap Procedure DrawDebugInfos(*Drawing.DrawingParameters) ; Display how many images in cache - VectorFont(FontID(PBMap\StandardFont), 16) + VectorFont(FontID(*PBMap\StandardFont), 16) VectorSourceColor(RGBA(0, 0, 0, 80)) MovePathCursor(50, 50) - DrawVectorText("Images in cache : " + 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 IsThread(PBMap\MemCache\Images()\Tile\GetImageThread) + ForEach *PBMap\MemCache\Images() + If *PBMap\MemCache\Images()\Tile > 0 + If IsThread(*PBMap\MemCache\Images()\Tile\GetImageThread) ThreadCounter + 1 EndIf EndIf Next DrawVectorText("Threads nb : " + Str(ThreadCounter)) MovePathCursor(50, 90) - DrawVectorText("Zoom : " + Str(PBMap\Zoom)) + DrawVectorText("Zoom : " + Str(*PBMap\Zoom)) MovePathCursor(50, 110) DrawVectorText("Lat-Lon 1 : " + StrD(*Drawing\Bounds\NorthWest\Latitude) + "," + StrD(*Drawing\Bounds\NorthWest\Longitude)) MovePathCursor(50, 130) @@ -1934,28 +1934,28 @@ Module PBMap Procedure DrawOSMCopyright(*Drawing.DrawingParameters) Protected Text.s = "© OpenStreetMap contributors" - VectorFont(FontID(PBMap\StandardFont), 12) + VectorFont(FontID(*PBMap\StandardFont), 12) VectorSourceColor(RGBA(0, 0, 0, 80)) - MovePathCursor(GadgetWidth(PBMAP\Gadget) - VectorTextWidth(Text), GadgetHeight(PBMAP\Gadget) - 20) + MovePathCursor(GadgetWidth(*PBMap\Gadget) - VectorTextWidth(Text), GadgetHeight(*PBMap\Gadget) - 20) DrawVectorText(Text) EndProcedure Procedure Drawing() - Protected *Drawing.DrawingParameters = @PBMap\Drawing + Protected *Drawing.DrawingParameters = @*PBMap\Drawing Protected PixelCenter.PixelCoordinates - Protected Px.d, Py.d,a, ts = PBMap\TileSize, nx, ny + Protected Px.d, Py.d,a, ts = *PBMap\TileSize, nx, ny Protected LayerOrder.i = 0 Protected NW.Coordinates, SE.Coordinates Protected OSMCopyright.i = #False - PBMap\Dirty = #False - PBMap\Redraw = #False + *PBMap\Dirty = #False + *PBMap\Redraw = #False ; *** 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) + *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 @@ -1968,47 +1968,47 @@ Module PBMap 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 + 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)) + 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. ; Draws layers based on their number - ForEach PBMap\LayersList() - If PBMap\LayersList()\Enabled - DrawTiles(*Drawing, PBMap\LayersList()\Name) + ForEach *PBMap\LayersList() + If *PBMap\LayersList()\Enabled + DrawTiles(*Drawing, *PBMap\LayersList()\Name) EndIf - If PBMap\LayersList()\LayerType = 0 ; OSM + If *PBMap\LayersList()\LayerType = 0 ; OSM OSMCopyright = #True EndIf Next - If PBMap\Options\ShowTrack + If *PBMap\Options\ShowTrack DrawTracks(*Drawing) EndIf - If PBMap\Options\ShowMarkers + If *PBMap\Options\ShowMarkers DrawMarkers(*Drawing) EndIf - If PBMap\Options\ShowDegrees And PBMap\Zoom > 2 + If *PBMap\Options\ShowDegrees And *PBMap\Zoom > 2 DrawDegrees(*Drawing, 192) EndIf - If PBMap\Options\ShowPointer + If *PBMap\Options\ShowPointer DrawPointer(*Drawing) EndIf - If PBMap\Options\ShowDebugInfos + If *PBMap\Options\ShowDebugInfos DrawDebugInfos(*Drawing) EndIf - If PBMap\Options\ShowScale - DrawScale(*Drawing, 10, GadgetHeight(PBMAP\Gadget) - 20, 192) + 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 + If *PBMap\Options\ShowZoom + DrawZoom(GadgetWidth(*PBMap\Gadget) - 30, 5) ; ajout YA - affiche le niveau de zoom EndIf If OSMCopyright DrawOSMCopyright(*Drawing) @@ -2017,56 +2017,56 @@ Module PBMap EndProcedure Procedure Refresh() - PBMap\Redraw = #True + *PBMap\Redraw = #True ; Drawing() EndProcedure ;-*** Misc functions 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) + 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 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) + 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 Procedure SetLocation(latitude.d, longitude.d, Zoom = -1, Mode.i = #PB_Absolute) Select Mode Case #PB_Absolute - PBMap\GeographicCoordinates\Latitude = latitude - PBMap\GeographicCoordinates\Longitude = longitude + *PBMap\GeographicCoordinates\Latitude = latitude + *PBMap\GeographicCoordinates\Longitude = longitude If Zoom <> -1 - PBMap\Zoom = Zoom + *PBMap\Zoom = Zoom EndIf Case #PB_Relative - PBMap\GeographicCoordinates\Latitude + latitude - PBMap\GeographicCoordinates\Longitude + longitude + *PBMap\GeographicCoordinates\Latitude + latitude + *PBMap\GeographicCoordinates\Longitude + longitude If Zoom <> -1 - PBMap\Zoom + Zoom + *PBMap\Zoom + Zoom EndIf EndSelect - PBMap\GeographicCoordinates\Longitude = ClipLongitude(PBMap\GeographicCoordinates\Longitude) - If PBMap\GeographicCoordinates\Latitude < -89 - PBMap\GeographicCoordinates\Latitude = -89 + *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 + 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) + 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) ; 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\GeographicCoordinates) + *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\GeographicCoordinates) EndIf EndProcedure @@ -2080,20 +2080,20 @@ Module PBMap 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 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 viewHeightHalf.d = *PBMap\Drawing\RadiusY ; Protected zoomFactorPowered.d = viewHeightHalf / (40.7436654315252*(vy1 - vy0)) - Protected resolutionVertical.d = 360.0 / (zoomFactorPowered * PBMap\TileSize) + 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 zoom.d = Log(360 / (resolution * *PBMap\TileSize))/Log(2) Protected lon.d = centerX; Protected lat.d = centerY; SetLocation(lat, lon, Round(zoom,#PB_Round_Down)) Else - SetLocation(PBMap\GeographicCoordinates\Latitude, PBMap\GeographicCoordinates\Longitude, 15) + SetLocation(*PBMap\GeographicCoordinates\Latitude, *PBMap\GeographicCoordinates\Longitude, 15) EndIf EndProcedure @@ -2125,64 +2125,64 @@ Module PBMap 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 + *PBMap\Zoom = zoom EndSelect - 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) + 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 + *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\GeographicCoordinates) + *PBMap\Redraw = #True + If *PBMap\CallBackLocation > 0 + CallFunctionFast(*PBMap\CallBackLocation, @*PBMap\GeographicCoordinates) EndIf EndProcedure Procedure SetAngle(Angle.d, Mode = #PB_Absolute) If Mode = #PB_Absolute - PBmap\Angle = Angle + *PBMap\Angle = Angle Else - PBMap\Angle + Angle - PBMap\Angle = Mod(PBMap\Angle,360) + *PBMap\Angle + Angle + *PBMap\Angle = Mod(*PBMap\Angle,360) EndIf - PBMap\Redraw = #True + *PBMap\Redraw = #True EndProcedure ;-*** Callbacks Procedure SetCallBackLocation(CallBackLocation.i) - PBMap\CallBackLocation = CallBackLocation + *PBMap\CallBackLocation = CallBackLocation EndProcedure Procedure SetCallBackMainPointer(CallBackMainPointer.i) - PBMap\CallBackMainPointer = CallBackMainPointer + *PBMap\CallBackMainPointer = CallBackMainPointer EndProcedure Procedure SetCallBackMarker(CallBackLocation.i) - PBMap\CallBackMarker = CallBackLocation + *PBMap\CallBackMarker = CallBackLocation EndProcedure Procedure SetCallBackLeftClic(CallBackLocation.i) - PBMap\CallBackLeftClic = CallBackLocation + *PBMap\CallBackLeftClic = CallBackLocation EndProcedure Procedure SetCallBackDrawTile(CallBackLocation.i) - PBMap\CallBackDrawTile = CallBackLocation + *PBMap\CallBackDrawTile = CallBackLocation EndProcedure Procedure SetCallBackModifyTileFile(CallBackLocation.i) - PBMap\CallBackModifyTileFile = CallBackLocation + *PBMap\CallBackModifyTileFile = CallBackLocation EndProcedure ;*** Procedure SetMapScaleUnit(ScaleUnit.i = PBMAP::#SCALE_KM) - PBMap\Options\ScaleUnit = ScaleUnit - PBMap\Redraw = #True + *PBMap\Options\ScaleUnit = ScaleUnit + *PBMap\Redraw = #True ; Drawing() EndProcedure @@ -2192,82 +2192,82 @@ Module PBMap ; #MODE_SELECT = 2 -> Move objects only ; #MODE_EDIT = 3 -> Create objects Procedure SetMode(Mode.i = #MODE_DEFAULT) - PBMap\Mode = Mode + *PBMap\Mode = Mode EndProcedure Procedure.i GetMode() - ProcedureReturn PBMap\Mode + ProcedureReturn *PBMap\Mode EndProcedure ; 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 - LatLon2Pixel(@PBMap\GeographicCoordinates, @PBMap\PixelCoordinates, PBMap\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 + *PBMap\PixelCoordinates\x + x + *PBMap\PixelCoordinates\y + y ElseIf zoom = -1 - PBMap\PixelCoordinates\x - x/2 - PBMap\PixelCoordinates\y - y/2 + *PBMap\PixelCoordinates\x - x/2 + *PBMap\PixelCoordinates\y - y/2 EndIf - Pixel2LatLon(@PBMap\PixelCoordinates, @PBMap\GeographicCoordinates, PBMap\Zoom) + Pixel2LatLon(@*PBMap\PixelCoordinates, @*PBMap\GeographicCoordinates, *PBMap\Zoom) ; Start drawing - PBMap\Redraw = #True + *PBMap\Redraw = #True ; If CallBackLocation send Location To function - If PBMap\CallBackLocation > 0 - CallFunctionFast(PBMap\CallBackLocation, @PBMap\GeographicCoordinates) + If *PBMap\CallBackLocation > 0 + CallFunctionFast(*PBMap\CallBackLocation, @*PBMap\GeographicCoordinates) EndIf EndProcedure ; 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) + SetZoomOnPixel(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) - LatLon2Pixel(@PBMap\GeographicCoordinates, @PBMap\PixelCoordinates, PBMap\Zoom) - PBMap\PixelCoordinates\x + x - PBMap\Drawing\RadiusX - PBMap\PixelCoordinates\y + y - PBMap\Drawing\RadiusY - Pixel2LatLon(@PBMap\PixelCoordinates, @PBMap\GeographicCoordinates, PBMap\Zoom) + LatLon2Pixel(@*PBMap\GeographicCoordinates, @*PBMap\PixelCoordinates, *PBMap\Zoom) + *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 + *PBMap\Redraw = #True ; If CallBackLocation send Location to function - If PBMap\CallBackLocation > 0 - CallFunctionFast(PBMap\CallBackLocation, @PBMap\GeographicCoordinates) + 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) + *PBMap\PixelCoordinates\x = x + *PBMap\PixelCoordinates\y = y + Pixel2LatLon(@*PBMap\PixelCoordinates, @*PBMap\GeographicCoordinates, *PBMap\Zoom) ; Start drawing - PBMap\Redraw = #True + *PBMap\Redraw = #True ; If CallBackLocation send Location to function - If PBMap\CallBackLocation > 0 - CallFunctionFast(PBMap\CallBackLocation, @PBMap\GeographicCoordinates) + If *PBMap\CallBackLocation > 0 + CallFunctionFast(*PBMap\CallBackLocation, @*PBMap\GeographicCoordinates) EndIf EndProcedure Procedure.d GetLatitude() - ProcedureReturn PBMap\GeographicCoordinates\Latitude + ProcedureReturn *PBMap\GeographicCoordinates\Latitude EndProcedure Procedure.d GetLongitude() - ProcedureReturn PBMap\GeographicCoordinates\Longitude + ProcedureReturn *PBMap\GeographicCoordinates\Longitude EndProcedure Procedure.i GetZoom() - ProcedureReturn PBMap\Zoom + ProcedureReturn *PBMap\Zoom EndProcedure Procedure.d GetAngle() - ProcedureReturn PBMap\Angle + ProcedureReturn *PBMap\Angle EndProcedure Procedure NominatimGeoLocationQuery(Address.s, *ReturnPosition.GeographicCoordinates = 0) @@ -2275,13 +2275,13 @@ Module PBMap 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) + 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) - If PBMap\Options\Proxy - HTTPProxy(PBMap\Options\ProxyURL + ":" + PBMap\Options\ProxyPort, PBMap\Options\ProxyUser, PBMap\Options\ProxyPassword) + 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 @@ -2311,18 +2311,18 @@ Module PBMap 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 *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", 3) - CreateDirectoryEx(PBMap\Options\HDDCachePath) + If DeleteDirectory(*PBMap\Options\HDDCachePath, "", #PB_FileSystem_Recursive) + MyDebug("Cache in : " + *PBMap\Options\HDDCachePath + " cleared", 3) + CreateDirectoryEx(*PBMap\Options\HDDCachePath) ProcedureReturn #True Else - MyDebug("Can't clear cache in " + PBMap\Options\HDDCachePath, 3) + MyDebug("Can't clear cache in " + *PBMap\Options\HDDCachePath, 3) ProcedureReturn #False EndIf EndProcedure @@ -2331,85 +2331,85 @@ Module PBMap Procedure CanvasEvents() Protected CanvasMouseX.d, CanvasMouseY.d, MouseX.d, MouseY.d - Protected MarkerCoords.PixelCoordinates, *Tile.Tile, MapWidth = Pow(2, PBMap\Zoom) * PBMap\TileSize + Protected MarkerCoords.PixelCoordinates, *Tile.Tile, MapWidth = Pow(2, *PBMap\Zoom) * *PBMap\TileSize Protected key.s, Touch.i Protected Pixel.PixelCoordinates Protected ImgNB.i, TileNewFilename.s Static CtrlKey Protected Location.GeographicCoordinates - CanvasMouseX = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) - PBMap\Drawing\RadiusX - CanvasMouseY = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY) - PBMap\Drawing\RadiusY + 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) + ; 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 + *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) + 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 + *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) + With *PBMap\Markers() + Select GetGadgetAttribute(*PBMap\Gadget, #PB_Canvas_Key) Case #PB_Shortcut_Left - ForEach PBMap\Markers() + ForEach *PBMap\Markers() If \Selected - \GeographicCoordinates\Longitude = ClipLongitude( \GeographicCoordinates\Longitude - 10* 360 / Pow(2, PBMap\Zoom + 8)) + \GeographicCoordinates\Longitude = ClipLongitude( \GeographicCoordinates\Longitude - 10* 360 / Pow(2, *PBMap\Zoom + 8)) EndIf Next Case #PB_Shortcut_Up - ForEach PBMap\Markers() + ForEach *PBMap\Markers() If \Selected - \GeographicCoordinates\Latitude + 10* 360 / Pow(2, PBMap\Zoom + 8) + \GeographicCoordinates\Latitude + 10* 360 / Pow(2, *PBMap\Zoom + 8) EndIf Next Case #PB_Shortcut_Right - ForEach PBMap\Markers() + ForEach *PBMap\Markers() If \Selected - \GeographicCoordinates\Longitude = ClipLongitude( \GeographicCoordinates\Longitude + 10* 360 / Pow(2, PBMap\Zoom + 8)) + \GeographicCoordinates\Longitude = ClipLongitude( \GeographicCoordinates\Longitude + 10* 360 / Pow(2, *PBMap\Zoom + 8)) EndIf Next Case #PB_Shortcut_Down - ForEach PBMap\Markers() + ForEach *PBMap\Markers() If \Selected - \GeographicCoordinates\Latitude - 10* 360 / Pow(2, PBMap\Zoom + 8) + \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 + *PBMap\Redraw = #True + If GetGadgetAttribute(*PBMap\Gadget, #PB_Canvas_Modifiers)&#PB_Canvas_Control <> 0 CtrlKey = #True EndIf Case #PB_EventType_LeftDoubleClick - LatLon2Pixel(@PBMap\GeographicCoordinates, @PBMap\PixelCoordinates, PBMap\Zoom) - MouseX = PBMap\PixelCoordinates\x + CanvasMouseX - MouseY = PBMap\PixelCoordinates\y + CanvasMouseY + 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) + 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 + 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) - ElseIf PBMap\Mode = #MODE_EDIT + SetLocation(*PBMap\Markers()\GeographicCoordinates\Latitude, *PBMap\Markers()\GeographicCoordinates\Longitude) + ElseIf *PBMap\Mode = #MODE_EDIT ; Edit the legend - MarkerEdit(@PBMap\Markers()) + MarkerEdit(@*PBMap\Markers()) EndIf Break EndIf @@ -2418,121 +2418,121 @@ Module PBMap GotoPixel(MouseX, MouseY) EndIf Case #PB_EventType_MouseWheel - If PBMap\Options\WheelMouseRelative + If *PBMap\Options\WheelMouseRelative ; Relative zoom (centered on the mouse) - SetZoomOnPixel(CanvasMouseX, CanvasMouseY, GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_WheelDelta)) + SetZoomOnPixel(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) + SetZoom(GetGadgetAttribute(*PBMap\Gadget, #PB_Canvas_WheelDelta), #PB_Relative) EndIf Case #PB_EventType_LeftButtonDown - ; LatLon2Pixel(@PBMap\GeographicCoordinates, @PBMap\PixelCoordinates, PBMap\Zoom) - PBMap\Dragging = #True + ; LatLon2Pixel(@*PBMap\GeographicCoordinates, @*PBMap\PixelCoordinates, *PBMap\Zoom) + *PBMap\Dragging = #True ; Memorize cursor Coord - PBMap\MoveStartingPoint\x = CanvasMouseX - PBMap\MoveStartingPoint\y = CanvasMouseY + *PBMap\MoveStartingPoint\x = CanvasMouseX + *PBMap\MoveStartingPoint\y = CanvasMouseY ; 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 + *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) - ForEach PBMap\Markers() + 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\Markers()\Focus = #False + If *PBMap\Markers()\Focus + *PBMap\Markers()\Selected = #True + *PBMap\EditMarker = #True; ListIndex(*PBMap\Markers()) + *PBMap\Markers()\Focus = #False EndIf Next ; Check if we select track(s) - ForEach PBMap\TracksList() + 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 - PBMap\TracksList()\Focus = #False + If *PBMap\TracksList()\Focus + *PBMap\TracksList()\Selected = #True + *PBMap\TracksList()\Focus = #False EndIf Next EndIf ; YA pour sélectionner un point de la trace avec le clic gauche - If PBMap\EditMarker = #False + If *PBMap\EditMarker = #False Location\Latitude = GetMouseLatitude() Location\Longitude = GetMouseLongitude() - If PBMap\CallBackLeftClic > 0 - CallFunctionFast(PBMap\CallBackLeftClic, @Location) + 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) + 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 + SetGadgetAttribute(*PBMap\Gadget, #PB_Canvas_Cursor, #PB_Cursor_Default) ; ajout YA pour remettre le pointeur souris en normal EndIf Case #PB_EventType_MouseMove ; Drag - 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 + 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 - 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) + 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) + Pixel2LatLon(@MarkerCoords, @*PBMap\Markers()\GeographicCoordinates, *PBMap\Zoom) EndIf Next - ElseIf PBMap\Mode = #MODE_DEFAULT Or PBMap\Mode = #MODE_HAND + 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) + 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) + If *PBMap\CallBackLocation > 0 + CallFunctionFast(*PBMap\CallBackLocation, @*PBMap\GeographicCoordinates) EndIf EndIf - PBMap\Redraw = #True + *PBMap\Redraw = #True Else ; Touch test - LatLon2Pixel(@PBMap\GeographicCoordinates, @PBMap\PixelCoordinates, PBMap\Zoom) - MouseX = PBMap\PixelCoordinates\x + CanvasMouseX - MouseY = PBMap\PixelCoordinates\y + CanvasMouseY + 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) - If PBMap\Mode = #MODE_DEFAULT Or PBMap\Mode = #MODE_SELECT Or PBMap\Mode = #MODE_EDIT + 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) + 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 + *PBMap\Markers()\Focus = #True + *PBMap\Redraw = #True + ElseIf *PBMap\Markers()\Focus ; If CtrlKey = #False - PBMap\Markers()\Focus = #False - PBMap\Redraw = #True + *PBMap\Markers()\Focus = #False + *PBMap\Redraw = #True EndIf Next ; Check if mouse touch tracks - If PBMap\Options\ShowTrackSelection ; YA ajout pour éviter la sélection de la trace - With PBMap\TracksList() + If *PBMap\Options\ShowTrackSelection ; YA ajout pour éviter la sélection de la trace + With *PBMap\TracksList() ; Trace Track - If ListSize(PBMap\TracksList()) > 0 - ForEach PBMap\TracksList() + If ListSize(*PBMap\TracksList()) > 0 + ForEach *PBMap\TracksList() If ListSize(\Track()) > 0 If \Visible - StartVectorDrawing(CanvasVectorOutput(PBMap\Gadget)) + StartVectorDrawing(CanvasVectorOutput(*PBMap\Gadget)) ; Simulates track drawing ForEach \Track() - LatLon2Pixel(@PBMap\TracksList()\Track(), @Pixel, PBMap\Zoom) + LatLon2Pixel(@*PBMap\TracksList()\Track(), @Pixel, *PBMap\Zoom) If ListIndex(\Track()) = 0 MovePathCursor(Pixel\x, Pixel\y) Else @@ -2541,10 +2541,10 @@ Module PBMap Next If IsInsideStroke(MouseX, MouseY, \StrokeWidth) \Focus = #True - PBMap\Redraw = #True + *PBMap\Redraw = #True ElseIf \Focus \Focus = #False - PBMap\Redraw = #True + *PBMap\Redraw = #True EndIf StopVectorDrawing() EndIf @@ -2556,55 +2556,55 @@ Module PBMap EndIf EndIf Case #PB_EventType_LeftButtonUp - 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 + 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()); + ForEach *PBMap\Markers() + If *PBMap\Markers()\Selected = #True + If *PBMap\CallBackMarker > 0 + CallFunctionFast(*PBMap\CallBackMarker, @*PBMap\Markers()); EndIf EndIf Next Case #PB_MAP_REDRAW - PBMap\Redraw = #True + *PBMap\Redraw = #True Case #PB_MAP_RETRY - PBMap\Redraw = #True - ;- #PB_MAP_TILE_CLEANUP : Tile web loading thread cleanup - ; After a Web tile loading thread, clean the tile structure memory, see GetImageThread() + *PBMap\Redraw = #True + ;- #PB_MAP_TILE_CLEANUP : 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 *Tile\Download = 0 - If FindMapElement(PBMap\MemCache\Images(), key) <> 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 + *PBMap\MemCache\Images(key)\Tile = *Tile\Size If *Tile\Size - PBMap\MemCache\Images(key)\Tile = -1 ; Web loading thread has finished successfully + *PBMap\MemCache\Images(key)\Tile = -1 ; Web loading thread has finished successfully ;- Allows to post edit the tile image file with a customised code - If PBMap\CallBackModifyTileFile - TileNewFilename = PBMap\CallBackModifyTileFile(*Tile\CacheFile, *Tile\URL) + If *PBMap\CallBackModifyTileFile + TileNewFilename = *PBMap\CallBackModifyTileFile(*Tile\CacheFile, *Tile\URL) If TileNewFilename ;TODO : Not used by now, a new filename is sent back *Tile\CacheFile = TileNewFilename EndIf EndIf Else - PBMap\MemCache\Images(key)\Tile = 0 + *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 + 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 ; Redraws at regular intervals Procedure TimerEvents() - If EventTimer() = PBMap\Timer And (PBMap\Redraw Or PBMap\Dirty) + If EventTimer() = *PBMap\Timer And (*PBMap\Redraw Or *PBMap\Dirty) MemoryCacheManagement() Drawing() EndIf @@ -2612,51 +2612,56 @@ Module PBMap ; 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) + *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 + *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 + *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) + *PBMap\Gadget = Gadget + CanvasGadget(*PBMap\Gadget, X, Y, Width, Height, #PB_Canvas_Keyboard) EndIf - BindMapGadget(PBMap\Gadget) + BindMapGadget(*PBMap\Gadget) EndProcedure Procedure Quit() - PBMap\Drawing\End = #True + *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) + 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) + KillThread(*PBMap\MemCache\Images()\Tile\GetImageThread) EndIf Else - FreeMemory(PBMap\MemCache\Images()\Tile) - PBMap\MemCache\Images()\Tile = 0 + FreeMemory(*PBMap\MemCache\Images()\Tile) + *PBMap\MemCache\Images()\Tile = 0 EndIf Else - DeleteMapElement(PBMap\MemCache\Images()) + DeleteMapElement(*PBMap\MemCache\Images()) EndIf Next Delay(10) - Until MapSize(PBMap\MemCache\Images()) = 0 + Until MapSize(*PBMap\MemCache\Images()) = 0 + FreeStructure(*PBMap) EndProcedure - Procedure InitPBMap(Window) - With PBMap + Procedure.i InitPBMap(Window, TimerNB = 1) ; For multiple PBMaps in one window, TimerNB should be defined and unique for each. *PBMap is returned + *PBMap.PBMap = AllocateStructure(PBMap) + If *PBMap = 0 + FatalError("Cannot initialize PBMap memory") + EndIf + With *PBMap Protected Result.i \ZoomMin = 1 \ZoomMax = 18 @@ -2667,7 +2672,7 @@ Module PBMap \StandardFont = LoadFont(#PB_Any, "Arial", 20, #PB_Font_Bold) \UnderlineFont = LoadFont(#PB_Any, "Arial", 20, #PB_Font_Underline) \Window = Window - \Timer = 1 + \Timer = TimerNB \Mode = #MODE_DEFAULT \MemoryCacheAccessMutex = CreateMutex() If \MemoryCacheAccessMutex = #False @@ -2677,9 +2682,14 @@ Module PBMap EndWith LoadOptions() TechnicalImagesCreation() - SetLocation(0, 0) + SetLocation(0, 0) + ProcedureReturn *PBMap EndProcedure + Procedure SelectPBMap(*NewPBMap) ; Could be used to have multiple PBMaps in one window + *PBMap = *NewPBMap + EndProcedure + EndModule ; **************************************************************** @@ -2869,9 +2879,10 @@ CompilerIf #PB_Compiler_IsMainFile Define pfValue.d Define Degrees = 1 Define *Track + Define *PBMap ; Our main gadget - PBMap::InitPBMap(#Window_0) + *PBMap = PBMap::InitPBMap(#Window_0) PBMap::SetOption("ShowDegrees", "1") : Degrees = 0 PBMap::SetOption("ShowDebugInfos", "1") PBMap::SetDebugLevel(5) @@ -2885,7 +2896,7 @@ CompilerIf #PB_Compiler_IsMainFile 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::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()) ;PBMap::SetCallBackDrawTile(@DrawTileCallBack()) @@ -3022,8 +3033,8 @@ CompilerEndIf ; IDE Options = PureBasic 5.61 (Windows - x64) -; CursorPosition = 1222 -; FirstLine = 1194 +; CursorPosition = 440 +; FirstLine = 455 ; Folding = --------------------- ; EnableThread ; EnableXP From 12723fab31ce2da78f7c8c0402e82d7a8d2bafc3 Mon Sep 17 00:00:00 2001 From: djes Date: Fri, 2 Mar 2018 19:42:22 +0100 Subject: [PATCH 42/60] Multiple MapGadget bugfix --- PBMap.pb | 205 +++++++++++++++++++++++++++++++------------------------ 1 file changed, 117 insertions(+), 88 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index 6091b75..bce707b 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -68,8 +68,7 @@ DeclareModule PBMap EndStructure ;*** - Declare.i InitPBMap(Window, TimerNB = 1) ; Returns *PBMap structure pointer - Declare SelectPBMap(*NewPBMap) ; Could be used to have multiple PBMaps in one window + Declare SelectPBMap(Gadget.i) ; Could be used to have multiple PBMaps in one window Declare SetDebugLevel(Level.i) Declare SetOption(Option.s, Value.s) Declare.s GetOption(Option.s) @@ -84,14 +83,15 @@ DeclareModule PBMap Declare DisableLayer(Name.s) Declare SetLayerAlpha(Name.s, Alpha.d) Declare.d GetLayerAlpha(Name.s) - Declare BindMapGadget(Gadget.i) + Declare BindMapGadget(Gadget.i, TimerNB = 1) Declare SetCallBackLocation(*CallBackLocation) Declare SetCallBackMainPointer(CallBackMainPointer.i) Declare SetCallBackDrawTile(*CallBackLocation) Declare SetCallBackMarker(*CallBackLocation) Declare SetCallBackLeftClic(*CallBackLocation) Declare SetCallBackModifyTileFile(*CallBackLocation) - Declare MapGadget(Gadget.i, X.i, Y.i, Width.i, Height.i) + Declare.i MapGadget(Gadget.i, X.i, Y.i, Width.i, Height.i, TimerNB = 1) ; Returns Gadget NB if #PB_Any is used for gadget + Declare FreeMapGadget(Gadget.i) Declare.d GetLatitude() Declare.d GetLongitude() Declare.d GetMouseLatitude() @@ -118,7 +118,6 @@ DeclareModule PBMap Declare DeleteMarker(*Ptr) Declare DeleteSelectedMarkers() Declare Drawing() - Declare Quit() Declare FatalError(msg.s) Declare Error(msg.s) Declare Refresh() @@ -156,6 +155,8 @@ Module PBMap Download.i Time.i Size.i + Window.i ; Parent Window + Gadget.i EndStructure Structure BoundingBox @@ -318,7 +319,7 @@ Module PBMap Dragging.i Dirty.i ; To signal that drawing need a refresh - MemoryCacheAccessMutex.i ; Memorycache access variable mutual exclusion + MemoryCacheAccessMutex.i ; Memorycache access variable mutual exclusion DownloadSlots.i ; Actual nb of used download slots List TracksList.Tracks() ; To display a GPX track @@ -337,6 +338,7 @@ Module PBMap ;-Show debug infos Global MyDebugLevel = 5 + Global NewMap PBMaps() Global *PBMap.PBMap Global slash.s @@ -891,7 +893,8 @@ Module PBMap EndWith EndProcedure - Procedure LoadOptions(PreferencesFile.s = "PBMap.prefs") + Procedure LoadOptions(MapGadget.i, PreferencesFile.s = "PBMap.prefs") + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) If PreferencesFile = "PBMap.prefs" OpenPreferences(GetHomeDirectory() + "PBMap.prefs") Else @@ -1219,7 +1222,7 @@ Module PBMap EndIf ; 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 + PostEvent(#PB_Event_Gadget, *Tile\Window, *Tile\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ; To free memory outside the thread ;UnlockMutex(*PBMap\MemoryCacheAccessMutex) EndProcedure @@ -1315,6 +1318,8 @@ Module PBMap \CacheFile = CacheFile \nImage = 0 \Time = ElapsedMilliseconds() + \Window = *PBMap\Window + \Gadget = *PBMap\Gadget \GetImageThread = CreateThread(@GetImageThread(), *NewTile) If \GetImageThread *timg\Tile = *NewTile ; There's now a loading thread @@ -2331,12 +2336,15 @@ Module PBMap Procedure CanvasEvents() Protected CanvasMouseX.d, CanvasMouseY.d, MouseX.d, MouseY.d - Protected MarkerCoords.PixelCoordinates, *Tile.Tile, MapWidth = Pow(2, *PBMap\Zoom) * *PBMap\TileSize + Protected MarkerCoords.PixelCoordinates, *Tile.Tile, MapWidth Protected key.s, Touch.i Protected Pixel.PixelCoordinates Protected ImgNB.i, TileNewFilename.s Static CtrlKey Protected Location.GeographicCoordinates + + Protected *PBMap.PBmap = PBMaps(Str(EventGadget())) + MapWidth = Pow(2, *PBMap\Zoom) * *PBMap\TileSize CanvasMouseX = GetGadgetAttribute(*PBMap\Gadget, #PB_Canvas_MouseX) - *PBMap\Drawing\RadiusX CanvasMouseY = GetGadgetAttribute(*PBMap\Gadget, #PB_Canvas_MouseY) - *PBMap\Drawing\RadiusY ; rotation wip @@ -2523,41 +2531,41 @@ Module PBMap Next ; Check if mouse touch tracks If *PBMap\Options\ShowTrackSelection ; YA ajout pour éviter la sélection de la trace - With *PBMap\TracksList() - ; Trace Track - If ListSize(*PBMap\TracksList()) > 0 - ForEach *PBMap\TracksList() - If ListSize(\Track()) > 0 - If \Visible - StartVectorDrawing(CanvasVectorOutput(*PBMap\Gadget)) - ; Simulates track 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) + With *PBMap\TracksList() + ; Trace Track + If ListSize(*PBMap\TracksList()) > 0 + ForEach *PBMap\TracksList() + If ListSize(\Track()) > 0 + If \Visible + StartVectorDrawing(CanvasVectorOutput(*PBMap\Gadget)) + ; Simulates track 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 - 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 + StopVectorDrawing() + EndIf + EndIf + Next + EndIf + EndWith + EndIf EndIf EndIf - EndIf Case #PB_EventType_LeftButtonUp SetGadgetAttribute(*PBMap\Gadget,#PB_Canvas_Cursor,#PB_Cursor_Default) ; ajout YA pour remettre le pointeur souris en normal - ; *PBMap\MoveStartingPoint\x = - 1 + ; *PBMap\MoveStartingPoint\x = - 1 *PBMap\Dragging = #False *PBMap\Redraw = #True ;YA pour connaitre les coordonnées d'un marqueur après déplacement @@ -2572,8 +2580,8 @@ Module PBMap *PBMap\Redraw = #True Case #PB_MAP_RETRY *PBMap\Redraw = #True - ;- #PB_MAP_TILE_CLEANUP : Tile web loading thread cleanup - ; After a Web tile loading thread, clean the tile structure memory, see GetImageThread() + ;- #PB_MAP_TILE_CLEANUP : 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 @@ -2583,7 +2591,7 @@ Module PBMap *PBMap\MemCache\Images(key)\Tile = *Tile\Size If *Tile\Size *PBMap\MemCache\Images(key)\Tile = -1 ; Web loading thread has finished successfully - ;- Allows to post edit the tile image file with a customised code + ;- Allows to post edit the tile image file with a customised code If *PBMap\CallBackModifyTileFile TileNewFilename = *PBMap\CallBackModifyTileFile(*Tile\CacheFile, *Tile\URL) If TileNewFilename @@ -2604,14 +2612,46 @@ Module PBMap ; Redraws at regular intervals Procedure TimerEvents() - If EventTimer() = *PBMap\Timer And (*PBMap\Redraw Or *PBMap\Dirty) - MemoryCacheManagement() - Drawing() - EndIf + Protected *PBMap.PBMap + ForEach PBMaps() + *PBMap = PBMaps() + If EventTimer() = *PBMap\Timer And (*PBMap\Redraw Or *PBMap\Dirty) + MemoryCacheManagement() + Drawing() + EndIf + Next EndProcedure ; Could be called directly to attach our map to an existing canvas - Procedure BindMapGadget(Gadget.i) + Procedure BindMapGadget(Gadget.i, TimerNB = 1) + Protected *PBMap.PBMap + *PBMap.PBMap = AllocateStructure(PBMap) + If *PBMap = 0 + FatalError("Cannot initialize PBMap memory") + EndIf + PBMaps(Str(Gadget)) = *PBMap + With *PBMap + Protected Result.i + \ZoomMin = 1 + \ZoomMax = 18 + \Dragging = #False + \TileSize = 256 + \Dirty = #False + \EditMarker = #False + \StandardFont = LoadFont(#PB_Any, "Arial", 20, #PB_Font_Bold) + \UnderlineFont = LoadFont(#PB_Any, "Arial", 20, #PB_Font_Underline) + \Window = GetActiveWindow() + \Timer = TimerNB + \Mode = #MODE_DEFAULT + \MemoryCacheAccessMutex = CreateMutex() + If \MemoryCacheAccessMutex = #False + MyDebug("Cannot create a mutex", 0) + End + EndIf + EndWith + LoadOptions(*PBMap) + TechnicalImagesCreation(*PBMap) + SetLocation(*PBMap, 0, 0) *PBMap\Gadget = Gadget BindGadgetEvent(*PBMap\Gadget, @CanvasEvents()) AddWindowTimer(*PBMap\Window, *PBMap\Timer, *PBMap\Options\TimerInterval) @@ -2621,17 +2661,22 @@ Module PBMap EndProcedure ; Creates a canvas and attach our map - Procedure MapGadget(Gadget.i, X.i, Y.i, Width.i, Height.i) + Procedure MapGadget(Gadget.i, X.i, Y.i, Width.i, Height.i, TimerNB = 1) 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 + Protected GadgetNB.i + GadgetNB = CanvasGadget(#PB_Any, X, Y, Width, Height, #PB_Canvas_Keyboard) ; #PB_Canvas_Keyboard has to be set for mousewheel to work on windows + BindMapGadget(GadgetNB, TimerNB) + ProcedureReturn GadgetNB Else - *PBMap\Gadget = Gadget - CanvasGadget(*PBMap\Gadget, X, Y, Width, Height, #PB_Canvas_Keyboard) - EndIf - BindMapGadget(*PBMap\Gadget) + If CanvasGadget(Gadget, X, Y, Width, Height, #PB_Canvas_Keyboard) + BindMapGadget(Gadget, TimerNB) + Else + FatalError("Cannot create the map gadget") + EndIf + EndIf EndProcedure - Procedure Quit() + Procedure Quit(*PBMap.PBMap) *PBMap\Drawing\End = #True ; Wait for loading threads to finish nicely. Passed 2 seconds, kills them. Protected TimeCounter = ElapsedMilliseconds() @@ -2653,41 +2698,24 @@ Module PBMap Next Delay(10) Until MapSize(*PBMap\MemCache\Images()) = 0 + RemoveWindowTimer(*PBMap\Window, *PBMap\Timer) + UnbindGadgetEvent(*PBMap\Gadget, @CanvasEvents()) FreeStructure(*PBMap) EndProcedure - Procedure.i InitPBMap(Window, TimerNB = 1) ; For multiple PBMaps in one window, TimerNB should be defined and unique for each. *PBMap is returned - *PBMap.PBMap = AllocateStructure(PBMap) - If *PBMap = 0 - FatalError("Cannot initialize PBMap memory") - EndIf - With *PBMap - Protected Result.i - \ZoomMin = 1 - \ZoomMax = 18 - \Dragging = #False - \TileSize = 256 - \Dirty = #False - \EditMarker = #False - \StandardFont = LoadFont(#PB_Any, "Arial", 20, #PB_Font_Bold) - \UnderlineFont = LoadFont(#PB_Any, "Arial", 20, #PB_Font_Underline) - \Window = Window - \Timer = TimerNB - \Mode = #MODE_DEFAULT - \MemoryCacheAccessMutex = CreateMutex() - If \MemoryCacheAccessMutex = #False - MyDebug("Cannot create a mutex", 0) - End + Procedure FreeMapGadget(Gadget.i) + Protected *PBMap.PBMap + ForEach PBMaps() + *PBMap = PBMaps() + If *PBMap\Gadget = Gadget + Quit(*PBMap) + DeleteMapElement(PBMaps()) EndIf - EndWith - LoadOptions() - TechnicalImagesCreation() - SetLocation(0, 0) - ProcedureReturn *PBMap + Next EndProcedure - Procedure SelectPBMap(*NewPBMap) ; Could be used to have multiple PBMaps in one window - *PBMap = *NewPBMap + Procedure SelectPBMap(Gadget.i) ; Could be used to have multiple PBMaps in one window + *PBMap = PBMaps(Str(Gadget)) EndProcedure EndModule @@ -2882,7 +2910,8 @@ CompilerIf #PB_Compiler_IsMainFile Define *PBMap ; Our main gadget - *PBMap = PBMap::InitPBMap(#Window_0) + ;*PBMap = PBMap::InitPBMap(#Window_0) + PBMap::MapGadget(#Map, 10, 10, 512, 512) PBMap::SetOption("ShowDegrees", "1") : Degrees = 0 PBMap::SetOption("ShowDebugInfos", "1") PBMap::SetDebugLevel(5) @@ -2892,7 +2921,7 @@ CompilerIf #PB_Compiler_IsMainFile PBMap::SetOption("ShowMarkersLegend", "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(-36.81148, 175.08634,12) ; Change the PBMap coordinates @@ -3026,15 +3055,15 @@ CompilerIf #PB_Compiler_IsMainFile EndSelect Until Quit = #True - PBMap::Quit() + PBMap::FreeMapGadget(#Map) EndIf CompilerEndIf ; IDE Options = PureBasic 5.61 (Windows - x64) -; CursorPosition = 440 -; FirstLine = 455 +; CursorPosition = 897 +; FirstLine = 895 ; Folding = --------------------- ; EnableThread ; EnableXP From 1c7b161a87ea247067c15ccfabd7650ddea4844f Mon Sep 17 00:00:00 2001 From: djes Date: Fri, 2 Mar 2018 21:55:38 +0100 Subject: [PATCH 43/60] Multiple PBMaps WIP --- PBMap.pb | 608 +++++++++++++++++++++++++++++++------------------------ 1 file changed, 343 insertions(+), 265 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index bce707b..3ea23ad 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -68,60 +68,60 @@ DeclareModule PBMap EndStructure ;*** - Declare SelectPBMap(Gadget.i) ; Could be used to have multiple PBMaps in one window + ;Declare SelectPBMap(Gadget.i) ; Could be used to have multiple PBMaps in one 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 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, TimerNB = 1) - Declare SetCallBackLocation(*CallBackLocation) - Declare SetCallBackMainPointer(CallBackMainPointer.i) - Declare SetCallBackDrawTile(*CallBackLocation) - Declare SetCallBackMarker(*CallBackLocation) - Declare SetCallBackLeftClic(*CallBackLocation) - Declare SetCallBackModifyTileFile(*CallBackLocation) - Declare.i MapGadget(Gadget.i, X.i, Y.i, Width.i, Height.i, TimerNB = 1) ; Returns Gadget NB if #PB_Any is used for gadget - Declare FreeMapGadget(Gadget.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 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() - 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() - Declare Drawing() + Declare SetOption(MapGadget.i, Option.s, Value.s) + Declare.s GetOption(MapGadget.i, Option.s) + Declare LoadOptions(MapGadget.i, PreferencesFile.s = "PBMap.prefs") + Declare SaveOptions(MapGadget.i, PreferencesFile.s = "PBMap.prefs") + Declare.i AddOSMServerLayer(MapGadget.i, LayerName.s, Order.i, ServerURL.s = "http://tile.openstreetmap.org/") + Declare.i AddHereServerLayer(MapGadget.i, 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(MapGadget.i, LayerName.s, Order.i, ServerLayerName.s, ServerURL.s = "http://localhost:8080/", path.s = "geowebcache/service/gmaps", format.s = "image/png") + Declare IsLayer(MapGadget.i, Name.s) + Declare DeleteLayer(MapGadget.i, Name.s) + Declare EnableLayer(MapGadget.i, Name.s) + Declare DisableLayer(MapGadget.i, Name.s) + Declare SetLayerAlpha(MapGadget.i, Name.s, Alpha.d) + Declare.d GetLayerAlpha(MapGadget.i, Name.s) + Declare BindMapGadget(MapGadget.i, TimerNB = 1) + Declare SetCallBackLocation(MapGadget.i, *CallBackLocation) + Declare SetCallBackMainPointer(MapGadget.i, CallBackMainPointer.i) + Declare SetCallBackDrawTile(MapGadget.i, *CallBackLocation) + Declare SetCallBackMarker(MapGadget.i, *CallBackLocation) + Declare SetCallBackLeftClic(MapGadget.i, *CallBackLocation) + Declare SetCallBackModifyTileFile(MapGadget.i, *CallBackLocation) + Declare.i MapGadget(MapGadget.i, X.i, Y.i, Width.i, Height.i, TimerNB = 1) ; Returns Gadget NB if #PB_Any is used for gadget + Declare FreeMapGadget(MapGadget.i) + Declare.d GetLatitude(MapGadget.i) + Declare.d GetLongitude(MapGadget.i) + Declare.d GetMouseLatitude(MapGadget.i) + Declare.d GetMouseLongitude(MapGadget.i) + Declare.d GetAngle(MapGadget.i) + Declare.i GetZoom(MapGadget.i) + Declare.i GetMode(MapGadget.i) + Declare SetMode(MapGadget.i, Mode.i = #MODE_DEFAULT) + Declare SetMapScaleUnit(MapGadget.i, ScaleUnit=PBMAP::#SCALE_KM) + Declare SetLocation(MapGadget.i, Latitude.d, Longitude.d, Zoom = -1, Mode.i = #PB_Absolute) + Declare SetAngle(MapGadget.i, Angle.d, Mode = #PB_Absolute) + Declare SetZoom(MapGadget.i, Zoom.i, Mode.i = #PB_Relative) + Declare SetZoomToArea(MapGadget.i, MinY.d, MaxY.d, MinX.d, MaxX.d) + Declare SetZoomToTracks(MapGadget.i, *Tracks) + Declare NominatimGeoLocationQuery(MapGadget.i, Address.s, *ReturnPosition = 0) ; Send back the position *ptr.GeographicCoordinates + Declare.i LoadGpxFile(MapGadget.i, FileName.s) ; + Declare.i SaveGpxFile(MapGadget.i, FileName.s, *Track) ; + Declare ClearTracks(MapGadget.i) + Declare DeleteTrack(MapGadget.i, *Ptr) + Declare DeleteSelectedTracks(MapGadget.i) + Declare SetTrackColour(MapGadget.i, *Ptr, Colour.i) + Declare.i AddMarker(MapGadget.i, Latitude.d, Longitude.d, Identifier.s = "", Legend.s = "", color.l=-1, CallBackPointer.i = -1) + Declare ClearMarkers(MapGadget.i) + Declare DeleteMarker(MapGadget.i, *Ptr) + Declare DeleteSelectedMarkers(MapGadget.i) + Declare Drawing(MapGadget.i) Declare FatalError(msg.s) Declare Error(msg.s) - Declare Refresh() - Declare.i ClearDiskCache() + Declare Refresh(MapGadget.i) + Declare.i ClearDiskCache(MapGadget.i) EndDeclareModule @@ -388,8 +388,10 @@ Module PBMap ; 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 - PrintN(msg) +; Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) +; If *PBMap\Options\Verbose And DbgLevel <= MyDebugLevel + If DbgLevel <= MyDebugLevel + ;;PrintN(msg) ; Debug msg EndIf EndProcedure @@ -440,7 +442,8 @@ Module PBMap EndIf EndProcedure - Procedure TechnicalImagesCreation() + Procedure TechnicalImagesCreation(MapGadget.i) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) ; "Loading" image Protected LoadingText$ = "Loading" Protected NothingText$ = "Nothing" @@ -490,8 +493,8 @@ Module PBMap 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("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 @@ -509,7 +512,8 @@ Module PBMap EndIf EndProcedure - Procedure Pixel2LatLon(*Coords.PixelCoordinates, *Location.GeographicCoordinates, Zoom) + Procedure Pixel2LatLon(MapGadget.i, *Coords.PixelCoordinates, *Location.GeographicCoordinates, Zoom) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) 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 @@ -528,7 +532,8 @@ Module PBMap EndProcedure ; Lat Lon coordinates 2 pixel absolute [0 to 2^Zoom * TileSize [ - Procedure LatLon2Pixel(*Location.GeographicCoordinates, *Pixel.PixelCoordinates, Zoom) + Procedure LatLon2Pixel(MapGadget.i, *Location.GeographicCoordinates, *Pixel.PixelCoordinates, Zoom) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) 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 ) @@ -536,7 +541,8 @@ Module PBMap EndProcedure ; Lat Lon coordinates 2 pixel relative to the center of view - Procedure LatLon2PixelRel(*Location.GeographicCoordinates, *Pixel.PixelCoordinates, Zoom) + Procedure LatLon2PixelRel(MapGadget.i, *Location.GeographicCoordinates, *Pixel.PixelCoordinates, Zoom) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) Protected tilemax = Pow(2.0, Zoom) * *PBMap\TileSize Protected cx.d = *PBMap\Drawing\RadiusX Protected dpx.d = *PBMap\PixelCoordinates\x @@ -560,14 +566,16 @@ Module PBMap *Pixel\y = *PBMap\Drawing\RadiusY + (py - *PBMap\PixelCoordinates\y) EndProcedure - Procedure.d Pixel2Lon(x) + Procedure.d Pixel2Lon(MapGadget.i, x) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) 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) + Procedure.d Pixel2Lat(MapGadget.i, y) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) 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)))) @@ -588,11 +596,12 @@ Module PBMap EndProcedure Procedure.d HaversineInM(*posA.GeographicCoordinates, *posB.GeographicCoordinates) - ProcedureReturn (1000 * HaversineInKM(@*posA,@*posB)); + ProcedureReturn (1000 * HaversineInKM(@*posA, @*posB)); EndProcedure ; No more used, see LatLon2PixelRel - Procedure GetPixelCoordFromLocation(*Location.GeographicCoordinates, *Pixel.PixelCoordinates, Zoom) ; TODO to Optimize + Procedure GetPixelCoordFromLocation(MapGadget.i, *Location.GeographicCoordinates, *Pixel.PixelCoordinates, Zoom) ; TODO to Optimize + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) Protected mapWidth.l = Pow(2, Zoom + 8) Protected mapHeight.l = Pow(2, Zoom + 8) Protected x1.l,y1.l @@ -611,9 +620,10 @@ Module PBMap *Pixel\y=*PBMap\Drawing\RadiusY - (y2-y1) EndProcedure - Procedure IsInDrawingPixelBoundaries(*Drawing.DrawingParameters, *Position.GeographicCoordinates) + Procedure IsInDrawingPixelBoundaries(MapGadget.i, *Drawing.DrawingParameters, *Position.GeographicCoordinates) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) Protected Pixel.PixelCoordinates - LatLon2PixelRel(*Position, @Pixel, *PBMap\Zoom) + LatLon2PixelRel(MapGadget, *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 @@ -680,7 +690,8 @@ Module PBMap ;-*** Options - Procedure SetOptions() + Procedure SetOptions(MapGadget.i) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) With *PBMap\Options If \Proxy HTTPProxy(*PBMap\Options\ProxyURL + ":" + *PBMap\Options\ProxyPort, *PBMap\Options\ProxyUser, *PBMap\Options\ProxyPassword) @@ -689,8 +700,8 @@ Module PBMap OpenConsole() EndIf CreateDirectoryEx(\HDDCachePath) - If \DefaultOSMServer <> "" And IsLayer("OSM") = #False ; First time creation of the basis OSM layer - AddOSMServerLayer("OSM", 1, \DefaultOSMServer) + If \DefaultOSMServer <> "" And IsLayer(MapGadget, "OSM") = #False ; First time creation of the basis OSM layer + AddOSMServerLayer(MapGadget, "OSM", 1, \DefaultOSMServer) EndIf EndWith EndProcedure @@ -704,7 +715,8 @@ Module PBMap EndSelect EndMacro - Procedure SetOption(Option.s, Value.s) + Procedure SetOption(MapGadget.i, Option.s, Value.s) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) Option = StringCheck(Option) Select LCase(Option) Case "proxy" @@ -766,7 +778,7 @@ Module PBMap Case "colourtrackdefault" *PBMap\Options\ColourTrackDefault = ColourString2Value(Value) EndSelect - SetOptions() + SetOptions(MapGadget) EndProcedure Procedure.s GetBoolString(Value.i) @@ -778,7 +790,8 @@ Module PBMap EndSelect EndProcedure - Procedure.s GetOption(Option.s) + Procedure.s GetOption(MapGadget.i, Option.s) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) Option = StringCheck(Option) With *PBMap\Options Select LCase(Option) @@ -845,7 +858,8 @@ Module PBMap EndProcedure ; By default, save options in the user's home directory - Procedure SaveOptions(PreferencesFile.s = "PBMap.prefs") + Procedure SaveOptions(MapGadget.i, PreferencesFile.s = "PBMap.prefs") + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) If PreferencesFile = "PBMap.prefs" CreatePreferences(GetHomeDirectory() + "PBMap.prefs") Else @@ -961,12 +975,13 @@ Module PBMap \TimerInterval = 12 ClosePreferences() EndWith - SetOptions() + SetOptions(MapGadget) 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) + Procedure.i AddLayer(MapGadget.i, Name.s, Order.i, Alpha.d) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) Protected *Ptr = 0 *Ptr = AddMapElement(*PBMap\Layers(), Name) If *Ptr @@ -985,8 +1000,9 @@ Module PBMap EndProcedure ; "OpenStreetMap" layer - Procedure.i AddOSMServerLayer(LayerName.s, Order.i, ServerURL.s = "http://tile.openstreetmap.org/") - Protected *Ptr.Layer = AddLayer(LayerName, Order, 1) + Procedure.i AddOSMServerLayer(MapGadget.i, LayerName.s, Order.i, ServerURL.s = "http://tile.openstreetmap.org/") + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) + Protected *Ptr.Layer = AddLayer(MapGadget, LayerName, Order, 1) If *Ptr *Ptr\ServerURL = ServerURL *Ptr\LayerType = 0 ; OSM @@ -1002,8 +1018,9 @@ Module PBMap ; 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) + Procedure.i AddHereServerLayer(MapGadget.i, 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 *PBMap.PBMap = PBMaps(Str(MapGadget)) + Protected *Ptr.Layer = AddLayer(MapGadget, LayerName, Order, 1) If *Ptr With *Ptr ; *PBMap\Layers() \ServerURL = ServerURL @@ -1035,8 +1052,9 @@ Module PBMap ; 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) + Procedure.i AddGeoServerLayer(MapGadget.i, LayerName.s, Order.i, ServerLayerName.s, ServerURL.s = "http://localhost:8080/", path.s = "geowebcache/service/gmaps", format.s = "image/png") + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) + Protected *Ptr.Layer = AddLayer(MapGadget, LayerName, Order, 1) If *Ptr With *Ptr ; *PBMap\Layers() \ServerURL = ServerURL @@ -1053,11 +1071,13 @@ Module PBMap EndIf EndProcedure - Procedure.i IsLayer(Name.s) + Procedure.i IsLayer(MapGadget.i, Name.s) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) ProcedureReturn FindMapElement(*PBMap\Layers(), Name) EndProcedure - Procedure DeleteLayer(Name.s) + Procedure DeleteLayer(MapGadget.i, Name.s) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) FindMapElement(*PBMap\Layers(), Name) Protected *Ptr = *PBMap\Layers() ; Free the list element @@ -1068,28 +1088,33 @@ Module PBMap *PBMap\Redraw = #True EndProcedure - Procedure EnableLayer(Name.s) - *PBMap\Layers(Name)\Enabled = #True + Procedure EnableLayer(MapGadget.i, Name.s) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) + *PBMap\Layers(Name)\Enabled = #True *PBMap\Redraw = #True EndProcedure - Procedure DisableLayer(Name.s) + Procedure DisableLayer(MapGadget.i, Name.s) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) *PBMap\Layers(Name)\Enabled = #False *PBMap\Redraw = #True EndProcedure - Procedure SetLayerAlpha(Name.s, Alpha.d) + Procedure SetLayerAlpha(MapGadget.i, Name.s, Alpha.d) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) *PBMap\Layers(Name)\Alpha = Alpha *PBMap\Redraw = #True EndProcedure - Procedure.d GetLayerAlpha(Name.s) + Procedure.d GetLayerAlpha(MapGadget.i, Name.s) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) 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() + Procedure MemoryCacheManagement(MapGadget.i) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) 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 @@ -1228,7 +1253,8 @@ Module PBMap ;-*** - Procedure.i GetTile(key.s, URL.s, CacheFile.s) + Procedure.i GetTile(MapGadget.i, key.s, URL.s, CacheFile.s) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) ; MemoryCache access management LockMutex(*PBMap\MemoryCacheAccessMutex) ; Try to find the tile in memory cache @@ -1346,7 +1372,8 @@ Module PBMap ProcedureReturn #False EndProcedure - Procedure DrawTiles(*Drawing.DrawingParameters, LayerName.s) + Procedure DrawTiles(MapGadget.i, *Drawing.DrawingParameters, LayerName.s) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) Protected x.i, y.i, kq.q Protected tx.i = Int(*Drawing\TileCoordinates\x) ; Don't forget the Int() ! Protected ty.i = Int(*Drawing\TileCoordinates\y) @@ -1422,7 +1449,7 @@ Module PBMap CacheFile = DirName + slash + Str(tiley) + ".png" EndSelect EndWith - *timg = GetTile(key, URL, CacheFile) + *timg = GetTile(MapGadget, key, URL, CacheFile) If *timg And *timg\nImage If *PBMap\CallBackDrawTile ;CallFunctionFast(*PBMap\CallBackDrawTile, px, py, *timg\nImage) @@ -1461,7 +1488,8 @@ Module PBMap Next EndProcedure - Procedure DrawPointer(*Drawing.DrawingParameters) + Procedure DrawPointer(MapGadget.i, *Drawing.DrawingParameters) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) If *PBMap\CallBackMainPointer > 0 ; @Procedure(X.i, Y.i) to DrawPointer (you must use VectorDrawing lib) CallFunctionFast(*PBMap\CallBackMainPointer, *Drawing\RadiusX, *Drawing\RadiusY) @@ -1478,7 +1506,8 @@ Module PBMap EndIf EndProcedure - Procedure DrawScale(*Drawing.DrawingParameters,x,y,alpha=80) + Procedure DrawScale(MapGadget.i, *Drawing.DrawingParameters,x,y,alpha=80) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) Protected sunit.s Protected Scale.d= 40075*Cos(Radian(*PBMap\GeographicCoordinates\Latitude))/Pow(2,*PBMap\Zoom) / 2 Select *PBMap\Options\ScaleUnit @@ -1497,7 +1526,8 @@ Module PBMap StrokePath(1) EndProcedure - Procedure DrawDegrees(*Drawing.DrawingParameters, alpha=192) + Procedure DrawDegrees(MapGadget.i, *Drawing.DrawingParameters, alpha=192) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) Protected nx, ny, nx1, ny1, x, y Protected pos1.PixelCoordinates, pos2.PixelCoordinates, Degrees1.GeographicCoordinates, degrees2.GeographicCoordinates CopyStructure(*Drawing\Bounds\NorthWest, @Degrees1, GeographicCoordinates) @@ -1512,15 +1542,15 @@ Module PBMap 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) + LatLon2PixelRel(MapGadget, @Degrees1, @pos1, *PBMap\Zoom) + LatLon2PixelRel(MapGadget, @Degrees2, @pos2, *PBMap\Zoom) VectorFont(FontID(*PBMap\StandardFont), 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) + LatLon2PixelRel(MapGadget, @Degrees1, @pos1, *PBMap\Zoom) MovePathCursor(pos1\x, pos1\y) AddPathLine( pos2\x, pos1\y) MovePathCursor(10, pos1\y) @@ -1531,7 +1561,7 @@ Module PBMap Repeat Degrees1\Longitude = x Degrees1\Latitude = ny - LatLon2PixelRel(@Degrees1, @pos1, *PBMap\Zoom) + LatLon2PixelRel(MapGadget, @Degrees1, @pos1, *PBMap\Zoom) MovePathCursor(pos1\x, pos1\y) AddPathLine( pos1\x, pos2\y) MovePathCursor(pos1\x,10) @@ -1541,15 +1571,17 @@ Module PBMap StrokePath(1) EndProcedure - Procedure DrawZoom(x.i, y.i) + Procedure DrawZoom(MapGadget.i, x.i, y.i) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) VectorFont(FontID(*PBMap\StandardFont), 20) VectorSourceColor(RGBA(0, 0, 0,150)) MovePathCursor(x,y) - DrawVectorText(Str(GetZoom())) + DrawVectorText(Str(GetZoom(MapGadget))) EndProcedure ;-*** Tracks - Procedure DrawTrackPointer(x.d, y.d, dist.l) + Procedure DrawTrackPointer(MapGadget.i, x.d, y.d, dist.l) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) Protected color.l color=RGBA(0, 0, 0, 255) MovePathCursor(x,y) @@ -1568,7 +1600,8 @@ Module PBMap DrawVectorText(Str(dist)) EndProcedure - Procedure DrawTrackPointerFirst(x.d, y.d, dist.l) + Procedure DrawTrackPointerFirst(MapGadget.i, x.d, y.d, dist.l) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) Protected color.l color=RGBA(0, 0, 0, 255) MovePathCursor(x,y) @@ -1587,14 +1620,16 @@ Module PBMap DrawVectorText(Str(dist)) EndProcedure - Procedure DeleteTrack(*Ptr) + Procedure DeleteTrack(MapGadget.i, *Ptr) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) If *Ptr ChangeCurrentElement(*PBMap\TracksList(), *Ptr) DeleteElement(*PBMap\TracksList()) EndIf EndProcedure - Procedure DeleteSelectedTracks() + Procedure DeleteSelectedTracks(MapGadget.i) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) ForEach *PBMap\TracksList() If *PBMap\TracksList()\Selected DeleteElement(*PBMap\TracksList()) @@ -1603,12 +1638,14 @@ Module PBMap Next EndProcedure - Procedure ClearTracks() + Procedure ClearTracks(MapGadget.i) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) ClearList(*PBMap\TracksList()) *PBMap\Redraw = #True EndProcedure - Procedure SetTrackColour(*Ptr, Colour.i) + Procedure SetTrackColour(MapGadget.i, *Ptr, Colour.i) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) If *Ptr ChangeCurrentElement(*PBMap\TracksList(), *Ptr) *PBMap\TracksList()\Colour = Colour @@ -1616,7 +1653,8 @@ Module PBMap EndIf EndProcedure - Procedure DrawTracks(*Drawing.DrawingParameters) + Procedure DrawTracks(MapGadget.i, *Drawing.DrawingParameters) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) Protected Pixel.PixelCoordinates Protected Location.GeographicCoordinates Protected km.f, memKm.i @@ -1629,7 +1667,7 @@ Module PBMap ; Check visibility \Visible = #False ForEach \Track() - If IsInDrawingPixelBoundaries(*Drawing, @*PBMap\TracksList()\Track()) + If IsInDrawingPixelBoundaries(MapGadget, *Drawing, @*PBMap\TracksList()\Track()) \Visible = #True Break EndIf @@ -1637,7 +1675,7 @@ Module PBMap If \Visible ; Draw tracks ForEach \Track() - LatLon2PixelRel(@*PBMap\TracksList()\Track(), @Pixel, *PBMap\Zoom) + LatLon2PixelRel(MapGadget, @*PBMap\TracksList()\Track(), @Pixel, *PBMap\Zoom) If ListIndex(\Track()) = 0 MovePathCursor(Pixel\x, Pixel\y) Else @@ -1659,7 +1697,7 @@ Module PBMap ; YA pour marquer chaque point d'un rond ForEach \Track() - LatLon2PixelRel(@*PBMap\TracksList()\Track(), @Pixel, *PBMap\Zoom) + LatLon2PixelRel(MapGadget, @*PBMap\TracksList()\Track(), @Pixel, *PBMap\Zoom) AddPathCircle(Pixel\x,Pixel\y,(\StrokeWidth / 4)) Next VectorSourceColor(RGBA(255, 255, 0, 255)) @@ -1685,13 +1723,13 @@ Module PBMap Location\Latitude = \Track()\Latitude Location\Longitude = \Track()\Longitude EndIf - LatLon2PixelRel(@*PBMap\TracksList()\Track(), @Pixel, *PBMap\Zoom) + LatLon2PixelRel(MapGadget, @*PBMap\TracksList()\Track(), @Pixel, *PBMap\Zoom) If Int(km) <> memKm memKm = Int(km) If Int(km) = 0 - DrawTrackPointerFirst(Pixel\x , Pixel\y, Int(km)) + DrawTrackPointerFirst(MapGadget, Pixel\x , Pixel\y, Int(km)) Else - DrawTrackPointer(Pixel\x , Pixel\y, Int(km)) + DrawTrackPointer(MapGadget, Pixel\x , Pixel\y, Int(km)) EndIf EndIf Next @@ -1703,7 +1741,8 @@ Module PBMap EndWith EndProcedure - Procedure.i LoadGpxFile(FileName.s) + Procedure.i LoadGpxFile(MapGadget.i, FileName.s) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) If LoadXML(0, FileName.s) Protected Message.s If XMLStatus(0) <> #PB_XML_Success @@ -1732,12 +1771,13 @@ Module PBMap Wend EndIf Next - SetZoomToTracks(LastElement(*PBMap\TracksList())) ; <-To center the view, and zoom on the tracks + SetZoomToTracks(MapGadget, LastElement(*PBMap\TracksList())) ; <-To center the view, and zoom on the tracks ProcedureReturn *NewTrack EndIf EndProcedure - Procedure.i SaveGpxFile(FileName.s, *Track.Tracks) + Procedure.i SaveGpxFile(MapGadget.i, FileName.s, *Track.Tracks) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) Protected Message.s If CreateXML(0) Protected *MainNode, *subNode, *child @@ -1765,12 +1805,14 @@ Module PBMap ;-*** Markers - Procedure ClearMarkers() + Procedure ClearMarkers(MapGadget.i) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) ClearList(*PBMap\Markers()) *PBMap\Redraw = #True EndProcedure - Procedure DeleteMarker(*Ptr) + Procedure DeleteMarker(MapGadget.i, *Ptr) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) If *Ptr ChangeCurrentElement(*PBMap\Markers(), *Ptr) DeleteElement(*PBMap\Markers()) @@ -1778,7 +1820,8 @@ Module PBMap EndIf EndProcedure - Procedure DeleteSelectedMarkers() + Procedure DeleteSelectedMarkers(MapGadget.i) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) ForEach *PBMap\Markers() If *PBMap\Markers()\Selected DeleteElement(*PBMap\Markers()) @@ -1787,7 +1830,8 @@ Module PBMap Next EndProcedure - Procedure.i AddMarker(Latitude.d, Longitude.d, Identifier.s = "", Legend.s = "", Color.l=-1, CallBackPointer.i = -1) + Procedure.i AddMarker(MapGadget.i, Latitude.d, Longitude.d, Identifier.s = "", Legend.s = "", Color.l=-1, CallBackPointer.i = -1) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) Protected *Ptr = AddElement(*PBMap\Markers()) If *Ptr *PBMap\Markers()\GeographicCoordinates\Latitude = Latitude @@ -1815,7 +1859,8 @@ Module PBMap EndIf EndProcedure - Procedure MarkerEditCloseWindow() + Procedure MarkerEditCloseWindow(MapGadget.i) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) ForEach *PBMap\Markers() If *PBMap\Markers()\EditWindow = EventWindow() *PBMap\Markers()\EditWindow = 0 @@ -1824,7 +1869,8 @@ Module PBMap CloseWindow(EventWindow()) EndProcedure - Procedure MarkerEdit(*Marker.Marker) + Procedure MarkerEdit(MapGadget.i, *Marker.Marker) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) 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) @@ -1841,7 +1887,8 @@ Module PBMap EndIf EndProcedure - Procedure DrawMarker(x.i, y.i, Nb.i, *Marker.Marker) + Procedure DrawMarker(MapGadget.i, x.i, y.i, Nb.i, *Marker.Marker) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) Protected Text.s VectorSourceColor(*Marker\Color) MovePathCursor(x, y) @@ -1897,15 +1944,16 @@ Module PBMap EndProcedure ; Draw all markers - Procedure DrawMarkers(*Drawing.DrawingParameters) + Procedure DrawMarkers(MapGadget.i, *Drawing.DrawingParameters) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) Protected Pixel.PixelCoordinates ForEach *PBMap\Markers() - If IsInDrawingPixelBoundaries(*Drawing, @*PBMap\Markers()\GeographicCoordinates) - LatLon2PixelRel(@*PBMap\Markers()\GeographicCoordinates, @Pixel, *PBMap\Zoom) + If IsInDrawingPixelBoundaries(MapGadget, *Drawing, @*PBMap\Markers()\GeographicCoordinates) + LatLon2PixelRel(MapGadget, @*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()) + DrawMarker(MapGadget, Pixel\x, Pixel\y, ListIndex(*PBMap\Markers()), @*PBMap\Markers()) EndIf EndIf Next @@ -1913,7 +1961,8 @@ Module PBMap ;-*** Main drawing stuff - Procedure DrawDebugInfos(*Drawing.DrawingParameters) + Procedure DrawDebugInfos(MapGadget.i, *Drawing.DrawingParameters) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) ; Display how many images in cache VectorFont(FontID(*PBMap\StandardFont), 16) VectorSourceColor(RGBA(0, 0, 0, 80)) @@ -1937,7 +1986,8 @@ Module PBMap DrawVectorText("Lat-Lon 2 : " + StrD(*Drawing\Bounds\SouthEast\Latitude) + "," + StrD(*Drawing\Bounds\SouthEast\Longitude)) EndProcedure - Procedure DrawOSMCopyright(*Drawing.DrawingParameters) + Procedure DrawOSMCopyright(MapGadget.i, *Drawing.DrawingParameters) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) Protected Text.s = "© OpenStreetMap contributors" VectorFont(FontID(*PBMap\StandardFont), 12) VectorSourceColor(RGBA(0, 0, 0, 80)) @@ -1945,7 +1995,8 @@ Module PBMap DrawVectorText(Text) EndProcedure - Procedure Drawing() + Procedure Drawing(MapGadget.i) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) Protected *Drawing.DrawingParameters = @*PBMap\Drawing Protected PixelCenter.PixelCoordinates Protected Px.d, Py.d,a, ts = *PBMap\TileSize, nx, ny @@ -1960,7 +2011,7 @@ Module PBMap *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) + LatLon2Pixel(MapGadget, *Drawing\GeographicCoordinates, @PixelCenter, *PBMap\Zoom) ; Pixel shift, aka position in the tile Px = *Drawing\TileCoordinates\x Py = *Drawing\TileCoordinates\y @@ -1988,60 +2039,63 @@ Module PBMap ; Draws layers based on their number ForEach *PBMap\LayersList() If *PBMap\LayersList()\Enabled - DrawTiles(*Drawing, *PBMap\LayersList()\Name) + DrawTiles(MapGadget, *Drawing, *PBMap\LayersList()\Name) EndIf If *PBMap\LayersList()\LayerType = 0 ; OSM OSMCopyright = #True EndIf Next If *PBMap\Options\ShowTrack - DrawTracks(*Drawing) + DrawTracks(MapGadget, *Drawing) EndIf If *PBMap\Options\ShowMarkers - DrawMarkers(*Drawing) + DrawMarkers(MapGadget, *Drawing) EndIf If *PBMap\Options\ShowDegrees And *PBMap\Zoom > 2 - DrawDegrees(*Drawing, 192) + DrawDegrees(MapGadget, *Drawing, 192) EndIf If *PBMap\Options\ShowPointer - DrawPointer(*Drawing) + DrawPointer(MapGadget, *Drawing) EndIf If *PBMap\Options\ShowDebugInfos - DrawDebugInfos(*Drawing) + DrawDebugInfos(MapGadget, *Drawing) EndIf If *PBMap\Options\ShowScale - DrawScale(*Drawing, 10, GadgetHeight(*PBMap\Gadget) - 20, 192) + DrawScale(MapGadget, *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 + DrawZoom(MapGadget, GadgetWidth(*PBMap\Gadget) - 30, 5) ; ajout YA - affiche le niveau de zoom EndIf If OSMCopyright - DrawOSMCopyright(*Drawing) + DrawOSMCopyright(MapGadget, *Drawing) EndIf StopVectorDrawing() EndProcedure - Procedure Refresh() + Procedure Refresh(MapGadget.i) *PBMap\Redraw = #True ; Drawing() EndProcedure ;-*** Misc functions - Procedure.d GetMouseLongitude() + Procedure.d GetMouseLongitude(MapGadget.i) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) 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 GetMouseLatitude() + Procedure.d GetMouseLatitude(MapGadget.i) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) 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 - Procedure SetLocation(latitude.d, longitude.d, Zoom = -1, Mode.i = #PB_Absolute) + Procedure SetLocation(MapGadget.i, latitude.d, longitude.d, Zoom = -1, Mode.i = #PB_Absolute) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) Select Mode Case #PB_Absolute *PBMap\GeographicCoordinates\Latitude = latitude @@ -2075,7 +2129,8 @@ Module PBMap EndIf EndProcedure - Procedure SetZoomToArea(MinY.d, MaxY.d, MinX.d, MaxX.d) + Procedure SetZoomToArea(MapGadget.i, MinY.d, MaxY.d, MinX.d, MaxX.d) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) ; 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 @@ -2096,13 +2151,14 @@ 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(MapGadget, lat, lon, Round(zoom,#PB_Round_Down)) Else - SetLocation(*PBMap\GeographicCoordinates\Latitude, *PBMap\GeographicCoordinates\Longitude, 15) + SetLocation(MapGadget, *PBMap\GeographicCoordinates\Latitude, *PBMap\GeographicCoordinates\Longitude, 15) EndIf EndProcedure - Procedure SetZoomToTracks(*Tracks.Tracks) + Procedure SetZoomToTracks(MapGadget.i, *Tracks.Tracks) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) Protected MinY.d, MaxY.d, MinX.d, MaxX.d If ListSize(*Tracks\Track()) > 0 With *Tracks\Track() @@ -2122,12 +2178,13 @@ Module PBMap MaxY = \Latitude EndIf Next - SetZoomToArea(MinY.d, MaxY.d, MinX.d, MaxX.d) + SetZoomToArea(MapGadget, MinY.d, MaxY.d, MinX.d, MaxX.d) EndWith EndIf EndProcedure - Procedure SetZoom(Zoom.i, mode.i = #PB_Relative) + Procedure SetZoom(MapGadget.i, Zoom.i, mode.i = #PB_Relative) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) Select mode Case #PB_Relative *PBMap\Zoom = *PBMap\Zoom + zoom @@ -2147,7 +2204,8 @@ Module PBMap EndIf EndProcedure - Procedure SetAngle(Angle.d, Mode = #PB_Absolute) + Procedure SetAngle(MapGadget.i, Angle.d, Mode = #PB_Absolute) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) If Mode = #PB_Absolute *PBMap\Angle = Angle Else @@ -2159,33 +2217,40 @@ Module PBMap ;-*** Callbacks - Procedure SetCallBackLocation(CallBackLocation.i) + Procedure SetCallBackLocation(MapGadget.i, CallBackLocation.i) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) *PBMap\CallBackLocation = CallBackLocation EndProcedure - Procedure SetCallBackMainPointer(CallBackMainPointer.i) + Procedure SetCallBackMainPointer(MapGadget.i, CallBackMainPointer.i) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) *PBMap\CallBackMainPointer = CallBackMainPointer EndProcedure - Procedure SetCallBackMarker(CallBackLocation.i) + Procedure SetCallBackMarker(MapGadget.i, CallBackLocation.i) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) *PBMap\CallBackMarker = CallBackLocation EndProcedure - Procedure SetCallBackLeftClic(CallBackLocation.i) + Procedure SetCallBackLeftClic(MapGadget.i, CallBackLocation.i) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) *PBMap\CallBackLeftClic = CallBackLocation EndProcedure - Procedure SetCallBackDrawTile(CallBackLocation.i) + Procedure SetCallBackDrawTile(MapGadget.i, CallBackLocation.i) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) *PBMap\CallBackDrawTile = CallBackLocation EndProcedure - Procedure SetCallBackModifyTileFile(CallBackLocation.i) + Procedure SetCallBackModifyTileFile(MapGadget.i, CallBackLocation.i) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) *PBMap\CallBackModifyTileFile = CallBackLocation EndProcedure ;*** - Procedure SetMapScaleUnit(ScaleUnit.i = PBMAP::#SCALE_KM) + Procedure SetMapScaleUnit(MapGadget.i, ScaleUnit.i = PBMAP::#SCALE_KM) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) *PBMap\Options\ScaleUnit = ScaleUnit *PBMap\Redraw = #True ; Drawing() @@ -2196,21 +2261,24 @@ Module PBMap ; #MODE_HAND = 1 -> Hand only ; #MODE_SELECT = 2 -> Move objects only ; #MODE_EDIT = 3 -> Create objects - Procedure SetMode(Mode.i = #MODE_DEFAULT) + Procedure SetMode(MapGadget.i, Mode.i = #MODE_DEFAULT) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) *PBMap\Mode = Mode EndProcedure - Procedure.i GetMode() + Procedure.i GetMode(MapGadget.i) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) ProcedureReturn *PBMap\Mode EndProcedure ; Zoom on x, y pixel position from the center - Procedure SetZoomOnPixel(x, y, zoom) + Procedure SetZoomOnPixel(MapGadget.i, x, y, zoom) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) ; *** 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) + LatLon2Pixel(MapGadget, @*PBMap\GeographicCoordinates, @*PBMap\PixelCoordinates, *PBMap\Zoom) If Zoom = 1 *PBMap\PixelCoordinates\x + x *PBMap\PixelCoordinates\y + y @@ -2218,7 +2286,7 @@ Module PBMap *PBMap\PixelCoordinates\x - x/2 *PBMap\PixelCoordinates\y - y/2 EndIf - Pixel2LatLon(@*PBMap\PixelCoordinates, @*PBMap\GeographicCoordinates, *PBMap\Zoom) + Pixel2LatLon(MapGadget, @*PBMap\PixelCoordinates, @*PBMap\GeographicCoordinates, *PBMap\Zoom) ; Start drawing *PBMap\Redraw = #True ; If CallBackLocation send Location To function @@ -2228,16 +2296,18 @@ Module PBMap EndProcedure ; 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) + Procedure SetZoomOnPixelRel(MapGadget.i, x, y, zoom) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) + SetZoomOnPixel(MapGadget, 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) - LatLon2Pixel(@*PBMap\GeographicCoordinates, @*PBMap\PixelCoordinates, *PBMap\Zoom) + Procedure GotoPixelRel(MapGadget.i, x, y) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) + LatLon2Pixel(MapGadget, @*PBMap\GeographicCoordinates, @*PBMap\PixelCoordinates, *PBMap\Zoom) *PBMap\PixelCoordinates\x + x - *PBMap\Drawing\RadiusX *PBMap\PixelCoordinates\y + y - *PBMap\Drawing\RadiusY - Pixel2LatLon(@*PBMap\PixelCoordinates, @*PBMap\GeographicCoordinates, *PBMap\Zoom) + Pixel2LatLon(MapGadget, @*PBMap\PixelCoordinates, @*PBMap\GeographicCoordinates, *PBMap\Zoom) ; Start drawing *PBMap\Redraw = #True ; If CallBackLocation send Location to function @@ -2247,10 +2317,11 @@ Module PBMap EndProcedure ; Go to x, y position relative to the canvas gadget - Procedure GotoPixel(x, y) + Procedure GotoPixel(MapGadget.i, x, y) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) *PBMap\PixelCoordinates\x = x *PBMap\PixelCoordinates\y = y - Pixel2LatLon(@*PBMap\PixelCoordinates, @*PBMap\GeographicCoordinates, *PBMap\Zoom) + Pixel2LatLon(MapGadget, @*PBMap\PixelCoordinates, @*PBMap\GeographicCoordinates, *PBMap\Zoom) ; Start drawing *PBMap\Redraw = #True ; If CallBackLocation send Location to function @@ -2259,23 +2330,28 @@ Module PBMap EndIf EndProcedure - Procedure.d GetLatitude() + Procedure.d GetLatitude(MapGadget.i) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) ProcedureReturn *PBMap\GeographicCoordinates\Latitude EndProcedure - Procedure.d GetLongitude() + Procedure.d GetLongitude(MapGadget.i) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) ProcedureReturn *PBMap\GeographicCoordinates\Longitude EndProcedure - Procedure.i GetZoom() + Procedure.i GetZoom(MapGadget.i) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) ProcedureReturn *PBMap\Zoom EndProcedure - Procedure.d GetAngle() + Procedure.d GetAngle(MapGadget.i) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) ProcedureReturn *PBMap\Angle EndProcedure - Procedure NominatimGeoLocationQuery(Address.s, *ReturnPosition.GeographicCoordinates = 0) + Procedure NominatimGeoLocationQuery(MapGadget.i, Address.s, *ReturnPosition.GeographicCoordinates = 0) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) Protected Size.i Protected Query.s = "http://nominatim.openstreetmap.org/search/" + URLEncoder(Address) + @@ -2309,13 +2385,14 @@ Module PBMap *ReturnPosition\Longitude = ValD(lon) EndIf If lat <> "" And lon <> "" - SetZoomToArea(bbox\SouthEast\Latitude, bbox\NorthWest\Latitude, bbox\NorthWest\Longitude, bbox\SouthEast\Longitude) + SetZoomToArea(MapGadget, bbox\SouthEast\Latitude, bbox\NorthWest\Latitude, bbox\NorthWest\Longitude, bbox\SouthEast\Longitude) ; SetLocation(Position\Latitude, Position\Longitude) EndIf EndIf EndProcedure - Procedure.i ClearDiskCache() + Procedure.i ClearDiskCache(MapGadget.i) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) 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 @@ -2342,8 +2419,9 @@ Module PBMap Protected ImgNB.i, TileNewFilename.s Static CtrlKey Protected Location.GeographicCoordinates + Protected MapGadget.i = EventGadget() - Protected *PBMap.PBmap = PBMaps(Str(EventGadget())) + Protected *PBMap.PBmap = PBMaps(Str(MapGadget)) MapWidth = Pow(2, *PBMap\Zoom) * *PBMap\TileSize CanvasMouseX = GetGadgetAttribute(*PBMap\Gadget, #PB_Canvas_MouseX) - *PBMap\Drawing\RadiusX CanvasMouseY = GetGadgetAttribute(*PBMap\Gadget, #PB_Canvas_MouseY) - *PBMap\Drawing\RadiusY @@ -2360,8 +2438,8 @@ Module PBMap Case #PB_EventType_KeyUp Select GetGadgetAttribute(*PBMap\Gadget, #PB_Canvas_Key) Case #PB_Shortcut_Delete - DeleteSelectedMarkers() - DeleteSelectedTracks() + DeleteSelectedMarkers(MapGadget) + DeleteSelectedTracks(MapGadget) EndSelect *PBMap\Redraw = #True If GetGadgetAttribute(*PBMap\Gadget, #PB_Canvas_Modifiers)&#PB_Canvas_Control = 0 @@ -2401,7 +2479,7 @@ Module PBMap CtrlKey = #True EndIf Case #PB_EventType_LeftDoubleClick - LatLon2Pixel(@*PBMap\GeographicCoordinates, @*PBMap\PixelCoordinates, *PBMap\Zoom) + LatLon2Pixel(MapGadget, @*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) @@ -2409,29 +2487,29 @@ Module PBMap Touch = #False ; Check if the mouse touch a marker ForEach *PBMap\Markers() - LatLon2Pixel(@*PBMap\Markers()\GeographicCoordinates, @MarkerCoords, *PBMap\Zoom) + LatLon2Pixel(MapGadget, @*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) + SetLocation(MapGadget, *PBMap\Markers()\GeographicCoordinates\Latitude, *PBMap\Markers()\GeographicCoordinates\Longitude) ElseIf *PBMap\Mode = #MODE_EDIT ; Edit the legend - MarkerEdit(@*PBMap\Markers()) + MarkerEdit(MapGadget, @*PBMap\Markers()) EndIf Break EndIf Next If Not Touch - GotoPixel(MouseX, MouseY) + GotoPixel(MapGadget, MouseX, MouseY) EndIf Case #PB_EventType_MouseWheel If *PBMap\Options\WheelMouseRelative ; Relative zoom (centered on the mouse) - SetZoomOnPixel(CanvasMouseX, CanvasMouseY, GetGadgetAttribute(*PBMap\Gadget, #PB_Canvas_WheelDelta)) + SetZoomOnPixel(MapGadget, 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) + SetZoom(MapGadget, GetGadgetAttribute(*PBMap\Gadget, #PB_Canvas_WheelDelta), #PB_Relative) EndIf Case #PB_EventType_LeftButtonDown ; LatLon2Pixel(@*PBMap\GeographicCoordinates, @*PBMap\PixelCoordinates, *PBMap\Zoom) @@ -2467,8 +2545,8 @@ Module PBMap EndIf ; YA pour sélectionner un point de la trace avec le clic gauche If *PBMap\EditMarker = #False - Location\Latitude = GetMouseLatitude() - Location\Longitude = GetMouseLongitude() + Location\Latitude = GetMouseLatitude(MapGadget) + Location\Longitude = GetMouseLongitude(MapGadget) If *PBMap\CallBackLeftClic > 0 CallFunctionFast(*PBMap\CallBackLeftClic, @Location) EndIf @@ -2489,20 +2567,20 @@ Module PBMap 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) + LatLon2Pixel(MapGadget, @*PBMap\Markers()\GeographicCoordinates, @MarkerCoords, *PBMap\Zoom) MarkerCoords\x + MouseX MarkerCoords\y + MouseY - Pixel2LatLon(@MarkerCoords, @*PBMap\Markers()\GeographicCoordinates, *PBMap\Zoom) + Pixel2LatLon(MapGadget, @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 + LatLon2Pixel(MapGadget, @*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) + Pixel2LatLon(MapGadget, @*PBMap\PixelCoordinates, @*PBMap\GeographicCoordinates, *PBMap\Zoom) ; If CallBackLocation send Location to function If *PBMap\CallBackLocation > 0 CallFunctionFast(*PBMap\CallBackLocation, @*PBMap\GeographicCoordinates) @@ -2511,7 +2589,7 @@ Module PBMap *PBMap\Redraw = #True Else ; Touch test - LatLon2Pixel(@*PBMap\GeographicCoordinates, @*PBMap\PixelCoordinates, *PBMap\Zoom) + LatLon2Pixel(MapGadget, @*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) @@ -2519,7 +2597,7 @@ Module PBMap 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) + LatLon2Pixel(MapGadget, @*PBMap\Markers()\GeographicCoordinates, @MarkerCoords, *PBMap\Zoom) If Distance(MarkerCoords\x, MarkerCoords\y, MouseX, MouseY) < 8 *PBMap\Markers()\Focus = #True *PBMap\Redraw = #True @@ -2540,7 +2618,7 @@ Module PBMap StartVectorDrawing(CanvasVectorOutput(*PBMap\Gadget)) ; Simulates track drawing ForEach \Track() - LatLon2Pixel(@*PBMap\TracksList()\Track(), @Pixel, *PBMap\Zoom) + LatLon2Pixel(MapGadget, @*PBMap\TracksList()\Track(), @Pixel, *PBMap\Zoom) If ListIndex(\Track()) = 0 MovePathCursor(Pixel\x, Pixel\y) Else @@ -2616,20 +2694,20 @@ Module PBMap ForEach PBMaps() *PBMap = PBMaps() If EventTimer() = *PBMap\Timer And (*PBMap\Redraw Or *PBMap\Dirty) - MemoryCacheManagement() - Drawing() + MemoryCacheManagement(*PBMap\Gadget) + Drawing(*PBMap\Gadget) EndIf Next EndProcedure ; Could be called directly to attach our map to an existing canvas - Procedure BindMapGadget(Gadget.i, TimerNB = 1) + Procedure BindMapGadget(MapGadget.i, TimerNB = 1) Protected *PBMap.PBMap *PBMap.PBMap = AllocateStructure(PBMap) If *PBMap = 0 FatalError("Cannot initialize PBMap memory") EndIf - PBMaps(Str(Gadget)) = *PBMap + PBMaps(Str(MapGadget)) = *PBMap With *PBMap Protected Result.i \ZoomMin = 1 @@ -2649,10 +2727,10 @@ Module PBMap End EndIf EndWith - LoadOptions(*PBMap) - TechnicalImagesCreation(*PBMap) - SetLocation(*PBMap, 0, 0) - *PBMap\Gadget = Gadget + LoadOptions(MapGadget) + TechnicalImagesCreation(MapGadget) + SetLocation(MapGadget, 0, 0) + *PBMap\Gadget = MapGadget BindGadgetEvent(*PBMap\Gadget, @CanvasEvents()) AddWindowTimer(*PBMap\Window, *PBMap\Timer, *PBMap\Options\TimerInterval) BindEvent(#PB_Event_Timer, @TimerEvents()) @@ -2661,15 +2739,15 @@ Module PBMap EndProcedure ; Creates a canvas and attach our map - Procedure MapGadget(Gadget.i, X.i, Y.i, Width.i, Height.i, TimerNB = 1) - If Gadget = #PB_Any + Procedure MapGadget(MapGadget.i, X.i, Y.i, Width.i, Height.i, TimerNB = 1) + If MapGadget = #PB_Any Protected GadgetNB.i GadgetNB = CanvasGadget(#PB_Any, X, Y, Width, Height, #PB_Canvas_Keyboard) ; #PB_Canvas_Keyboard has to be set for mousewheel to work on windows BindMapGadget(GadgetNB, TimerNB) ProcedureReturn GadgetNB Else - If CanvasGadget(Gadget, X, Y, Width, Height, #PB_Canvas_Keyboard) - BindMapGadget(Gadget, TimerNB) + If CanvasGadget(MapGadget, X, Y, Width, Height, #PB_Canvas_Keyboard) + BindMapGadget(MapGadget, TimerNB) Else FatalError("Cannot create the map gadget") EndIf @@ -2703,19 +2781,19 @@ Module PBMap FreeStructure(*PBMap) EndProcedure - Procedure FreeMapGadget(Gadget.i) + Procedure FreeMapGadget(MapGadget.i) Protected *PBMap.PBMap ForEach PBMaps() *PBMap = PBMaps() - If *PBMap\Gadget = Gadget + If *PBMap\Gadget = MapGadget Quit(*PBMap) DeleteMapElement(PBMaps()) EndIf Next EndProcedure - Procedure SelectPBMap(Gadget.i) ; Could be used to have multiple PBMaps in one window - *PBMap = PBMaps(Str(Gadget)) + Procedure SelectPBMap(MapGadget.i) ; Could be used to have multiple PBMaps in one window + *PBMap = PBMaps(Str(MapGadget)) EndProcedure EndModule @@ -2858,7 +2936,7 @@ CompilerIf #PB_Compiler_IsMainFile 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() + PBMap::Refresh(#Map) EndProcedure ;- MAIN TEST @@ -2912,22 +2990,22 @@ CompilerIf #PB_Compiler_IsMainFile ; Our main gadget ;*PBMap = PBMap::InitPBMap(#Window_0) PBMap::MapGadget(#Map, 10, 10, 512, 512) - PBMap::SetOption("ShowDegrees", "1") : Degrees = 0 - PBMap::SetOption("ShowDebugInfos", "1") + PBMap::SetOption(#Map, "ShowDegrees", "1") : Degrees = 0 + PBMap::SetOption(#Map, "ShowDebugInfos", "1") 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(#Map, "Verbose", "0") + PBMap::SetOption(#Map, "ShowScale", "1") + PBMap::SetOption(#Map, "Warning", "1") + PBMap::SetOption(#Map, "ShowMarkersLegend", "1") + PBMap::SetOption(#Map, "ShowTrackKms", "1") + PBMap::SetOption(#Map, "ColourFocus", "$FFFF00AA") - 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()) + PBMap::SetCallBackMainPointer(#Map, @MainPointer()) ; To change the main pointer (center of the view) + PBMap::SetCallBackLocation(#Map, @UpdateLocation()) ; To obtain realtime coordinates + PBMap::SetLocation(#Map, -36.81148, 175.08634,12) ; Change the PBMap coordinates + PBMap::SetMapScaleUnit(#Map, PBMAP::#SCALE_KM) ; To change the scale unit + PBMap::AddMarker(#Map, 49.0446828398, 2.0349812508, "", "", -1, @MyMarker()) ; To add a marker with a customised GFX + PBMap::SetCallBackMarker(#Map, @MarkerMoveCallBack()) ;PBMap::SetCallBackDrawTile(@DrawTileCallBack()) ;PBMap::SetCallBackModifyTileFile(@ModifyTileFileCallback()) @@ -2939,13 +3017,13 @@ CompilerIf #PB_Compiler_IsMainFile Gadget = EventGadget() Select Gadget Case #Gdt_Up - PBMap::SetLocation(10* 360 / Pow(2, PBMap::GetZoom() + 8), 0, 0, #PB_Relative) + PBMap::SetLocation(#Map, 10* 360 / Pow(2, PBMap::GetZoom(#Map) + 8), 0, 0, #PB_Relative) Case #Gdt_Down - PBMap::SetLocation(10* -360 / Pow(2, PBMap::GetZoom() + 8), 0, 0, #PB_Relative) + PBMap::SetLocation(#Map, 10* -360 / Pow(2, PBMap::GetZoom(#Map) + 8), 0, 0, #PB_Relative) Case #Gdt_Left - PBMap::SetLocation(0, 10* -360 / Pow(2, PBMap::GetZoom() + 8), 0, #PB_Relative) + PBMap::SetLocation(#Map, 0, 10* -360 / Pow(2, PBMap::GetZoom(#Map) + 8), 0, #PB_Relative) Case #Gdt_Right - PBMap::SetLocation(0, 10* 360 / Pow(2, PBMap::GetZoom() + 8), 0, #PB_Relative) + PBMap::SetLocation(#Map, 0, 10* 360 / Pow(2, PBMap::GetZoom(#Map) + 8), 0, #PB_Relative) ; Case #Gdt_RotateLeft ; PBMAP::SetAngle(-5,#PB_Relative) ; PBMap::Refresh() @@ -2953,15 +3031,15 @@ CompilerIf #PB_Compiler_IsMainFile ; PBMAP::SetAngle(5,#PB_Relative) ; PBMap::Refresh() Case #Button_4 - PBMap::SetZoom(1) + PBMap::SetZoom(#Map, 1) Case #Button_5 - PBMap::SetZoom( - 1) + PBMap::SetZoom(#Map, -1) 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)) + *Track = PBMap::LoadGpxFile(#Map, OpenFileRequester("Choose a file to load", "", "Gpx|*.gpx", 0)) + PBMap::SetTrackColour(#Map, *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) + If PBMap::SaveGpxFile(#Map, 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) @@ -2977,56 +3055,56 @@ CompilerIf #PB_Compiler_IsMainFile 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(#Map, ValD(GetGadgetText(#StringLatitude)), ValD(GetGadgetText(#StringLongitude)), "", "Test", RGBA(Random(255), Random(255), Random(255), 255)) Case #Gdt_AddOpenseaMap - If PBMap::IsLayer("OpenSeaMap") - PBMap::DeleteLayer("OpenSeaMap") + If PBMap::IsLayer(#Map, "OpenSeaMap") + PBMap::DeleteLayer(#Map, "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 + PBMap::AddOSMServerLayer(#Map, "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(#Map) Case #Gdt_AddHereMap - If PBMap::IsLayer("Here") - PBMap::DeleteLayer("Here") + If PBMap::IsLayer(#Map, "Here") + PBMap::DeleteLayer(#Map, "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) + If PBMap::GetOption(#Map, "appid") <> "" And PBMap::GetOption(#Map, "appcode") <> "" + PBMap::AddHereServerLayer(#Map, "Here", 2) ; Add a "HERE" overlay map on layer nb 2 + PBMap::SetLayerAlpha(#Map, "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 + PBMap::AddHereServerLayer(#Map, "Here", 2, "my_id", "my_code") ; Add a here overlay map on layer nb 2 EndIf SetGadgetState(#Gdt_AddHereMap, 1) EndIf - PBMap::Refresh() + PBMap::Refresh(#Map) Case #Gdt_AddGeoServerMap - If PBMap::IsLayer("GeoServer") - PBMap::DeleteLayer("GeoServer") + If PBMap::IsLayer(#Map, "GeoServer") + PBMap::DeleteLayer(#Map, "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) + PBMap::AddGeoServerLayer(#Map, "GeoServer", 3, "demolayer", "http://localhost:8080/", "geowebcache/service/gmaps", "image/png") ; Add a geoserver overlay map on layer nb 3 + PBMap::SetLayerAlpha(#Map, "GeoServer", 0.75) SetGadgetState(#Gdt_AddGeoServerMap, 1) EndIf - PBMap::Refresh() + PBMap::Refresh(#Map) Case #Gdt_Degrees Degrees = 1 - Degrees - PBMap::SetOption("ShowDegrees", Str(Degrees)) - PBMap::Refresh() + PBMap::SetOption(#Map, "ShowDegrees", Str(Degrees)) + PBMap::Refresh(#Map) SetGadgetState(#Gdt_Degrees, Degrees) Case #Gdt_EditMode - If PBMap::GetMode() <> PBMap::#MODE_EDIT - PBMap::SetMode(PBMap::#MODE_EDIT) + If PBMap::GetMode(#Map) <> PBMap::#MODE_EDIT + PBMap::SetMode(#Map, PBMap::#MODE_EDIT) SetGadgetState(#Gdt_EditMode, 1) Else - PBMap::SetMode(PBMap::#MODE_DEFAULT) + PBMap::SetMode(#Map, PBMap::#MODE_DEFAULT) SetGadgetState(#Gdt_EditMode, 0) EndIf Case #Gdt_ClearDiskCache - PBMap::ClearDiskCache() + PBMap::ClearDiskCache(#Map) Case #StringGeoLocationQuery Select EventType() Case #PB_EventType_Focus @@ -3042,15 +3120,15 @@ CompilerIf #PB_Compiler_IsMainFile Select EventMenu() Case #MenuEventGeoLocationStringEnter If GetGadgetText(#StringGeoLocationQuery) <> "" - PBMap::NominatimGeoLocationQuery(GetGadgetText(#StringGeoLocationQuery)) - PBMap::Refresh() + PBMap::NominatimGeoLocationQuery(#Map, GetGadgetText(#StringGeoLocationQuery)) + PBMap::Refresh(#Map) 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() + PBMap::SetLocation(#Map, ValD(GetGadgetText(#StringLatitude)), ValD(GetGadgetText(#StringLongitude))) ; Change the PBMap coordinates + PBMap::Refresh(#Map) EndSelect EndSelect Until Quit = #True @@ -3062,8 +3140,8 @@ CompilerEndIf ; IDE Options = PureBasic 5.61 (Windows - x64) -; CursorPosition = 897 -; FirstLine = 895 +; CursorPosition = 396 +; FirstLine = 381 ; Folding = --------------------- ; EnableThread ; EnableXP From 648c9c9a4aad349126afb1111a8748b5bfdb9029 Mon Sep 17 00:00:00 2001 From: djes Date: Sat, 3 Mar 2018 19:26:28 +0100 Subject: [PATCH 44/60] Multiple PBMaps WIP MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit PBMap is now able to handle multiple maps. Warning : it breaks compatibility with older codes ! InitPBMap() and Quit() are no longer used, only MapGadget() and FreeMapGadget() as in standard PureBASIC gadgets. All functions should now include the MapGadget id as first parameter. Now included, the André Beer demo. --- Multiple-PBMaps-Demo.pb | 369 ++++++++++++++++++++++++++++++++++++++++ PBMap.pb | 138 ++++++++------- 2 files changed, 436 insertions(+), 71 deletions(-) create mode 100644 Multiple-PBMaps-Demo.pb diff --git a/Multiple-PBMaps-Demo.pb b/Multiple-PBMaps-Demo.pb new file mode 100644 index 0000000..5bc8cab --- /dev/null +++ b/Multiple-PBMaps-Demo.pb @@ -0,0 +1,369 @@ +; Based on the orginal PBMap example (delivered with the package in Feb. 2018), this is an example with +; less functionality, but with 2 different Canvas Map gadgets placed in 2 tabs of a PanelGadget... +; (for testing purposes related to my GeoWorldEditor) +; +; Author: André Beer +; Last change: 26. Feb. 2018 +; Modified by djes : 01. March 2018 +; Adapted to new PBMap syntax by André: 02. March 2018 +; +; **************************************************************** +; +;- Example of application +; +; **************************************************************** +XIncludeFile "PBMap.pb" + +InitNetwork() + +Enumeration + #Window_0 + #Map + #Gdt_Left + #Gdt_Right + #Gdt_Up + #Gdt_Down + #Button_4 + #Button_5 + #Combo_0 + #Text_0 + #Text_1 + #Text_2 + #Text_3 + #Text_4 + #StringLatitude + #StringLongitude + #Gdt_AddMarker + #Gdt_Degrees + #Gdt_ClearDiskCache + #TextGeoLocationQuery + #StringGeoLocationQuery + ; Additions for a 2nd panel: + #PanelGadget + #Map2_Canvas + #Map2_Move + #Map2_Left + #Map2_Right + #Map2_Up + #Map2_Down + #Map2_Zoom + #Map2_ZoomIn + #Map2_ZoomOut + #Map2_LatitudeText + #Map2_StringLatitude + #Map2_LongitudeText + #Map2_StringLongitude +EndEnumeration + +; Menu events +Enumeration + #MenuEventLonLatStringEnter + #MenuEventGeoLocationStringEnter +EndEnumeration + +Structure Location + Longitude.d + Latitude.d +EndStructure + +Procedure UpdateLocation(*Location.Location) + SetGadgetText(#StringLatitude, StrD(*Location\Latitude)) + SetGadgetText(#StringLongitude, StrD(*Location\Longitude)) + ProcedureReturn 0 +EndProcedure + +; 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) + 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 MarkerMoveCallBack(*Marker.PBMap::Marker) + Debug "Identifier : " + *Marker\Identifier + "(" + StrD(*Marker\GeographicCoordinates\Latitude) + ", " + StrD(*Marker\GeographicCoordinates\Longitude) + ")" +EndProcedure + +; Example of a custom procedure to alter tile rendering +Procedure DrawTileCallBack(x.i, y.i, image.i, alpha.d) + MovePathCursor(x, y) + DrawVectorImage(ImageID(image), 255 * alpha) +EndProcedure + +; Example of a custom procedure to alter tile file just after loading +Procedure.s ModifyTileFileCallback(CacheFile.s, OrgURL.s) + Protected ImgNB = LoadImage(#PB_Any, CacheFile) + If ImgNB + StartDrawing(ImageOutput(ImgNB)) + DrawText(0, 0,"PUREBASIC", RGB(255, 255, 0)) + StopDrawing() + ;*** Could be used to create new files + ; Cachefile = ReplaceString(Cachefile, ".png", "_PB.png") + ;*** + If SaveImage(ImgNB, CacheFile, #PB_ImagePlugin_PNG, 0, 32) ;Warning, the 32 is mandatory as some tiles aren't correctly rendered + ; Send back the new name (not functional by now) + ProcedureReturn CacheFile + EndIf + 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) +EndProcedure + +Procedure ResizeAll() + Protected PanelTabHeight = GetGadgetAttribute(#PanelGadget, #PB_Panel_TabHeight) + ResizeGadget(#PanelGadget, #PB_Ignore, #PB_Ignore, WindowWidth(#Window_0), WindowHeight(#Window_0)-PanelTabHeight) + Protected PanelItemWidth = GetGadgetAttribute(#PanelGadget, #PB_Panel_ItemWidth) + Protected PanelItemHeight = GetGadgetAttribute(#PanelGadget, #PB_Panel_ItemHeight) + ; First tab: + ResizeGadget(#Map, 10, 10, PanelItemWidth-198, PanelItemHeight-59) + ResizeGadget(#Text_1, PanelItemWidth-170, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ResizeGadget(#Gdt_Left, PanelItemWidth-150, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ResizeGadget(#Gdt_Right, PanelItemWidth-90, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ResizeGadget(#Gdt_Up, PanelItemWidth-120, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ResizeGadget(#Gdt_Down, PanelItemWidth-120, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ResizeGadget(#Text_2, PanelItemWidth-170, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ResizeGadget(#Button_4, PanelItemWidth-150, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ResizeGadget(#Button_5, PanelItemWidth-100, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ResizeGadget(#Text_3, PanelItemWidth-170, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ResizeGadget(#StringLatitude, PanelItemWidth-120, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ResizeGadget(#StringLongitude, PanelItemWidth-120, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ResizeGadget(#Text_4, PanelItemWidth-170, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ResizeGadget(#Gdt_AddMarker, PanelItemWidth-170, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ResizeGadget(#Gdt_Degrees, PanelItemWidth-170, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ResizeGadget(#Gdt_ClearDiskCache, PanelItemWidth-170, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ResizeGadget(#TextGeoLocationQuery, PanelItemWidth-170, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ResizeGadget(#StringGeoLocationQuery, PanelItemWidth-170, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ; Second tab: + ResizeGadget(#Map2_Canvas, 10, 10, PanelItemWidth-198, PanelItemHeight-59) + ResizeGadget(#Map2_Move, PanelItemWidth-170, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ResizeGadget(#Map2_Left, PanelItemWidth-150, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ResizeGadget(#Map2_Right, PanelItemWidth-90, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ResizeGadget(#Map2_Up, PanelItemWidth-120, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ResizeGadget(#Map2_Down, PanelItemWidth-120, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ResizeGadget(#Map2_Zoom, PanelItemWidth-170, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ResizeGadget(#Map2_ZoomIn, PanelItemWidth-150, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ResizeGadget(#Map2_ZoomOut, PanelItemWidth-100, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ResizeGadget(#Map2_LatitudeText, PanelItemWidth-170, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ResizeGadget(#Map2_StringLatitude, PanelItemWidth-120, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ResizeGadget(#Map2_LongitudeText, PanelItemWidth-170, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ResizeGadget(#Map2_StringLongitude, PanelItemWidth-120, #PB_Ignore, #PB_Ignore, #PB_Ignore) + + ; Refresh the PBMap: + PBMap::Refresh(#Map) + PBMap::Refresh(#Map2_Canvas) +EndProcedure + +;- MAIN TEST +If OpenWindow(#Window_0, 260, 225, 720, 595, "PBMap", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered | #PB_Window_SizeGadget) + ; *** + Define Event.i, Gadget.i, Quit.b = #False + Define pfValue.d + Define Degrees = 1 + Define *Track + Define a, ActivePanel + + LoadFont(0, "Arial", 12) + LoadFont(1, "Arial", 12, #PB_Font_Bold) + LoadFont(2, "Arial", 8) + + PanelGadget(#PanelGadget, 0, 0, 720, 595) + AddGadgetItem(#PanelGadget, 0, "Map 1") + TextGadget(#Text_1, 530, 10, 60, 15, "Movements") + 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_Degrees, 530, 420, 150, 30, "Show/Hide Degrees", #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) + + ; Our main gadget + PBMap::MapGadget(#Map, 10, 10, 512, 512) + PBMap::SetOption(#Map, "ShowDegrees", "1") : Degrees = 0 + PBMap::SetOption(#Map, "ShowDebugInfos", "1") + PBMap::SetDebugLevel(5) + PBMap::SetOption(#Map, "Verbose", "0") + PBMap::SetOption(#Map, "ShowScale", "1") + PBMap::SetOption(#Map, "Warning", "1") + PBMap::SetOption(#Map, "ShowMarkersLegend", "1") + PBMap::SetOption(#Map, "ShowTrackKms", "1") + PBMap::SetOption(#Map, "ColourFocus", "$FFFF00AA") + + PBMap::SetCallBackMainPointer(#Map, @MainPointer()) ; To change the main pointer (center of the view) + PBMap::SetCallBackLocation(#Map, @UpdateLocation()) ; To obtain realtime coordinates + PBMap::SetLocation(#Map, -36.81148, 175.08634,12) ; Change the PBMap coordinates + PBMAP::SetMapScaleUnit(#Map, PBMAP::#SCALE_KM) ; To change the scale unit + PBMap::AddMarker(#Map, 49.0446828398, 2.0349812508, "", "", -1, @MyMarker()) ; To add a marker with a customised GFX + PBMap::SetCallBackMarker(#Map, @MarkerMoveCallBack()) + PBMap::SetCallBackDrawTile(#Map, @DrawTileCallBack()) + PBMap::SetCallBackModifyTileFile(#Map, @ModifyTileFileCallback()) + + AddGadgetItem(#PanelGadget, 1, "Map 2") + TextGadget(#Map2_Move, 530, 10, 60, 15, "Movements") + ButtonGadget(#Map2_Left, 550, 60, 30, 30, Chr($25C4)) : SetGadgetFont(#Gdt_Left, FontID(0)) + ButtonGadget(#Map2_Right, 610, 60, 30, 30, Chr($25BA)) : SetGadgetFont(#Gdt_Right, FontID(0)) + ButtonGadget(#Map2_Up, 580, 030, 30, 30, Chr($25B2)) : SetGadgetFont(#Gdt_Up, FontID(0)) + ButtonGadget(#Map2_Down, 580, 90, 30, 30, Chr($25BC)) : SetGadgetFont(#Gdt_Down, FontID(0)) + TextGadget(#Map2_Zoom, 530, 120, 60, 15, "Zoom") + ButtonGadget(#Map2_ZoomIn, 550, 140, 50, 30, " + ") : SetGadgetFont(#Button_4, FontID(1)) + ButtonGadget(#Map2_ZoomOut, 600, 140, 50, 30, " - ") : SetGadgetFont(#Button_5, FontID(1)) + TextGadget(#Map2_LatitudeText, 530, 190, 50, 15, "Latitude ") + StringGadget(#Map2_StringLatitude, 580, 190, 90, 20, "") + TextGadget(#Map2_LongitudeText, 530, 210, 50, 15, "Longitude ") + StringGadget(#Map2_StringLongitude, 580, 210, 90, 20, "") + + ; Our second map: + PBMap::MapGadget(#Map2_Canvas, 10, 10, 512, 512) + PBMap::SetOption(#Map2_Canvas, "ShowDegrees", "1") : Degrees = 0 + PBMap::SetOption(#Map2_Canvas, "ShowDebugInfos", "1") + PBMap::SetDebugLevel(5) + PBMap::SetOption(#Map2_Canvas, "Verbose", "0") + PBMap::SetOption(#Map2_Canvas, "ShowScale", "1") + PBMap::SetOption(#Map2_Canvas, "Warning", "1") + PBMap::SetOption(#Map2_Canvas, "ShowMarkersLegend", "1") + PBMap::SetOption(#Map2_Canvas, "ShowTrackKms", "1") + PBMap::SetOption(#Map2_Canvas, "ColourFocus", "$FFFF00AA") + PBMap::SetCallBackMainPointer(#Map2_Canvas, @MainPointer()) ; To change the main pointer (center of the view) + PBMap::SetCallBackLocation(#Map2_Canvas, @UpdateLocation()) ; To obtain realtime coordinates + PBMap::SetLocation(#Map2_Canvas, 6.81148, 15.08634,12) ; Change the PBMap coordinates + PBMAP::SetMapScaleUnit(#Map2_Canvas, PBMAP::#SCALE_KM) ; To change the scale unit + PBMap::AddMarker(#Map2_Canvas, 49.0446828398, 2.0349812508) + + CloseGadgetList() + + ActivePanel = 2 ; Set the current active panel (1 = Map1, 2 = Map2) + SetGadgetState(#PanelGadget, 1) + + 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 + + Repeat + Event = WaitWindowEvent() + Select Event + Case #PB_Event_CloseWindow : Quit = 1 + Case #PB_Event_Gadget ; { + Gadget = EventGadget() + Select Gadget + Case #PanelGadget + Select EventType() + Case #PB_EventType_Change + a = GetGadgetState(#PanelGadget) + If a <> ActivePanel + ActivePanel = a + If ActivePanel = 0 + ; .... + Else + ; .... + EndIf + EndIf + EndSelect + Case #Gdt_Up + PBMap::SetLocation(#Map, 10* 360 / Pow(2, PBMap::GetZoom(#Map) + 8), 0, 0, #PB_Relative) + Case #Map2_Up + PBMap::SetLocation(#Map2_Canvas, 10* 360 / Pow(2, PBMap::GetZoom(#Map2_Canvas) + 8), 0, 0, #PB_Relative) + Case #Gdt_Down + PBMap::SetLocation(#Map, 10* -360 / Pow(2, PBMap::GetZoom(#Map) + 8), 0, 0, #PB_Relative) + Case #Map2_Down + PBMap::SetLocation(#Map2_Canvas, 10* -360 / Pow(2, PBMap::GetZoom(#Map2_Canvas) + 8), 0, 0, #PB_Relative) + Case #Gdt_Left + PBMap::SetLocation(#Map, 0, 10* -360 / Pow(2, PBMap::GetZoom(#Map) + 8), 0, #PB_Relative) + Case #Map2_Left + PBMap::SetLocation(#Map2_Canvas, 0, 10* -360 / Pow(2, PBMap::GetZoom(#Map2_Canvas) + 8), 0, #PB_Relative) + Case #Gdt_Right + PBMap::SetLocation(#Map, 0, 10* 360 / Pow(2, PBMap::GetZoom(#Map) + 8), 0, #PB_Relative) + Case #Map2_Right + PBMap::SetLocation(#Map2_Canvas, 0, 10* 360 / Pow(2, PBMap::GetZoom(#Map2_Canvas) + 8), 0, #PB_Relative) + Case #Button_4 + PBMap::SetZoom(#Map, 1) + Case #Map2_ZoomIn + PBMap::SetZoom(#Map2_Canvas, 1) + Case #Button_5 + PBMap::SetZoom(#Map, - 1) + Case #Map2_ZoomOut + PBMap::SetZoom(#Map2_Canvas, - 1) + Case #StringLatitude, #StringLongitude, #Map2_StringLatitude, #Map2_StringLongitude + Select EventType() + Case #PB_EventType_Focus + AddKeyboardShortcut(#Window_0, #PB_Shortcut_Return, #MenuEventLonLatStringEnter) + Case #PB_EventType_LostFocus + RemoveKeyboardShortcut(#Window_0, #PB_Shortcut_Return) + EndSelect + Case #Gdt_AddMarker + PBMap::AddMarker(#Map, ValD(GetGadgetText(#StringLatitude)), ValD(GetGadgetText(#StringLongitude)), "", "Test", RGBA(Random(255), Random(255), Random(255), 255)) + Case #Gdt_Degrees + Degrees = 1 - Degrees + PBMap::SetOption(#Map, "ShowDegrees", Str(Degrees)) + PBMap::Refresh(#Map) + SetGadgetState(#Gdt_Degrees, Degrees) + Case #Gdt_ClearDiskCache + PBMap::ClearDiskCache(#Map) + 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(#Map, GetGadgetText(#StringGeoLocationQuery)) + PBMap::Refresh(#Map) + EndIf + ; *** TODO : code to change when the SetActiveGadget(-1) will be fixed + SetActiveGadget(Dummy) + ; *** + Case #MenuEventLonLatStringEnter + PBMap::SetLocation(#Map, ValD(GetGadgetText(#StringLatitude)), ValD(GetGadgetText(#StringLongitude))) ; Change the PBMap coordinates + PBMap::Refresh(#Map) + EndSelect + EndSelect + Until Quit = #True + + PBMap::FreeMapGadget(#Map) + PBMap::FreeMapGadget(#Map2_Canvas) +EndIf +; IDE Options = PureBasic 5.61 (Windows - x64) +; CursorPosition = 204 +; FirstLine = 176 +; Folding = -- +; EnableThread +; EnableXP +; CompileSourceDirectory \ No newline at end of file diff --git a/PBMap.pb b/PBMap.pb index 3ea23ad..b05deec 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -118,8 +118,8 @@ DeclareModule PBMap Declare DeleteMarker(MapGadget.i, *Ptr) Declare DeleteSelectedMarkers(MapGadget.i) Declare Drawing(MapGadget.i) - Declare FatalError(msg.s) - Declare Error(msg.s) + Declare FatalError(MapGadget.i, msg.s) + Declare Error(MapGadget.i, msg.s) Declare Refresh(MapGadget.i) Declare.i ClearDiskCache(MapGadget.i) @@ -339,7 +339,6 @@ Module PBMap Global MyDebugLevel = 5 Global NewMap PBMaps() - Global *PBMap.PBMap Global slash.s CompilerSelect #PB_Compiler_OS @@ -367,7 +366,8 @@ Module PBMap ;-Error management ; Shows an error msg and terminates the program - Procedure FatalError(msg.s) + Procedure FatalError(MapGadget, msg.s) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) If *PBMap\Options\Warning MessageRequester("PBMap", msg, #PB_MessageRequester_Ok) EndIf @@ -375,7 +375,8 @@ Module PBMap EndProcedure ; Shows an error msg - Procedure Error(msg.s) + Procedure Error(MapGadget, msg.s) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) If *PBMap\Options\Warning MessageRequester("PBMap", msg, #PB_MessageRequester_Ok) EndIf @@ -387,11 +388,9 @@ Module PBMap EndProcedure ; Send debug infos to stdout (allowing mixed debug infos with curl or other libs) - Procedure MyDebug(msg.s, DbgLevel = 0) -; Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) -; If *PBMap\Options\Verbose And DbgLevel <= MyDebugLevel - If DbgLevel <= MyDebugLevel - ;;PrintN(msg) + Procedure MyDebug(*PBMap.PBMap, msg.s, DbgLevel = 0) ;Directly pass the PBMap structure (faster) + If *PBMap\Options\Verbose And DbgLevel <= MyDebugLevel + PrintN(msg) ; Debug msg EndIf EndProcedure @@ -493,8 +492,8 @@ Module PBMap 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(*PBMap, "Latitude : " + StrD(*Location\Latitude) + " ; Longitude : " + StrD(*Location\Longitude), 5) + ;MyDebug(*PBMap, "Coords X : " + Str(*Coords\x) + " ; Y : " + Str(*Coords\y), 5) EndProcedure ; *** Converts tile.decimal to coords @@ -1118,25 +1117,25 @@ Module PBMap 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) + MyDebug(*PBMap, "Cache size : " + Str(CacheSize/1024) + " / CacheLimit : " + Str(CacheLimit/1024), 5) If CacheSize > CacheLimit - MyDebug(" Cache full. Trying cache cleaning", 5) + MyDebug(*PBMap, " 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) + MyDebug(*PBMap, " 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) + MyDebug(*PBMap, " 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) + ; MyDebug(*PBMap, " Delete " + CacheMapKey, 5) ; DeleteMapElement(*PBMap\MemCache\Images(), CacheMapKey) ; DeleteElement(*PBMap\MemCache\ImagesTimeStack(), 1) ; ElseIf *PBMap\MemCache\Images(CacheMapKey)\Tile > 0 @@ -1147,27 +1146,27 @@ Module PBMap 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) + MyDebug(*PBMap, " New cache size : " + Str(CacheSize/1024) + " / CacheLimit : " + Str(CacheLimit/1024), 5) If CacheSize > CacheLimit - MyDebug(" Cache cleaning unsuccessfull, can't add new tiles.", 5) + MyDebug(*PBMap, " Cache cleaning unsuccessfull, can't add new tiles.", 5) EndIf EndIf UnlockMutex(*PBMap\MemoryCacheAccessMutex) EndProcedure - Procedure.i GetTileFromHDD(CacheFile.s) + Procedure.i GetTileFromHDD(*PBMap.PBMap, CacheFile.s) ;Directly pass the PBMap structure (faster) Protected nImage.i, LifeTime.i, MaxLifeTime.i ; Everything is OK, loads the file nImage = LoadImage(#PB_Any, CacheFile) If nImage - MyDebug(" Success loading " + CacheFile + " as nImage " + Str(nImage), 3) + MyDebug(*PBMap, " Success loading " + CacheFile + " as nImage " + Str(nImage), 3) ProcedureReturn nImage Else - MyDebug(" Failed loading " + CacheFile + " as nImage " + Str(nImage) + " -> not an image !", 3) + MyDebug(*PBMap, " Failed loading " + CacheFile + " as nImage " + Str(nImage) + " -> not an image !", 3) If DeleteFile(CacheFile) - MyDebug(" Deleting faulty image file " + CacheFile, 3) + MyDebug(*PBMap, " Deleting faulty image file " + CacheFile, 3) Else - MyDebug(" Can't delete faulty image file " + CacheFile, 3) + MyDebug(*PBMap, " Can't delete faulty image file " + CacheFile, 3) EndIf EndIf ProcedureReturn #False @@ -1184,17 +1183,17 @@ Module PBMap ; 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) + ; MyDebug(*PBMap, "Loaded from web " + TileURL + " as CacheFile " + CacheFile, 3) ; Else - ; MyDebug("Loaded from web " + TileURL + " but cannot save to CacheFile " + CacheFile, 3) + ; MyDebug(*PBMap, "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) + ; MyDebug(*PBMap, "Can't catch image loaded from web " + TileURL, 3) ; nImage = -1 ; EndIf ; Else - ; MyDebug(" Problem loading from web " + TileURL, 3) + ; MyDebug(*PBMap, " Problem loading from web " + TileURL, 3) ; EndIf ; **** @@ -1204,10 +1203,10 @@ Module PBMap Procedure GetImageThread(*Tile.Tile) ;LockMutex(*PBMap\MemoryCacheAccessMutex) - MyDebug("Thread nb " + Str(*Tile\GetImageThread) + " " + *Tile\key + " starting for image " + *Tile\CacheFile, 5) + ;MyDebug(*PBMap, "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) +; MyDebug(*PBMap, " 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) @@ -1223,22 +1222,22 @@ Module PBMap 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) + ;MyDebug(*PBMap, " 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) + ;MyDebug(*PBMap, " 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) + ;MyDebug(*PBMap, " 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) + ;MyDebug(*PBMap, " 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) + ;MyDebug(*PBMap, " Thread nb " + Str(*Tile\GetImageThread) + " " + *Tile\key + " for image " + *Tile\CacheFile + " canceled after 10 seconds.", 5) AbortHTTP(*Tile\Download) EndIf EndSelect @@ -1260,11 +1259,11 @@ Module PBMap ; 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", 4) + MyDebug(*PBMap, "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) + MyDebug(*PBMap, " 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) @@ -1275,13 +1274,13 @@ Module PBMap ProcedureReturn *timg Else ; No, try to load it from HD (see below) - MyDebug(" but not the image.", 4) + MyDebug(*PBMap, " but not the image.", 4) EndIf Else ; 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) + MyDebug(*PBMap, " Can't add a new cache element.", 4) UnlockMutex(*PBMap\MemoryCacheAccessMutex) ProcedureReturn #False EndIf @@ -1290,14 +1289,14 @@ Module PBMap ; 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) + MyDebug(*PBMap, " 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) + MyDebug(*PBMap, "Key : " + key + " added in memory cache", 4) EndIf ; If there's no active download thread for this tile If *timg\Tile <= 0 @@ -1308,10 +1307,10 @@ Module PBMap If *timg\Size >= 0 ; Does the file exists ? If *timg\Size = 0 Or (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 image file " + CacheFile, 3) + MyDebug(*PBMap, " Deleting image file " + CacheFile, 3) *timg\Size = 0 Else - MyDebug(" Can't delete image file " + CacheFile, 3) + MyDebug(*PBMap, " Can't delete image file " + CacheFile, 3) UnlockMutex(*PBMap\MemoryCacheAccessMutex) ProcedureReturn #False EndIf @@ -1320,9 +1319,9 @@ Module PBMap EndIf ; Try To load it from HD If *timg\Size > 0 - *timg\nImage = GetTileFromHDD(CacheFile.s) + *timg\nImage = GetTileFromHDD(*PBMap, CacheFile.s) Else - MyDebug(" Failed loading from HDD " + CacheFile + " -> Filesize = " + FileSize(CacheFile), 3) + MyDebug(*PBMap, " Failed loading from HDD " + CacheFile + " -> Filesize = " + FileSize(CacheFile), 3) EndIf If *timg\nImage ; Image found and loaded from HDD @@ -1350,21 +1349,21 @@ Module PBMap 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) + MyDebug(*PBMap, " 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) + MyDebug(*PBMap, " 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) + MyDebug(*PBMap, " 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) + MyDebug(*PBMap, " Thread needed " + key + " for image " + CacheFile + " canceled because no free download slot.", 5) EndIf Else - MyDebug(" Error, maximum threads nb reached", 3) + MyDebug(*PBMap, " Error, maximum threads nb reached", 3) EndIf EndIf EndIf @@ -1384,7 +1383,7 @@ Module PBMap Protected tilemax.i = 1<<*PBMap\Zoom Protected HereLoadBalancing.b ; Here is providing a load balancing system FindMapElement(*PBMap\Layers(), LayerName) - MyDebug("Drawing tiles") + MyDebug(*PBMap, "Drawing tiles") For y = - ny - 1 To ny + 1 For x = - nx - 1 To nx + 1 px = *Drawing\RadiusX + x * *PBMap\TileSize - *Drawing\DeltaX @@ -1401,27 +1400,27 @@ 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 layer directory : " + DirName) + Error(MapGadget, "Can't create the following layer directory : " + DirName) Else - MyDebug(DirName + " successfully created", 4) + MyDebug(*PBMap, DirName + " successfully created", 4) EndIf 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 zoom directory : " + DirName) + Error(MapGadget, "Can't create the following zoom directory : " + DirName) Else - MyDebug(DirName + " successfully created", 4) + MyDebug(*PBMap, DirName + " successfully created", 4) EndIf EndIf ; Creates the sub-directory based on x DirName.s + slash + Str(tilex) If FileSize(DirName) <> -2 If CreateDirectory(DirName) = #False - Error("Can't create the following x directory : " + DirName) + Error(MapGadget, "Can't create the following x directory : " + DirName) Else - MyDebug(DirName + " successfully created", 4) + MyDebug(*PBMap, DirName + " successfully created", 4) EndIf EndIf With *PBMap\Layers() @@ -1749,7 +1748,7 @@ Module PBMap 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) + Error(MapGadget, Message) EndIf Protected *MainNode,*subNode,*child,child.l *MainNode = MainXMLNode(0) @@ -1794,7 +1793,7 @@ Module PBMap 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) + Error(MapGadget, Message) ProcedureReturn #False EndIf ProcedureReturn #True @@ -2073,6 +2072,7 @@ Module PBMap EndProcedure Procedure Refresh(MapGadget.i) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) *PBMap\Redraw = #True ; Drawing() EndProcedure @@ -2367,7 +2367,7 @@ Module PBMap Size = ReceiveHTTPFile(Query, JSONFileName) If LoadJSON(0, JSONFileName) = 0 ; Demivec's code - MyDebug( JSONErrorMessage() + " at position " + + MyDebug(*PBMap, JSONErrorMessage() + " at position " + JSONErrorPosition() + " in line " + JSONErrorLine() + " of JSON web Data", 1) ElseIf JSONArraySize(JSONValue(0)) > 0 @@ -2400,11 +2400,11 @@ Module PBMap EndIf EndIf If DeleteDirectory(*PBMap\Options\HDDCachePath, "", #PB_FileSystem_Recursive) - MyDebug("Cache in : " + *PBMap\Options\HDDCachePath + " cleared", 3) + MyDebug(*PBMap, "Cache in : " + *PBMap\Options\HDDCachePath + " cleared", 3) CreateDirectoryEx(*PBMap\Options\HDDCachePath) ProcedureReturn #True Else - MyDebug("Can't clear cache in " + *PBMap\Options\HDDCachePath, 3) + MyDebug(*PBMap, "Can't clear cache in " + *PBMap\Options\HDDCachePath, 3) ProcedureReturn #False EndIf EndProcedure @@ -2705,7 +2705,7 @@ Module PBMap Protected *PBMap.PBMap *PBMap.PBMap = AllocateStructure(PBMap) If *PBMap = 0 - FatalError("Cannot initialize PBMap memory") + FatalError(MapGadget, "Cannot initialize PBMap memory") EndIf PBMaps(Str(MapGadget)) = *PBMap With *PBMap @@ -2723,7 +2723,7 @@ Module PBMap \Mode = #MODE_DEFAULT \MemoryCacheAccessMutex = CreateMutex() If \MemoryCacheAccessMutex = #False - MyDebug("Cannot create a mutex", 0) + MyDebug(*PBMap, "Cannot create a mutex", 0) End EndIf EndWith @@ -2749,7 +2749,7 @@ Module PBMap If CanvasGadget(MapGadget, X, Y, Width, Height, #PB_Canvas_Keyboard) BindMapGadget(MapGadget, TimerNB) Else - FatalError("Cannot create the map gadget") + FatalError(MapGadget, "Cannot create the map gadget") EndIf EndIf EndProcedure @@ -2791,10 +2791,6 @@ Module PBMap EndIf Next EndProcedure - - Procedure SelectPBMap(MapGadget.i) ; Could be used to have multiple PBMaps in one window - *PBMap = PBMaps(Str(MapGadget)) - EndProcedure EndModule @@ -3140,8 +3136,8 @@ CompilerEndIf ; IDE Options = PureBasic 5.61 (Windows - x64) -; CursorPosition = 396 -; FirstLine = 381 +; CursorPosition = 340 +; FirstLine = 76 ; Folding = --------------------- ; EnableThread ; EnableXP From 55bc5c8f78a491c1b6aaf7f180719147fa659b99 Mon Sep 17 00:00:00 2001 From: djes Date: Sat, 17 Mar 2018 14:36:44 +0100 Subject: [PATCH 45/60] Debug mode corrected Active Window wasn't anymore when console opened --- Multiple-PBMaps-Demo.pb | 12 ++++++------ PBMap.pb | 24 +++++++++++++++--------- README.md | 3 ++- 3 files changed, 23 insertions(+), 16 deletions(-) diff --git a/Multiple-PBMaps-Demo.pb b/Multiple-PBMaps-Demo.pb index 5bc8cab..001e77a 100644 --- a/Multiple-PBMaps-Demo.pb +++ b/Multiple-PBMaps-Demo.pb @@ -204,11 +204,11 @@ If OpenWindow(#Window_0, 260, 225, 720, 595, "PBMap", #PB_Window_SystemMenu | #P SetActiveGadget(#StringGeoLocationQuery) ; Our main gadget - PBMap::MapGadget(#Map, 10, 10, 512, 512) + PBMap::MapGadget(#Map, 10, 10, 512, 512, 1, #Window_0) PBMap::SetOption(#Map, "ShowDegrees", "1") : Degrees = 0 PBMap::SetOption(#Map, "ShowDebugInfos", "1") PBMap::SetDebugLevel(5) - PBMap::SetOption(#Map, "Verbose", "0") + PBMap::SetOption(#Map, "Verbose", "1") PBMap::SetOption(#Map, "ShowScale", "1") PBMap::SetOption(#Map, "Warning", "1") PBMap::SetOption(#Map, "ShowMarkersLegend", "1") @@ -239,11 +239,11 @@ If OpenWindow(#Window_0, 260, 225, 720, 595, "PBMap", #PB_Window_SystemMenu | #P StringGadget(#Map2_StringLongitude, 580, 210, 90, 20, "") ; Our second map: - PBMap::MapGadget(#Map2_Canvas, 10, 10, 512, 512) + PBMap::MapGadget(#Map2_Canvas, 10, 10, 512, 512, 1, #Window_0) PBMap::SetOption(#Map2_Canvas, "ShowDegrees", "1") : Degrees = 0 PBMap::SetOption(#Map2_Canvas, "ShowDebugInfos", "1") PBMap::SetDebugLevel(5) - PBMap::SetOption(#Map2_Canvas, "Verbose", "0") + PBMap::SetOption(#Map2_Canvas, "Verbose", "1") PBMap::SetOption(#Map2_Canvas, "ShowScale", "1") PBMap::SetOption(#Map2_Canvas, "Warning", "1") PBMap::SetOption(#Map2_Canvas, "ShowMarkersLegend", "1") @@ -361,8 +361,8 @@ If OpenWindow(#Window_0, 260, 225, 720, 595, "PBMap", #PB_Window_SystemMenu | #P PBMap::FreeMapGadget(#Map2_Canvas) EndIf ; IDE Options = PureBasic 5.61 (Windows - x64) -; CursorPosition = 204 -; FirstLine = 176 +; CursorPosition = 241 +; FirstLine = 198 ; Folding = -- ; EnableThread ; EnableXP diff --git a/PBMap.pb b/PBMap.pb index b05deec..fb1b6a9 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -83,14 +83,14 @@ DeclareModule PBMap Declare DisableLayer(MapGadget.i, Name.s) Declare SetLayerAlpha(MapGadget.i, Name.s, Alpha.d) Declare.d GetLayerAlpha(MapGadget.i, Name.s) - Declare BindMapGadget(MapGadget.i, TimerNB = 1) + Declare BindMapGadget(MapGadget.i, TimerNB = 1, Window = -1) Declare SetCallBackLocation(MapGadget.i, *CallBackLocation) Declare SetCallBackMainPointer(MapGadget.i, CallBackMainPointer.i) Declare SetCallBackDrawTile(MapGadget.i, *CallBackLocation) Declare SetCallBackMarker(MapGadget.i, *CallBackLocation) Declare SetCallBackLeftClic(MapGadget.i, *CallBackLocation) Declare SetCallBackModifyTileFile(MapGadget.i, *CallBackLocation) - Declare.i MapGadget(MapGadget.i, X.i, Y.i, Width.i, Height.i, TimerNB = 1) ; Returns Gadget NB if #PB_Any is used for gadget + Declare.i MapGadget(MapGadget.i, X.i, Y.i, Width.i, Height.i, TimerNB = 1, Window = -1) ; Returns Gadget NB if #PB_Any is used for gadget Declare FreeMapGadget(MapGadget.i) Declare.d GetLatitude(MapGadget.i) Declare.d GetLongitude(MapGadget.i) @@ -2701,12 +2701,15 @@ Module PBMap EndProcedure ; Could be called directly to attach our map to an existing canvas - Procedure BindMapGadget(MapGadget.i, TimerNB = 1) + Procedure BindMapGadget(MapGadget.i, TimerNB = 1, Window = -1) Protected *PBMap.PBMap *PBMap.PBMap = AllocateStructure(PBMap) If *PBMap = 0 FatalError(MapGadget, "Cannot initialize PBMap memory") EndIf + If Window = -1 + Window = GetActiveWindow() + EndIf PBMaps(Str(MapGadget)) = *PBMap With *PBMap Protected Result.i @@ -2718,7 +2721,7 @@ Module PBMap \EditMarker = #False \StandardFont = LoadFont(#PB_Any, "Arial", 20, #PB_Font_Bold) \UnderlineFont = LoadFont(#PB_Any, "Arial", 20, #PB_Font_Underline) - \Window = GetActiveWindow() + \Window = Window \Timer = TimerNB \Mode = #MODE_DEFAULT \MemoryCacheAccessMutex = CreateMutex() @@ -2739,15 +2742,18 @@ Module PBMap EndProcedure ; Creates a canvas and attach our map - Procedure MapGadget(MapGadget.i, X.i, Y.i, Width.i, Height.i, TimerNB = 1) + Procedure MapGadget(MapGadget.i, X.i, Y.i, Width.i, Height.i, TimerNB = 1, Window.i = -1) + If Window = -1 + Window = GetActiveWindow() + EndIf If MapGadget = #PB_Any Protected GadgetNB.i GadgetNB = CanvasGadget(#PB_Any, X, Y, Width, Height, #PB_Canvas_Keyboard) ; #PB_Canvas_Keyboard has to be set for mousewheel to work on windows - BindMapGadget(GadgetNB, TimerNB) + BindMapGadget(GadgetNB, TimerNB, Window) ProcedureReturn GadgetNB Else If CanvasGadget(MapGadget, X, Y, Width, Height, #PB_Canvas_Keyboard) - BindMapGadget(MapGadget, TimerNB) + BindMapGadget(MapGadget, TimerNB, Window) Else FatalError(MapGadget, "Cannot create the map gadget") EndIf @@ -3136,8 +3142,8 @@ CompilerEndIf ; IDE Options = PureBasic 5.61 (Windows - x64) -; CursorPosition = 340 -; FirstLine = 76 +; CursorPosition = 2751 +; FirstLine = 2744 ; Folding = --------------------- ; EnableThread ; EnableXP diff --git a/README.md b/README.md index 32d63bb..0e5a1d2 100644 --- a/README.md +++ b/README.md @@ -6,7 +6,7 @@ To develop tiled map applications in PureBasic. Based on OpenStreetMap services OSM copyright : http://www.openstreetmap.org/copyright -This code is free ! +This code is free, but any use should mention the origin of this code. Officials forums topics here : http://www.purebasic.fr/english/viewtopic.php?f=27&t=66320 (english) @@ -18,3 +18,4 @@ djes Idle Progi1984 yves86 +André From 864d1e33f5dd717642801d300d408669a04ff9a4 Mon Sep 17 00:00:00 2001 From: djes Date: Mon, 11 Jun 2018 23:23:48 +0200 Subject: [PATCH 46/60] Optimisation Little optimisation by Michael Vogel, see https://www.purebasic.fr/english/viewtopic.php?p=523247#p523247 --- PBMap.pb | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index fb1b6a9..98019a7 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -515,7 +515,7 @@ Module PBMap Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) 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\Longitude = Mod((1 + *Coords\x / n) * 360, 360) - 180 ; 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 @@ -3141,9 +3141,9 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf -; IDE Options = PureBasic 5.61 (Windows - x64) -; CursorPosition = 2751 -; FirstLine = 2744 +; IDE Options = PureBasic 5.61 (Windows - x86) +; CursorPosition = 517 +; FirstLine = 513 ; Folding = --------------------- ; EnableThread ; EnableXP From 79707581148dfe0838e99d29808a603abe9f7eeb Mon Sep 17 00:00:00 2001 From: djes Date: Mon, 11 Jun 2018 23:36:47 +0200 Subject: [PATCH 47/60] UTF8 source --- PBMap.pb | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index 3800a50..43b94ee 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -1,4 +1,4 @@ -; ******************************************************************** +; ******************************************************************** ; Program: PBMap ; Description: Permits the use of tiled maps like ; OpenStreetMap in a handy PureBASIC module @@ -2543,14 +2543,13 @@ 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(MapGadget) Location\Longitude = GetMouseLongitude(MapGadget) 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 + ; ajout YA // Mouse pointer when moving map 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 @@ -2608,7 +2607,7 @@ Module PBMap EndIf Next ; Check if mouse touch tracks - If *PBMap\Options\ShowTrackSelection ; YA ajout pour éviter la sélection de la trace + If *PBMap\Options\ShowTrackSelection ; YA to avoid selecting track With *PBMap\TracksList() ; Trace Track If ListSize(*PBMap\TracksList()) > 0 @@ -2642,11 +2641,11 @@ Module PBMap EndIf EndIf Case #PB_EventType_LeftButtonUp - SetGadgetAttribute(*PBMap\Gadget,#PB_Canvas_Cursor,#PB_Cursor_Default) ; ajout YA pour remettre le pointeur souris en normal + SetGadgetAttribute(*PBMap\Gadget,#PB_Canvas_Cursor,#PB_Cursor_Default) ; YA normal mouse pointer ; *PBMap\MoveStartingPoint\x = - 1 *PBMap\Dragging = #False *PBMap\Redraw = #True - ;YA pour connaitre les coordonnées d'un marqueur après déplacement + ;YA to knows marker coordinates after moving ForEach *PBMap\Markers() If *PBMap\Markers()\Selected = #True If *PBMap\CallBackMarker > 0 @@ -3141,11 +3140,11 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf -; IDE Options = PureBasic 5.61 (Windows - x86) -; CursorPosition = 517 -; FirstLine = 513 +; IDE Options = PureBasic 5.61 (Windows - x64) +; CursorPosition = 2648 +; FirstLine = 2606 ; Folding = --------------------- ; EnableThread ; EnableXP ; CompileSourceDirectory -; DisablePurifier = 1,1,1,1 +; DisablePurifier = 1,1,1,1 \ No newline at end of file From 7b17b7166e7e5411edf5401dac71d70191f44d80 Mon Sep 17 00:00:00 2001 From: djes Date: Mon, 11 Jun 2018 23:39:02 +0200 Subject: [PATCH 48/60] UTF8 --- PBMap.pb | 1 + 1 file changed, 1 insertion(+) diff --git a/PBMap.pb b/PBMap.pb index 43b94ee..f0be39b 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -2543,6 +2543,7 @@ Module PBMap EndIf Next EndIf + ; YA To select a track with LMB If *PBMap\EditMarker = #False Location\Latitude = GetMouseLatitude(MapGadget) Location\Longitude = GetMouseLongitude(MapGadget) From b09559c5ee7ef8cdc41ce1e367482e9ac425353f Mon Sep 17 00:00:00 2001 From: djes Date: Mon, 3 Sep 2018 14:46:24 +0200 Subject: [PATCH 49/60] Pixel2Lon()/Pixel2Lat() correction and GetCanvasPixelLon()/Lat() functions --- PBMap.pb | 77 +++++++++++++++++++++++++++++++++++--------------------- 1 file changed, 48 insertions(+), 29 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index f0be39b..82a68e3 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -511,20 +511,6 @@ Module PBMap EndIf EndProcedure - Procedure Pixel2LatLon(MapGadget.i, *Coords.PixelCoordinates, *Location.GeographicCoordinates, Zoom) - Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) - Protected n.d = *PBMap\TileSize * Pow(2.0, Zoom) - ; Ensures the longitude to be in the range [-180; 180[ - *Location\Longitude = Mod((1 + *Coords\x / n) * 360, 360) - 180 ; 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[ Procedure.d ClipLongitude(Longitude.d) ProcedureReturn Mod(Mod(Longitude + 180, 360.0) + 360.0, 360.0) - 180 @@ -565,19 +551,37 @@ Module PBMap *Pixel\y = *PBMap\Drawing\RadiusY + (py - *PBMap\PixelCoordinates\y) EndProcedure + Procedure Pixel2LatLon(MapGadget.i, *Coords.PixelCoordinates, *Location.GeographicCoordinates, Zoom) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) + Protected n.d = *PBMap\TileSize * Pow(2.0, Zoom) + ; Ensures the longitude to be in the range [-180; 180[ + *Location\Longitude = Mod((1 + *Coords\x / n) * 360, 360) - 180 ; 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.d Pixel2Lon(MapGadget.i, x) Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) - 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 + Protected n.d = *PBMap\TileSize * Pow(2.0, *PBMap\Zoom) + ProcedureReturn Mod((1 + x / n) * 360.0, 360.0) - 180 EndProcedure Procedure.d Pixel2Lat(MapGadget.i, y) Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) - 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)))) + Protected n.d = *PBMap\TileSize * Pow(2.0, *PBMap\Zoom) + Protected latitude.d = Degree(ATan(SinH(#PI * (1.0 - 2.0 * y / n)))) + If latitude <= -89 + latitude = -89 + EndIf + If latitude >= 89 + latitude = 89 + EndIf + ProcedureReturn latitude EndProcedure ; HaversineAlgorithm @@ -2079,20 +2083,30 @@ Module PBMap ;-*** Misc functions - Procedure.d GetMouseLongitude(MapGadget.i) + Procedure.d GetCanvasPixelLon(MapGadget.i, x) Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) - Protected MouseX.d = (*PBMap\PixelCoordinates\x - *PBMap\Drawing\RadiusX + GetGadgetAttribute(*PBMap\Gadget, #PB_Canvas_MouseX)) / *PBMap\TileSize + Protected MouseX.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(MouseX / n * 360.0, 360.0) + 360.0, 360.0) - 180 EndProcedure - Procedure.d GetMouseLatitude(MapGadget.i) + Procedure.d GetCanvasPixelLat(MapGadget.i, y) Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) - Protected MouseY.d = (*PBMap\PixelCoordinates\y - *PBMap\Drawing\RadiusY + GetGadgetAttribute(*PBMap\Gadget, #PB_Canvas_MouseY)) / *PBMap\TileSize + Protected MouseY.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 * MouseY / n)))) EndProcedure + + Procedure.d GetMouseLongitude(MapGadget.i) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) + ProcedureReturn GetCanvasPixelLon(MapGadget.i, GetGadgetAttribute(*PBMap\Gadget, #PB_Canvas_MouseX)) + EndProcedure + + Procedure.d GetMouseLatitude(MapGadget.i) + Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) + ProcedureReturn GetCanvasPixelLat(MapGadget.i, GetGadgetAttribute(*PBMap\Gadget, #PB_Canvas_MouseY)) + EndProcedure Procedure SetLocation(MapGadget.i, latitude.d, longitude.d, Zoom = -1, Mode.i = #PB_Absolute) Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) @@ -2510,7 +2524,12 @@ Module PBMap Else ; Absolute zoom (centered on the center of the map) SetZoom(MapGadget, GetGadgetAttribute(*PBMap\Gadget, #PB_Canvas_WheelDelta), #PB_Relative) - EndIf + EndIf +; Case #PB_EventType_RightClick +; Debug GetMouseLongitude(MapGadget) +; Debug GetMouseLatitude(MapGadget) +; Debug GetCanvasPixelLon(MapGadget, CanvasMouseX + *PBMap\Drawing\RadiusX) +; Debug GetCanvasPixelLat(MapGadget, CanvasMouseY + *PBMap\Drawing\RadiusY) Case #PB_EventType_LeftButtonDown ; LatLon2Pixel(@*PBMap\GeographicCoordinates, @*PBMap\PixelCoordinates, *PBMap\Zoom) *PBMap\Dragging = #True @@ -3141,9 +3160,9 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf -; IDE Options = PureBasic 5.61 (Windows - x64) -; CursorPosition = 2648 -; FirstLine = 2606 +; IDE Options = PureBasic 5.62 (Windows - x64) +; CursorPosition = 2105 +; FirstLine = 2084 ; Folding = --------------------- ; EnableThread ; EnableXP From 55930e68b15d6f9ef0ee0e79abb27404d746a615 Mon Sep 17 00:00:00 2001 From: djes Date: Thu, 18 Jul 2019 15:04:43 +0200 Subject: [PATCH 50/60] Bug tracking Some bugs removed and OnError() coded added (thanks to falsam) Spotted png image library bug, reported on PB forum. --- PBMap.pb | 71 ++++++++++++++++++++++++++++++++++++++------------------ 1 file changed, 49 insertions(+), 22 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index f0be39b..66e6fda 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -1,18 +1,41 @@ -; ******************************************************************** +; ******************************************************************** ; Program: PBMap ; Description: Permits the use of tiled maps like ; OpenStreetMap in a handy PureBASIC module ; Author: Thyphoon, djes, Idle, yves86 -; Date: June, 2018 +; Date: July, 2019 ; License: PBMap : Free, unrestricted, credit ; appreciated but not required. ; OSM : see http://www.openstreetmap.org/copyright ; Note: Please share improvement ! -; Thanks: Progi1984 +; Thanks: Progi1984, falsam +; HowToRun: Just compile this code, example is included +; ******************************************************************** +; +; Track bugs with the following options with debugger enabled (see in the example) +; PBMap::SetOption(#Map, "ShowDebugInfos", "1") +; PBMap::SetDebugLevel(5) +; PBMap::SetOption(#Map, "Verbose", "1") +; +; or with the OnError() PB capabilities : +; +; CompilerIf #PB_Compiler_LineNumbering = #False +; MessageRequester("Warning !", "You must enable 'OnError lines support' in compiler options", #PB_MessageRequester_Ok ) +; End +; CompilerEndIf +; +; Declare ErrorHandler() +; +; OnErrorCall(@ErrorHandler()) +; +; Procedure ErrorHandler() +; MessageRequester("Ooops", "The following error happened : " + ErrorMessage(ErrorCode()) + #CRLF$ +"line : " + Str(ErrorLine())) +; EndProcedure +; ; ******************************************************************** CompilerIf #PB_Compiler_Thread = #False - MessageRequester("Warning !", "You must enable ThreadSafe support in compiler options", #PB_MessageRequester_Ok ) + MessageRequester("Warning !", "You must enable 'Create ThreadSafe Executable' in compiler options", #PB_MessageRequester_Ok ) End CompilerEndIf @@ -29,7 +52,7 @@ UseJPEGImageEncoder() DeclareModule PBMap #PBMAPNAME = "PBMap" - #PBMAPVERSION = "0.9" + #PBMAPVERSION = "0.91" #USERAGENT = #PBMAPNAME + "/" + #PBMAPVERSION + " (https://github.com/djes/PBMap)" CompilerIf #PB_Compiler_OS = #PB_OS_Linux @@ -57,10 +80,10 @@ DeclareModule PBMap EndStructure Structure Marker - GeographicCoordinates.GeographicCoordinates ; Marker latitude and longitude + GeographicCoordinates.GeographicCoordinates ; Marker's latitude and longitude Identifier.s Legend.s - Color.l ; Marker color + Color.l ; Marker's color Focus.i Selected.i ; Is the marker selected ? CallBackPointer.i ; @Procedure(X.i, Y.i) to DrawPointer (you must use VectorDrawing lib) @@ -1220,16 +1243,16 @@ Module PBMap Repeat Progress = HTTPProgress(*Tile\Download) Select Progress - Case #PB_Http_Success + Case #PB_HTTP_Success *Tile\Size = FinishHTTP(*Tile\Download) ; \Size signals that the download is OK ;MyDebug(*PBMap, " Thread nb " + Str(*Tile\GetImageThread) + " " + *Tile\key + " for image " + *Tile\CacheFile + " finished. Size : " + Str(*Tile\Size), 5) Quit = #True - Case #PB_Http_Failed + Case #PB_HTTP_Failed FinishHTTP(*Tile\Download) *Tile\Size = 0 ; \Size = 0 signals that the download has failed ;MyDebug(*PBMap, " Thread nb " + Str(*Tile\GetImageThread) + " " + *Tile\key + " for image " + *Tile\CacheFile + " failed.", 5) Quit = #True - Case #PB_Http_Aborted + Case #PB_HTTP_Aborted FinishHTTP(*Tile\Download) *Tile\Size = 0 ; \Size = 0 signals that the download has failed ;MyDebug(*PBMap, " Thread nb " + Str(*Tile\GetImageThread) + " " + *Tile\key + " for image " + *Tile\CacheFile + " aborted.", 5) @@ -1299,9 +1322,9 @@ Module PBMap MyDebug(*PBMap, "Key : " + key + " added in memory cache", 4) EndIf ; If there's no active download thread for this tile - If *timg\Tile <= 0 + If *timg\Tile <= 0 *timg\nImage = 0 - *timg\Size = FileSize(CacheFile) + *timg\Size = FileSize(CacheFile) ; Manage tile file lifetime, delete if too old, or if size = 0 If *PBMap\Options\TileLifetime <> -1 If *timg\Size >= 0 ; Does the file exists ? @@ -1311,14 +1334,14 @@ Module PBMap *timg\Size = 0 Else MyDebug(*PBMap, " Can't delete image file " + CacheFile, 3) - UnlockMutex(*PBMap\MemoryCacheAccessMutex) - ProcedureReturn #False EndIf + UnlockMutex(*PBMap\MemoryCacheAccessMutex) + ProcedureReturn #False EndIf EndIf EndIf ; Try To load it from HD - If *timg\Size > 0 + If *timg\Size > 0 *timg\nImage = GetTileFromHDD(*PBMap, CacheFile.s) Else MyDebug(*PBMap, " Failed loading from HDD " + CacheFile + " -> Filesize = " + FileSize(CacheFile), 3) @@ -1333,9 +1356,10 @@ Module PBMap 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 + *timg\Tile = *NewTile ; There's now a loading thread + *timg\Alpha = 0 With *NewTile ; New tile parameters \key = key @@ -1346,12 +1370,13 @@ Module PBMap \Window = *PBMap\Window \Gadget = *PBMap\Gadget \GetImageThread = CreateThread(@GetImageThread(), *NewTile) - If \GetImageThread - *timg\Tile = *NewTile ; There's now a loading thread - *timg\Alpha = 0 + If \GetImageThread MyDebug(*PBMap, " Creating get image thread nb " + Str(\GetImageThread) + " to get " + CacheFile + " (key = " + key, 3) *PBMap\ThreadsNB + 1 + *PBMap\DownloadSlots + 1 Else + ; Thread creation failed this time + *timg\Tile = 0 MyDebug(*PBMap, " Can't create get image thread to get " + CacheFile, 3) FreeMemory(*NewTile) EndIf @@ -3141,11 +3166,13 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf -; IDE Options = PureBasic 5.61 (Windows - x64) -; CursorPosition = 2648 -; FirstLine = 2606 +; IDE Options = PureBasic 5.70 LTS (Windows - x64) +; CursorPosition = 255 +; FirstLine = 227 ; Folding = --------------------- ; EnableThread ; EnableXP +; EnableOnError +; DisableDebugger ; CompileSourceDirectory ; DisablePurifier = 1,1,1,1 \ No newline at end of file From 629c469a6b4c6f31f11f5f803876e54bc360a46a Mon Sep 17 00:00:00 2001 From: djes Date: Thu, 18 Jul 2019 16:24:12 +0200 Subject: [PATCH 51/60] Code cleanup Misc internal fixes, especially in GetImageThread() --- PBMap.pb | 130 +++++++++++++++++++++++++++---------------------------- 1 file changed, 64 insertions(+), 66 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index 66ac1fd..d9dc0fb 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -1141,7 +1141,7 @@ Module PBMap ; If cache size exceeds limit, try to delete the oldest tiles used (first in the time stack) Procedure MemoryCacheManagement(MapGadget.i) Protected *PBMap.PBMap = PBMaps(Str(MapGadget)) - LockMutex(*PBMap\MemoryCacheAccessMutex) ; Prevents thread to start or finish + LockMutex(*PBMap\MemoryCacheAccessMutex) ; Prevents threads 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(*PBMap, "Cache size : " + Str(CacheSize/1024) + " / CacheLimit : " + Str(CacheLimit/1024), 5) @@ -1228,7 +1228,7 @@ Module PBMap Threaded Progress = 0, Quit = #False - Procedure GetImageThread(*Tile.Tile) + Procedure GetImageThread(*Tile.Tile) ;LockMutex(*PBMap\MemoryCacheAccessMutex) ;MyDebug(*PBMap, "Thread nb " + Str(*Tile\GetImageThread) + " " + *Tile\key + " starting for image " + *Tile\CacheFile, 5) ; If MemoryCache is currently being cleaned, abort @@ -1287,7 +1287,7 @@ Module PBMap Protected *timg.ImgMemCach = FindMapElement(*PBMap\MemCache\Images(), key) If *timg MyDebug(*PBMap, "Key : " + key + " found in memory cache", 4) - ; Is the associated image already been loaded in memory ? + ; Is the associated image already loaded in memory ? If *timg\nImage ; Yes, returns the image's nb MyDebug(*PBMap, " as image " + *timg\nImage, 4) @@ -1325,13 +1325,14 @@ Module PBMap *PBMap\MemCache\ImagesTimeStack()\MapKey = MapKey(*PBMap\MemCache\Images()) MyDebug(*PBMap, "Key : " + key + " added in memory cache", 4) EndIf - ; If there's no active download thread for this tile + ; If there's no active downloading thread for this image If *timg\Tile <= 0 *timg\nImage = 0 - *timg\Size = FileSize(CacheFile) - ; Manage tile file lifetime, delete if too old, or if size = 0 - If *PBMap\Options\TileLifetime <> -1 - If *timg\Size >= 0 ; Does the file exists ? + *timg\Size = FileSize(CacheFile) + ; Does a valid file exists on HD ? Try to load it. + If *timg\Size >= 0 + ; Manage tile file lifetime, delete if too old, or if size = 0 + If *PBMap\Options\TileLifetime <> -1 If *timg\Size = 0 Or (Date() - GetFileDate(CacheFile, #PB_Date_Modified) > *PBMap\Options\TileLifetime) ; If Lifetime > MaxLifeTime ; There's a bug with #PB_Date_Created If DeleteFile(CacheFile) MyDebug(*PBMap, " Deleting image file " + CacheFile, 3) @@ -1343,58 +1344,53 @@ Module PBMap ProcedureReturn #False EndIf EndIf - EndIf - ; Try To load it from HD - If *timg\Size > 0 - *timg\nImage = GetTileFromHDD(*PBMap, CacheFile.s) - Else - MyDebug(*PBMap, " 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 - Protected *NewTile.Tile = AllocateMemory(SizeOf(Tile)) - If *NewTile - *timg\Tile = *NewTile ; There's now a loading thread - *timg\Alpha = 0 - With *NewTile - ; New tile parameters - \key = key - \URL = URL - \CacheFile = CacheFile - \nImage = 0 - \Time = ElapsedMilliseconds() - \Window = *PBMap\Window - \Gadget = *PBMap\Gadget - \GetImageThread = CreateThread(@GetImageThread(), *NewTile) - If \GetImageThread - MyDebug(*PBMap, " Creating get image thread nb " + Str(\GetImageThread) + " to get " + CacheFile + " (key = " + key, 3) - *PBMap\ThreadsNB + 1 - *PBMap\DownloadSlots + 1 - Else - ; Thread creation failed this time - *timg\Tile = 0 - MyDebug(*PBMap, " Can't create get image thread to get " + CacheFile, 3) - FreeMemory(*NewTile) - EndIf - EndWith - Else - MyDebug(*PBMap, " Error, can't allocate memory for a new tile loading thread", 3) - EndIf - Else - MyDebug(*PBMap, " Thread needed " + key + " for image " + CacheFile + " canceled because no free download slot.", 5) - EndIf - Else - MyDebug(*PBMap, " Error, maximum threads nb reached", 3) + ; Try to load tile's image from HD + *timg\nImage = GetTileFromHDD(*PBMap, CacheFile.s) + If *timg\nImage + ; Success : image found and loaded from HDD + *timg\Alpha = 0 + UnlockMutex(*PBMap\MemoryCacheAccessMutex) + ProcedureReturn *timg EndIf EndIf + ; If GetTileFromHDD failed, will try to download the image from the web in a thread + MyDebug(*PBMap, " Failed loading from HDD " + CacheFile + " -> Filesize = " + FileSize(CacheFile), 3) + If *PBMap\ThreadsNB < *PBMap\Options\MaxThreads + If *PBMap\DownloadSlots < *PBMap\Options\MaxDownloadSlots + Protected *NewTile.Tile = AllocateMemory(SizeOf(Tile)) + If *NewTile + *timg\Tile = *NewTile ; There's now a loading thread + *timg\Alpha = 0 + With *NewTile + ; New tile parameters + \key = key + \URL = URL + \CacheFile = CacheFile + \nImage = 0 + \Time = ElapsedMilliseconds() + \Window = *PBMap\Window + \Gadget = *PBMap\Gadget + \GetImageThread = CreateThread(@GetImageThread(), *NewTile) + If \GetImageThread + MyDebug(*PBMap, " Creating get image thread nb " + Str(\GetImageThread) + " to get " + CacheFile + " (key = " + key, 3) + *PBMap\ThreadsNB + 1 + *PBMap\DownloadSlots + 1 + Else + ; Thread creation failed this time + *timg\Tile = 0 + MyDebug(*PBMap, " Can't create get image thread to get " + CacheFile, 3) + FreeMemory(*NewTile) + EndIf + EndWith + Else + MyDebug(*PBMap, " Error, can't allocate memory for a new tile loading thread", 3) + EndIf + Else + MyDebug(*PBMap, " Thread needed " + key + " for image " + CacheFile + " canceled because no free download slot.", 5) + EndIf + Else + MyDebug(*PBMap, " Error, maximum threads nb reached", 3) + EndIf EndIf UnlockMutex(*PBMap\MemoryCacheAccessMutex) ProcedureReturn #False @@ -2687,7 +2683,7 @@ Module PBMap EndIf Case #PB_EventType_LeftButtonUp SetGadgetAttribute(*PBMap\Gadget,#PB_Canvas_Cursor,#PB_Cursor_Default) ; YA normal mouse pointer - ; *PBMap\MoveStartingPoint\x = - 1 + ; *PBMap\MoveStartingPoint\x = - 1 *PBMap\Dragging = #False *PBMap\Redraw = #True ;YA to knows marker coordinates after moving @@ -2702,18 +2698,19 @@ Module PBMap *PBMap\Redraw = #True Case #PB_MAP_RETRY *PBMap\Redraw = #True - ;- #PB_MAP_TILE_CLEANUP : Tile web loading thread cleanup - ; After a Web tile loading thread, clean the tile structure memory, see GetImageThread() + ;- *** Tile web loading thread cleanup + ; After a Web tile loading thread, cleans the tile structure memory, see GetImageThread() Case #PB_MAP_TILE_CLEANUP + LockMutex(*PBMap\MemoryCacheAccessMutex) ; Prevents threads to start or finish *Tile = EventData() 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 + ;*PBMap\MemCache\Images(key)\Tile = *Tile\Size If *Tile\Size *PBMap\MemCache\Images(key)\Tile = -1 ; Web loading thread has finished successfully - ;- Allows to post edit the tile image file with a customised code + ; Allows to post edit the tile image file with a customised code If *PBMap\CallBackModifyTileFile TileNewFilename = *PBMap\CallBackModifyTileFile(*Tile\CacheFile, *Tile\URL) If TileNewFilename @@ -2729,10 +2726,11 @@ Module PBMap *PBMap\ThreadsNB - 1 *PBMap\DownloadSlots - 1 *PBMap\Redraw = #True + UnlockMutex(*PBMap\MemoryCacheAccessMutex) EndSelect EndProcedure - ; Redraws at regular intervals + ;-*** Main timer : Cache management and drawing Procedure TimerEvents() Protected *PBMap.PBMap ForEach PBMaps() @@ -3185,8 +3183,8 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.70 LTS (Windows - x64) -; CursorPosition = 3154 -; FirstLine = 3136 +; CursorPosition = 1369 +; FirstLine = 1354 ; Folding = --------------------- ; EnableThread ; EnableXP \ No newline at end of file From ff6a10feb4011333490d344577ddabc8b63f0be9 Mon Sep 17 00:00:00 2001 From: djes Date: Thu, 18 Jul 2019 16:38:22 +0200 Subject: [PATCH 52/60] Update README.md --- README.md | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/README.md b/README.md index 0e5a1d2..4bc0dbd 100644 --- a/README.md +++ b/README.md @@ -1,14 +1,14 @@ -# PBMap +# PBMap 0.91 Open source tiled map software. -To develop tiled map applications in PureBasic. +Module to develop tiled map applications in PureBasic, like like OpenStreetMap(c), Google Maps(c), Here(c), ... -Based on OpenStreetMap services +Functional example based on OpenStreetMap services(c) OSM copyright : http://www.openstreetmap.org/copyright -This code is free, but any use should mention the origin of this code. +This code is free, but any user should mention the origin of this code. -Officials forums topics here : +Official forums topics : http://www.purebasic.fr/english/viewtopic.php?f=27&t=66320 (english) http://www.purebasic.fr/french/viewtopic.php?f=3&t=16160 (french) @@ -16,6 +16,11 @@ Contributors : Thyphoon djes Idle + +Thanks to : Progi1984 yves86 -André +André +falsam + +Special thanks to Fred and Fantaisie Software's team From 86acc0be602f89b882d513138096fbc21c08d4a5 Mon Sep 17 00:00:00 2001 From: djes Date: Thu, 18 Jul 2019 16:39:22 +0200 Subject: [PATCH 53/60] Update README.md --- README.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/README.md b/README.md index 4bc0dbd..3ef3f0d 100644 --- a/README.md +++ b/README.md @@ -3,9 +3,12 @@ Open source tiled map software. Module to develop tiled map applications in PureBasic, like like OpenStreetMap(c), Google Maps(c), Here(c), ... + Functional example based on OpenStreetMap services(c) + OSM copyright : http://www.openstreetmap.org/copyright + This code is free, but any user should mention the origin of this code. Official forums topics : From 741aa2afb11adf3570833ddffda37a0580862114 Mon Sep 17 00:00:00 2001 From: djes Date: Thu, 18 Jul 2019 16:39:41 +0200 Subject: [PATCH 54/60] Update README.md --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 3ef3f0d..4d3b905 100644 --- a/README.md +++ b/README.md @@ -4,7 +4,7 @@ Open source tiled map software. Module to develop tiled map applications in PureBasic, like like OpenStreetMap(c), Google Maps(c), Here(c), ... -Functional example based on OpenStreetMap services(c) +Functional example based on OpenStreetMap(c) services OSM copyright : http://www.openstreetmap.org/copyright From 705be8f877082b0ad158b6b8186cc1cc1742fff3 Mon Sep 17 00:00:00 2001 From: djes Date: Thu, 18 Jul 2019 20:56:33 +0200 Subject: [PATCH 55/60] Incomplete image file download automatic deletion Little update to delete incomplete (eventually malformed) image file --- PBMap.pb | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index d9dc0fb..e01259f 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -1273,7 +1273,7 @@ Module PBMap EndIf ; End of the memory cache access ;LockMutex(*PBMap\MemoryCacheAccessMutex) - PostEvent(#PB_Event_Gadget, *Tile\Window, *Tile\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ; To free memory outside the thread + PostEvent(#PB_Event_Gadget, *Tile\Window, *Tile\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ; To free memory and eventually delete aborted image file outside the thread ;UnlockMutex(*PBMap\MemoryCacheAccessMutex) EndProcedure @@ -2720,6 +2720,11 @@ Module PBMap EndIf Else *PBMap\MemCache\Images(key)\Tile = 0 + If DeleteFile(*Tile\CacheFile) + MyDebug(*PBMap, " Deleting not fully loaded image file " + *Tile\CacheFile, 3) + Else + MyDebug(*PBMap, " Can't delete not fully loaded image file " + *Tile\CacheFile, 3) + EndIf EndIf EndIf FreeMemory(*Tile) ; Frees the data needed for the thread (*tile=*PBMap\MemCache\Images(key)\Tile) @@ -3183,8 +3188,8 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.70 LTS (Windows - x64) -; CursorPosition = 1369 -; FirstLine = 1354 +; CursorPosition = 1261 +; FirstLine = 1242 ; Folding = --------------------- ; EnableThread ; EnableXP \ No newline at end of file From a909362ee2375c63b02a05240f74ae7eec200b5b Mon Sep 17 00:00:00 2001 From: djes Date: Thu, 18 Jul 2019 21:39:34 +0200 Subject: [PATCH 56/60] Update PBMap.pb --- PBMap.pb | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index e01259f..ad145bd 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -1243,6 +1243,7 @@ Module PBMap ;UnlockMutex(*PBMap\MemoryCacheAccessMutex) *Tile\Size = 0 *Tile\Download = ReceiveHTTPFile(*Tile\URL, *Tile\CacheFile, #PB_HTTP_Asynchronous, #USERAGENT) + ;TODO : obtain original file size to compare and eventually delete truncated file If *Tile\Download Repeat Progress = HTTPProgress(*Tile\Download) @@ -1273,7 +1274,8 @@ Module PBMap EndIf ; End of the memory cache access ;LockMutex(*PBMap\MemoryCacheAccessMutex) - PostEvent(#PB_Event_Gadget, *Tile\Window, *Tile\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ; To free memory and eventually delete aborted image file outside the thread + ; To free memory and eventually delete aborted image file outside the thread + PostEvent(#PB_Event_Gadget, *Tile\Window, *Tile\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ;UnlockMutex(*PBMap\MemoryCacheAccessMutex) EndProcedure @@ -2709,6 +2711,7 @@ Module PBMap ; 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 + ;TODO : check if file size = server file size *PBMap\MemCache\Images(key)\Tile = -1 ; Web loading thread has finished successfully ; Allows to post edit the tile image file with a customised code If *PBMap\CallBackModifyTileFile @@ -3188,8 +3191,8 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.70 LTS (Windows - x64) -; CursorPosition = 1261 -; FirstLine = 1242 +; CursorPosition = 1245 +; FirstLine = 1230 ; Folding = --------------------- ; EnableThread ; EnableXP \ No newline at end of file From 10e88b685a6ac3a9f0711303574907a9882d9a72 Mon Sep 17 00:00:00 2001 From: djes Date: Thu, 18 Jul 2019 22:07:23 +0200 Subject: [PATCH 57/60] pngcheck comment --- PBMap.pb | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index ad145bd..e82184f 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -2712,6 +2712,7 @@ Module PBMap ;*PBMap\MemCache\Images(key)\Tile = *Tile\Size If *Tile\Size ;TODO : check if file size = server file size + ;and eventually use pngcheck to avoid problematic files http://www.libpng.org/pub/png/apps/pngcheck.html *PBMap\MemCache\Images(key)\Tile = -1 ; Web loading thread has finished successfully ; Allows to post edit the tile image file with a customised code If *PBMap\CallBackModifyTileFile @@ -3191,8 +3192,8 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.70 LTS (Windows - x64) -; CursorPosition = 1245 -; FirstLine = 1230 +; CursorPosition = 2714 +; FirstLine = 2702 ; Folding = --------------------- ; EnableThread ; EnableXP \ No newline at end of file From 297fe00f575533f4440e841f3f51e12193520d30 Mon Sep 17 00:00:00 2001 From: djes Date: Fri, 19 Jul 2019 11:15:29 +0200 Subject: [PATCH 58/60] PNG checking Thanks to idle ! --- PBMap.pb | 26 +++++++++++++++++++++++--- 1 file changed, 23 insertions(+), 3 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index e82184f..0c9f547 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -1181,10 +1181,30 @@ Module PBMap UnlockMutex(*PBMap\MemoryCacheAccessMutex) EndProcedure + ;- LoadImage workaround + ; by idle + ; Check that the file is valid + Procedure _LoadImage(ImageNumber, File.s) + Protected fn, pat, pos, res + If UCase(GetExtensionPart(File)) = "PNG" + pat = $444E4549 + fn= ReadFile(#PB_Any, File) + If fn + pos = Lof(fn) + FileSeek(fn, pos - 8) + res = ReadLong(fn) + CloseFile(fn) + If res = pat + ProcedureReturn LoadImage(ImageNumber, File) + EndIf + EndIf + EndIf + EndProcedure + Procedure.i GetTileFromHDD(*PBMap.PBMap, CacheFile.s) ;Directly pass the PBMap structure (faster) Protected nImage.i, LifeTime.i, MaxLifeTime.i ; Everything is OK, loads the file - nImage = LoadImage(#PB_Any, CacheFile) + nImage = _LoadImage(#PB_Any, CacheFile) If nImage MyDebug(*PBMap, " Success loading " + CacheFile + " as nImage " + Str(nImage), 3) ProcedureReturn nImage @@ -3192,8 +3212,8 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.70 LTS (Windows - x64) -; CursorPosition = 2714 -; FirstLine = 2702 +; CursorPosition = 2962 +; FirstLine = 2945 ; Folding = --------------------- ; EnableThread ; EnableXP \ No newline at end of file From bbd1d75c02d320fddcc24c723938b7089992f814 Mon Sep 17 00:00:00 2001 From: djes Date: Fri, 19 Jul 2019 13:42:09 +0200 Subject: [PATCH 59/60] Update PBMap.pb --- PBMap.pb | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/PBMap.pb b/PBMap.pb index 0c9f547..f27d88d 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -1183,7 +1183,7 @@ Module PBMap ;- LoadImage workaround ; by idle - ; Check that the file is valid + ; Check that the PNG file is valid Procedure _LoadImage(ImageNumber, File.s) Protected fn, pat, pos, res If UCase(GetExtensionPart(File)) = "PNG" @@ -3212,8 +3212,8 @@ CompilerIf #PB_Compiler_IsMainFile CompilerEndIf ; IDE Options = PureBasic 5.70 LTS (Windows - x64) -; CursorPosition = 2962 -; FirstLine = 2945 +; CursorPosition = 1185 +; FirstLine = 1171 ; Folding = --------------------- ; EnableThread ; EnableXP \ No newline at end of file From 00d7cdceb7b9989e9de8caf728fe095146ef5dfc Mon Sep 17 00:00:00 2001 From: djes Date: Sun, 17 Jan 2021 11:30:57 +0100 Subject: [PATCH 60/60] Demo separated from module --- Demo.pb | 380 ++++++++++++++++++++++++++++++++++++++++ Multiple-PBMaps-Demo.pb | 12 +- PBMap.pb | 351 +------------------------------------ 3 files changed, 395 insertions(+), 348 deletions(-) create mode 100644 Demo.pb diff --git a/Demo.pb b/Demo.pb new file mode 100644 index 0000000..bd14ea6 --- /dev/null +++ b/Demo.pb @@ -0,0 +1,380 @@ +; ******************************************************************** +; Program: PBMap example +; Author: djes +; Date: Jan, 2021 +; License: PBMap : Free, unrestricted, credit +; appreciated but not required. +; OSM : see http://www.openstreetmap.org/copyright +; Note: Please share improvement ! +; Thanks: Progi1984, falsam +; ******************************************************************** +; +; Track bugs with the following options with debugger enabled +; PBMap::SetOption(#Map, "ShowDebugInfos", "1") +; PBMap::SetDebugLevel(5) +; PBMap::SetOption(#Map, "Verbose", "1") +; +; or with the OnError() PB capabilities : +; +; CompilerIf #PB_Compiler_LineNumbering = #False +; MessageRequester("Warning !", "You must enable 'OnError lines support' in compiler options", #PB_MessageRequester_Ok ) +; End +; CompilerEndIf +; +; Declare ErrorHandler() +; +; OnErrorCall(@ErrorHandler()) +; +; Procedure ErrorHandler() +; MessageRequester("Ooops", "The following error happened : " + ErrorMessage(ErrorCode()) + #CRLF$ +"line : " + Str(ErrorLine())) +; EndProcedure +; +; ******************************************************************** + +XIncludeFile "PBMap.pb" + +InitNetwork() + +CompilerIf #PB_Compiler_Thread = #False + MessageRequester("Warning !", "You must enable 'Create ThreadSafe Executable' in compiler options", #PB_MessageRequester_Ok ) + End +CompilerEndIf + +EnableExplicit + +Enumeration + #Window_0 + #Map + #Gdt_Left + #Gdt_Right + #Gdt_Up + #Gdt_Down + ; #Gdt_RotateLeft + ; #Gdt_RotateRight + #Button_4 + #Button_5 + #Combo_0 + #Text_0 + #Text_1 + #Text_2 + #Text_3 + #Text_4 + #StringLatitude + #StringLongitude + #Gdt_LoadGpx + #Gdt_SaveGpx + #Gdt_AddMarker + #Gdt_AddOpenseaMap + #Gdt_AddHereMap + #Gdt_AddGeoServerMap + #Gdt_Degrees + #Gdt_EditMode + #Gdt_ClearDiskCache + #TextGeoLocationQuery + #StringGeoLocationQuery +EndEnumeration + +; Menu events +Enumeration + #MenuEventLonLatStringEnter + #MenuEventGeoLocationStringEnter +EndEnumeration + +Structure Location + Longitude.d + Latitude.d +EndStructure + +Procedure UpdateLocation(*Location.Location) + SetGadgetText(#StringLatitude, StrD(*Location\Latitude)) + SetGadgetText(#StringLongitude, StrD(*Location\Longitude)) + ProcedureReturn 0 +EndProcedure + +; 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) + 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 MarkerMoveCallBack(*Marker.PBMap::Marker) + Debug "Identifier : " + *Marker\Identifier + "(" + StrD(*Marker\GeographicCoordinates\Latitude) + ", " + StrD(*Marker\GeographicCoordinates\Longitude) + ")" +EndProcedure + +; Example of a custom procedure to alter tile rendering +Procedure DrawTileCallBack(x.i, y.i, image.i, alpha.d) + MovePathCursor(x, y) + DrawVectorImage(ImageID(image), 255 * alpha) +EndProcedure + +; Example of a custom procedure to alter tile file just after loading +Procedure.s ModifyTileFileCallback(CacheFile.s, OrgURL.s) + Protected ImgNB = LoadImage(#PB_Any, CacheFile) + If ImgNB + StartDrawing(ImageOutput(ImgNB)) + DrawText(0, 0,"PUREBASIC", RGB(255, 255, 0)) + StopDrawing() + ;*** Could be used to create new files + ; Cachefile = ReplaceString(Cachefile, ".png", "_PB.png") + ;*** + If SaveImage(ImgNB, CacheFile, #PB_ImagePlugin_PNG, 0, 32) ;Warning, the 32 is mandatory as some tiles aren't correctly rendered + ; Send back the new name (not functional by now) + ProcedureReturn CacheFile + EndIf + 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) +EndProcedure + +Procedure ResizeAll() + ResizeGadget(#Map, 10, 10, WindowWidth(#Window_0)-198, WindowHeight(#Window_0)-59) + ResizeGadget(#Text_1, WindowWidth(#Window_0)-170, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ResizeGadget(#Gdt_Left, WindowWidth(#Window_0) - 150, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ResizeGadget(#Gdt_Right, WindowWidth(#Window_0) - 90, #PB_Ignore, #PB_Ignore, #PB_Ignore) + ; ResizeGadget(#Gdt_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)-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_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) + 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(#Map) +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, "Arial", 12) + LoadFont(1, "Arial", 12, #PB_Font_Bold) + LoadFont(2, "Arial", 8) + + 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 + 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 Degrees = 1 + Define *Track + Define *PBMap + + ; Our main gadget + ;*PBMap = PBMap::InitPBMap(#Window_0) + PBMap::MapGadget(#Map, 10, 10, 512, 512) + PBMap::SetOption(#Map, "ShowDegrees", "1") : Degrees = 0 + PBMap::SetOption(#Map, "ShowDebugInfos", "1") + PBMap::SetDebugLevel(5) + PBMap::SetOption(#Map, "Verbose", "0") + PBMap::SetOption(#Map, "ShowScale", "1") + PBMap::SetOption(#Map, "Warning", "1") + PBMap::SetOption(#Map, "ShowMarkersLegend", "1") + PBMap::SetOption(#Map, "ShowTrackKms", "1") + PBMap::SetOption(#Map, "ColourFocus", "$FFFF00AA") + + PBMap::SetCallBackMainPointer(#Map, @MainPointer()) ; To change the main pointer (center of the view) + PBMap::SetCallBackLocation(#Map, @UpdateLocation()) ; To obtain realtime coordinates + PBMap::SetLocation(#Map, -36.81148, 175.08634,12) ; Change the PBMap coordinates + PBMap::SetMapScaleUnit(#Map, PBMAP::#SCALE_KM) ; To change the scale unit + PBMap::AddMarker(#Map, 49.0446828398, 2.0349812508, "", "", -1, @MyMarker()) ; To add a marker with a customised GFX + PBMap::SetCallBackMarker(#Map, @MarkerMoveCallBack()) + ;PBMap::SetCallBackDrawTile(@DrawTileCallBack()) + ;PBMap::SetCallBackModifyTileFile(@ModifyTileFileCallback()) + + Repeat + Event = WaitWindowEvent() + Select Event + Case #PB_Event_CloseWindow : Quit = 1 + Case #PB_Event_Gadget ; { + Gadget = EventGadget() + Select Gadget + Case #Gdt_Up + PBMap::SetLocation(#Map, 10* 360 / Pow(2, PBMap::GetZoom(#Map) + 8), 0, 0, #PB_Relative) + Case #Gdt_Down + PBMap::SetLocation(#Map, 10* -360 / Pow(2, PBMap::GetZoom(#Map) + 8), 0, 0, #PB_Relative) + Case #Gdt_Left + PBMap::SetLocation(#Map, 0, 10* -360 / Pow(2, PBMap::GetZoom(#Map) + 8), 0, #PB_Relative) + Case #Gdt_Right + PBMap::SetLocation(#Map, 0, 10* 360 / Pow(2, PBMap::GetZoom(#Map) + 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(#Map, 1) + Case #Button_5 + PBMap::SetZoom(#Map, -1) + Case #Gdt_LoadGpx + *Track = PBMap::LoadGpxFile(#Map, OpenFileRequester("Choose a file to load", "", "Gpx|*.gpx", 0)) + PBMap::SetTrackColour(#Map, *Track, RGBA(Random(255), Random(255), Random(255), 128)) + Case #Gdt_SaveGpx + If *Track + If PBMap::SaveGpxFile(#Map, 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 + AddKeyboardShortcut(#Window_0, #PB_Shortcut_Return, #MenuEventLonLatStringEnter) + Case #PB_EventType_LostFocus + RemoveKeyboardShortcut(#Window_0, #PB_Shortcut_Return) + EndSelect + Case #Gdt_AddMarker + PBMap::AddMarker(#Map, ValD(GetGadgetText(#StringLatitude)), ValD(GetGadgetText(#StringLongitude)), "", "Test", RGBA(Random(255), Random(255), Random(255), 255)) + Case #Gdt_AddOpenseaMap + If PBMap::IsLayer(#Map, "OpenSeaMap") + PBMap::DeleteLayer(#Map, "OpenSeaMap") + SetGadgetState(#Gdt_AddOpenseaMap, 0) + Else + PBMap::AddOSMServerLayer(#Map, "OpenSeaMap", 3, "http://t1.openseamap.org/seamark/") ; Add a special osm overlay map on layer nb 3 + SetGadgetState(#Gdt_AddOpenseaMap, 1) + EndIf + PBMap::Refresh(#Map) + Case #Gdt_AddHereMap + If PBMap::IsLayer(#Map, "Here") + PBMap::DeleteLayer(#Map, "Here") + SetGadgetState(#Gdt_AddHereMap, 0) + Else + If PBMap::GetOption(#Map, "appid") <> "" And PBMap::GetOption(#Map, "appcode") <> "" + PBMap::AddHereServerLayer(#Map, "Here", 2) ; Add a "HERE" overlay map on layer nb 2 + PBMap::SetLayerAlpha(#Map, "Here", 0.75) + Else + MessageRequester("Info", "Don't forget to register on HERE and change the following line or edit options file") + PBMap::AddHereServerLayer(#Map, "Here", 2, "my_id", "my_code") ; Add a here overlay map on layer nb 2 + EndIf + SetGadgetState(#Gdt_AddHereMap, 1) + EndIf + PBMap::Refresh(#Map) + Case #Gdt_AddGeoServerMap + If PBMap::IsLayer(#Map, "GeoServer") + PBMap::DeleteLayer(#Map, "GeoServer") + SetGadgetState(#Gdt_AddGeoServerMap, 0) + Else + PBMap::AddGeoServerLayer(#Map, "GeoServer", 3, "demolayer", "http://localhost:8080/", "geowebcache/service/gmaps", "image/png") ; Add a geoserver overlay map on layer nb 3 + PBMap::SetLayerAlpha(#Map, "GeoServer", 0.75) + SetGadgetState(#Gdt_AddGeoServerMap, 1) + EndIf + PBMap::Refresh(#Map) + Case #Gdt_Degrees + Degrees = 1 - Degrees + PBMap::SetOption(#Map, "ShowDegrees", Str(Degrees)) + PBMap::Refresh(#Map) + SetGadgetState(#Gdt_Degrees, Degrees) + Case #Gdt_EditMode + If PBMap::GetMode(#Map) <> PBMap::#MODE_EDIT + PBMap::SetMode(#Map, PBMap::#MODE_EDIT) + SetGadgetState(#Gdt_EditMode, 1) + Else + PBMap::SetMode(#Map, PBMap::#MODE_DEFAULT) + SetGadgetState(#Gdt_EditMode, 0) + EndIf + Case #Gdt_ClearDiskCache + PBMap::ClearDiskCache(#Map) + 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(#Map, GetGadgetText(#StringGeoLocationQuery)) + PBMap::Refresh(#Map) + EndIf + ; *** TODO : code to change when the SetActiveGadget(-1) will be fixed + SetActiveGadget(Dummy) + ; *** + Case #MenuEventLonLatStringEnter + PBMap::SetLocation(#Map, ValD(GetGadgetText(#StringLatitude)), ValD(GetGadgetText(#StringLongitude))) ; Change the PBMap coordinates + PBMap::Refresh(#Map) + EndSelect + EndSelect + Until Quit = #True + + PBMap::FreeMapGadget(#Map) +EndIf + + +; IDE Options = PureBasic 5.73 LTS (Windows - x64) +; CursorPosition = 7 +; Folding = -- +; EnableThread +; EnableXP \ No newline at end of file diff --git a/Multiple-PBMaps-Demo.pb b/Multiple-PBMaps-Demo.pb index 001e77a..efe567b 100644 --- a/Multiple-PBMaps-Demo.pb +++ b/Multiple-PBMaps-Demo.pb @@ -14,6 +14,13 @@ ; **************************************************************** XIncludeFile "PBMap.pb" +CompilerIf #PB_Compiler_Thread = #False + MessageRequester("Warning !", "You must enable 'Create ThreadSafe Executable' in compiler options", #PB_MessageRequester_Ok ) + End +CompilerEndIf + +EnableExplicit + InitNetwork() Enumeration @@ -360,9 +367,8 @@ If OpenWindow(#Window_0, 260, 225, 720, 595, "PBMap", #PB_Window_SystemMenu | #P PBMap::FreeMapGadget(#Map) PBMap::FreeMapGadget(#Map2_Canvas) EndIf -; IDE Options = PureBasic 5.61 (Windows - x64) -; CursorPosition = 241 -; FirstLine = 198 +; IDE Options = PureBasic 5.73 LTS (Windows - x64) +; CursorPosition = 21 ; Folding = -- ; EnableThread ; EnableXP diff --git a/PBMap.pb b/PBMap.pb index f27d88d..0e67dc0 100644 --- a/PBMap.pb +++ b/PBMap.pb @@ -3,13 +3,13 @@ ; Description: Permits the use of tiled maps like ; OpenStreetMap in a handy PureBASIC module ; Author: Thyphoon, djes, Idle, yves86 -; Date: July, 2019 +; Date: Jan, 2021 ; License: PBMap : Free, unrestricted, credit ; appreciated but not required. ; OSM : see http://www.openstreetmap.org/copyright ; Note: Please share improvement ! ; Thanks: Progi1984, falsam -; HowToRun: Just compile this code, example is included +; HowToRun: Include this code ; ******************************************************************** ; ; Track bugs with the following options with debugger enabled (see in the example) @@ -2871,349 +2871,10 @@ Module PBMap EndModule -; **************************************************************** -; -;- Example of application -; -; **************************************************************** + -CompilerIf #PB_Compiler_IsMainFile - InitNetwork() - - Enumeration - #Window_0 - #Map - #Gdt_Left - #Gdt_Right - #Gdt_Up - #Gdt_Down - ; #Gdt_RotateLeft - ; #Gdt_RotateRight - #Button_4 - #Button_5 - #Combo_0 - #Text_0 - #Text_1 - #Text_2 - #Text_3 - #Text_4 - #StringLatitude - #StringLongitude - #Gdt_LoadGpx - #Gdt_SaveGpx - #Gdt_AddMarker - #Gdt_AddOpenseaMap - #Gdt_AddHereMap - #Gdt_AddGeoServerMap - #Gdt_Degrees - #Gdt_EditMode - #Gdt_ClearDiskCache - #TextGeoLocationQuery - #StringGeoLocationQuery - EndEnumeration - - ; Menu events - Enumeration - #MenuEventLonLatStringEnter - #MenuEventGeoLocationStringEnter - EndEnumeration - - Structure Location - Longitude.d - Latitude.d - EndStructure - - Procedure UpdateLocation(*Location.Location) - SetGadgetText(#StringLatitude, StrD(*Location\Latitude)) - SetGadgetText(#StringLongitude, StrD(*Location\Longitude)) - ProcedureReturn 0 - EndProcedure - - ; 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) - 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 MarkerMoveCallBack(*Marker.PBMap::Marker) - Debug "Identifier : " + *Marker\Identifier + "(" + StrD(*Marker\GeographicCoordinates\Latitude) + ", " + StrD(*Marker\GeographicCoordinates\Longitude) + ")" - EndProcedure - - ; Example of a custom procedure to alter tile rendering - Procedure DrawTileCallBack(x.i, y.i, image.i, alpha.d) - MovePathCursor(x, y) - DrawVectorImage(ImageID(image), 255 * alpha) - EndProcedure - - ; Example of a custom procedure to alter tile file just after loading - Procedure.s ModifyTileFileCallback(CacheFile.s, OrgURL.s) - Protected ImgNB = LoadImage(#PB_Any, CacheFile) - If ImgNB - StartDrawing(ImageOutput(ImgNB)) - DrawText(0, 0,"PUREBASIC", RGB(255, 255, 0)) - StopDrawing() - ;*** Could be used to create new files - ; Cachefile = ReplaceString(Cachefile, ".png", "_PB.png") - ;*** - If SaveImage(ImgNB, CacheFile, #PB_ImagePlugin_PNG, 0, 32) ;Warning, the 32 is mandatory as some tiles aren't correctly rendered - ; Send back the new name (not functional by now) - ProcedureReturn CacheFile - EndIf - 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) - EndProcedure - - Procedure ResizeAll() - ResizeGadget(#Map, 10, 10, WindowWidth(#Window_0)-198, WindowHeight(#Window_0)-59) - ResizeGadget(#Text_1, WindowWidth(#Window_0)-170, #PB_Ignore, #PB_Ignore, #PB_Ignore) - ResizeGadget(#Gdt_Left, WindowWidth(#Window_0) - 150, #PB_Ignore, #PB_Ignore, #PB_Ignore) - ResizeGadget(#Gdt_Right, WindowWidth(#Window_0) - 90, #PB_Ignore, #PB_Ignore, #PB_Ignore) - ; ResizeGadget(#Gdt_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)-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_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) - 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(#Map) - 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, "Arial", 12) - LoadFont(1, "Arial", 12, #PB_Font_Bold) - LoadFont(2, "Arial", 8) - - 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 - 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 Degrees = 1 - Define *Track - Define *PBMap - - ; Our main gadget - ;*PBMap = PBMap::InitPBMap(#Window_0) - PBMap::MapGadget(#Map, 10, 10, 512, 512) - PBMap::SetOption(#Map, "ShowDegrees", "1") : Degrees = 0 - PBMap::SetOption(#Map, "ShowDebugInfos", "1") - PBMap::SetDebugLevel(5) - PBMap::SetOption(#Map, "Verbose", "0") - PBMap::SetOption(#Map, "ShowScale", "1") - PBMap::SetOption(#Map, "Warning", "1") - PBMap::SetOption(#Map, "ShowMarkersLegend", "1") - PBMap::SetOption(#Map, "ShowTrackKms", "1") - PBMap::SetOption(#Map, "ColourFocus", "$FFFF00AA") - - PBMap::SetCallBackMainPointer(#Map, @MainPointer()) ; To change the main pointer (center of the view) - PBMap::SetCallBackLocation(#Map, @UpdateLocation()) ; To obtain realtime coordinates - PBMap::SetLocation(#Map, -36.81148, 175.08634,12) ; Change the PBMap coordinates - PBMap::SetMapScaleUnit(#Map, PBMAP::#SCALE_KM) ; To change the scale unit - PBMap::AddMarker(#Map, 49.0446828398, 2.0349812508, "", "", -1, @MyMarker()) ; To add a marker with a customised GFX - PBMap::SetCallBackMarker(#Map, @MarkerMoveCallBack()) - ;PBMap::SetCallBackDrawTile(@DrawTileCallBack()) - ;PBMap::SetCallBackModifyTileFile(@ModifyTileFileCallback()) - - Repeat - Event = WaitWindowEvent() - Select Event - Case #PB_Event_CloseWindow : Quit = 1 - Case #PB_Event_Gadget ; { - Gadget = EventGadget() - Select Gadget - Case #Gdt_Up - PBMap::SetLocation(#Map, 10* 360 / Pow(2, PBMap::GetZoom(#Map) + 8), 0, 0, #PB_Relative) - Case #Gdt_Down - PBMap::SetLocation(#Map, 10* -360 / Pow(2, PBMap::GetZoom(#Map) + 8), 0, 0, #PB_Relative) - Case #Gdt_Left - PBMap::SetLocation(#Map, 0, 10* -360 / Pow(2, PBMap::GetZoom(#Map) + 8), 0, #PB_Relative) - Case #Gdt_Right - PBMap::SetLocation(#Map, 0, 10* 360 / Pow(2, PBMap::GetZoom(#Map) + 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(#Map, 1) - Case #Button_5 - PBMap::SetZoom(#Map, -1) - Case #Gdt_LoadGpx - *Track = PBMap::LoadGpxFile(#Map, OpenFileRequester("Choose a file to load", "", "Gpx|*.gpx", 0)) - PBMap::SetTrackColour(#Map, *Track, RGBA(Random(255), Random(255), Random(255), 128)) - Case #Gdt_SaveGpx - If *Track - If PBMap::SaveGpxFile(#Map, 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 - AddKeyboardShortcut(#Window_0, #PB_Shortcut_Return, #MenuEventLonLatStringEnter) - Case #PB_EventType_LostFocus - RemoveKeyboardShortcut(#Window_0, #PB_Shortcut_Return) - EndSelect - Case #Gdt_AddMarker - PBMap::AddMarker(#Map, ValD(GetGadgetText(#StringLatitude)), ValD(GetGadgetText(#StringLongitude)), "", "Test", RGBA(Random(255), Random(255), Random(255), 255)) - Case #Gdt_AddOpenseaMap - If PBMap::IsLayer(#Map, "OpenSeaMap") - PBMap::DeleteLayer(#Map, "OpenSeaMap") - SetGadgetState(#Gdt_AddOpenseaMap, 0) - Else - PBMap::AddOSMServerLayer(#Map, "OpenSeaMap", 3, "http://t1.openseamap.org/seamark/") ; Add a special osm overlay map on layer nb 3 - SetGadgetState(#Gdt_AddOpenseaMap, 1) - EndIf - PBMap::Refresh(#Map) - Case #Gdt_AddHereMap - If PBMap::IsLayer(#Map, "Here") - PBMap::DeleteLayer(#Map, "Here") - SetGadgetState(#Gdt_AddHereMap, 0) - Else - If PBMap::GetOption(#Map, "appid") <> "" And PBMap::GetOption(#Map, "appcode") <> "" - PBMap::AddHereServerLayer(#Map, "Here", 2) ; Add a "HERE" overlay map on layer nb 2 - PBMap::SetLayerAlpha(#Map, "Here", 0.75) - Else - MessageRequester("Info", "Don't forget to register on HERE and change the following line or edit options file") - PBMap::AddHereServerLayer(#Map, "Here", 2, "my_id", "my_code") ; Add a here overlay map on layer nb 2 - EndIf - SetGadgetState(#Gdt_AddHereMap, 1) - EndIf - PBMap::Refresh(#Map) - Case #Gdt_AddGeoServerMap - If PBMap::IsLayer(#Map, "GeoServer") - PBMap::DeleteLayer(#Map, "GeoServer") - SetGadgetState(#Gdt_AddGeoServerMap, 0) - Else - PBMap::AddGeoServerLayer(#Map, "GeoServer", 3, "demolayer", "http://localhost:8080/", "geowebcache/service/gmaps", "image/png") ; Add a geoserver overlay map on layer nb 3 - PBMap::SetLayerAlpha(#Map, "GeoServer", 0.75) - SetGadgetState(#Gdt_AddGeoServerMap, 1) - EndIf - PBMap::Refresh(#Map) - Case #Gdt_Degrees - Degrees = 1 - Degrees - PBMap::SetOption(#Map, "ShowDegrees", Str(Degrees)) - PBMap::Refresh(#Map) - SetGadgetState(#Gdt_Degrees, Degrees) - Case #Gdt_EditMode - If PBMap::GetMode(#Map) <> PBMap::#MODE_EDIT - PBMap::SetMode(#Map, PBMap::#MODE_EDIT) - SetGadgetState(#Gdt_EditMode, 1) - Else - PBMap::SetMode(#Map, PBMap::#MODE_DEFAULT) - SetGadgetState(#Gdt_EditMode, 0) - EndIf - Case #Gdt_ClearDiskCache - PBMap::ClearDiskCache(#Map) - 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(#Map, GetGadgetText(#StringGeoLocationQuery)) - PBMap::Refresh(#Map) - EndIf - ; *** TODO : code to change when the SetActiveGadget(-1) will be fixed - SetActiveGadget(Dummy) - ; *** - Case #MenuEventLonLatStringEnter - PBMap::SetLocation(#Map, ValD(GetGadgetText(#StringLatitude)), ValD(GetGadgetText(#StringLongitude))) ; Change the PBMap coordinates - PBMap::Refresh(#Map) - EndSelect - EndSelect - Until Quit = #True - - PBMap::FreeMapGadget(#Map) - EndIf - -CompilerEndIf - -; IDE Options = PureBasic 5.70 LTS (Windows - x64) -; CursorPosition = 1185 -; FirstLine = 1171 -; Folding = --------------------- +; IDE Options = PureBasic 5.73 LTS (Windows - x64) +; CursorPosition = 35 +; Folding = -------------------- ; EnableThread ; EnableXP \ No newline at end of file