thyphoonfr
60647f4928
replace CallFunctionFast(PBMap\CallBackMarker, @PBMap\Markers()\GeographicCoordinates) by CallFunctionFast(PBMap\CallBackMarker, @PBMap\Markers()) To use Marker identifier if necessary move "Marker" and "GeographicCoordinates" from Module to DeclareModule. I need it's public to read easly data send to callback function.
2960 lines
119 KiB
Plaintext
2960 lines
119 KiB
Plaintext
; ********************************************************************
|
|
; Program: PBMap
|
|
; Description: Permits the use of tiled maps like
|
|
; OpenStreetMap in a handy PureBASIC module
|
|
; 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
|
|
; ********************************************************************
|
|
|
|
CompilerIf #PB_Compiler_Thread = #False
|
|
MessageRequester("Warning !", "You must enable ThreadSafe support in compiler options", #PB_MessageRequester_Ok )
|
|
End
|
|
CompilerEndIf
|
|
|
|
EnableExplicit
|
|
|
|
InitNetwork()
|
|
UsePNGImageDecoder()
|
|
UseJPEGImageDecoder()
|
|
UsePNGImageEncoder()
|
|
UseJPEGImageEncoder()
|
|
|
|
;- Module declaration
|
|
|
|
DeclareModule PBMap
|
|
|
|
CompilerIf #PB_Compiler_OS = #PB_OS_Linux
|
|
#Red = 255
|
|
CompilerEndIf
|
|
|
|
#SCALE_NAUTICAL = 1
|
|
#SCALE_KM = 0
|
|
|
|
#MODE_DEFAULT = 0
|
|
#MODE_HAND = 1
|
|
#MODE_SELECT = 2
|
|
#MODE_EDIT = 3
|
|
|
|
#MARKER_EDIT_EVENT = #PB_Event_FirstCustomValue
|
|
|
|
#PB_MAP_REDRAW = #PB_EventType_FirstCustomValue + 1
|
|
#PB_MAP_RETRY = #PB_EventType_FirstCustomValue + 2
|
|
#PB_MAP_TILE_CLEANUP = #PB_EventType_FirstCustomValue + 3
|
|
|
|
Structure GeographicCoordinates
|
|
Longitude.d
|
|
Latitude.d
|
|
EndStructure
|
|
|
|
Structure Marker
|
|
GeographicCoordinates.GeographicCoordinates ; Marker latitude and longitude
|
|
Identifier.s
|
|
Legend.s
|
|
Color.l ; Marker color
|
|
Focus.i
|
|
Selected.i ; Is the marker selected ?
|
|
CallBackPointer.i ; @Procedure(X.i, Y.i) to DrawPointer (you must use VectorDrawing lib)
|
|
EditWindow.i
|
|
EndStructure
|
|
|
|
|
|
Declare InitPBMap(window)
|
|
Declare SetDebugLevel(level.i)
|
|
Declare SetOption(Option.s, Value.s)
|
|
Declare.s GetOption(Option.s)
|
|
Declare LoadOptions(PreferencesFile.s = "PBMap.prefs")
|
|
Declare SaveOptions(PreferencesFile.s = "PBMap.prefs")
|
|
Declare.i AddOSMServerLayer(LayerName.s, Order.i, ServerURL.s = "http://tile.openstreetmap.org/")
|
|
Declare.i AddHereServerLayer(LayerName.s, Order.i, APP_ID.s = "", APP_CODE.s = "", ServerURL.s = "aerial.maps.api.here.com", path.s = "/maptile/2.1/", ressource.s = "maptile", id.s = "newest", scheme.s = "satellite.day", format.s = "jpg", lg.s = "eng", lg2.s = "eng", param.s = "")
|
|
Declare.i AddGeoServerLayer(LayerName.s, Order.i, ServerLayerName.s, ServerURL.s = "http://localhost:8080/", path.s = "geowebcache/service/gmaps", format.s = "image/png")
|
|
Declare IsLayer(Name.s)
|
|
Declare DeleteLayer(Name.s)
|
|
Declare EnableLayer(Name.s)
|
|
Declare DisableLayer(Name.s)
|
|
Declare SetLayerAlpha(Name.s, Alpha.d)
|
|
Declare.d GetLayerAlpha(Name.s)
|
|
Declare BindMapGadget(Gadget.i)
|
|
Declare 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(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 Quit()
|
|
Declare FatalError(msg.s)
|
|
Declare Error(msg.s)
|
|
Declare Refresh()
|
|
Declare.i ClearDiskCache()
|
|
Declare SetCallBackMarker(*CallBackLocation)
|
|
Declare SetCallBackLeftClic(*CallBackLocation)
|
|
|
|
EndDeclareModule
|
|
|
|
Module PBMap
|
|
|
|
EnableExplicit
|
|
|
|
;-*** Structures
|
|
|
|
|
|
|
|
Structure PixelCoordinates
|
|
x.d
|
|
y.d
|
|
EndStructure
|
|
|
|
Structure Coordinates
|
|
x.d
|
|
y.d
|
|
EndStructure
|
|
|
|
Structure Tile
|
|
nImage.i
|
|
key.s
|
|
URL.s
|
|
CacheFile.s
|
|
GetImageThread.i
|
|
Download.i
|
|
Time.i
|
|
Size.i
|
|
EndStructure
|
|
|
|
Structure BoundingBox
|
|
NorthWest.GeographicCoordinates
|
|
SouthEast.GeographicCoordinates
|
|
BottomRight.PixelCoordinates
|
|
TopLeft.PixelCoordinates
|
|
EndStructure
|
|
|
|
Structure DrawingParameters
|
|
Canvas.i
|
|
RadiusX.d ; Canvas radius, or center in pixels
|
|
RadiusY.d
|
|
GeographicCoordinates.GeographicCoordinates ; Real center in lat/lon
|
|
TileCoordinates.Coordinates ; Center coordinates in tile.decimal
|
|
Bounds.BoundingBox ; Drawing boundaries in lat/lon
|
|
Width.d ; Drawing width in degrees
|
|
Height.d ; Drawing height in degrees
|
|
PBMapZoom.i
|
|
DeltaX.i ; Screen relative pixels tile shift
|
|
DeltaY.i
|
|
Dirty.i
|
|
End.i
|
|
EndStructure
|
|
|
|
Structure ImgMemCach
|
|
nImage.i
|
|
Size.i
|
|
*Tile.Tile
|
|
*TimeStackPtr
|
|
Alpha.i
|
|
EndStructure
|
|
|
|
Structure ImgMemCachKey
|
|
MapKey.s
|
|
EndStructure
|
|
|
|
Structure TileMemCach
|
|
Map Images.ImgMemCach(4096)
|
|
List ImagesTimeStack.ImgMemCachKey() ; Usage of the tile (first = older)
|
|
EndStructure
|
|
|
|
|
|
|
|
;-Options
|
|
Structure Option
|
|
HDDCachePath.s ; Path where to load and save tiles downloaded from server
|
|
DefaultOSMServer.s ; Base layer OSM server
|
|
WheelMouseRelative.i
|
|
ScaleUnit.i ; Scale unit to use for measurements
|
|
Proxy.i ; Proxy ON/OFF
|
|
ProxyURL.s
|
|
ProxyPort.s
|
|
ProxyUser.s
|
|
ProxyPassword.s
|
|
ShowDegrees.i
|
|
ShowZoom.i
|
|
ShowDebugInfos.i
|
|
ShowScale.i
|
|
ShowTrack.i
|
|
ShowTrackKms.i
|
|
ShowMarkers.i
|
|
ShowPointer.i
|
|
TimerInterval.i
|
|
MaxMemCache.i ; in MiB
|
|
MaxThreads.i ; Maximum simultaneous web loading threads
|
|
MaxDownloadSlots.i ; Maximum simultaneous download slots
|
|
TileLifetime.i
|
|
Verbose.i ; Maximum debug informations
|
|
Warning.i ; Warning requesters
|
|
ShowMarkersNb.i
|
|
ShowMarkersLegend.i
|
|
ShowTrackSelection.i ; YA to show or not track selection
|
|
; Drawing stuff
|
|
StrokeWidthTrackDefault.i
|
|
; Colours
|
|
ColourFocus.i
|
|
ColourSelected.i
|
|
ColourTrackDefault.i
|
|
; HERE specific
|
|
appid.s
|
|
appcode.s
|
|
EndStructure
|
|
|
|
Structure Layer
|
|
Order.i ; Layer nb
|
|
Name.s
|
|
ServerURL.s ; Web URL ex: http://tile.openstreetmap.org/
|
|
path.s
|
|
LayerType.i ; OSM : 0 ; Here : 1
|
|
Enabled.i
|
|
Alpha.d ; 1 : opaque ; 0 : transparent
|
|
format.s
|
|
; > HERE specific params
|
|
APP_ID.s
|
|
APP_CODE.s
|
|
ressource.s
|
|
param.s
|
|
id.s
|
|
scheme.s
|
|
lg.s
|
|
lg2.s
|
|
; <
|
|
; > GeoServer specific params
|
|
ServerLayerName.s
|
|
; <
|
|
EndStructure
|
|
|
|
Structure Box
|
|
x1.i
|
|
y1.i
|
|
x2.i
|
|
y2.i
|
|
EndStructure
|
|
|
|
Structure Tracks
|
|
List Track.GeographicCoordinates() ; To display a GPX track
|
|
BoundingBox.Box
|
|
Visible.i
|
|
Focus.i
|
|
Selected.i
|
|
Colour.i
|
|
StrokeWidth.i
|
|
EndStructure
|
|
|
|
;- PBMap
|
|
Structure PBMap
|
|
Window.i ; Parent Window
|
|
Gadget.i ; Canvas Gadget Id
|
|
Font.i ; Font to uses when write on the map
|
|
Timer.i ; Redraw/update timer
|
|
|
|
GeographicCoordinates.GeographicCoordinates ; Latitude and Longitude from focus point
|
|
Drawing.DrawingParameters ; Drawing parameters based on focus point
|
|
|
|
CallBackLocation.i ; @Procedure(latitude.d,lontitude.d)
|
|
CallBackMainPointer.i ; @Procedure(X.i, Y.i) to DrawPointer (you must use VectorDrawing lib)
|
|
CallBackMarker.i ; @Procedure (latitude.d,lontitude.d) pour connaitre la nouvelle position du marqueur (YA)
|
|
CallBackLeftClic.i ; @Procdeure (latitude.d,lontitude.d) pour connaitre la position lors du clic gauche (YA)
|
|
|
|
PixelCoordinates.PixelCoordinates ; Actual focus point coords in pixels (global)
|
|
MoveStartingPoint.PixelCoordinates ; Start mouse position coords when dragging the map
|
|
|
|
List LayersList.Layer()
|
|
Map *Layers.Layer()
|
|
|
|
Angle.d
|
|
ZoomMin.i ; Min Zoom supported by server
|
|
ZoomMax.i ; Max Zoom supported by server
|
|
Zoom.i ; Current zoom
|
|
TileSize.i ; Tile size downloaded on the server ex : 256
|
|
|
|
MemCache.TileMemCach ; Images in memory cache
|
|
|
|
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
|
|
Dirty.i ; To signal that drawing need a refresh
|
|
|
|
MemoryCacheAccessMutex.i ; Memorycache access variable mutual exclusion
|
|
DownloadSlots.i ; Actual nb of used download slots
|
|
|
|
List TracksList.Tracks() ; To display a GPX track
|
|
List Markers.Marker() ; To diplay marker
|
|
EditMarker.l
|
|
|
|
ImgLoading.i ; Image Loading Tile
|
|
ImgNothing.i ; Image Nothing Tile
|
|
|
|
Options.option ; Options
|
|
|
|
EndStructure
|
|
|
|
;-*** Global variables
|
|
|
|
;-Show debug infos
|
|
Global MyDebugLevel = 5
|
|
|
|
Global PBMap.PBMap, Null.i, NullPtrMem.i, *NullPtr = @NullPtrMem
|
|
Global slash.s
|
|
|
|
CompilerSelect #PB_Compiler_OS
|
|
CompilerCase #PB_OS_Windows
|
|
Global slash = "\"
|
|
CompilerDefault
|
|
Global slash = "/"
|
|
CompilerEndSelect
|
|
|
|
;- *** GetText - Translation purpose
|
|
|
|
; TODO use this for all text
|
|
IncludeFile "gettext.pbi"
|
|
|
|
;-*** Misc tools
|
|
|
|
Macro Min(a, b)
|
|
(Bool((a) <= (b)) * (a) + Bool((b) < (a)) * (b))
|
|
EndMacro
|
|
|
|
Macro Max(a, b)
|
|
(Bool((a) >= (b)) * (a) + Bool((b) > (a)) * (b))
|
|
EndMacro
|
|
|
|
;-Error management
|
|
|
|
; Shows an error msg and terminates the program
|
|
Procedure FatalError(msg.s)
|
|
If PBMap\Options\Warning
|
|
MessageRequester("PBMap", msg, #PB_MessageRequester_Ok)
|
|
EndIf
|
|
End
|
|
EndProcedure
|
|
|
|
; Shows an error msg
|
|
Procedure Error(msg.s)
|
|
If PBMap\Options\Warning
|
|
MessageRequester("PBMap", msg, #PB_MessageRequester_Ok)
|
|
EndIf
|
|
EndProcedure
|
|
|
|
; Set the debug level allowing more or less debug infos
|
|
Procedure SetDebugLevel(level.i)
|
|
MyDebugLevel = level
|
|
EndProcedure
|
|
|
|
; Send debug infos to stdout (allowing mixed debug infos with curl or other libs)
|
|
Procedure MyDebug(msg.s, DbgLevel = 0)
|
|
If PBMap\Options\Verbose And DbgLevel <= MyDebugLevel
|
|
PrintN(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
|
|
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
|
|
Protected LoadingText$ = "Loading"
|
|
Protected NothingText$ = "Nothing"
|
|
PBmap\ImgLoading = CreateImage(#PB_Any, 256, 256)
|
|
If PBmap\ImgLoading
|
|
StartVectorDrawing(ImageVectorOutput(PBMap\Imgloading))
|
|
BeginVectorLayer()
|
|
VectorSourceColor(RGBA(255, 255, 255, 128))
|
|
AddPathBox(0, 0, 256, 256)
|
|
FillPath()
|
|
MovePathCursor(0, 0)
|
|
VectorFont(FontID(PBMap\Font), 256 / 20)
|
|
VectorSourceColor(RGBA(150, 150, 150, 255))
|
|
MovePathCursor(0 + (256 - VectorTextWidth(LoadingText$)) / 2, 0 + (256 - VectorTextHeight(LoadingText$)) / 2)
|
|
DrawVectorText(LoadingText$)
|
|
EndVectorLayer()
|
|
StopVectorDrawing()
|
|
EndIf
|
|
; "Nothing" tile
|
|
PBmap\ImgNothing = CreateImage(#PB_Any, 256, 256)
|
|
If PBmap\ImgNothing
|
|
StartVectorDrawing(ImageVectorOutput(PBMap\ImgNothing))
|
|
; BeginVectorLayer()
|
|
VectorSourceColor(RGBA(220, 230, 255, 255))
|
|
AddPathBox(0, 0, 256, 256)
|
|
FillPath()
|
|
; MovePathCursor(0, 0)
|
|
; VectorFont(FontID(PBMap\Font), 256 / 20)
|
|
; VectorSourceColor(RGBA(150, 150, 150, 255))
|
|
; MovePathCursor(0 + (256 - VectorTextWidth(NothingText$)) / 2, 0 + (256 - VectorTextHeight(NothingText$)) / 2)
|
|
; DrawVectorText(NothingText$)
|
|
; EndVectorLayer()
|
|
StopVectorDrawing()
|
|
EndIf
|
|
EndProcedure
|
|
|
|
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.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
|
|
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
|
|
|
|
Procedure.i ColourString2Value(Value.s)
|
|
; TODO : better string check
|
|
Protected Col.s = RemoveString(Value, " ")
|
|
If Left(Col, 1) = "$"
|
|
Protected r.i, g.i, b.i, a.i = 255
|
|
Select Len(Col)
|
|
Case 4 ; RGB (eg : "$9BC"
|
|
r = Val("$"+Mid(Col, 2, 1)) : g = Val("$"+Mid(Col, 3, 1)) : b = Val("$"+Mid(Col, 4, 1))
|
|
Case 5 ; RGBA (eg : "$9BC5")
|
|
r = Val("$"+Mid(Col, 2, 1)) : g = Val("$"+Mid(Col, 3, 1)) : b = Val("$"+Mid(Col, 4, 1)) : a = Val("$"+Mid(Col, 5, 1))
|
|
Case 7 ; RRGGBB (eg : "$95B4C2")
|
|
r = Val("$"+Mid(Col, 2, 2)) : g = Val("$"+Mid(Col, 4, 2)) : b = Val("$"+Mid(Col, 6, 2))
|
|
Case 9 ; RRGGBBAA (eg : "$95B4C249")
|
|
r = Val("$"+Mid(Col, 2, 2)) : g = Val("$"+Mid(Col, 4, 2)) : b = Val("$"+Mid(Col, 6, 2)) : a = Val("$"+Mid(Col, 8, 2))
|
|
EndSelect
|
|
ProcedureReturn RGBA(r, g, b, a)
|
|
Else
|
|
ProcedureReturn Val(Value)
|
|
EndIf
|
|
EndProcedure
|
|
|
|
Procedure.s Value2ColourString(Value.i)
|
|
ProcedureReturn "$" + StrU(Red(Value), #PB_Byte) + StrU(Green(Value), #PB_Byte) + StrU(Blue(Value), #PB_Byte)
|
|
EndProcedure
|
|
|
|
;-*** Options
|
|
|
|
Procedure SetOptions()
|
|
With PBMap\Options
|
|
If \Proxy
|
|
HTTPProxy(PBMap\Options\ProxyURL + ":" + PBMap\Options\ProxyPort, PBMap\Options\ProxyUser, PBMap\Options\ProxyPassword)
|
|
EndIf
|
|
If \Verbose
|
|
OpenConsole()
|
|
EndIf
|
|
CreateDirectoryEx(\HDDCachePath)
|
|
If \DefaultOSMServer <> "" And IsLayer("OSM") = #False ; First time creation of the basis OSM layer
|
|
AddOSMServerLayer("OSM", 1, \DefaultOSMServer)
|
|
EndIf
|
|
EndWith
|
|
EndProcedure
|
|
|
|
Macro SelBool(Name)
|
|
Select UCase(Value)
|
|
Case "0", "FALSE", "DISABLE"
|
|
PBMap\Options\Name = #False
|
|
Default
|
|
PBMap\Options\Name = #True
|
|
EndSelect
|
|
EndMacro
|
|
|
|
Procedure SetOption(Option.s, Value.s)
|
|
Option = StringCheck(Option)
|
|
Select LCase(Option)
|
|
Case "proxy"
|
|
SelBool(Proxy)
|
|
Case "proxyurl"
|
|
PBMap\Options\ProxyURL = Value
|
|
Case "proxyport"
|
|
PBMap\Options\ProxyPort = Value
|
|
Case "proxyuser"
|
|
PBMap\Options\ProxyUser = Value
|
|
Case "appid"
|
|
PBMap\Options\appid = Value
|
|
Case "appcode"
|
|
PBMap\Options\appcode = Value
|
|
Case "tilescachepath"
|
|
PBMap\Options\HDDCachePath = Value
|
|
Case "maxmemcache"
|
|
PBMap\Options\MaxMemCache = Val(Value)
|
|
Case "maxthreads"
|
|
PBMap\Options\MaxThreads = Val(Value)
|
|
Case "maxdownloadslots"
|
|
PBMap\Options\MaxDownloadSlots = Val(Value)
|
|
Case "tilelifetime"
|
|
PBMap\Options\TileLifetime = Val(Value)
|
|
Case "verbose"
|
|
SelBool(Verbose)
|
|
Case "warning"
|
|
SelBool(Warning)
|
|
Case "wheelmouserelative"
|
|
SelBool(WheelMouseRelative)
|
|
Case "showdegrees"
|
|
SelBool(ShowDegrees)
|
|
Case "showzoom"
|
|
SelBool(ShowZoom)
|
|
Case "showdebuginfos"
|
|
SelBool(ShowDebugInfos)
|
|
Case "showscale"
|
|
SelBool(ShowScale)
|
|
Case "showmarkers"
|
|
SelBool(ShowMarkers)
|
|
Case "showpointer"
|
|
SelBool(ShowPointer)
|
|
Case "showtrack"
|
|
SelBool(ShowTrack)
|
|
Case "showtrackselection"
|
|
SelBool(ShowTrackSelection)
|
|
Case "showmarkersnb"
|
|
SelBool(ShowMarkersNb)
|
|
Case "showmarkerslegend"
|
|
SelBool(ShowMarkersLegend)
|
|
Case "showtrackkms"
|
|
SelBool(ShowTrackKms)
|
|
Case "strokewidthtrackdefault"
|
|
SelBool(StrokeWidthTrackDefault)
|
|
Case "colourfocus"
|
|
PBMap\Options\ColourFocus = ColourString2Value(Value)
|
|
Case "colourselected"
|
|
PBMap\Options\ColourSelected = ColourString2Value(Value)
|
|
Case "colourtrackdefault"
|
|
PBMap\Options\ColourTrackDefault = ColourString2Value(Value)
|
|
EndSelect
|
|
SetOptions()
|
|
EndProcedure
|
|
|
|
Procedure.s GetBoolString(Value.i)
|
|
Select Value
|
|
Case #False
|
|
ProcedureReturn "0"
|
|
Default
|
|
ProcedureReturn "1"
|
|
EndSelect
|
|
EndProcedure
|
|
|
|
Procedure.s GetOption(Option.s)
|
|
Option = StringCheck(Option)
|
|
With PBMap\Options
|
|
Select LCase(Option)
|
|
Case "proxy"
|
|
ProcedureReturn GetBoolString(\Proxy)
|
|
Case "proxyurl"
|
|
ProcedureReturn \ProxyURL
|
|
Case "proxyport"
|
|
ProcedureReturn \ProxyPort
|
|
Case "proxyuser"
|
|
ProcedureReturn \ProxyUser
|
|
Case "appid"
|
|
ProcedureReturn \appid
|
|
Case "appcode"
|
|
ProcedureReturn \appcode
|
|
Case "tilescachepath"
|
|
ProcedureReturn \HDDCachePath
|
|
Case "maxmemcache"
|
|
ProcedureReturn StrU(\MaxMemCache)
|
|
Case "maxthreads"
|
|
ProcedureReturn StrU(\MaxThreads)
|
|
Case "maxdownloadslots"
|
|
ProcedureReturn StrU(\MaxDownloadSlots)
|
|
Case "tilelifetime"
|
|
ProcedureReturn StrU(\TileLifetime)
|
|
Case "verbose"
|
|
ProcedureReturn GetBoolString(\Verbose)
|
|
Case "warning"
|
|
ProcedureReturn GetBoolString(\Warning)
|
|
Case "wheelmouserelative"
|
|
ProcedureReturn GetBoolString(\WheelMouseRelative)
|
|
Case "showdegrees"
|
|
ProcedureReturn GetBoolString(\ShowDegrees)
|
|
Case "showdebuginfos"
|
|
ProcedureReturn GetBoolString(\ShowDebugInfos)
|
|
Case "showscale"
|
|
ProcedureReturn GetBoolString(\ShowScale)
|
|
Case "showzoom"
|
|
ProcedureReturn GetBoolString(\ShowZoom)
|
|
Case "showmarkers"
|
|
ProcedureReturn GetBoolString(\ShowMarkers)
|
|
Case "showpointer"
|
|
ProcedureReturn GetBoolString(\ShowPointer)
|
|
Case "showtrack"
|
|
ProcedureReturn GetBoolString(\ShowTrack)
|
|
Case "showtrackselection"
|
|
ProcedureReturn GetBoolString(\ShowTrackSelection)
|
|
Case "showmarkersnb"
|
|
ProcedureReturn GetBoolString(\ShowMarkersNb)
|
|
Case "showmarkerslegend"
|
|
ProcedureReturn GetBoolString(\ShowMarkersLegend)
|
|
Case "showtrackkms"
|
|
ProcedureReturn GetBoolString(\ShowTrackKms)
|
|
Case "strokewidthtrackdefault"
|
|
ProcedureReturn GetBoolString(\StrokeWidthTrackDefault)
|
|
Case "colourfocus"
|
|
ProcedureReturn Value2ColourString(\ColourFocus)
|
|
Case "colourselected"
|
|
ProcedureReturn Value2ColourString(\ColourSelected)
|
|
Case "colourtrackdefault"
|
|
ProcedureReturn Value2ColourString(\ColourTrackDefault)
|
|
EndSelect
|
|
EndWith
|
|
EndProcedure
|
|
|
|
; By default, save options in the user's home directory
|
|
Procedure SaveOptions(PreferencesFile.s = "PBMap.prefs")
|
|
If PreferencesFile = "PBMap.prefs"
|
|
CreatePreferences(GetHomeDirectory() + "PBMap.prefs")
|
|
Else
|
|
CreatePreferences(PreferencesFile)
|
|
EndIf
|
|
With PBMap\Options
|
|
PreferenceGroup("PROXY")
|
|
WritePreferenceInteger("Proxy", \Proxy)
|
|
WritePreferenceString("ProxyURL", \ProxyURL)
|
|
WritePreferenceString("ProxyPort", \ProxyPort)
|
|
WritePreferenceString("ProxyUser", \ProxyUser)
|
|
PreferenceGroup("HERE")
|
|
WritePreferenceString("APP_ID", \appid)
|
|
WritePreferenceString("APP_CODE", \appcode)
|
|
PreferenceGroup("URL")
|
|
WritePreferenceString("DefaultOSMServer", \DefaultOSMServer)
|
|
PreferenceGroup("PATHS")
|
|
WritePreferenceString("TilesCachePath", \HDDCachePath)
|
|
PreferenceGroup("OPTIONS")
|
|
WritePreferenceInteger("WheelMouseRelative", \WheelMouseRelative)
|
|
WritePreferenceInteger("MaxMemCache", \MaxMemCache)
|
|
WritePreferenceInteger("MaxThreads", \MaxThreads)
|
|
WritePreferenceInteger("MaxDownloadSlots", \MaxDownloadSlots)
|
|
WritePreferenceInteger("TileLifetime", \TileLifetime)
|
|
WritePreferenceInteger("Verbose", \Verbose)
|
|
WritePreferenceInteger("Warning", \Warning)
|
|
WritePreferenceInteger("ShowDegrees", \ShowDegrees)
|
|
WritePreferenceInteger("ShowDebugInfos", \ShowDebugInfos)
|
|
WritePreferenceInteger("ShowScale", \ShowScale)
|
|
WritePreferenceInteger("ShowZoom", \ShowZoom)
|
|
WritePreferenceInteger("ShowMarkers", \ShowMarkers)
|
|
WritePreferenceInteger("ShowPointer", \ShowPointer)
|
|
WritePreferenceInteger("ShowTrack", \ShowTrack)
|
|
WritePreferenceInteger("ShowTrackSelection", \ShowTrackSelection)
|
|
WritePreferenceInteger("ShowTrackKms", \ShowTrackKms)
|
|
WritePreferenceInteger("ShowMarkersNb", \ShowMarkersNb)
|
|
WritePreferenceInteger("ShowMarkersLegend", \ShowMarkersLegend)
|
|
PreferenceGroup("DRAWING")
|
|
WritePreferenceInteger("StrokeWidthTrackDefault", \StrokeWidthTrackDefault)
|
|
; Colours;
|
|
WritePreferenceInteger("ColourFocus", \ColourFocus)
|
|
WritePreferenceInteger("ColourSelected", \ColourSelected)
|
|
WritePreferenceInteger("ColourTrackDefault", \ColourTrackDefault)
|
|
ClosePreferences()
|
|
EndWith
|
|
EndProcedure
|
|
|
|
Procedure LoadOptions(PreferencesFile.s = "PBMap.prefs")
|
|
If PreferencesFile = "PBMap.prefs"
|
|
OpenPreferences(GetHomeDirectory() + "PBMap.prefs")
|
|
Else
|
|
OpenPreferences(PreferencesFile)
|
|
EndIf
|
|
; Use this to create and customize your preferences file for the first time
|
|
; CreatePreferences(GetHomeDirectory() + "PBMap.prefs")
|
|
; ; Or this to modify
|
|
; ; OpenPreferences(GetHomeDirectory() + "PBMap.prefs")
|
|
; ; Or this
|
|
; ; RunProgram("notepad.exe", GetHomeDirectory() + "PBMap.prefs", GetHomeDirectory())
|
|
; PreferenceGroup("PROXY")
|
|
; WritePreferenceInteger("Proxy", #True)
|
|
; WritePreferenceString("ProxyURL", "myproxy.fr")
|
|
; WritePreferenceString("ProxyPort", "myproxyport")
|
|
; WritePreferenceString("ProxyUser", "myproxyname")
|
|
; WritePreferenceString("ProxyPass", "myproxypass") ; TODO !Warning! !not encoded!
|
|
; PreferenceGroup("HERE")
|
|
; WritePreferenceString("APP_ID", "myhereid") ; TODO !Warning! !not encoded!
|
|
; WritePreferenceString("APP_CODE", "myherecode") ; TODO !Warning! !not encoded!
|
|
; ClosePreferences()
|
|
With PBMap\Options
|
|
PreferenceGroup("PROXY")
|
|
\Proxy = ReadPreferenceInteger("Proxy", #False)
|
|
If \Proxy
|
|
\ProxyURL = ReadPreferenceString("ProxyURL", "") ; = InputRequester("ProxyServer", "Do you use a Proxy Server? Then enter the full url:", "")
|
|
\ProxyPort = ReadPreferenceString("ProxyPort", "") ; = InputRequester("ProxyPort" , "Do you use a specific port? Then enter it", "")
|
|
\ProxyUser = ReadPreferenceString("ProxyUser", "") ; = InputRequester("ProxyUser" , "Do you use a user name? Then enter it", "")
|
|
\ProxyPassword = ReadPreferenceString("ProxyPass", "") ; = InputRequester("ProxyPass", "Do you use a password ? Then enter it", "") ; TODO
|
|
EndIf
|
|
PreferenceGroup("HERE")
|
|
\appid = ReadPreferenceString("APP_ID", "") ; = InputRequester("Here App ID", "Do you use HERE ? Enter app ID", "") ; TODO
|
|
\appcode = ReadPreferenceString("APP_CODE", "") ; = InputRequester("Here App Code", "Do you use HERE ? Enter app Code", "") ; TODO
|
|
PreferenceGroup("URL")
|
|
\DefaultOSMServer = ReadPreferenceString("DefaultOSMServer", "http://tile.openstreetmap.org/")
|
|
|
|
PreferenceGroup("PATHS")
|
|
\HDDCachePath = ReadPreferenceString("TilesCachePath", GetTemporaryDirectory() + "PBMap" + slash)
|
|
PreferenceGroup("OPTIONS")
|
|
\WheelMouseRelative = ReadPreferenceInteger("WheelMouseRelative", #True)
|
|
\MaxMemCache = ReadPreferenceInteger("MaxMemCache", 20480) ; 20 MiB, about 80 tiles in memory
|
|
\MaxThreads = ReadPreferenceInteger("MaxThreads", 40)
|
|
\MaxDownloadSlots = ReadPreferenceInteger("MaxDownloadSlots", 2)
|
|
\TileLifetime = ReadPreferenceInteger("TileLifetime", 1209600) ; about 2 weeks ;-1 = unlimited
|
|
\Verbose = ReadPreferenceInteger("Verbose", #False)
|
|
\Warning = ReadPreferenceInteger("Warning", #False)
|
|
\ShowDegrees = ReadPreferenceInteger("ShowDegrees", #False)
|
|
\ShowDebugInfos = ReadPreferenceInteger("ShowDebugInfos", #False)
|
|
\ShowScale = ReadPreferenceInteger("ShowScale", #False)
|
|
\ShowZoom = ReadPreferenceInteger("ShowZoom", #True)
|
|
\ShowMarkers = ReadPreferenceInteger("ShowMarkers", #True)
|
|
\ShowPointer = ReadPreferenceInteger("ShowPointer", #True)
|
|
\ShowTrack = ReadPreferenceInteger("ShowTrack", #True)
|
|
\ShowTrackSelection = ReadPreferenceInteger("ShowTrackSelection", #False)
|
|
\ShowTrackKms = ReadPreferenceInteger("ShowTrackKms", #False)
|
|
\ShowMarkersNb = ReadPreferenceInteger("ShowMarkersNb", #True)
|
|
\ShowMarkersLegend = ReadPreferenceInteger("ShowMarkersLegend", #False)
|
|
PreferenceGroup("DRAWING")
|
|
\StrokeWidthTrackDefault = ReadPreferenceInteger("StrokeWidthTrackDefault", 10)
|
|
PreferenceGroup("COLOURS")
|
|
\ColourFocus = ReadPreferenceInteger("ColourFocus", RGBA(255, 255, 0, 255))
|
|
\ColourSelected = ReadPreferenceInteger("ColourSelected", RGBA(225, 225, 0, 255))
|
|
\ColourTrackDefault = ReadPreferenceInteger("ColourTrackDefault", RGBA(0, 255, 0, 150))
|
|
\TimerInterval = 12
|
|
ClosePreferences()
|
|
EndWith
|
|
SetOptions()
|
|
EndProcedure
|
|
|
|
;-*** Layers
|
|
|
|
; Add a layer to a list (to get things ordered) and to a map (to access things easily)
|
|
Procedure.i AddLayer(Name.s, Order.i, Alpha.d)
|
|
Protected *Ptr = 0
|
|
*Ptr = AddMapElement(PBMap\Layers(), Name)
|
|
If *Ptr
|
|
PBMap\Layers() = AddElement(PBMap\LayersList()) ; This map element is a ptr to a linked list element
|
|
If PBMap\Layers()
|
|
PBMap\LayersList()\Name = Name
|
|
PBMap\LayersList()\Order = Order
|
|
PBMap\LayersList()\Alpha = Alpha
|
|
SortStructuredList(PBMap\LayersList(), #PB_Sort_Ascending, OffsetOf(Layer\Order), TypeOf(Layer\Order))
|
|
ProcedureReturn PBMap\Layers()
|
|
Else
|
|
*Ptr = 0
|
|
EndIf
|
|
EndIf
|
|
ProcedureReturn *Ptr
|
|
EndProcedure
|
|
|
|
; "OpenStreetMap" layer
|
|
Procedure.i AddOSMServerLayer(LayerName.s, Order.i, ServerURL.s = "http://tile.openstreetmap.org/")
|
|
Protected *Ptr.Layer = AddLayer(LayerName, Order, 1)
|
|
If *Ptr
|
|
*Ptr\ServerURL = ServerURL
|
|
*Ptr\LayerType = 0 ; OSM
|
|
*Ptr\Enabled = #True
|
|
PBMap\Redraw = #True
|
|
ProcedureReturn *Ptr
|
|
Else
|
|
ProcedureReturn #False
|
|
EndIf
|
|
EndProcedure
|
|
|
|
; "Here" layer
|
|
; see there for parameters : https://developer.here.com/rest-apis/documentation/enterprise-map-tile/topics/resource-base-maptile.html
|
|
; you could use base.maps.api.here.com or aerial.maps.api.here.com or traffic.maps.api.here.com or pano.maps.api.here.com.
|
|
; use *.cit.map.api.com For Customer Integration Testing (see https://developer.here.com/rest-apis/documentation/enterprise-Map-tile/common/request-cit-environment-rest.html)
|
|
Procedure.i AddHereServerLayer(LayerName.s, Order.i, APP_ID.s = "", APP_CODE.s = "", ServerURL.s = "aerial.maps.api.here.com", path.s = "/maptile/2.1/", ressource.s = "maptile", id.s = "newest", scheme.s = "satellite.day", format.s = "jpg", lg.s = "eng", lg2.s = "eng", param.s = "")
|
|
Protected *Ptr.Layer = AddLayer(LayerName, Order, 1)
|
|
If *Ptr
|
|
With *Ptr ; PBMap\Layers()
|
|
\ServerURL = ServerURL
|
|
\path = path
|
|
\ressource = ressource
|
|
\LayerType = 1 ; HERE
|
|
\Enabled = #True
|
|
If APP_ID = ""
|
|
APP_ID = PBMap\Options\appid
|
|
EndIf
|
|
If APP_CODE = ""
|
|
APP_CODE = PBMap\Options\appcode
|
|
EndIf
|
|
\APP_CODE = APP_CODE
|
|
\APP_ID = APP_ID
|
|
\format = format
|
|
\id = id
|
|
\lg = lg
|
|
\lg2 = lg2
|
|
\param = param
|
|
\scheme = scheme
|
|
EndWith
|
|
PBMap\Redraw = #True
|
|
ProcedureReturn *Ptr
|
|
Else
|
|
ProcedureReturn #False
|
|
EndIf
|
|
EndProcedure
|
|
|
|
; GeoServer / geowebcache - google maps service
|
|
; template 'http://localhost:8080/geowebcache/service/gmaps?layers=layer-name&zoom={Z}&x={X}&y={Y}&format=image/png'
|
|
Procedure.i AddGeoServerLayer(LayerName.s, Order.i, ServerLayerName.s, ServerURL.s = "http://localhost:8080/", path.s = "geowebcache/service/gmaps", format.s = "image/png")
|
|
Protected *Ptr.Layer = AddLayer(LayerName, Order, 1)
|
|
If *Ptr
|
|
With *Ptr ; PBMap\Layers()
|
|
\ServerURL = ServerURL
|
|
\path = path
|
|
\LayerType = 2 ; GeoServer
|
|
\format = format
|
|
\Enabled = #True
|
|
\ServerLayerName = ServerLayerName
|
|
EndWith
|
|
PBMap\Redraw = #True
|
|
ProcedureReturn *Ptr
|
|
Else
|
|
ProcedureReturn #False
|
|
EndIf
|
|
EndProcedure
|
|
|
|
Procedure.i IsLayer(Name.s)
|
|
ProcedureReturn FindMapElement(PBMap\Layers(), Name)
|
|
EndProcedure
|
|
|
|
Procedure DeleteLayer(Name.s)
|
|
FindMapElement(PBMap\Layers(), Name)
|
|
Protected *Ptr = PBMap\Layers()
|
|
; Free the list element
|
|
ChangeCurrentElement(PBMap\LayersList(), *Ptr)
|
|
DeleteElement(PBMap\LayersList())
|
|
; Free the map element
|
|
DeleteMapElement(PBMap\Layers())
|
|
PBMap\Redraw = #True
|
|
EndProcedure
|
|
|
|
Procedure EnableLayer(Name.s)
|
|
PBMap\Layers(Name)\Enabled = #True
|
|
PBMap\Redraw = #True
|
|
EndProcedure
|
|
|
|
Procedure DisableLayer(Name.s)
|
|
PBMap\Layers(Name)\Enabled = #False
|
|
PBMap\Redraw = #True
|
|
EndProcedure
|
|
|
|
Procedure SetLayerAlpha(Name.s, Alpha.d)
|
|
PBMap\Layers(Name)\Alpha = Alpha
|
|
PBMap\Redraw = #True
|
|
EndProcedure
|
|
|
|
Procedure.d GetLayerAlpha(Name.s)
|
|
ProcedureReturn PBMap\Layers(Name)\Alpha
|
|
EndProcedure
|
|
|
|
;-***
|
|
; If cache size exceeds limit, try to delete the oldest tiles used (first in the time stack)
|
|
Procedure MemoryCacheManagement()
|
|
LockMutex(PBMap\MemoryCacheAccessMutex) ; Prevents thread to start or finish
|
|
Protected CacheSize = MapSize(PBMap\MemCache\Images()) * Pow(PBMap\TileSize, 2) * 4 ; Size of a tile = TileSize * TileSize * 4 bytes (RGBA)
|
|
Protected CacheLimit = PBMap\Options\MaxMemCache * 1024
|
|
MyDebug("Cache size : " + Str(CacheSize/1024) + " / CacheLimit : " + Str(CacheLimit/1024), 5)
|
|
If CacheSize > CacheLimit
|
|
MyDebug(" Cache full. Trying cache cleaning", 5)
|
|
ResetList(PBMap\MemCache\ImagesTimeStack())
|
|
; Try to free half the cache memory (one pass)
|
|
While NextElement(PBMap\MemCache\ImagesTimeStack()) And CacheSize > (CacheLimit / 2) ; /2 = half
|
|
Protected CacheMapKey.s = PBMap\MemCache\ImagesTimeStack()\MapKey
|
|
; Is the loading over
|
|
If PBMap\MemCache\Images(CacheMapKey)\Tile <= 0 ;TODO Should not verify this var directly
|
|
MyDebug(" Delete " + CacheMapKey, 5)
|
|
If PBMap\MemCache\Images(CacheMapKey)\nImage;IsImage(PBMap\MemCache\Images(CacheMapKey)\nImage)
|
|
FreeImage(PBMap\MemCache\Images(CacheMapKey)\nImage)
|
|
MyDebug(" and free image nb " + Str(PBMap\MemCache\Images(CacheMapKey)\nImage), 5)
|
|
PBMap\MemCache\Images(CacheMapKey)\nImage = 0
|
|
EndIf
|
|
DeleteMapElement(PBMap\MemCache\Images(), CacheMapKey)
|
|
DeleteElement(PBMap\MemCache\ImagesTimeStack(), 1)
|
|
; ElseIf PBMap\MemCache\Images(CacheMapKey)\Tile = 0
|
|
; MyDebug(" Delete " + CacheMapKey, 5)
|
|
; DeleteMapElement(PBMap\MemCache\Images(), CacheMapKey)
|
|
; DeleteElement(PBMap\MemCache\ImagesTimeStack(), 1)
|
|
; ElseIf PBMap\MemCache\Images(CacheMapKey)\Tile > 0
|
|
; ; If the thread is running, try to abort the download
|
|
; If PBMap\MemCache\Images(CacheMapKey)\Tile\Download
|
|
; AbortHTTP(PBMap\MemCache\Images(CacheMapKey)\Tile\Download) ; Could lead to error
|
|
; EndIf
|
|
EndIf
|
|
CacheSize = MapSize(PBMap\MemCache\Images()) * Pow(PBMap\TileSize, 2) * 4 ; Size of a tile = TileSize * TileSize * 4 bytes (RGBA)
|
|
Wend
|
|
MyDebug(" New cache size : " + Str(CacheSize/1024) + " / CacheLimit : " + Str(CacheLimit/1024), 5)
|
|
If CacheSize > CacheLimit
|
|
MyDebug(" Cache cleaning unsuccessfull, can't add new tiles.", 5)
|
|
EndIf
|
|
EndIf
|
|
UnlockMutex(PBMap\MemoryCacheAccessMutex)
|
|
EndProcedure
|
|
|
|
Procedure.i GetTileFromHDD(CacheFile.s)
|
|
Protected nImage.i, 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)
|
|
ProcedureReturn nImage
|
|
Else
|
|
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
|
|
ProcedureReturn #False
|
|
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
|
|
; ****
|
|
|
|
;-*** These are threaded
|
|
|
|
Threaded Progress = 0, Quit = #False
|
|
|
|
Procedure GetImageThread(*Tile.Tile)
|
|
LockMutex(PBMap\MemoryCacheAccessMutex)
|
|
MyDebug("Thread nb " + Str(*Tile\GetImageThread) + " " + *Tile\key + " starting for image " + *Tile\CacheFile, 5)
|
|
; If MemoryCache is currently being cleaned, abort
|
|
; If PBMap\MemoryCacheAccessNB = -1
|
|
; MyDebug(" Thread nb " + Str(*Tile\GetImageThread) + " " + *Tile\key + " for image " + *Tile\CacheFile + " canceled because of cleaning.", 5)
|
|
; *Tile\Size = 0 ; \Size = 0 signals that the download has failed
|
|
; PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ; To free memory outside the thread
|
|
; UnlockMutex(PBMap\MemoryCacheAccessMutex)
|
|
; ProcedureReturn
|
|
; EndIf
|
|
; We're accessing MemoryCache
|
|
UnlockMutex(PBMap\MemoryCacheAccessMutex)
|
|
*Tile\Size = 0
|
|
*Tile\Download = ReceiveHTTPFile(*Tile\URL, *Tile\CacheFile, #PB_HTTP_Asynchronous)
|
|
If *Tile\Download
|
|
Repeat
|
|
Progress = HTTPProgress(*Tile\Download)
|
|
Select Progress
|
|
Case #PB_Http_Success
|
|
*Tile\Size = FinishHTTP(*Tile\Download) ; \Size signals that the download is OK
|
|
MyDebug(" Thread nb " + Str(*Tile\GetImageThread) + " " + *Tile\key + " for image " + *Tile\CacheFile + " finished. Size : " + Str(*Tile\Size), 5)
|
|
Quit = #True
|
|
Case #PB_Http_Failed
|
|
FinishHTTP(*Tile\Download)
|
|
*Tile\Size = 0 ; \Size = 0 signals that the download has failed
|
|
MyDebug(" Thread nb " + Str(*Tile\GetImageThread) + " " + *Tile\key + " for image " + *Tile\CacheFile + " failed.", 5)
|
|
Quit = #True
|
|
Case #PB_Http_Aborted
|
|
FinishHTTP(*Tile\Download)
|
|
*Tile\Size = 0 ; \Size = 0 signals that the download has failed
|
|
MyDebug(" Thread nb " + Str(*Tile\GetImageThread) + " " + *Tile\key + " for image " + *Tile\CacheFile + " aborted.", 5)
|
|
Quit = #True
|
|
Default
|
|
MyDebug(" Thread nb " + Str(*Tile\GetImageThread) + " " + *Tile\key + " for image " + *Tile\CacheFile + " downloading " + Str(Progress) + " bytes", 5)
|
|
If ElapsedMilliseconds() - *Tile\Time > 10000
|
|
MyDebug(" Thread nb " + Str(*Tile\GetImageThread) + " " + *Tile\key + " for image " + *Tile\CacheFile + " canceled after 10 seconds.", 5)
|
|
AbortHTTP(*Tile\Download)
|
|
EndIf
|
|
EndSelect
|
|
Delay(200) ; Frees CPU
|
|
Until Quit
|
|
EndIf
|
|
; End of the memory cache access
|
|
LockMutex(PBMap\MemoryCacheAccessMutex)
|
|
PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ; To free memory outside the thread
|
|
UnlockMutex(PBMap\MemoryCacheAccessMutex)
|
|
EndProcedure
|
|
|
|
;-***
|
|
|
|
Procedure.i GetTile(key.s, URL.s, CacheFile.s)
|
|
; MemoryCache access management
|
|
LockMutex(PBMap\MemoryCacheAccessMutex)
|
|
; Try to find the tile in memory cache
|
|
Protected *timg.ImgMemCach = FindMapElement(PBMap\MemCache\Images(), key)
|
|
If *timg
|
|
MyDebug("Key : " + key + " found in memory cache", 4)
|
|
; Is the associated image already been loaded in memory ?
|
|
If *timg\nImage
|
|
; Yes, returns the image's nb
|
|
MyDebug(" as image " + *timg\nImage, 4)
|
|
; *** Cache management
|
|
; Retrieves the image in the time stack, push it to the end (to say it's the lastly used)
|
|
ChangeCurrentElement(PBMap\MemCache\ImagesTimeStack(), *timg\TimeStackPtr)
|
|
MoveElement(PBMap\MemCache\ImagesTimeStack(), #PB_List_Last)
|
|
; *timg\TimeStackPtr = LastElement(PBMap\MemCache\ImagesTimeStack())
|
|
; ***
|
|
UnlockMutex(PBMap\MemoryCacheAccessMutex)
|
|
ProcedureReturn *timg
|
|
Else
|
|
; No, try to load it from HD (see below)
|
|
MyDebug(" but not the image.", 4)
|
|
EndIf
|
|
Else
|
|
; The tile has not been found in the cache, so creates a new cache element
|
|
*timg = AddMapElement(PBMap\MemCache\Images(), key)
|
|
If *timg = 0
|
|
MyDebug(" Can't add a new cache element.", 4)
|
|
UnlockMutex(PBMap\MemoryCacheAccessMutex)
|
|
ProcedureReturn #False
|
|
EndIf
|
|
; add a new time stack element at the End
|
|
LastElement(PBMap\MemCache\ImagesTimeStack())
|
|
; Stores the time stack ptr
|
|
*timg\TimeStackPtr = AddElement(PBMap\MemCache\ImagesTimeStack())
|
|
If *timg\TimeStackPtr = 0
|
|
MyDebug(" Can't add a new time stack element.", 4)
|
|
DeleteMapElement(PBMap\MemCache\Images())
|
|
UnlockMutex(PBMap\MemoryCacheAccessMutex)
|
|
ProcedureReturn #False
|
|
EndIf
|
|
; Associates the time stack element to the cache element
|
|
PBMap\MemCache\ImagesTimeStack()\MapKey = MapKey(PBMap\MemCache\Images())
|
|
MyDebug("Key : " + key + " added in memory cache", 4)
|
|
EndIf
|
|
; If there's no active download thread for this tile
|
|
If *timg\Tile <= 0
|
|
; Manage tile file lifetime, delete if too old
|
|
If PBMap\Options\TileLifetime <> -1
|
|
If FileSize(CacheFile) > 0 ; Does the file exists ?
|
|
If Date() - GetFileDate(CacheFile, #PB_Date_Modified) > PBMap\Options\TileLifetime ; If Lifetime > MaxLifeTime ; There's a bug with #PB_Date_Created
|
|
If DeleteFile(CacheFile)
|
|
MyDebug(" Deleting too old image file " + CacheFile, 3)
|
|
Else
|
|
MyDebug(" Can't delete too old image file " + CacheFile, 3)
|
|
UnlockMutex(PBMap\MemoryCacheAccessMutex)
|
|
ProcedureReturn #False
|
|
EndIf
|
|
EndIf
|
|
EndIf
|
|
EndIf
|
|
; Try To load it from HD
|
|
*timg\nImage = 0
|
|
*timg\Size = FileSize(CacheFile)
|
|
If *timg\Size > 0
|
|
*timg\nImage = GetTileFromHDD(CacheFile.s)
|
|
Else
|
|
MyDebug(" Failed loading from HDD " + CacheFile + " -> Filesize = " + FileSize(CacheFile), 3)
|
|
EndIf
|
|
If *timg\nImage
|
|
; Image found and loaded from HDD
|
|
*timg\Alpha = 0
|
|
UnlockMutex(PBMap\MemoryCacheAccessMutex)
|
|
ProcedureReturn *timg
|
|
Else
|
|
; If GetTileFromHDD failed, will load it (again?) from the web
|
|
If PBMap\ThreadsNB < PBMap\Options\MaxThreads
|
|
If PBMap\DownloadSlots < PBMap\Options\MaxDownloadSlots
|
|
; Launch a new web loading thread
|
|
PBMap\DownloadSlots + 1
|
|
Protected *NewTile.Tile = AllocateMemory(SizeOf(Tile))
|
|
If *NewTile
|
|
With *NewTile
|
|
; New tile parameters
|
|
\key = key
|
|
\URL = URL
|
|
\CacheFile = CacheFile
|
|
\nImage = 0
|
|
\Time = ElapsedMilliseconds()
|
|
\GetImageThread = CreateThread(@GetImageThread(), *NewTile)
|
|
If \GetImageThread
|
|
*timg\Tile = *NewTile ; There's now a loading thread
|
|
*timg\Alpha = 0
|
|
MyDebug(" Creating get image thread nb " + Str(\GetImageThread) + " to get " + CacheFile + " (key = " + key, 3)
|
|
PBMap\ThreadsNB + 1
|
|
Else
|
|
MyDebug(" Can't create get image thread to get " + CacheFile, 3)
|
|
FreeMemory(*NewTile)
|
|
EndIf
|
|
EndWith
|
|
Else
|
|
MyDebug(" Error, can't allocate memory for a new tile loading thread", 3)
|
|
EndIf
|
|
Else
|
|
MyDebug(" Thread needed " + key + " for image " + CacheFile + " canceled because no free download slot.", 5)
|
|
EndIf
|
|
Else
|
|
MyDebug(" Error, maximum threads nb reached", 3)
|
|
EndIf
|
|
EndIf
|
|
EndIf
|
|
UnlockMutex(PBMap\MemoryCacheAccessMutex)
|
|
ProcedureReturn #False
|
|
EndProcedure
|
|
|
|
Procedure DrawTiles(*Drawing.DrawingParameters, 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 URL.s, CacheFile.s
|
|
Protected tilemax = 1<<PBMap\Zoom
|
|
Protected HereLoadBalancing.b ; Here is providing a load balancing system
|
|
FindMapElement(PBMap\Layers(), LayerName)
|
|
MyDebug("Drawing tiles")
|
|
For y = - ny - 1 To ny + 1
|
|
For x = - nx - 1 To nx + 1
|
|
px = *Drawing\RadiusX + x * PBMap\TileSize - *Drawing\DeltaX
|
|
py = *Drawing\RadiusY + y * PBMap\TileSize - *Drawing\DeltaY
|
|
tilex = (tx + x) % tilemax
|
|
If tilex < 0
|
|
tilex + tilemax
|
|
EndIf
|
|
tiley = ty + y
|
|
If tiley >= 0 And tiley < tilemax
|
|
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
|
|
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)
|
|
Else
|
|
MyDebug(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)
|
|
Else
|
|
MyDebug(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)
|
|
Else
|
|
MyDebug(DirName + " successfully created", 4)
|
|
EndIf
|
|
EndIf
|
|
With PBMap\Layers()
|
|
Select \LayerType
|
|
;---- OSM tiles
|
|
Case 0
|
|
URL = \ServerURL + Str(PBMap\Zoom) + "/" + Str(tilex) + "/" + Str(tiley) + ".png"
|
|
; Tile cache name based on y
|
|
CacheFile = DirName + slash + Str(tiley) + ".png"
|
|
;---- Here tiles
|
|
Case 1
|
|
HereLoadBalancing = 1 + ((tiley + tilex) % 4)
|
|
; {Base URL}{Path}{resource (tile type)}/{Map id}/{scheme}/{zoom}/{column}/{row}/{size}/{format}?app_id={YOUR_APP_ID}&app_code={YOUR_APP_CODE}&{param}={value}
|
|
URL = "https://" + StrU(HereLoadBalancing, #PB_Byte) + "." + \ServerURL + \path + \ressource + "/" + \id + "/" + \scheme + "/" + Str(PBMap\Zoom) + "/" + Str(tilex) + "/" + Str(tiley) + "/256/" + \format + "?app_id=" + \APP_ID + "&app_code=" + \APP_CODE + "&lg=" + \lg + "&lg2=" + \lg2
|
|
If \param <> ""
|
|
URL + "&" + \param
|
|
EndIf
|
|
; Tile cache name based on y
|
|
CacheFile = DirName + slash + Str(tiley) + "." + \format
|
|
;---- GeoServer / geowebcache - google maps service tiles
|
|
Case 2
|
|
; template 'http://localhost:8080/geowebcache/service/gmaps?layers=layer-name&zoom={Z}&x={X}&y={Y}&format=image/png'
|
|
URL = \ServerURL + \path + "?layers=" + \ServerLayerName + "&zoom={" + Str(PBMap\Zoom) + "}&x={" + Str(tilex) + "}&y={" + Str(tiley) + "}&format=" + \format
|
|
; Tile cache name based on y
|
|
CacheFile = DirName + slash + Str(tiley) + ".png"
|
|
EndSelect
|
|
EndWith
|
|
*timg = GetTile(key, URL, CacheFile)
|
|
If *timg And *timg\nImage
|
|
MovePathCursor(px, py)
|
|
If *timg\Alpha <= 224
|
|
DrawVectorImage(ImageID(*timg\nImage), *timg\Alpha * PBMap\Layers()\Alpha)
|
|
*timg\Alpha + 32
|
|
PBMap\Redraw = #True
|
|
Else
|
|
DrawVectorImage(ImageID(*timg\nImage), 255 * PBMap\Layers()\Alpha)
|
|
*timg\Alpha = 256
|
|
EndIf
|
|
Else
|
|
MovePathCursor(px, py)
|
|
DrawVectorImage(ImageID(PBMap\ImgLoading), 255 * PBMap\Layers()\Alpha)
|
|
EndIf
|
|
Else
|
|
; If PBMap\Layers()\Name = ""
|
|
MovePathCursor(px, py)
|
|
DrawVectorImage(ImageID(PBMap\ImgNothing), 255 * PBMap\Layers()\Alpha)
|
|
; EndIf
|
|
EndIf
|
|
If PBMap\Options\ShowDebugInfos
|
|
VectorFont(FontID(PBMap\Font), 16)
|
|
VectorSourceColor(RGBA(0, 0, 0, 80))
|
|
MovePathCursor(px, py)
|
|
DrawVectorText("x:" + Str(tilex))
|
|
MovePathCursor(px, py + 16)
|
|
DrawVectorText("y:" + Str(tiley))
|
|
EndIf
|
|
Next
|
|
Next
|
|
EndProcedure
|
|
|
|
Procedure DrawPointer(*Drawing.DrawingParameters)
|
|
If PBMap\CallBackMainPointer > 0
|
|
; @Procedure(X.i, Y.i) to DrawPointer (you must use VectorDrawing lib)
|
|
CallFunctionFast(PBMap\CallBackMainPointer, *Drawing\RadiusX, *Drawing\RadiusY)
|
|
Else
|
|
VectorSourceColor(RGBA($FF, 0, 0, $FF))
|
|
MovePathCursor(*Drawing\RadiusX, *Drawing\RadiusY)
|
|
AddPathLine(-8, -16, #PB_Path_Relative)
|
|
AddPathCircle(8, 0, 8, 180, 0, #PB_Path_Relative)
|
|
AddPathLine(-8, 16, #PB_Path_Relative)
|
|
AddPathCircle(0, -16, 5, 0, 360, #PB_Path_Relative)
|
|
VectorSourceColor(RGBA($FF, 0, 0, $FF))
|
|
FillPath(#PB_Path_Preserve):VectorSourceColor(RGBA($FF, 0, 0, $FF)); RGBA(0, 0, 0, 255))
|
|
StrokePath(1)
|
|
EndIf
|
|
EndProcedure
|
|
|
|
Procedure DrawScale(*Drawing.DrawingParameters,x,y,alpha=80)
|
|
Protected sunit.s
|
|
Protected Scale.d= 40075*Cos(Radian(PBMap\GeographicCoordinates\Latitude))/Pow(2,PBMap\Zoom) / 2
|
|
Select PBMap\Options\ScaleUnit
|
|
Case #SCALE_Nautical
|
|
Scale * 0.539957
|
|
sunit = " Nm"
|
|
Case #SCALE_KM;
|
|
sunit = " Km"
|
|
EndSelect
|
|
VectorFont(FontID(PBMap\Font), 10)
|
|
VectorSourceColor(RGBA(0, 0, 0, alpha))
|
|
MovePathCursor(x,y)
|
|
DrawVectorText(StrD(Scale,3)+sunit)
|
|
MovePathCursor(x,y+12)
|
|
AddPathLine(x+128,y+12)
|
|
StrokePath(1)
|
|
EndProcedure
|
|
|
|
Procedure DrawDegrees(*Drawing.DrawingParameters, alpha=192)
|
|
Protected nx, ny, nx1, ny1, x, y
|
|
Protected pos1.PixelCoordinates, pos2.PixelCoordinates, Degrees1.GeographicCoordinates, degrees2.GeographicCoordinates
|
|
CopyStructure(*Drawing\Bounds\NorthWest, @Degrees1, GeographicCoordinates)
|
|
CopyStructure(*Drawing\Bounds\SouthEast, @Degrees2, GeographicCoordinates)
|
|
; ensure we stay positive for the drawing
|
|
nx = Mod(Mod(Round(Degrees1\Longitude, #PB_Round_Down)-1, 360) + 360, 360)
|
|
ny = Round(Degrees1\Latitude, #PB_Round_Up) +1
|
|
nx1 = Mod(Mod(Round(Degrees2\Longitude, #PB_Round_Up) +1, 360) + 360, 360)
|
|
ny1 = Round(Degrees2\Latitude, #PB_Round_Down)-1
|
|
Degrees1\Longitude = nx
|
|
Degrees1\Latitude = ny
|
|
Degrees2\Longitude = nx1
|
|
Degrees2\Latitude = ny1
|
|
; Debug "NW : " + StrD(Degrees1\Longitude) + " ; NE : " + StrD(Degrees2\Longitude)
|
|
LatLon2PixelRel(@Degrees1, @pos1, PBMap\Zoom)
|
|
LatLon2PixelRel(@Degrees2, @pos2, PBMap\Zoom)
|
|
VectorFont(FontID(PBMap\Font), 10)
|
|
VectorSourceColor(RGBA(0, 0, 0, alpha))
|
|
; draw latitudes
|
|
For y = ny1 To ny
|
|
Degrees1\Longitude = nx
|
|
Degrees1\Latitude = y
|
|
LatLon2PixelRel(@Degrees1, @pos1, PBMap\Zoom)
|
|
MovePathCursor(pos1\x, pos1\y)
|
|
AddPathLine( pos2\x, pos1\y)
|
|
MovePathCursor(10, pos1\y)
|
|
DrawVectorText(StrD(y, 1))
|
|
Next
|
|
; draw longitudes
|
|
x = nx
|
|
Repeat
|
|
Degrees1\Longitude = x
|
|
Degrees1\Latitude = ny
|
|
LatLon2PixelRel(@Degrees1, @pos1, PBMap\Zoom)
|
|
MovePathCursor(pos1\x, pos1\y)
|
|
AddPathLine( pos1\x, pos2\y)
|
|
MovePathCursor(pos1\x,10)
|
|
DrawVectorText(StrD(Mod(x + 180, 360) - 180, 1))
|
|
x = (x + 1)%360
|
|
Until x = nx1
|
|
StrokePath(1)
|
|
EndProcedure
|
|
|
|
Procedure DrawZoom(x.i, y.i)
|
|
VectorFont(FontID(PBMap\Font), 20)
|
|
VectorSourceColor(RGBA(0, 0, 0,150))
|
|
MovePathCursor(x,y)
|
|
DrawVectorText(Str(GetZoom()))
|
|
EndProcedure
|
|
;-*** Tracks
|
|
|
|
Procedure DrawTrackPointer(x.d, y.d, dist.l)
|
|
Protected color.l
|
|
color=RGBA(0, 0, 0, 255)
|
|
MovePathCursor(x,y)
|
|
AddPathLine(-8,-16,#PB_Path_Relative)
|
|
AddPathLine(16,0,#PB_Path_Relative)
|
|
AddPathLine(-8,16,#PB_Path_Relative)
|
|
VectorSourceColor(color)
|
|
AddPathCircle(x,y-20,14)
|
|
FillPath()
|
|
VectorSourceColor(RGBA(255, 255, 255, 255))
|
|
AddPathCircle(x,y-20,12)
|
|
FillPath()
|
|
VectorFont(FontID(PBMap\Font), 13)
|
|
MovePathCursor(x-VectorTextWidth(Str(dist))/2, y-20-VectorTextHeight(Str(dist))/2)
|
|
VectorSourceColor(RGBA(0, 0, 0, 255))
|
|
DrawVectorText(Str(dist))
|
|
EndProcedure
|
|
|
|
Procedure DrawTrackPointerFirst(x.d, y.d, dist.l)
|
|
Protected color.l
|
|
color=RGBA(0, 0, 0, 255)
|
|
MovePathCursor(x,y)
|
|
AddPathLine(-9,-17,#PB_Path_Relative)
|
|
AddPathLine(17,0,#PB_Path_Relative)
|
|
AddPathLine(-9,17,#PB_Path_Relative)
|
|
VectorSourceColor(color)
|
|
AddPathCircle(x,y-24,16)
|
|
FillPath()
|
|
VectorSourceColor(RGBA(255, 0, 0, 255))
|
|
AddPathCircle(x,y-24,14)
|
|
FillPath()
|
|
VectorFont(FontID(PBMap\Font), 14)
|
|
MovePathCursor(x-VectorTextWidth(Str(dist))/2, y-24-VectorTextHeight(Str(dist))/2)
|
|
VectorSourceColor(RGBA(0, 0, 0, 255))
|
|
DrawVectorText(Str(dist))
|
|
EndProcedure
|
|
|
|
Procedure DeleteTrack(*Ptr)
|
|
If *Ptr
|
|
ChangeCurrentElement(PBMap\TracksList(), *Ptr)
|
|
DeleteElement(PBMap\TracksList())
|
|
EndIf
|
|
EndProcedure
|
|
|
|
Procedure DeleteSelectedTracks()
|
|
ForEach PBMap\TracksList()
|
|
If PBMap\TracksList()\Selected
|
|
DeleteElement(PBMap\TracksList())
|
|
PBMap\Redraw = #True
|
|
EndIf
|
|
Next
|
|
EndProcedure
|
|
|
|
Procedure ClearTracks()
|
|
ClearList(PBMap\TracksList())
|
|
PBMap\Redraw = #True
|
|
EndProcedure
|
|
|
|
Procedure SetTrackColour(*Ptr, Colour.i)
|
|
If *Ptr
|
|
ChangeCurrentElement(PBMap\TracksList(), *Ptr)
|
|
PBMap\TracksList()\Colour = Colour
|
|
PBMap\Redraw = #True
|
|
EndIf
|
|
EndProcedure
|
|
|
|
Procedure DrawTracks(*Drawing.DrawingParameters)
|
|
Protected Pixel.PixelCoordinates
|
|
Protected Location.GeographicCoordinates
|
|
Protected km.f, memKm.i
|
|
With PBMap\TracksList()
|
|
; Trace Track
|
|
If ListSize(PBMap\TracksList()) > 0
|
|
BeginVectorLayer()
|
|
ForEach PBMap\TracksList()
|
|
If ListSize(\Track()) > 0
|
|
; Check visibility
|
|
\Visible = #False
|
|
ForEach \Track()
|
|
If IsInDrawingPixelBoundaries(*Drawing, @PBMap\TracksList()\Track())
|
|
\Visible = #True
|
|
Break
|
|
EndIf
|
|
Next
|
|
If \Visible
|
|
; Draw tracks
|
|
ForEach \Track()
|
|
LatLon2PixelRel(@PBMap\TracksList()\Track(), @Pixel, PBMap\Zoom)
|
|
If ListIndex(\Track()) = 0
|
|
MovePathCursor(Pixel\x, Pixel\y)
|
|
Else
|
|
AddPathLine(Pixel\x, Pixel\y)
|
|
EndIf
|
|
Next
|
|
; \BoundingBox\x = PathBoundsX()
|
|
; \BoundingBox\y = PathBoundsY()
|
|
; \BoundingBox\w = PathBoundsWidth()
|
|
; \BoundingBox\h = PathBoundsHeight()
|
|
If \Focus
|
|
VectorSourceColor(PBMap\Options\ColourFocus)
|
|
ElseIf \Selected
|
|
VectorSourceColor(PBMap\Options\ColourSelected)
|
|
Else
|
|
VectorSourceColor(\Colour)
|
|
EndIf
|
|
StrokePath(\StrokeWidth, #PB_Path_RoundEnd|#PB_Path_RoundCorner)
|
|
|
|
; 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
|
|
If PBMap\Options\ShowTrackKms And PBMap\Zoom > 10
|
|
BeginVectorLayer()
|
|
ForEach PBMap\TracksList()
|
|
If \Visible
|
|
km = 0 : memKm = -1
|
|
ForEach PBMap\TracksList()\Track()
|
|
; Test Distance
|
|
If ListIndex(\Track()) = 0
|
|
Location\Latitude = \Track()\Latitude
|
|
Location\Longitude = \Track()\Longitude
|
|
Else
|
|
km = km + HaversineInKM(@Location, @PBMap\TracksList()\Track())
|
|
Location\Latitude = \Track()\Latitude
|
|
Location\Longitude = \Track()\Longitude
|
|
EndIf
|
|
LatLon2PixelRel(@PBMap\TracksList()\Track(), @Pixel, PBMap\Zoom)
|
|
If Int(km) <> memKm
|
|
memKm = Int(km)
|
|
If Int(km) = 0
|
|
DrawTrackPointerFirst(Pixel\x , Pixel\y, Int(km))
|
|
Else
|
|
DrawTrackPointer(Pixel\x , Pixel\y, Int(km))
|
|
EndIf
|
|
EndIf
|
|
Next
|
|
EndIf
|
|
Next
|
|
EndVectorLayer()
|
|
EndIf
|
|
EndIf
|
|
EndWith
|
|
EndProcedure
|
|
|
|
Procedure.i LoadGpxFile(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))
|
|
Error(Message)
|
|
EndIf
|
|
Protected *MainNode,*subNode,*child,child.l
|
|
*MainNode = MainXMLNode(0)
|
|
*MainNode = XMLNodeFromPath(*MainNode, "/gpx/trk/trkseg")
|
|
Protected *NewTrack.Tracks = AddElement(PBMap\TracksList())
|
|
PBMap\TracksList()\StrokeWidth = PBMap\Options\StrokeWidthTrackDefault
|
|
PBMap\TracksList()\Colour = PBMap\Options\ColourTrackDefault
|
|
For child = 1 To XMLChildCount(*MainNode)
|
|
*child = ChildXMLNode(*MainNode, child)
|
|
AddElement(*NewTrack\Track())
|
|
If ExamineXMLAttributes(*child)
|
|
While NextXMLAttribute(*child)
|
|
Select XMLAttributeName(*child)
|
|
Case "lat"
|
|
*NewTrack\Track()\Latitude = ValD(XMLAttributeValue(*child))
|
|
Case "lon"
|
|
*NewTrack\Track()\Longitude = ValD(XMLAttributeValue(*child))
|
|
EndSelect
|
|
Wend
|
|
EndIf
|
|
Next
|
|
SetZoomToTracks(LastElement(PBMap\TracksList())) ; <-To center the view, and zoom on the tracks
|
|
ProcedureReturn *NewTrack
|
|
EndIf
|
|
EndProcedure
|
|
|
|
Procedure.i SaveGpxFile(FileName.s, *Track.Tracks)
|
|
Protected Message.s
|
|
If CreateXML(0)
|
|
Protected *MainNode, *subNode, *child
|
|
*MainNode = CreateXMLNode(RootXMLNode(0), "gpx")
|
|
*subNode = CreateXMLNode(*MainNode, "trk")
|
|
*subNode = CreateXMLNode(*subNode, "trkseg")
|
|
ForEach *Track\Track()
|
|
*child = CreateXMLNode(*subNode, "trkpt")
|
|
SetXMLAttribute(*child, "lat", StrD(*Track\Track()\Latitude))
|
|
SetXMLAttribute(*child, "lon", StrD(*Track\Track()\Longitude))
|
|
Next
|
|
SaveXML(0, FileName)
|
|
If XMLStatus(0) <> #PB_XML_Success
|
|
Message = "Error in the XML file:" + Chr(13)
|
|
Message + "Message: " + XMLError(0) + Chr(13)
|
|
Message + "Line: " + Str(XMLErrorLine(0)) + " Character: " + Str(XMLErrorPosition(0))
|
|
Error(Message)
|
|
ProcedureReturn #False
|
|
EndIf
|
|
ProcedureReturn #True
|
|
Else
|
|
ProcedureReturn #False
|
|
EndIf
|
|
EndProcedure
|
|
|
|
;-*** Markers
|
|
|
|
Procedure ClearMarkers()
|
|
ClearList(PBMap\Markers())
|
|
PBMap\Redraw = #True
|
|
EndProcedure
|
|
|
|
Procedure DeleteMarker(*Ptr)
|
|
If *Ptr
|
|
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
|
|
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())
|
|
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
|
|
ProcedureReturn *Ptr
|
|
EndIf
|
|
EndProcedure
|
|
|
|
Procedure MarkerIdentifierChange()
|
|
Protected *Marker.Marker = GetGadgetData(EventGadget())
|
|
If GetGadgetText(EventGadget()) <> *Marker\Identifier
|
|
*Marker\Identifier = GetGadgetText(EventGadget())
|
|
EndIf
|
|
EndProcedure
|
|
|
|
Procedure MarkerLegendChange()
|
|
Protected *Marker.Marker = GetGadgetData(EventGadget())
|
|
If GetGadgetText(EventGadget()) <> *Marker\Legend
|
|
*Marker\Legend = GetGadgetText(EventGadget())
|
|
EndIf
|
|
EndProcedure
|
|
|
|
Procedure MarkerEditCloseWindow()
|
|
ForEach PBMap\Markers()
|
|
If PBMap\Markers()\EditWindow = EventWindow()
|
|
PBMap\Markers()\EditWindow = 0
|
|
EndIf
|
|
Next
|
|
CloseWindow(EventWindow())
|
|
EndProcedure
|
|
|
|
Procedure MarkerEdit(*Marker.Marker)
|
|
If *Marker\EditWindow = 0 ; Check that this marker has no already opened window
|
|
Protected WindowMarkerEdit = OpenWindow(#PB_Any, WindowX(PBMap\Window) + WindowWidth(PBMap\Window) / 2 - 150, WindowY(PBMap\Window)+ WindowHeight(PBMap\Window) / 2 + 50, 300, 100, "Marker Edit", #PB_Window_SystemMenu | #PB_Window_TitleBar)
|
|
StickyWindow(WindowMarkerEdit, #True)
|
|
TextGadget(#PB_Any, 2, 2, 80, 25, gettext("Identifier"))
|
|
TextGadget(#PB_Any, 2, 27, 80, 25, gettext("Legend"))
|
|
Protected StringIdentifier = StringGadget(#PB_Any, 84, 2, 120, 25, *Marker\Identifier) : SetGadgetData(StringIdentifier, *Marker)
|
|
Protected EditorLegend = EditorGadget(#PB_Any, 84, 27, 210, 70) : SetGadgetText(EditorLegend, *Marker\Legend) : SetGadgetData(EditorLegend, *Marker)
|
|
*Marker\EditWindow = WindowMarkerEdit
|
|
BindGadgetEvent(StringIdentifier, @MarkerIdentifierChange(), #PB_EventType_Change)
|
|
BindGadgetEvent(EditorLegend, @MarkerLegendChange(), #PB_EventType_Change)
|
|
BindEvent(#PB_Event_CloseWindow, @MarkerEditCloseWindow(), WindowMarkerEdit)
|
|
Else
|
|
SetActiveWindow(*Marker\EditWindow)
|
|
EndIf
|
|
EndProcedure
|
|
|
|
Procedure DrawMarker(x.i, y.i, Nb.i, *Marker.Marker)
|
|
Protected Text.s
|
|
VectorSourceColor(*Marker\Color)
|
|
MovePathCursor(x, y)
|
|
AddPathLine(-8, -16, #PB_Path_Relative)
|
|
AddPathCircle(8, 0, 8, 180, 0, #PB_Path_Relative)
|
|
AddPathLine(-8, 16, #PB_Path_Relative)
|
|
; FillPath(#PB_Path_Preserve)
|
|
; ClipPath(#PB_Path_Preserve)
|
|
AddPathCircle(0, -16, 5, 0, 360, #PB_Path_Relative)
|
|
VectorSourceColor(*Marker\Color)
|
|
FillPath(#PB_Path_Preserve)
|
|
If *Marker\Focus
|
|
VectorSourceColor(PBMap\Options\ColourFocus)
|
|
StrokePath(3)
|
|
ElseIf *Marker\Selected
|
|
VectorSourceColor(PBMap\Options\ColourSelected)
|
|
StrokePath(4)
|
|
Else
|
|
VectorSourceColor(*Marker\Color)
|
|
StrokePath(1)
|
|
EndIf
|
|
If PBMap\Options\ShowMarkersNb
|
|
If *Marker\Identifier = ""
|
|
Text.s = Str(Nb)
|
|
Else
|
|
Text.s = *Marker\Identifier
|
|
EndIf
|
|
VectorFont(FontID(PBMap\Font), 13)
|
|
MovePathCursor(x - VectorTextWidth(Text) / 2, y)
|
|
VectorSourceColor(RGBA(0, 0, 0, 255))
|
|
DrawVectorText(Text)
|
|
EndIf
|
|
If PBMap\Options\ShowMarkersLegend And *Marker\Legend <> ""
|
|
VectorFont(FontID(PBMap\Font), 13)
|
|
; dessin d'un cadre avec fond transparent
|
|
Protected Height = VectorParagraphHeight(*Marker\Legend, 100, 100)
|
|
Protected Width.l
|
|
If Height < 20 ; une ligne
|
|
Width = VectorTextWidth(*Marker\Legend)
|
|
Else
|
|
Width = 100
|
|
EndIf
|
|
AddPathBox(x - (Width / 2), y - 30 - Height, Width, Height)
|
|
VectorSourceColor(RGBA(168, 255, 255, 100))
|
|
FillPath()
|
|
AddPathBox(x - (Width / 2), y - 30 - Height, Width, Height)
|
|
VectorSourceColor(RGBA(36, 36, 255, 100))
|
|
StrokePath(2)
|
|
MovePathCursor(x - 50, y - 30 - Height)
|
|
VectorSourceColor(RGBA(0, 0, 0, 255))
|
|
DrawVectorParagraph(*Marker\Legend, 100, Height, #PB_VectorParagraph_Center)
|
|
EndIf
|
|
EndProcedure
|
|
|
|
; Draw all markers
|
|
Procedure DrawMarkers(*Drawing.DrawingParameters)
|
|
Protected Pixel.PixelCoordinates
|
|
ForEach PBMap\Markers()
|
|
If IsInDrawingPixelBoundaries(*Drawing, @PBMap\Markers()\GeographicCoordinates)
|
|
LatLon2PixelRel(@PBMap\Markers()\GeographicCoordinates, @Pixel, PBMap\Zoom)
|
|
If PBMap\Markers()\CallBackPointer > 0
|
|
CallFunctionFast(PBMap\Markers()\CallBackPointer, Pixel\x, Pixel\y, PBMap\Markers()\Focus, PBMap\Markers()\Selected)
|
|
Else
|
|
DrawMarker(Pixel\x, Pixel\y, ListIndex(PBMap\Markers()), @PBMap\Markers())
|
|
EndIf
|
|
EndIf
|
|
Next
|
|
EndProcedure
|
|
|
|
;-*** Main drawing stuff
|
|
|
|
Procedure DrawDebugInfos(*Drawing.DrawingParameters)
|
|
; Display how many images in cache
|
|
VectorFont(FontID(PBMap\Font), 16)
|
|
VectorSourceColor(RGBA(0, 0, 0, 80))
|
|
MovePathCursor(50, 50)
|
|
DrawVectorText("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)
|
|
ThreadCounter + 1
|
|
EndIf
|
|
EndIf
|
|
Next
|
|
DrawVectorText("Threads nb : " + Str(ThreadCounter))
|
|
MovePathCursor(50, 90)
|
|
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)
|
|
DrawVectorText("Lat-Lon 2 : " + StrD(*Drawing\Bounds\SouthEast\Latitude) + "," + StrD(*Drawing\Bounds\SouthEast\Longitude))
|
|
EndProcedure
|
|
|
|
Procedure DrawOSMCopyright(*Drawing.DrawingParameters)
|
|
Protected Text.s = "© OpenStreetMap contributors"
|
|
VectorFont(FontID(PBMap\Font), 12)
|
|
VectorSourceColor(RGBA(0, 0, 0, 80))
|
|
MovePathCursor(GadgetWidth(PBMAP\Gadget) - VectorTextWidth(Text), GadgetHeight(PBMAP\Gadget) - 20)
|
|
DrawVectorText(Text)
|
|
EndProcedure
|
|
|
|
Procedure Drawing()
|
|
Protected *Drawing.DrawingParameters = @PBMap\Drawing
|
|
Protected PixelCenter.PixelCoordinates
|
|
Protected Px.d, Py.d,a, ts = PBMap\TileSize, nx, ny
|
|
Protected LayerOrder.i = 0
|
|
Protected NW.Coordinates, SE.Coordinates
|
|
PBMap\Dirty = #False
|
|
PBMap\Redraw = #False
|
|
; *** Precalc some values
|
|
*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
|
|
*Drawing\DeltaX = Px * ts - (Int(Px) * ts) ; Don't forget the Int() !
|
|
*Drawing\DeltaY = Py * ts - (Int(Py) * ts)
|
|
; Drawing boundaries
|
|
nx = *Drawing\RadiusX / ts ; How many tiles around the point
|
|
ny = *Drawing\RadiusY / ts
|
|
NW\x = Px - nx - 1
|
|
NW\y = Py - ny - 1
|
|
SE\x = Px + nx + 2
|
|
SE\y = Py + ny + 2
|
|
TileXY2LatLon(@NW, *Drawing\Bounds\NorthWest, PBMap\Zoom)
|
|
TileXY2LatLon(@SE, *Drawing\Bounds\SouthEast, PBMap\Zoom)
|
|
; *Drawing\Width = (SE\x / Pow(2, PBMap\Zoom) * 360.0) - (NW\x / Pow(2, PBMap\Zoom) * 360.0) ; Calculus without clipping
|
|
; *Drawing\Height = *Drawing\Bounds\NorthWest\Latitude - *Drawing\Bounds\SouthEast\Latitude
|
|
; ***
|
|
; Main drawing stuff
|
|
StartVectorDrawing(CanvasVectorOutput(PBMap\Gadget))
|
|
; Clearscreen
|
|
VectorSourceColor(RGBA(150, 150, 150, 255))
|
|
FillVectorOutput()
|
|
; TODO add in layers of tiles ; this way we can cache them as 0 base 1.n layers
|
|
; such as for openseamap tiles which are overlaid. not that efficent from here though.
|
|
; Draws layers based on their number
|
|
ForEach PBMap\LayersList()
|
|
If PBMap\LayersList()\Enabled
|
|
DrawTiles(*Drawing, PBMap\LayersList()\Name)
|
|
EndIf
|
|
Next
|
|
If PBMap\Options\ShowTrack
|
|
DrawTracks(*Drawing)
|
|
EndIf
|
|
If PBMap\Options\ShowMarkers
|
|
DrawMarkers(*Drawing)
|
|
EndIf
|
|
If PBMap\Options\ShowDegrees And PBMap\Zoom > 2
|
|
DrawDegrees(*Drawing, 192)
|
|
EndIf
|
|
If PBMap\Options\ShowPointer
|
|
DrawPointer(*Drawing)
|
|
EndIf
|
|
If PBMap\Options\ShowDebugInfos
|
|
DrawDebugInfos(*Drawing)
|
|
EndIf
|
|
If PBMap\Options\ShowScale
|
|
DrawScale(*Drawing, 10, GadgetHeight(PBMAP\Gadget) - 20, 192)
|
|
EndIf
|
|
If PBMap\Options\ShowZoom
|
|
DrawZoom(GadgetWidth(PBMap\Gadget) - 30, 5) ; ajout YA - affiche le niveau de zoom
|
|
EndIf
|
|
DrawOSMCopyright(*Drawing)
|
|
StopVectorDrawing()
|
|
EndProcedure
|
|
|
|
Procedure Refresh()
|
|
PBMap\Redraw = #True
|
|
; Drawing()
|
|
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)
|
|
; 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)
|
|
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
|
|
If Zoom <> -1
|
|
PBMap\Zoom = Zoom
|
|
EndIf
|
|
Case #PB_Relative
|
|
PBMap\GeographicCoordinates\Latitude + latitude
|
|
PBMap\GeographicCoordinates\Longitude + longitude
|
|
If Zoom <> -1
|
|
PBMap\Zoom + Zoom
|
|
EndIf
|
|
EndSelect
|
|
PBMap\GeographicCoordinates\Longitude = ClipLongitude(PBMap\GeographicCoordinates\Longitude)
|
|
If PBMap\GeographicCoordinates\Latitude < -89
|
|
PBMap\GeographicCoordinates\Latitude = -89
|
|
EndIf
|
|
If PBMap\GeographicCoordinates\Latitude > 89
|
|
PBMap\GeographicCoordinates\Latitude = 89
|
|
EndIf
|
|
If PBMap\Zoom > PBMap\ZoomMax : PBMap\Zoom = PBMap\ZoomMax : EndIf
|
|
If PBMap\Zoom < PBMap\ZoomMin : PBMap\Zoom = PBMap\ZoomMin : EndIf
|
|
LatLon2TileXY(@PBMap\GeographicCoordinates, @PBMap\Drawing\TileCoordinates, PBMap\Zoom)
|
|
; 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)
|
|
EndIf
|
|
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
|
|
Protected centerX.d = MinX + DeltaX / 2 ; assumption ! In original code CenterX have no source
|
|
Protected paddingFactor.f= 1.2 ; paddingFactor: this can be used to get the "120%" effect ThomM refers to. Value of 1.2 would get you the 120%.
|
|
Protected ry1.d = Log((Sin(Radian(MinY)) + 1) / Cos(Radian(MinY)))
|
|
Protected ry2.d = Log((Sin(Radian(MaxY)) + 1) / Cos(Radian(MaxY)))
|
|
Protected ryc.d = (ry1 + ry2) / 2
|
|
Protected centerY.d = Degree(ATan(SinH(ryc)))
|
|
Protected resolutionHorizontal.d = DeltaX / (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 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;
|
|
SetLocation(lat, lon, Round(zoom,#PB_Round_Down))
|
|
Else
|
|
SetLocation(PBMap\GeographicCoordinates\Latitude, PBMap\GeographicCoordinates\Longitude, 15)
|
|
EndIf
|
|
EndProcedure
|
|
|
|
Procedure SetZoomToTracks(*Tracks.Tracks)
|
|
Protected MinY.d, MaxY.d, MinX.d, MaxX.d
|
|
If ListSize(*Tracks\Track()) > 0
|
|
With *Tracks\Track()
|
|
FirstElement(*Tracks\Track())
|
|
MinX = \Longitude : MaxX = MinX : MinY = \Latitude : MaxY = MinY
|
|
ForEach *Tracks\Track()
|
|
If \Longitude < MinX
|
|
MinX = \Longitude
|
|
EndIf
|
|
If \Longitude > MaxX
|
|
MaxX = \Longitude
|
|
EndIf
|
|
If \Latitude < MinY
|
|
MinY = \Latitude
|
|
EndIf
|
|
If \Latitude > MaxY
|
|
MaxY = \Latitude
|
|
EndIf
|
|
Next
|
|
SetZoomToArea(MinY.d, MaxY.d, MinX.d, MaxX.d)
|
|
EndWith
|
|
EndIf
|
|
EndProcedure
|
|
|
|
Procedure SetZoom(Zoom.i, mode.i = #PB_Relative)
|
|
Select mode
|
|
Case #PB_Relative
|
|
PBMap\Zoom = PBMap\Zoom + zoom
|
|
Case #PB_Absolute
|
|
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)
|
|
; Convert X, Y in tile.decimal into real pixels
|
|
PBMap\PixelCoordinates\X = PBMap\Drawing\TileCoordinates\x * PBMap\TileSize
|
|
PBMap\PixelCoordinates\Y = PBMap\Drawing\TileCoordinates\y * PBMap\TileSize
|
|
; First drawing
|
|
PBMap\Redraw = #True
|
|
If PBMap\CallBackLocation > 0
|
|
CallFunctionFast(PBMap\CallBackLocation, @PBMap\GeographicCoordinates)
|
|
EndIf
|
|
EndProcedure
|
|
|
|
Procedure SetAngle(Angle.d, Mode = #PB_Absolute)
|
|
If Mode = #PB_Absolute
|
|
PBmap\Angle = Angle
|
|
Else
|
|
PBMap\Angle + Angle
|
|
PBMap\Angle = Mod(PBMap\Angle,360)
|
|
EndIf
|
|
PBMap\Redraw = #True
|
|
EndProcedure
|
|
|
|
Procedure SetCallBackLocation(CallBackLocation.i)
|
|
PBMap\CallBackLocation = CallBackLocation
|
|
EndProcedure
|
|
|
|
Procedure SetCallBackMainPointer(CallBackMainPointer.i)
|
|
PBMap\CallBackMainPointer = CallBackMainPointer
|
|
EndProcedure
|
|
|
|
Procedure SetCallBackMarker(CallBackLocation.i)
|
|
PBMap\CallBackMarker = CallBackLocation
|
|
EndProcedure
|
|
|
|
Procedure SetCallBackLeftClic(CallBackLocation.i)
|
|
PBMap\CallBackLeftClic = CallBackLocation
|
|
EndProcedure
|
|
|
|
Procedure SetMapScaleUnit(ScaleUnit.i = PBMAP::#SCALE_KM)
|
|
PBMap\Options\ScaleUnit = ScaleUnit
|
|
PBMap\Redraw = #True
|
|
; Drawing()
|
|
EndProcedure
|
|
|
|
; User mode
|
|
; #MODE_DEFAULT = 0 -> "Hand" (move map) and move objects
|
|
; #MODE_HAND = 1 -> Hand only
|
|
; #MODE_SELECT = 2 -> Move objects only
|
|
; #MODE_EDIT = 3 -> Create objects
|
|
Procedure SetMode(Mode.i = #MODE_DEFAULT)
|
|
PBMap\Mode = Mode
|
|
EndProcedure
|
|
|
|
Procedure.i GetMode()
|
|
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)
|
|
If Zoom = 1
|
|
PBMap\PixelCoordinates\x + x
|
|
PBMap\PixelCoordinates\y + y
|
|
ElseIf zoom = -1
|
|
PBMap\PixelCoordinates\x - x/2
|
|
PBMap\PixelCoordinates\y - y/2
|
|
EndIf
|
|
Pixel2LatLon(@PBMap\PixelCoordinates, @PBMap\GeographicCoordinates, PBMap\Zoom)
|
|
; Start drawing
|
|
PBMap\Redraw = #True
|
|
; If CallBackLocation send Location To function
|
|
If PBMap\CallBackLocation > 0
|
|
CallFunctionFast(PBMap\CallBackLocation, @PBMap\GeographicCoordinates)
|
|
EndIf
|
|
EndProcedure
|
|
|
|
; 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
|
|
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)
|
|
; Start drawing
|
|
PBMap\Redraw = #True
|
|
; If CallBackLocation send Location to function
|
|
If PBMap\CallBackLocation > 0
|
|
CallFunctionFast(PBMap\CallBackLocation, @PBMap\GeographicCoordinates)
|
|
EndIf
|
|
EndProcedure
|
|
|
|
; Go to x, y position relative to the canvas gadget
|
|
Procedure GotoPixel(x, y)
|
|
PBMap\PixelCoordinates\x = x
|
|
PBMap\PixelCoordinates\y = y
|
|
Pixel2LatLon(@PBMap\PixelCoordinates, @PBMap\GeographicCoordinates, PBMap\Zoom)
|
|
; Start drawing
|
|
PBMap\Redraw = #True
|
|
; If CallBackLocation send Location to function
|
|
If PBMap\CallBackLocation > 0
|
|
CallFunctionFast(PBMap\CallBackLocation, @PBMap\GeographicCoordinates)
|
|
EndIf
|
|
EndProcedure
|
|
|
|
Procedure.d GetLatitude()
|
|
ProcedureReturn PBMap\GeographicCoordinates\Latitude
|
|
EndProcedure
|
|
|
|
Procedure.d GetLongitude()
|
|
ProcedureReturn PBMap\GeographicCoordinates\Longitude
|
|
EndProcedure
|
|
|
|
Procedure.i GetZoom()
|
|
ProcedureReturn PBMap\Zoom
|
|
EndProcedure
|
|
|
|
Procedure.d GetAngle()
|
|
ProcedureReturn PBMap\Angle
|
|
EndProcedure
|
|
|
|
Procedure NominatimGeoLocationQuery(Address.s, *ReturnPosition.GeographicCoordinates = 0)
|
|
Protected Size.i
|
|
Protected Query.s = "http://nominatim.openstreetmap.org/search/" +
|
|
URLEncoder(Address) +
|
|
"?format=json&addressdetails=0&polygon=0&limit=1"
|
|
Protected JSONFileName.s = PBMap\Options\HDDCachePath + "nominatimresponse.json"
|
|
; Protected *Buffer = CurlReceiveHTTPToMemory("http://nominatim.openstreetmap.org/search/Unter%20den%20Linden%201%20Berlin?format=json&addressdetails=1&limit=1&polygon_svg=1", PBMap\Options\ProxyURL, PBMap\Options\ProxyPort, PBMap\Options\ProxyUser, PBMap\Options\ProxyPassword)
|
|
; Debug *Buffer
|
|
; Debug MemorySize(*Buffer)
|
|
; Protected JSon.s = PeekS(*Buffer, MemorySize(*Buffer), #PB_UTF8)
|
|
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
|
|
MyDebug( JSONErrorMessage() + " at position " +
|
|
JSONErrorPosition() + " in line " +
|
|
JSONErrorLine() + " of JSON web Data", 1)
|
|
ElseIf JSONArraySize(JSONValue(0)) > 0
|
|
Protected object_val = GetJSONElement(JSONValue(0), 0)
|
|
Protected object_box = GetJSONMember(object_val, "boundingbox")
|
|
Protected bbox.BoundingBox
|
|
bbox\SouthEast\Latitude = ValD(GetJSONString(GetJSONElement(object_box, 0)))
|
|
bbox\NorthWest\Latitude = ValD(GetJSONString(GetJSONElement(object_box, 1)))
|
|
bbox\NorthWest\Longitude = ValD(GetJSONString(GetJSONElement(object_box, 2)))
|
|
bbox\SouthEast\Longitude = ValD(GetJSONString(GetJSONElement(object_box, 3)))
|
|
Protected lat.s = GetJSONString(GetJSONMember(object_val, "lat"))
|
|
Protected lon.s = GetJSONString(GetJSONMember(object_val, "lon"))
|
|
If *ReturnPosition <> 0
|
|
*ReturnPosition\Latitude = ValD(lat)
|
|
*ReturnPosition\Longitude = ValD(lon)
|
|
EndIf
|
|
If lat <> "" And lon <> ""
|
|
SetZoomToArea(bbox\SouthEast\Latitude, bbox\NorthWest\Latitude, bbox\NorthWest\Longitude, bbox\SouthEast\Longitude)
|
|
; SetLocation(Position\Latitude, Position\Longitude)
|
|
EndIf
|
|
EndIf
|
|
EndProcedure
|
|
|
|
Procedure.i ClearDiskCache()
|
|
If PBMap\Options\Warning
|
|
Protected Result.i = MessageRequester("Warning", "You will clear all cache content in " + PBMap\Options\HDDCachePath + ". Are you sure ?",#PB_MessageRequester_YesNo)
|
|
If Result = #PB_MessageRequester_No ; Quit if "no" selected
|
|
ProcedureReturn #False
|
|
EndIf
|
|
EndIf
|
|
If DeleteDirectory(PBMap\Options\HDDCachePath, "", #PB_FileSystem_Recursive)
|
|
MyDebug("Cache in : " + PBMap\Options\HDDCachePath + " cleared", 3)
|
|
CreateDirectoryEx(PBMap\Options\HDDCachePath)
|
|
ProcedureReturn #True
|
|
Else
|
|
MyDebug("Can't clear cache in " + PBMap\Options\HDDCachePath, 3)
|
|
ProcedureReturn #False
|
|
EndIf
|
|
EndProcedure
|
|
|
|
;-*** Main PBMap functions
|
|
|
|
Procedure CanvasEvents()
|
|
Protected CanvasMouseX.d, CanvasMouseY.d, MouseX.d, MouseY.d
|
|
Protected MarkerCoords.PixelCoordinates, *Tile.Tile, MapWidth = Pow(2, PBMap\Zoom) * PBMap\TileSize
|
|
Protected key.s, Touch.i
|
|
Protected Pixel.PixelCoordinates
|
|
Static CtrlKey
|
|
Protected Location.GeographicCoordinates
|
|
CanvasMouseX = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) - PBMap\Drawing\RadiusX
|
|
CanvasMouseY = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY) - PBMap\Drawing\RadiusY
|
|
; rotation wip
|
|
; StartVectorDrawing(CanvasVectorOutput(PBMap\Gadget))
|
|
; RotateCoordinates(0, 0, PBMap\Angle)
|
|
; CanvasMouseX = ConvertCoordinateX(MouseX, MouseY, #PB_Coordinate_Device, #PB_Coordinate_User)
|
|
; CanvasMouseY = ConvertCoordinateY(MouseX, MouseY, #PB_Coordinate_Device, #PB_Coordinate_User)
|
|
; StopVectorDrawing()
|
|
Select EventType()
|
|
Case #PB_EventType_Focus
|
|
PBMap\Drawing\RadiusX = GadgetWidth(PBMap\Gadget) / 2
|
|
PBMap\Drawing\RadiusY = GadgetHeight(PBMap\Gadget) / 2
|
|
Case #PB_EventType_KeyUp
|
|
Select GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_Key)
|
|
Case #PB_Shortcut_Delete
|
|
DeleteSelectedMarkers()
|
|
DeleteSelectedTracks()
|
|
EndSelect
|
|
PBMap\Redraw = #True
|
|
If GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_Modifiers)&#PB_Canvas_Control = 0
|
|
CtrlKey = #False
|
|
EndIf
|
|
Case #PB_EventType_KeyDown
|
|
With PBMap\Markers()
|
|
Select GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_Key)
|
|
Case #PB_Shortcut_Left
|
|
ForEach PBMap\Markers()
|
|
If \Selected
|
|
\GeographicCoordinates\Longitude = ClipLongitude( \GeographicCoordinates\Longitude - 10* 360 / Pow(2, PBMap\Zoom + 8))
|
|
EndIf
|
|
Next
|
|
Case #PB_Shortcut_Up
|
|
ForEach PBMap\Markers()
|
|
If \Selected
|
|
\GeographicCoordinates\Latitude + 10* 360 / Pow(2, PBMap\Zoom + 8)
|
|
EndIf
|
|
Next
|
|
Case #PB_Shortcut_Right
|
|
ForEach PBMap\Markers()
|
|
If \Selected
|
|
\GeographicCoordinates\Longitude = ClipLongitude( \GeographicCoordinates\Longitude + 10* 360 / Pow(2, PBMap\Zoom + 8))
|
|
EndIf
|
|
Next
|
|
Case #PB_Shortcut_Down
|
|
ForEach PBMap\Markers()
|
|
If \Selected
|
|
\GeographicCoordinates\Latitude - 10* 360 / Pow(2, PBMap\Zoom + 8)
|
|
EndIf
|
|
Next
|
|
EndSelect
|
|
EndWith
|
|
PBMap\Redraw = #True
|
|
If GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_Modifiers)&#PB_Canvas_Control <> 0
|
|
CtrlKey = #True
|
|
EndIf
|
|
Case #PB_EventType_LeftDoubleClick
|
|
LatLon2Pixel(@PBMap\GeographicCoordinates, @PBMap\PixelCoordinates, PBMap\Zoom)
|
|
MouseX = PBMap\PixelCoordinates\x + CanvasMouseX
|
|
MouseY = PBMap\PixelCoordinates\y + CanvasMouseY
|
|
; Clip MouseX to the map range (in X, the map is infinite)
|
|
MouseX = Mod(Mod(MouseX, MapWidth) + MapWidth, MapWidth)
|
|
Touch = #False
|
|
; Check if the mouse touch a marker
|
|
ForEach PBMap\Markers()
|
|
LatLon2Pixel(@PBMap\Markers()\GeographicCoordinates, @MarkerCoords, PBMap\Zoom)
|
|
If Distance(MarkerCoords\x, MarkerCoords\y, MouseX, MouseY) < 8
|
|
If PBMap\Mode = #MODE_DEFAULT Or PBMap\Mode = #MODE_SELECT
|
|
; Jump to the marker
|
|
Touch = #True
|
|
SetLocation(PBMap\Markers()\GeographicCoordinates\Latitude, PBMap\Markers()\GeographicCoordinates\Longitude)
|
|
ElseIf PBMap\Mode = #MODE_EDIT
|
|
; Edit the legend
|
|
MarkerEdit(@PBMap\Markers())
|
|
EndIf
|
|
Break
|
|
EndIf
|
|
Next
|
|
If Not Touch
|
|
GotoPixel(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))
|
|
Else
|
|
; Absolute zoom (centered on the center of the map)
|
|
SetZoom(GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_WheelDelta), #PB_Relative)
|
|
EndIf
|
|
Case #PB_EventType_LeftButtonDown
|
|
; LatLon2Pixel(@PBMap\GeographicCoordinates, @PBMap\PixelCoordinates, PBMap\Zoom)
|
|
PBMap\Dragging = #True
|
|
; Memorize cursor Coord
|
|
PBMap\MoveStartingPoint\x = CanvasMouseX
|
|
PBMap\MoveStartingPoint\y = CanvasMouseY
|
|
; Clip MouseX to the map range (in X, the map is infinite)
|
|
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()
|
|
If CtrlKey = #False
|
|
PBMap\Markers()\Selected = #False ; If no CTRL key, deselect everything and select only the focused marker
|
|
EndIf
|
|
If PBMap\Markers()\Focus
|
|
PBMap\Markers()\Selected = #True
|
|
PBMap\EditMarker = #True; ListIndex(PBMap\Markers())
|
|
PBMap\Markers()\Focus = #False
|
|
EndIf
|
|
Next
|
|
; Check if we select track(s)
|
|
ForEach PBMap\TracksList()
|
|
If CtrlKey = #False
|
|
PBMap\TracksList()\Selected = #False ; If no CTRL key, deselect everything and select only the focused track
|
|
EndIf
|
|
If PBMap\TracksList()\Focus
|
|
PBMap\TracksList()\Selected = #True
|
|
PBMap\TracksList()\Focus = #False
|
|
EndIf
|
|
Next
|
|
EndIf
|
|
; 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
|
|
; 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)
|
|
MarkerCoords\x + MouseX
|
|
MarkerCoords\y + MouseY
|
|
Pixel2LatLon(@MarkerCoords, @PBMap\Markers()\GeographicCoordinates, PBMap\Zoom)
|
|
EndIf
|
|
Next
|
|
ElseIf PBMap\Mode = #MODE_DEFAULT Or PBMap\Mode = #MODE_HAND
|
|
; Move map only
|
|
LatLon2Pixel(@PBMap\GeographicCoordinates, @PBMap\PixelCoordinates, PBMap\Zoom) ; This line could be removed as the coordinates don't have to change but I want to be sure we rely only on geographic coordinates
|
|
PBMap\PixelCoordinates\x - MouseX
|
|
; Ensures that pixel position stay in the range [0..2^Zoom*PBMap\TileSize[ coz of the wrapping of the map
|
|
PBMap\PixelCoordinates\x = Mod(Mod(PBMap\PixelCoordinates\x, MapWidth) + MapWidth, MapWidth)
|
|
PBMap\PixelCoordinates\y - MouseY
|
|
Pixel2LatLon(@PBMap\PixelCoordinates, @PBMap\GeographicCoordinates, PBMap\Zoom)
|
|
; If CallBackLocation send Location to function
|
|
If PBMap\CallBackLocation > 0
|
|
CallFunctionFast(PBMap\CallBackLocation, @PBMap\GeographicCoordinates)
|
|
EndIf
|
|
EndIf
|
|
PBMap\Redraw = #True
|
|
Else
|
|
; Touch test
|
|
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
|
|
; 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
|
|
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()
|
|
; 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
|
|
StopVectorDrawing()
|
|
EndIf
|
|
EndIf
|
|
Next
|
|
EndIf
|
|
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)
|
|
CallFunctionFast(PBMap\CallBackMarker, @PBMap\Markers());
|
|
EndIf
|
|
EndIf
|
|
Next
|
|
Case #PB_MAP_REDRAW
|
|
PBMap\Redraw = #True
|
|
Case #PB_MAP_RETRY
|
|
PBMap\Redraw = #True
|
|
;- Tile web loading thread cleanup
|
|
; After a Web tile loading thread, clean the tile structure memory, see GetImageThread()
|
|
Case #PB_MAP_TILE_CLEANUP
|
|
*Tile = EventData()
|
|
key = *Tile\key
|
|
*Tile\Download = 0
|
|
If FindMapElement(PBMap\MemCache\Images(), key) <> 0
|
|
; If the map element has not been deleted during the thread lifetime (should not occur)
|
|
PBMap\MemCache\Images(key)\Tile = *Tile\Size
|
|
If *Tile\Size
|
|
PBMap\MemCache\Images(key)\Tile = -1 ; Web loading thread has finished successfully
|
|
Else
|
|
PBMap\MemCache\Images(key)\Tile = 0
|
|
EndIf
|
|
EndIf
|
|
FreeMemory(*Tile) ; Frees the data needed for the thread (*tile=PBMap\MemCache\Images(key)\Tile)
|
|
PBMap\ThreadsNB - 1
|
|
PBMap\DownloadSlots - 1
|
|
PBMap\Redraw = #True
|
|
EndSelect
|
|
EndProcedure
|
|
|
|
; Redraws at regular intervals
|
|
Procedure TimerEvents()
|
|
If EventTimer() = PBMap\Timer And (PBMap\Redraw Or PBMap\Dirty)
|
|
MemoryCacheManagement()
|
|
Drawing()
|
|
EndIf
|
|
EndProcedure
|
|
|
|
; Could be called directly to attach our map to an existing canvas
|
|
Procedure BindMapGadget(Gadget.i)
|
|
PBMap\Gadget = Gadget
|
|
BindGadgetEvent(PBMap\Gadget, @CanvasEvents())
|
|
AddWindowTimer(PBMap\Window, PBMap\Timer, PBMap\Options\TimerInterval)
|
|
BindEvent(#PB_Event_Timer, @TimerEvents())
|
|
PBMap\Drawing\RadiusX = GadgetWidth(PBMap\Gadget) / 2
|
|
PBMap\Drawing\RadiusY = GadgetHeight(PBMap\Gadget) / 2
|
|
EndProcedure
|
|
|
|
; Creates a canvas and attach our map
|
|
Procedure MapGadget(Gadget.i, X.i, Y.i, Width.i, Height.i)
|
|
If Gadget = #PB_Any
|
|
PBMap\Gadget = CanvasGadget(PBMap\Gadget, X, Y, Width, Height, #PB_Canvas_Keyboard) ; #PB_Canvas_Keyboard has to be set for mousewheel to work on windows
|
|
Else
|
|
PBMap\Gadget = Gadget
|
|
CanvasGadget(PBMap\Gadget, X, Y, Width, Height, #PB_Canvas_Keyboard)
|
|
EndIf
|
|
BindMapGadget(PBMap\Gadget)
|
|
EndProcedure
|
|
|
|
Procedure Quit()
|
|
PBMap\Drawing\End = #True
|
|
; Wait for loading threads to finish nicely. Passed 2 seconds, kills them.
|
|
Protected TimeCounter = ElapsedMilliseconds()
|
|
Repeat
|
|
ForEach PBMap\MemCache\Images()
|
|
If PBMap\MemCache\Images()\Tile > 0
|
|
If IsThread(PBMap\MemCache\Images()\Tile\GetImageThread)
|
|
If ElapsedMilliseconds() - TimeCounter > 2000
|
|
; Should not occur
|
|
KillThread(PBMap\MemCache\Images()\Tile\GetImageThread)
|
|
EndIf
|
|
Else
|
|
FreeMemory(PBMap\MemCache\Images()\Tile)
|
|
PBMap\MemCache\Images()\Tile = 0
|
|
EndIf
|
|
Else
|
|
DeleteMapElement(PBMap\MemCache\Images())
|
|
EndIf
|
|
Next
|
|
Delay(10)
|
|
Until MapSize(PBMap\MemCache\Images()) = 0
|
|
EndProcedure
|
|
|
|
Procedure InitPBMap(Window)
|
|
With PBMap
|
|
Protected Result.i
|
|
\ZoomMin = 1
|
|
\ZoomMax = 18
|
|
\Dragging = #False
|
|
\TileSize = 256
|
|
\Dirty = #False
|
|
\EditMarker = #False
|
|
\Font = LoadFont(#PB_Any, "Arial", 20, #PB_Font_Bold)
|
|
\Window = Window
|
|
\Timer = 1
|
|
\Mode = #MODE_DEFAULT
|
|
\MemoryCacheAccessMutex = CreateMutex()
|
|
If \MemoryCacheAccessMutex = #False
|
|
MyDebug("Cannot create a mutex", 0)
|
|
End
|
|
EndIf
|
|
EndWith
|
|
LoadOptions()
|
|
TechnicalImagesCreation()
|
|
SetLocation(0, 0)
|
|
EndProcedure
|
|
|
|
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
|
|
|
|
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()
|
|
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
|
|
|
|
; Our main gadget
|
|
PBMap::InitPBMap(#Window_0)
|
|
PBMap::SetOption("ShowDegrees", "1") : Degrees = 0
|
|
PBMap::SetOption("ShowDebugInfos", "0")
|
|
PBMap::SetDebugLevel(5)
|
|
PBMap::SetOption("Verbose", "0")
|
|
PBMap::SetOption("ShowScale", "1")
|
|
PBMap::SetOption("Warning", "1")
|
|
PBMap::SetOption("ShowMarkersLegend", "1")
|
|
PBMap::SetOption("ShowTrackKms", "1")
|
|
PBMap::SetOption("ColourFocus", "$FFFF00AA")
|
|
PBMap::MapGadget(#Map, 10, 10, 512, 512)
|
|
PBMap::SetCallBackMainPointer(@MainPointer()) ; To change the main pointer (center of the view)
|
|
PBMap::SetCallBackLocation(@UpdateLocation()) ; To obtain realtime coordinates
|
|
PBMap::SetLocation(-36.81148, 175.08634,12) ; Change the PBMap coordinates
|
|
PBMAP::SetMapScaleUnit(PBMAP::#SCALE_KM) ; To change the scale unit
|
|
PBMap::AddMarker(49.0446828398, 2.0349812508, "", "", -1, @MyMarker()) ; To add a marker with a customised GFX
|
|
PBMap::SetCallBackMarker(@MarkerMoveCallBack())
|
|
|
|
Repeat
|
|
Event = WaitWindowEvent()
|
|
Select Event
|
|
Case #PB_Event_CloseWindow : Quit = 1
|
|
Case #PB_Event_Gadget ; {
|
|
Gadget = EventGadget()
|
|
Select Gadget
|
|
Case #Gdt_Up
|
|
PBMap::SetLocation(10* 360 / Pow(2, PBMap::GetZoom() + 8), 0, 0, #PB_Relative)
|
|
Case #Gdt_Down
|
|
PBMap::SetLocation(10* -360 / Pow(2, PBMap::GetZoom() + 8), 0, 0, #PB_Relative)
|
|
Case #Gdt_Left
|
|
PBMap::SetLocation(0, 10* -360 / Pow(2, PBMap::GetZoom() + 8), 0, #PB_Relative)
|
|
Case #Gdt_Right
|
|
PBMap::SetLocation(0, 10* 360 / Pow(2, PBMap::GetZoom() + 8), 0, #PB_Relative)
|
|
; Case #Gdt_RotateLeft
|
|
; PBMAP::SetAngle(-5,#PB_Relative)
|
|
; PBMap::Refresh()
|
|
; Case #Gdt_RotateRight
|
|
; PBMAP::SetAngle(5,#PB_Relative)
|
|
; PBMap::Refresh()
|
|
Case #Button_4
|
|
PBMap::SetZoom(1)
|
|
Case #Button_5
|
|
PBMap::SetZoom( - 1)
|
|
Case #Gdt_LoadGpx
|
|
*Track = PBMap::LoadGpxFile(OpenFileRequester("Choose a file to load", "", "Gpx|*.gpx", 0))
|
|
PBMap::SetTrackColour(*Track, RGBA(Random(255), Random(255), Random(255), 128))
|
|
Case #Gdt_SaveGpx
|
|
If *Track
|
|
If PBMap::SaveGpxFile(SaveFileRequester("Choose a filename", "mytrack.gpx", "Gpx|*.gpx", 0), *Track)
|
|
MessageRequester("PBMap", "Saving OK !", #PB_MessageRequester_Ok)
|
|
Else
|
|
MessageRequester("PBMap", "Problem while saving.", #PB_MessageRequester_Ok)
|
|
EndIf
|
|
Else
|
|
MessageRequester("PBMap", "No track to save.", #PB_MessageRequester_Ok)
|
|
EndIf
|
|
Case #StringLatitude, #StringLongitude
|
|
Select EventType()
|
|
Case #PB_EventType_Focus
|
|
AddKeyboardShortcut(#Window_0, #PB_Shortcut_Return, #MenuEventLonLatStringEnter)
|
|
Case #PB_EventType_LostFocus
|
|
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))
|
|
Case #Gdt_AddOpenseaMap
|
|
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 PBMap::IsLayer("Here")
|
|
PBMap::DeleteLayer("Here")
|
|
SetGadgetState(#Gdt_AddHereMap, 0)
|
|
Else
|
|
If PBMap::GetOption("appid") <> "" And PBMap::GetOption("appcode") <> ""
|
|
PBMap::AddHereServerLayer("Here", 2) ; Add a "HERE" overlay map on layer nb 2
|
|
PBMap::SetLayerAlpha("Here", 0.75)
|
|
Else
|
|
MessageRequester("Info", "Don't forget to register on HERE and change the following line or edit options file")
|
|
PBMap::AddHereServerLayer("Here", 2, "my_id", "my_code") ; Add a here overlay map on layer nb 2
|
|
EndIf
|
|
SetGadgetState(#Gdt_AddHereMap, 1)
|
|
EndIf
|
|
PBMap::Refresh()
|
|
Case #Gdt_AddGeoServerMap
|
|
If PBMap::IsLayer("GeoServer")
|
|
PBMap::DeleteLayer("GeoServer")
|
|
SetGadgetState(#Gdt_AddGeoServerMap, 0)
|
|
Else
|
|
PBMap::AddGeoServerLayer("GeoServer", 3, "demolayer", "http://localhost:8080/", "geowebcache/service/gmaps", "image/png") ; Add a geoserver overlay map on layer nb 3
|
|
PBMap::SetLayerAlpha("GeoServer", 0.75)
|
|
SetGadgetState(#Gdt_AddGeoServerMap, 1)
|
|
EndIf
|
|
PBMap::Refresh()
|
|
Case #Gdt_Degrees
|
|
Degrees = 1 - Degrees
|
|
PBMap::SetOption("ShowDegrees", Str(Degrees))
|
|
PBMap::Refresh()
|
|
SetGadgetState(#Gdt_Degrees, Degrees)
|
|
Case #Gdt_EditMode
|
|
If PBMap::GetMode() <> PBMap::#MODE_EDIT
|
|
PBMap::SetMode(PBMap::#MODE_EDIT)
|
|
SetGadgetState(#Gdt_EditMode, 1)
|
|
Else
|
|
PBMap::SetMode(PBMap::#MODE_DEFAULT)
|
|
SetGadgetState(#Gdt_EditMode, 0)
|
|
EndIf
|
|
Case #Gdt_ClearDiskCache
|
|
PBMap::ClearDiskCache()
|
|
Case #StringGeoLocationQuery
|
|
Select EventType()
|
|
Case #PB_EventType_Focus
|
|
AddKeyboardShortcut(#Window_0, #PB_Shortcut_Return, #MenuEventGeoLocationStringEnter)
|
|
Case #PB_EventType_LostFocus
|
|
RemoveKeyboardShortcut(#Window_0, #PB_Shortcut_Return)
|
|
EndSelect
|
|
EndSelect
|
|
Case #PB_Event_SizeWindow
|
|
ResizeAll()
|
|
Case #PB_Event_Menu
|
|
; Receive "enter" key events
|
|
Select EventMenu()
|
|
Case #MenuEventGeoLocationStringEnter
|
|
If GetGadgetText(#StringGeoLocationQuery) <> ""
|
|
PBMap::NominatimGeoLocationQuery(GetGadgetText(#StringGeoLocationQuery))
|
|
PBMap::Refresh()
|
|
EndIf
|
|
; *** TODO : code to change when the SetActiveGadget(-1) will be fixed
|
|
SetActiveGadget(Dummy)
|
|
; ***
|
|
Case #MenuEventLonLatStringEnter
|
|
PBMap::SetLocation(ValD(GetGadgetText(#StringLatitude)), ValD(GetGadgetText(#StringLongitude))) ; Change the PBMap coordinates
|
|
PBMap::Refresh()
|
|
EndSelect
|
|
EndSelect
|
|
Until Quit = #True
|
|
|
|
PBMap::Quit()
|
|
EndIf
|
|
|
|
CompilerEndIf
|
|
|
|
; IDE Options = PureBasic 5.60 (Windows - x86)
|
|
; CursorPosition = 2821
|
|
; FirstLine = 2780
|
|
; Folding = --------------------
|
|
; EnableThread
|
|
; EnableXP
|
|
; CompileSourceDirectory
|
|
; DisablePurifier = 1,1,1,1 |