Sub Class_Globals
Private Root As B4XView
Private xui As XUI
Type VerticalLine (X As Int, YTop As Int, YBottom As Int)
Type HorizontalLine (Y As Int, XLeft As Int, XRight As Int)
Private Pane1 As B4XView
Private Pane2 As B4XView
Private cvs1, cvs2 As B4XCanvas
Private VerticalLines, HorizontalLines As List
Private Scale As Float = 20
Private LineColor As Int = xui.Color_Red
Private LineStroke As Int = 2dip
Private SquaresSet As B4XSet
End Sub
Public Sub Initialize
End Sub
Private Sub B4XPage_Created (Root1 As B4XView)
Root = Root1
Root.LoadLayout("MainPage")
cvs1.Initialize(Pane1)
cvs2.Initialize(Pane2)
VerticalLines.Initialize
HorizontalLines.Initialize
SquaresSet.Initialize
AddSquare(1, 1)
AddSquare(2, 1)
AddSquare(2, 2)
AddSquare(3, 2)
AddSquare(3, 3)
AddSquare(4, 2)
AddSquare(5, 2)
AddSquare(5, 1)
DrawRegular
DrawBoundaries
End Sub
Private Sub AddSquare (Left As Int, Top As Int)
VerticalLines.Add(CreateVerticalLine(Left, Top, Top + 1))
VerticalLines.Add(CreateVerticalLine(Left + 1, Top, Top + 1))
HorizontalLines.Add(CreateHorizontalLine(Top, Left, Left + 1))
HorizontalLines.Add(CreateHorizontalLine(Top + 1, Left, Left + 1))
SquaresSet.Add(Left & "," & Top)
End Sub
Private Sub DrawRegular
cvs1.ClearRect(cvs1.TargetRect)
For Each vl As VerticalLine In VerticalLines
DrawVerticalLine(cvs1, vl)
Next
For Each hl As HorizontalLine In HorizontalLines
DrawHorizontalLine(cvs1, hl)
Next
cvs1.Invalidate
End Sub
Private Sub DrawBoundaries
VerticalLines.SortType("X", True)
HorizontalLines.SortType("Y", True)
cvs2.ClearRect(cvs2.TargetRect)
Dim r As B4XRect = FindBoundingRect
For y = r.Top To r.Bottom
Dim Inside As Boolean = False
For Each vl As VerticalLine In VerticalLines
If vl.YTop <> y Then Continue 'a line not on this row
If IsSquareInSet(vl.X, y) Then
If Inside = False Then
Inside = True
DrawVerticalLine(cvs2, vl)
End If
Else
Inside = False
DrawVerticalLine(cvs2, vl)
End If
Next
Next
For x = r.Left To r.Right
Dim Inside As Boolean = False
For Each hl As HorizontalLine In HorizontalLines
If hl.XLeft <> x Then Continue
If IsSquareInSet(x, hl.Y) Then
If Inside = False Then
Inside = True
DrawHorizontalLine(cvs2, hl)
End If
Else
Inside = False
DrawHorizontalLine(cvs2, hl)
End If
Next
Next
cvs2.Invalidate
End Sub
Private Sub IsSquareInSet(Left As Int, Top As Int) As Boolean
Return SquaresSet.Contains(Left & "," & Top)
End Sub
Private Sub DrawVerticalLine (cvs As B4XCanvas, vl As VerticalLine)
cvs.DrawLine(vl.X * Scale, vl.YTop * Scale, vl.X * Scale, vl.YBottom * Scale, LineColor, LineStroke)
End Sub
Private Sub DrawHorizontalLine (cvs As B4XCanvas, hl As HorizontalLine)
cvs.DrawLine(hl.XLeft * Scale, hl.Y * Scale, hl.XRight * Scale, hl.Y * Scale, LineColor, LineStroke)
End Sub
Private Sub FindBoundingRect As B4XRect
Dim r As B4XRect
r.Initialize(0x7fffffff, 0x7fffffff, 0, 0)
For Each vl As VerticalLine In VerticalLines
r.Left = Min(r.Left, vl.X)
r.Right = Max(r.Right, vl.X)
r.Top = Min(r.Top, vl.YTop)
r.Bottom = Max(r.Bottom, vl.YBottom)
Next
Return r
End Sub
Public Sub CreateHorizontalLine (Y As Int, XLeft As Int, XRight As Int) As HorizontalLine
Dim t1 As HorizontalLine
t1.Initialize
t1.Y = Y
t1.XLeft = XLeft
t1.XRight = XRight
Return t1
End Sub
Public Sub CreateVerticalLine (X As Int, YTop As Int, YBottom As Int) As VerticalLine
Dim t1 As VerticalLine
t1.Initialize
t1.X = X
t1.YTop = YTop
t1.YBottom = YBottom
Return t1
End Sub
Private Sub Pane1_Touch (Action As Int, X As Float, Y As Float)
If Action = Pane1.TOUCH_ACTION_UP Then
Dim NormalizedX As Int = x / Scale
Dim NormalizedY As Int = y / Scale
If IsSquareInSet(NormalizedX, NormalizedY) Then Return
AddSquare(NormalizedX, NormalizedY)
DrawRegular
DrawBoundaries
End If
End Sub
Thanks for that, will try that out now.Not tested too much:
View attachment 154085
B4X:Sub Class_Globals Private Root As B4XView Private xui As XUI Type VerticalLine (X As Int, YTop As Int, YBottom As Int) Type HorizontalLine (Y As Int, XLeft As Int, XRight As Int) Private Pane1 As B4XView Private Pane2 As B4XView Private cvs1, cvs2 As B4XCanvas Private VerticalLines, HorizontalLines As List Private Scale As Float = 20 Private LineColor As Int = xui.Color_Red Private LineStroke As Int = 2dip Private SquaresSet As B4XSet End Sub Public Sub Initialize End Sub Private Sub B4XPage_Created (Root1 As B4XView) Root = Root1 Root.LoadLayout("MainPage") cvs1.Initialize(Pane1) cvs2.Initialize(Pane2) VerticalLines.Initialize HorizontalLines.Initialize SquaresSet.Initialize AddSquare(1, 1) AddSquare(2, 1) AddSquare(2, 2) AddSquare(3, 2) AddSquare(3, 3) AddSquare(4, 2) AddSquare(5, 2) AddSquare(5, 1) DrawRegular DrawBoundaries End Sub Private Sub AddSquare (Left As Int, Top As Int) VerticalLines.Add(CreateVerticalLine(Left, Top, Top + 1)) VerticalLines.Add(CreateVerticalLine(Left + 1, Top, Top + 1)) HorizontalLines.Add(CreateHorizontalLine(Top, Left, Left + 1)) HorizontalLines.Add(CreateHorizontalLine(Top + 1, Left, Left + 1)) SquaresSet.Add(Left & "," & Top) End Sub Private Sub DrawRegular cvs1.ClearRect(cvs1.TargetRect) For Each vl As VerticalLine In VerticalLines DrawVerticalLine(cvs1, vl) Next For Each hl As HorizontalLine In HorizontalLines DrawHorizontalLine(cvs1, hl) Next cvs1.Invalidate End Sub Private Sub DrawBoundaries VerticalLines.SortType("X", True) HorizontalLines.SortType("Y", True) cvs2.ClearRect(cvs2.TargetRect) Dim r As B4XRect = FindBoundingRect For y = r.Top To r.Bottom Dim Inside As Boolean = False For Each vl As VerticalLine In VerticalLines If vl.YTop <> y Then Continue 'a line not on this row If IsSquareInSet(vl.X, y) Then If Inside = False Then Inside = True DrawVerticalLine(cvs2, vl) End If Else Inside = False DrawVerticalLine(cvs2, vl) End If Next Next For x = r.Left To r.Right Dim Inside As Boolean = False For Each hl As HorizontalLine In HorizontalLines If hl.XLeft <> x Then Continue If IsSquareInSet(x, hl.Y) Then If Inside = False Then Inside = True DrawHorizontalLine(cvs2, hl) End If Else Inside = False DrawHorizontalLine(cvs2, hl) End If Next Next cvs2.Invalidate End Sub Private Sub IsSquareInSet(Left As Int, Top As Int) As Boolean Return SquaresSet.Contains(Left & "," & Top) End Sub Private Sub DrawVerticalLine (cvs As B4XCanvas, vl As VerticalLine) cvs.DrawLine(vl.X * Scale, vl.YTop * Scale, vl.X * Scale, vl.YBottom * Scale, LineColor, LineStroke) End Sub Private Sub DrawHorizontalLine (cvs As B4XCanvas, hl As HorizontalLine) cvs.DrawLine(hl.XLeft * Scale, hl.Y * Scale, hl.XRight * Scale, hl.Y * Scale, LineColor, LineStroke) End Sub Private Sub FindBoundingRect As B4XRect Dim r As B4XRect r.Initialize(0x7fffffff, 0x7fffffff, 0, 0) For Each vl As VerticalLine In VerticalLines r.Left = Min(r.Left, vl.X) r.Right = Max(r.Right, vl.X) r.Top = Min(r.Top, vl.YTop) r.Bottom = Max(r.Bottom, vl.YBottom) Next Return r End Sub Public Sub CreateHorizontalLine (Y As Int, XLeft As Int, XRight As Int) As HorizontalLine Dim t1 As HorizontalLine t1.Initialize t1.Y = Y t1.XLeft = XLeft t1.XRight = XRight Return t1 End Sub Public Sub CreateVerticalLine (X As Int, YTop As Int, YBottom As Int) As VerticalLine Dim t1 As VerticalLine t1.Initialize t1.X = X t1.YTop = YTop t1.YBottom = YBottom Return t1 End Sub
B4J implementation is attached.
Not tested too much:
View attachment 154085
B4X:Sub Class_Globals Private Root As B4XView Private xui As XUI Type VerticalLine (X As Int, YTop As Int, YBottom As Int) Type HorizontalLine (Y As Int, XLeft As Int, XRight As Int) Private Pane1 As B4XView Private Pane2 As B4XView Private cvs1, cvs2 As B4XCanvas Private VerticalLines, HorizontalLines As List Private Scale As Float = 20 Private LineColor As Int = xui.Color_Red Private LineStroke As Int = 2dip Private SquaresSet As B4XSet End Sub Public Sub Initialize End Sub Private Sub B4XPage_Created (Root1 As B4XView) Root = Root1 Root.LoadLayout("MainPage") cvs1.Initialize(Pane1) cvs2.Initialize(Pane2) VerticalLines.Initialize HorizontalLines.Initialize SquaresSet.Initialize AddSquare(1, 1) AddSquare(2, 1) AddSquare(2, 2) AddSquare(3, 2) AddSquare(3, 3) AddSquare(4, 2) AddSquare(5, 2) AddSquare(5, 1) DrawRegular DrawBoundaries End Sub Private Sub AddSquare (Left As Int, Top As Int) VerticalLines.Add(CreateVerticalLine(Left, Top, Top + 1)) VerticalLines.Add(CreateVerticalLine(Left + 1, Top, Top + 1)) HorizontalLines.Add(CreateHorizontalLine(Top, Left, Left + 1)) HorizontalLines.Add(CreateHorizontalLine(Top + 1, Left, Left + 1)) SquaresSet.Add(Left & "," & Top) End Sub Private Sub DrawRegular cvs1.ClearRect(cvs1.TargetRect) For Each vl As VerticalLine In VerticalLines DrawVerticalLine(cvs1, vl) Next For Each hl As HorizontalLine In HorizontalLines DrawHorizontalLine(cvs1, hl) Next cvs1.Invalidate End Sub Private Sub DrawBoundaries VerticalLines.SortType("X", True) HorizontalLines.SortType("Y", True) cvs2.ClearRect(cvs2.TargetRect) Dim r As B4XRect = FindBoundingRect For y = r.Top To r.Bottom Dim Inside As Boolean = False For Each vl As VerticalLine In VerticalLines If vl.YTop <> y Then Continue 'a line not on this row If IsSquareInSet(vl.X, y) Then If Inside = False Then Inside = True DrawVerticalLine(cvs2, vl) End If Else Inside = False DrawVerticalLine(cvs2, vl) End If Next Next For x = r.Left To r.Right Dim Inside As Boolean = False For Each hl As HorizontalLine In HorizontalLines If hl.XLeft <> x Then Continue If IsSquareInSet(x, hl.Y) Then If Inside = False Then Inside = True DrawHorizontalLine(cvs2, hl) End If Else Inside = False DrawHorizontalLine(cvs2, hl) End If Next Next cvs2.Invalidate End Sub Private Sub IsSquareInSet(Left As Int, Top As Int) As Boolean Return SquaresSet.Contains(Left & "," & Top) End Sub Private Sub DrawVerticalLine (cvs As B4XCanvas, vl As VerticalLine) cvs.DrawLine(vl.X * Scale, vl.YTop * Scale, vl.X * Scale, vl.YBottom * Scale, LineColor, LineStroke) End Sub Private Sub DrawHorizontalLine (cvs As B4XCanvas, hl As HorizontalLine) cvs.DrawLine(hl.XLeft * Scale, hl.Y * Scale, hl.XRight * Scale, hl.Y * Scale, LineColor, LineStroke) End Sub Private Sub FindBoundingRect As B4XRect Dim r As B4XRect r.Initialize(0x7fffffff, 0x7fffffff, 0, 0) For Each vl As VerticalLine In VerticalLines r.Left = Min(r.Left, vl.X) r.Right = Max(r.Right, vl.X) r.Top = Min(r.Top, vl.YTop) r.Bottom = Max(r.Bottom, vl.YBottom) Next Return r End Sub Public Sub CreateHorizontalLine (Y As Int, XLeft As Int, XRight As Int) As HorizontalLine Dim t1 As HorizontalLine t1.Initialize t1.Y = Y t1.XLeft = XLeft t1.XRight = XRight Return t1 End Sub Public Sub CreateVerticalLine (X As Int, YTop As Int, YBottom As Int) As VerticalLine Dim t1 As VerticalLine t1.Initialize t1.X = X t1.YTop = YTop t1.YBottom = YBottom Return t1 End Sub
B4J implementation is attached.
Type TMapTileXY(fX As Long, fY As Long)
Type TMapLatLng(fLat As Double, fLng As Double)
Type tBorderPointTypes(iTopLine As Int, _
iRightLine As Int, _
iBottomLine As Int, _
iLeftLine As Int, _
iLeftTopCorner90 As Int, _
iRightTopCorner90 As Int, _
iRightBottomCorner90 As Int, _
iLeftBottomCorner90 As Int, _
iLeftTopCorner270 As Int, _
iRightTopCorner270 As Int, _
iRightBottomCorner270 As Int, _
iLeftBottomCorner270 As Int, _
iLeftTopAndRightBottomTouchingAtCornerOnly As Int, _
iRightTopAndLeftBottomTouchingAtCornerOnly As Int, _
iNotAtEdge As Int)
Public eBorderPointTypes As tBorderPointTypes
eBorderPointTypes.iTopLine = 0
eBorderPointTypes.iRightLine = 1
eBorderPointTypes.iBottomLine = 2
eBorderPointTypes.iLeftLine = 3
eBorderPointTypes.iLeftTopCorner90 = 4
eBorderPointTypes.iRightTopCorner90 = 5
eBorderPointTypes.iRightBottomCorner90 = 6
eBorderPointTypes.iLeftBottomCorner90 = 7
eBorderPointTypes.iLeftTopCorner270 = 8
eBorderPointTypes.iRightTopCorner270 = 9
eBorderPointTypes.iRightBottomCorner270 = 10
eBorderPointTypes.iLeftBottomCorner270 = 11
eBorderPointTypes.iLeftTopAndRightBottomTouchingAtCornerOnly = 12
eBorderPointTypes.iRightTopAndLeftBottomTouchingAtCornerOnly = 13
eBorderPointTypes.iNotAtEdge = 14
'return a TTileXY from X and Y
Public Sub initTileXY(aX As Long, aY As Long) As TMapTileXY
Dim fTileXY As TMapTileXY
fTileXY.Initialize
fTileXY.fX=aX
fTileXY.fY=aY
Return fTileXY
End Sub
'return a TLatLng from lat/lng
Public Sub initLatLng(aLat As Double,aLng As Double) As TMapLatLng
Dim ll As TMapLatLng
ll.Initialize
ll.fLat=validLat(aLat)
ll.fLng=validLng(aLng)
Return ll
End Sub
Sub GetBorderLinePointType(tMTXY As TMapTileXY, mapTileLookup As Map) As Int
Dim iRightBottom As Int
Dim iLeftBottom As Int
Dim iLeftTop As Int
Dim iRightTop As Int
Dim iPointType As Int
If mapTileLookup.ContainsKey(tMTXY.fX & "_" & tMTXY.fY) Then
iRightBottom = 1
End If
If mapTileLookup.ContainsKey((tMTXY.fX - 1) & "_" & tMTXY.fY) Then
iLeftBottom = 2
End If
If mapTileLookup.ContainsKey((tMTXY.fX - 1) & "_" & (tMTXY.fY - 1)) Then
iLeftTop = 4
End If
If mapTileLookup.ContainsKey(tMTXY.fX & "_" & (tMTXY.fY - 1)) Then
iRightTop = 8
End If
iPointType = iRightBottom + iLeftBottom + iLeftTop + iRightTop
'90 and 270 are to do with the clock-wise rotation and the turn to make at the corner
'------------------------------------------------------------------------------------
Select Case iPointType
Case 1
Return Enums.eBorderPointTypes.iLeftTopCorner90
Case 2
Return Enums.eBorderPointTypes.iRightTopCorner90
Case 3
Return Enums.eBorderPointTypes.iTopLine
Case 4
Return Enums.eBorderPointTypes.iRightBottomCorner90
Case 5
'this is a special case: top left tile and right bottom tile
Return Enums.eBorderPointTypes.iLeftTopAndRightBottomTouchingAtCornerOnly
Case 6
Return Enums.eBorderPointTypes.iRightLine
Case 7
Return Enums.eBorderPointTypes.iRightTopCorner270
Case 8
Return Enums.eBorderPointTypes.iLeftBottomCorner90
Case 9
Return Enums.eBorderPointTypes.iLeftLine
Case 10
'this is a special case: top right tile and left bottom tile
Return Enums.eBorderPointTypes.iRightTopAndLeftBottomTouchingAtCornerOnly
Case 11
Return Enums.eBorderPointTypes.iLeftTopCorner270
Case 12
Return Enums.eBorderPointTypes.iBottomLine
Case 13
Return Enums.eBorderPointTypes.iLeftBottomCorner270
Case 14
Return Enums.eBorderPointTypes.iRightBottomCorner270
Case 15
'all 4 tiles surrounding, so not at an edge, so no line to be drawn
Return Enums.eBorderPointTypes.iNotAtEdge
End Select
Return Enums.eBorderPointTypes.iNotAtEdge
End Sub
Public Sub GetPolygonListFromAreaBorderTiles(tMTXY_Start As TMapTileXY, mapTileLookup As Map, iZoom As Int) As List
Dim tMTXY As TMapTileXY 'indicating the current XY point
Dim lstTilesLatLng As List
Dim iPointType As Int
lstTilesLatLng.Initialize
tMTXY = initTileXY(tMTXY_Start.fX, tMTXY_Start.fY)
Dim tLL As TMapLatLng = Tile2LatLon(tMTXY.fX, tMTXY.fY, iZoom)
lstTilesLatLng.Add(tLL)
Do While True
iPointType = GetBorderLinePointType(tMTXY, mapTileLookup)
Select Case iPointType
Case Enums.eBorderPointTypes.iTopLine
'go right
Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX + 1), tMTXY.fY, iZoom)
lstTilesLatLng.Add(tLL)
tMTXY = initTileXY(tMTXY.fX + 1, tMTXY.fY)
Case Enums.eBorderPointTypes.iRightLine
'go down
Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX), tMTXY.fY + 1, iZoom)
lstTilesLatLng.Add(tLL)
tMTXY = initTileXY(tMTXY.fX, tMTXY.fY + 1)
Case Enums.eBorderPointTypes.iBottomLine
'go left
Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX - 1), tMTXY.fY, iZoom)
lstTilesLatLng.Add(tLL)
tMTXY = initTileXY(tMTXY.fX - 1, tMTXY.fY)
Case Enums.eBorderPointTypes.iLeftLine
'go up
Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX), tMTXY.fY - 1, iZoom)
lstTilesLatLng.Add(tLL)
tMTXY = initTileXY(tMTXY.fX, tMTXY.fY - 1)
Case Enums.eBorderPointTypes.iLeftTopCorner90
'go right
Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX + 1), tMTXY.fY, iZoom)
lstTilesLatLng.Add(tLL)
tMTXY = initTileXY(tMTXY.fX + 1, tMTXY.fY)
Case Enums.eBorderPointTypes.iRightTopCorner90
'go down
Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX), tMTXY.fY + 1, iZoom)
lstTilesLatLng.Add(tLL)
tMTXY = initTileXY(tMTXY.fX, tMTXY.fY + 1)
Case Enums.eBorderPointTypes.iRightBottomCorner90
'go left
Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX - 1), tMTXY.fY, iZoom)
lstTilesLatLng.Add(tLL)
tMTXY = initTileXY(tMTXY.fX - 1, tMTXY.fY)
Case Enums.eBorderPointTypes.iLeftBottomCorner90
'go up
Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX), tMTXY.fY - 1, iZoom)
lstTilesLatLng.Add(tLL)
tMTXY = initTileXY(tMTXY.fX, tMTXY.fY - 1)
Case Enums.eBorderPointTypes.iLeftTopCorner270
'go up
Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX), tMTXY.fY - 1, iZoom)
lstTilesLatLng.Add(tLL)
tMTXY = initTileXY(tMTXY.fX, tMTXY.fY - 1)
Case Enums.eBorderPointTypes.iRightTopCorner270
'go right
Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX + 1), tMTXY.fY, iZoom)
lstTilesLatLng.Add(tLL)
tMTXY = initTileXY(tMTXY.fX + 1, tMTXY.fY)
Case Enums.eBorderPointTypes.iRightBottomCorner270
'go down
Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX), tMTXY.fY + 1, iZoom)
lstTilesLatLng.Add(tLL)
tMTXY = initTileXY(tMTXY.fX, tMTXY.fY + 1)
Case Enums.eBorderPointTypes.iLeftBottomCorner270
'go left
Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX - 1), tMTXY.fY, iZoom)
lstTilesLatLng.Add(tLL)
tMTXY = initTileXY(tMTXY.fX - 1, tMTXY.fY)
Case Enums.eBorderPointTypes.iLeftTopAndRightBottomTouchingAtCornerOnly, Enums.eBorderPointTypes.iRightTopAndLeftBottomTouchingAtCornerOnly
'go to tiles touching point >> may need attention as tMTXY remains the same
Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX - 1), tMTXY.fY, iZoom)
lstTilesLatLng.Add(tLL)
Case Enums.eBorderPointTypes.iNotAtEdge
'no line to draw, so no tLL added to list
End Select
'check for returned to start
If tMTXY.fX = tMTXY_Start.fX Then
If tMTXY.fY = tMTXY_Start.fY Then
Exit
End If
End If
Loop
Return lstTilesLatLng
End Sub
[CODE]
All working fine, but only lightly tested.
RBS
As I need a sequential (so you could walk the border as it is) list of lat/lng types I will stick with my posted code.Said would report back and have done this now in a very different way.
Not sure it is better, but I found it easier to understand the code.
Will later work round Erel's posted code to work with the map class and then compare the two.
Basically this code looks at the type of line edge points and depending of the type does the drawing.
This code doesn't do any drawing but just produces a list of types, holding the latitude and the longitude
to be used for drawing on the map later.
B4X:Type TMapTileXY(fX As Long, fY As Long) Type TMapLatLng(fLat As Double, fLng As Double) Type tBorderPointTypes(iTopLine As Int, _ iRightLine As Int, _ iBottomLine As Int, _ iLeftLine As Int, _ iLeftTopCorner90 As Int, _ iRightTopCorner90 As Int, _ iRightBottomCorner90 As Int, _ iLeftBottomCorner90 As Int, _ iLeftTopCorner270 As Int, _ iRightTopCorner270 As Int, _ iRightBottomCorner270 As Int, _ iLeftBottomCorner270 As Int, _ iLeftTopAndRightBottomTouchingAtCornerOnly As Int, _ iRightTopAndLeftBottomTouchingAtCornerOnly As Int, _ iNotAtEdge As Int) Public eBorderPointTypes As tBorderPointTypes eBorderPointTypes.iTopLine = 0 eBorderPointTypes.iRightLine = 1 eBorderPointTypes.iBottomLine = 2 eBorderPointTypes.iLeftLine = 3 eBorderPointTypes.iLeftTopCorner90 = 4 eBorderPointTypes.iRightTopCorner90 = 5 eBorderPointTypes.iRightBottomCorner90 = 6 eBorderPointTypes.iLeftBottomCorner90 = 7 eBorderPointTypes.iLeftTopCorner270 = 8 eBorderPointTypes.iRightTopCorner270 = 9 eBorderPointTypes.iRightBottomCorner270 = 10 eBorderPointTypes.iLeftBottomCorner270 = 11 eBorderPointTypes.iLeftTopAndRightBottomTouchingAtCornerOnly = 12 eBorderPointTypes.iRightTopAndLeftBottomTouchingAtCornerOnly = 13 eBorderPointTypes.iNotAtEdge = 14 'return a TTileXY from X and Y Public Sub initTileXY(aX As Long, aY As Long) As TMapTileXY Dim fTileXY As TMapTileXY fTileXY.Initialize fTileXY.fX=aX fTileXY.fY=aY Return fTileXY End Sub 'return a TLatLng from lat/lng Public Sub initLatLng(aLat As Double,aLng As Double) As TMapLatLng Dim ll As TMapLatLng ll.Initialize ll.fLat=validLat(aLat) ll.fLng=validLng(aLng) Return ll End Sub Sub GetBorderLinePointType(tMTXY As TMapTileXY, mapTileLookup As Map) As Int Dim iRightBottom As Int Dim iLeftBottom As Int Dim iLeftTop As Int Dim iRightTop As Int Dim iPointType As Int If mapTileLookup.ContainsKey(tMTXY.fX & "_" & tMTXY.fY) Then iRightBottom = 1 End If If mapTileLookup.ContainsKey((tMTXY.fX - 1) & "_" & tMTXY.fY) Then iLeftBottom = 2 End If If mapTileLookup.ContainsKey((tMTXY.fX - 1) & "_" & (tMTXY.fY - 1)) Then iLeftTop = 4 End If If mapTileLookup.ContainsKey(tMTXY.fX & "_" & (tMTXY.fY - 1)) Then iRightTop = 8 End If iPointType = iRightBottom + iLeftBottom + iLeftTop + iRightTop '90 and 270 are to do with the clock-wise rotation and the turn to make at the corner '------------------------------------------------------------------------------------ Select Case iPointType Case 1 Return Enums.eBorderPointTypes.iLeftTopCorner90 Case 2 Return Enums.eBorderPointTypes.iRightTopCorner90 Case 3 Return Enums.eBorderPointTypes.iTopLine Case 4 Return Enums.eBorderPointTypes.iRightBottomCorner90 Case 5 'this is a special case: top left tile and right bottom tile Return Enums.eBorderPointTypes.iLeftTopAndRightBottomTouchingAtCornerOnly Case 6 Return Enums.eBorderPointTypes.iRightLine Case 7 Return Enums.eBorderPointTypes.iRightTopCorner270 Case 8 Return Enums.eBorderPointTypes.iLeftBottomCorner90 Case 9 Return Enums.eBorderPointTypes.iLeftLine Case 10 'this is a special case: top right tile and left bottom tile Return Enums.eBorderPointTypes.iRightTopAndLeftBottomTouchingAtCornerOnly Case 11 Return Enums.eBorderPointTypes.iLeftTopCorner270 Case 12 Return Enums.eBorderPointTypes.iBottomLine Case 13 Return Enums.eBorderPointTypes.iLeftBottomCorner270 Case 14 Return Enums.eBorderPointTypes.iRightBottomCorner270 Case 15 'all 4 tiles surrounding, so not at an edge, so no line to be drawn Return Enums.eBorderPointTypes.iNotAtEdge End Select Return Enums.eBorderPointTypes.iNotAtEdge End Sub Public Sub GetPolygonListFromAreaBorderTiles(tMTXY_Start As TMapTileXY, mapTileLookup As Map, iZoom As Int) As List Dim tMTXY As TMapTileXY 'indicating the current XY point Dim lstTilesLatLng As List Dim iPointType As Int lstTilesLatLng.Initialize tMTXY = initTileXY(tMTXY_Start.fX, tMTXY_Start.fY) Dim tLL As TMapLatLng = Tile2LatLon(tMTXY.fX, tMTXY.fY, iZoom) lstTilesLatLng.Add(tLL) Do While True iPointType = GetBorderLinePointType(tMTXY, mapTileLookup) Select Case iPointType Case Enums.eBorderPointTypes.iTopLine 'go right Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX + 1), tMTXY.fY, iZoom) lstTilesLatLng.Add(tLL) tMTXY = initTileXY(tMTXY.fX + 1, tMTXY.fY) Case Enums.eBorderPointTypes.iRightLine 'go down Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX), tMTXY.fY + 1, iZoom) lstTilesLatLng.Add(tLL) tMTXY = initTileXY(tMTXY.fX, tMTXY.fY + 1) Case Enums.eBorderPointTypes.iBottomLine 'go left Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX - 1), tMTXY.fY, iZoom) lstTilesLatLng.Add(tLL) tMTXY = initTileXY(tMTXY.fX - 1, tMTXY.fY) Case Enums.eBorderPointTypes.iLeftLine 'go up Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX), tMTXY.fY - 1, iZoom) lstTilesLatLng.Add(tLL) tMTXY = initTileXY(tMTXY.fX, tMTXY.fY - 1) Case Enums.eBorderPointTypes.iLeftTopCorner90 'go right Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX + 1), tMTXY.fY, iZoom) lstTilesLatLng.Add(tLL) tMTXY = initTileXY(tMTXY.fX + 1, tMTXY.fY) Case Enums.eBorderPointTypes.iRightTopCorner90 'go down Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX), tMTXY.fY + 1, iZoom) lstTilesLatLng.Add(tLL) tMTXY = initTileXY(tMTXY.fX, tMTXY.fY + 1) Case Enums.eBorderPointTypes.iRightBottomCorner90 'go left Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX - 1), tMTXY.fY, iZoom) lstTilesLatLng.Add(tLL) tMTXY = initTileXY(tMTXY.fX - 1, tMTXY.fY) Case Enums.eBorderPointTypes.iLeftBottomCorner90 'go up Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX), tMTXY.fY - 1, iZoom) lstTilesLatLng.Add(tLL) tMTXY = initTileXY(tMTXY.fX, tMTXY.fY - 1) Case Enums.eBorderPointTypes.iLeftTopCorner270 'go up Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX), tMTXY.fY - 1, iZoom) lstTilesLatLng.Add(tLL) tMTXY = initTileXY(tMTXY.fX, tMTXY.fY - 1) Case Enums.eBorderPointTypes.iRightTopCorner270 'go right Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX + 1), tMTXY.fY, iZoom) lstTilesLatLng.Add(tLL) tMTXY = initTileXY(tMTXY.fX + 1, tMTXY.fY) Case Enums.eBorderPointTypes.iRightBottomCorner270 'go down Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX), tMTXY.fY + 1, iZoom) lstTilesLatLng.Add(tLL) tMTXY = initTileXY(tMTXY.fX, tMTXY.fY + 1) Case Enums.eBorderPointTypes.iLeftBottomCorner270 'go left Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX - 1), tMTXY.fY, iZoom) lstTilesLatLng.Add(tLL) tMTXY = initTileXY(tMTXY.fX - 1, tMTXY.fY) Case Enums.eBorderPointTypes.iLeftTopAndRightBottomTouchingAtCornerOnly, Enums.eBorderPointTypes.iRightTopAndLeftBottomTouchingAtCornerOnly 'go to tiles touching point >> may need attention as tMTXY remains the same Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX - 1), tMTXY.fY, iZoom) lstTilesLatLng.Add(tLL) Case Enums.eBorderPointTypes.iNotAtEdge 'no line to draw, so no tLL added to list End Select 'check for returned to start If tMTXY.fX = tMTXY_Start.fX Then If tMTXY.fY = tMTXY_Start.fY Then Exit End If End If Loop Return lstTilesLatLng End Sub [CODE] All working fine, but only lightly tested. RBS
Type tBorderLineDirections(iRight As Int, _
iDown As Int, _
iLeft As Int, _
iUp As Int, _
iNoLine As Int)
Public eBorderLineDirection As tBorderLineDirections
eBorderLineDirection.iRight = 0
eBorderLineDirection.iDown = 1
eBorderLineDirection.iLeft = 2
eBorderLineDirection.iUp = 3
eBorderLineDirection.iNoLine = -1
Sub GetBorderLineDirection(tMTXY As TMapTileXY, mapTileLookup As Map) As Int
Dim iRightBottom As Int
Dim iLeftBottom As Int
Dim iLeftTop As Int
Dim iRightTop As Int
Dim iPointType As Int
If mapTileLookup.ContainsKey(tMTXY.fX & "_" & tMTXY.fY) Then
iRightBottom = 1
End If
If mapTileLookup.ContainsKey((tMTXY.fX - 1) & "_" & tMTXY.fY) Then
iLeftBottom = 2
End If
If mapTileLookup.ContainsKey((tMTXY.fX - 1) & "_" & (tMTXY.fY - 1)) Then
iLeftTop = 4
End If
If mapTileLookup.ContainsKey(tMTXY.fX & "_" & (tMTXY.fY - 1)) Then
iRightTop = 8
End If
iPointType = iRightBottom + iLeftBottom + iLeftTop + iRightTop
Select Case iPointType
Case 1, 3, 7
Return Enums.eLineDirection.iRight
Case 2, 6, 14
Return Enums.eLineDirection.iDown
Case 4, 12, 13
Return Enums.eLineDirection.iLeft
Case 8, 9, 11
Return Enums.eLineDirection.iUp
Case 5, 10, 15 'corners touching only or point is enclosed
Return Enums.eBorderLineDirection.iNoLine
End Select
Return Enums.eBorderLineDirection.iNoLine
End Sub
Public Sub GetPolygonListFromAreaBorderTiles(tMTXY_Start As TMapTileXY, mapTileLookup As Map, iZoom As Int) As List
Dim tMTXY As TMapTileXY 'indicating the current XY point
Dim lstTilesLatLng As List
Dim iBorderLineDirection As Int
lstTilesLatLng.Initialize
tMTXY = initTileXY(tMTXY_Start.fX, tMTXY_Start.fY)
Dim tLL As TMapLatLng = Tile2LatLon(tMTXY.fX, tMTXY.fY, iZoom)
lstTilesLatLng.Add(tLL)
Do While True
iBorderLineDirection = GetBorderLineDirection(tMTXY, mapTileLookup)
Select Case iBorderLineDirection
Case Enums.eBorderLineDirection.iRight
Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX + 1), tMTXY.fY, iZoom)
lstTilesLatLng.Add(tLL)
tMTXY = initTileXY(tMTXY.fX + 1, tMTXY.fY)
Case Enums.eBorderLineDirection.iDown
Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX), tMTXY.fY + 1, iZoom)
lstTilesLatLng.Add(tLL)
tMTXY = initTileXY(tMTXY.fX, tMTXY.fY + 1)
Case Enums.eBorderLineDirection.iLeft
Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX - 1), tMTXY.fY, iZoom)
lstTilesLatLng.Add(tLL)
tMTXY = initTileXY(tMTXY.fX - 1, tMTXY.fY)
Case Enums.eBorderLineDirection.iUp
Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX), tMTXY.fY - 1, iZoom)
lstTilesLatLng.Add(tLL)
tMTXY = initTileXY(tMTXY.fX, tMTXY.fY - 1)
Case Enums.eBorderLineDirection.iNoLine
End Select
'check for returned to start
If tMTXY.fX = tMTXY_Start.fX Then
If tMTXY.fY = tMTXY_Start.fY Then
Exit
End If
End If
Loop
Return lstTilesLatLng
End Sub
[CODE]
Fully tested now and all working fine.
RBS
Fixed one bug to do with an unusual case where the 4 tiles to check (to get the line direction) only had the top-left and bottom-right tile or bottom-left and top-right tile present. To fix this I added the previous direction as an argument to the Sub to get the next line direction:As I need a sequential (so you could walk the border as it is) list of lat/lng types I will stick with my posted code.
Can't see an easy way to adapt Erel's code to make such a list.
I streamlined the code as we don't need the line point types and it is easy get these if needed by looking at the current point direction and the previous point direction.
B4X:Type tBorderLineDirections(iRight As Int, _ iDown As Int, _ iLeft As Int, _ iUp As Int, _ iNoLine As Int) Public eBorderLineDirection As tBorderLineDirections eBorderLineDirection.iRight = 0 eBorderLineDirection.iDown = 1 eBorderLineDirection.iLeft = 2 eBorderLineDirection.iUp = 3 eBorderLineDirection.iNoLine = -1 Sub GetBorderLineDirection(tMTXY As TMapTileXY, mapTileLookup As Map) As Int Dim iRightBottom As Int Dim iLeftBottom As Int Dim iLeftTop As Int Dim iRightTop As Int Dim iPointType As Int If mapTileLookup.ContainsKey(tMTXY.fX & "_" & tMTXY.fY) Then iRightBottom = 1 End If If mapTileLookup.ContainsKey((tMTXY.fX - 1) & "_" & tMTXY.fY) Then iLeftBottom = 2 End If If mapTileLookup.ContainsKey((tMTXY.fX - 1) & "_" & (tMTXY.fY - 1)) Then iLeftTop = 4 End If If mapTileLookup.ContainsKey(tMTXY.fX & "_" & (tMTXY.fY - 1)) Then iRightTop = 8 End If iPointType = iRightBottom + iLeftBottom + iLeftTop + iRightTop Select Case iPointType Case 1, 3, 7 Return Enums.eLineDirection.iRight Case 2, 6, 14 Return Enums.eLineDirection.iDown Case 4, 12, 13 Return Enums.eLineDirection.iLeft Case 8, 9, 11 Return Enums.eLineDirection.iUp Case 5, 10, 15 'corners touching only or point is enclosed Return Enums.eBorderLineDirection.iNoLine End Select Return Enums.eBorderLineDirection.iNoLine End Sub Public Sub GetPolygonListFromAreaBorderTiles(tMTXY_Start As TMapTileXY, mapTileLookup As Map, iZoom As Int) As List Dim tMTXY As TMapTileXY 'indicating the current XY point Dim lstTilesLatLng As List Dim iBorderLineDirection As Int lstTilesLatLng.Initialize tMTXY = initTileXY(tMTXY_Start.fX, tMTXY_Start.fY) Dim tLL As TMapLatLng = Tile2LatLon(tMTXY.fX, tMTXY.fY, iZoom) lstTilesLatLng.Add(tLL) Do While True iBorderLineDirection = GetBorderLineDirection(tMTXY, mapTileLookup) Select Case iBorderLineDirection Case Enums.eBorderLineDirection.iRight Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX + 1), tMTXY.fY, iZoom) lstTilesLatLng.Add(tLL) tMTXY = initTileXY(tMTXY.fX + 1, tMTXY.fY) Case Enums.eBorderLineDirection.iDown Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX), tMTXY.fY + 1, iZoom) lstTilesLatLng.Add(tLL) tMTXY = initTileXY(tMTXY.fX, tMTXY.fY + 1) Case Enums.eBorderLineDirection.iLeft Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX - 1), tMTXY.fY, iZoom) lstTilesLatLng.Add(tLL) tMTXY = initTileXY(tMTXY.fX - 1, tMTXY.fY) Case Enums.eBorderLineDirection.iUp Dim tLL As TMapLatLng = Tile2LatLon((tMTXY.fX), tMTXY.fY - 1, iZoom) lstTilesLatLng.Add(tLL) tMTXY = initTileXY(tMTXY.fX, tMTXY.fY - 1) Case Enums.eBorderLineDirection.iNoLine End Select 'check for returned to start If tMTXY.fX = tMTXY_Start.fX Then If tMTXY.fY = tMTXY_Start.fY Then Exit End If End If Loop Return lstTilesLatLng End Sub [CODE] Fully tested now and all working fine. RBS
Sub GetBorderLineDirection(tMTXY As TMapTileXY, iPreviousDirection As Int, mapTileLookup As Map) As Int
Dim iRightBottom As Int
Dim iLeftBottom As Int
Dim iLeftTop As Int
Dim iRightTop As Int
Dim iPointType As Int
If mapTileLookup.ContainsKey(tMTXY.fX & "_" & tMTXY.fY) Then
iRightBottom = 1
End If
If mapTileLookup.ContainsKey((tMTXY.fX - 1) & "_" & tMTXY.fY) Then
iLeftBottom = 2
End If
If mapTileLookup.ContainsKey((tMTXY.fX - 1) & "_" & (tMTXY.fY - 1)) Then
iLeftTop = 4
End If
If mapTileLookup.ContainsKey(tMTXY.fX & "_" & (tMTXY.fY - 1)) Then
iRightTop = 8
End If
iPointType = iRightBottom + iLeftBottom + iLeftTop + iRightTop
Select Case iPointType
Case 1, 3, 7 'note this includes 5: left-top tile And right-bottom tile touching at corner only
Return Enums.eBorderLineDirection.iRight
Case 5 'special case, left-top tile And right-bottom tile touching at corner only
If iPreviousDirection = Enums.eBorderLineDirection.iDown Then
Return Enums.eBorderLineDirection.iLeft
Else
Return Enums.eBorderLineDirection.iRight
End If
Case 10 'special case, left-bottom tile And right-top tile touching at corner only
If iPreviousDirection = Enums.eBorderLineDirection.iRight Then
Return Enums.eBorderLineDirection.iDown
Else
Return Enums.eBorderLineDirection.iUp
End If
Case 2, 6, 14
Return Enums.eBorderLineDirection.iDown
Case 4, 12, 13
Return Enums.eBorderLineDirection.iLeft
Case 8, 9, 11
Return Enums.eBorderLineDirection.iUp
Case 15 'point is enclosed
Return Enums.eBorderLineDirection.iNoLine
Case Else
Return Enums.eBorderLineDirection.iNoLine
End Select
End Sub
'tMTXY_Start is the XY of the top/left of the border tiles
Public Sub GetPolygonListFromAreaBorderTiles(tMTXY_Start As TMapTileXY, mapTileLookup As Map, iZoom As Int) As List
Dim tMTXY As TMapTileXY
Dim iBorderLineDirection As Int
Dim lstTilesLatLng As List
Dim mapPoints As Map
Dim bExit As Boolean
lstTilesLatLng.Initialize
mapPoints.Initialize
tMTXY = initTileXY(tMTXY_Start.fX, tMTXY_Start.fY)
Dim tLL As TMapLatLng = Tile2LatLon(tMTXY.fX, tMTXY.fY, iZoom)
lstTilesLatLng.Add(tLL)
Do While True
'note we are adding the previous direction here, which is needed for mentioned special cases
'-------------------------------------------------------------------------------------------
iBorderLineDirection = GetBorderLineDirection(tMTXY, iBorderLineDirection, mapTileLookup)
Select Case iBorderLineDirection
Case Enums.eBorderLineDirection.iRight
Dim tLL As TMapLatLng = Tile2LatLon(tMTXY.fX + 1, tMTXY.fY, iZoom)
lstTilesLatLng.Add(tLL)
tMTXY = initTileXY(tMTXY.fX + 1, tMTXY.fY)
Case Enums.eBorderLineDirection.iDown
Dim tLL As TMapLatLng = Tile2LatLon(tMTXY.fX, tMTXY.fY + 1, iZoom)
lstTilesLatLng.Add(tLL)
tMTXY = initTileXY(tMTXY.fX, tMTXY.fY + 1)
Case Enums.eBorderLineDirection.iLeft
Dim tLL As TMapLatLng = Tile2LatLon(tMTXY.fX - 1, tMTXY.fY, iZoom)
lstTilesLatLng.Add(tLL)
tMTXY = initTileXY(tMTXY.fX - 1, tMTXY.fY)
Case Enums.eBorderLineDirection.iUp
Dim tLL As TMapLatLng = Tile2LatLon(tMTXY.fX, tMTXY.fY - 1, iZoom)
lstTilesLatLng.Add(tLL)
tMTXY = initTileXY(tMTXY.fX, tMTXY.fY - 1)
Case Enums.eBorderLineDirection.iNoLine
bExit = True
End Select
If bExit Then
Log("exit due to no line")
Exit
End If
'check for returned to start
If tMTXY.fX = tMTXY_Start.fX Then
If tMTXY.fY = tMTXY_Start.fY Then
Log("exit as back to start tile")
Exit
End If
End If
Loop
Return lstTilesLatLng
End Sub
We use cookies and similar technologies for the following purposes:
Do you accept cookies and these technologies?
We use cookies and similar technologies for the following purposes:
Do you accept cookies and these technologies?