Include "MapBasic.def"
'==Geometry
Global gsRdSideFld,gsRdCentreFld,gsRdSideCode, gsRdCentreCode,gsTiled as string
Global lineside1,lineside2,OffsetRegion,Crossline as object
Global OffsetLx,OffsetLy,OffsetRx,OffsetRy as float
Global gDTPtX(),gDTPtY(),ArcPntX(),ArcPntY(),newNodepntX, newNodepntY  as Float
Global gDTNumPtSect(),gDTNumSect as integer


Function GetPntsAlongLineBtwnXlines(byval oLineStart as object, byval oLineEnd as object, byval oBaseline as Object) as object
'have to round coords to 3 decimal places otherwise doesn't seem to match exactly
dim PntStart, PntEnd as object	'return objects from Intersectnodes - polyline
Dim newPnt1X(),newPnt1Y(),X1,Y1,X2,Y2 as float
dim i, j, iStart,iEnd as integer
dim lStart,lEnd as logical
dim oReturn as object
Onerror goto Error_handler
'call debugprint("GetPntsAlongLineBtwnXlines")

	call SetMapCoordsys(main_mapper_id,"m")
	

	'first add nodes to base line
	oBaseline = OverlayNodes(oBaseline,oLineStart)

	oBaseline = OverlayNodes(oBaseline,oLineEnd)


	call BuildCoordArrays(oBaseline)
	i = gDTNumPtSect(1)
	PntStart = IntersectNodes(oBaseline,oLineStart, INCL_CROSSINGS)
'#Call debugprint("GetPntsAlongLineBtwnXlines" + chr$(9) + "PntStart" + Objectinfo(PntStart,OBJ_INFO_TYPE) + " " + objectinfo(PntStart,OBJ_INFO_NPNTS))
	if objectinfo(PntStart,OBJ_INFO_NPNTS) = 0 then	'no intersect so find nearest end of baseline to start of linestart 
'#Call debugprint("PntStart not intersect")		
		if ObjectInfo(oLineStart,OBJ_INFO_TYPE) = OBJ_TYPE_LINE then
			X1 = ObjectGeography(oLineStart,OBJ_GEO_LINEBEGX)
			Y1 = ObjectGeography(oLineStart,OBJ_GEO_LINEBEGY)			
		else
			X1 = ObjectNodeX(oLineStart,1,1)
			Y1 = ObjectNodeY(oLineStart,1,1)		
		End If

		if getdistance(gDTPtX(1),gDTPtY(1), X1, Y1) < getdistance(gDTPtX(i),gDTPtY(i), X1, Y1) then
			X1 = gDTPtX(1)
			Y1 = gDTPtY(1)	
		else
			X1 = gDTPtX(i)		
			Y1 = gDTPtY(i)			
		end if
	else
		X1 = ObjectNodeX(PntStart,1,1)
		Y1 = ObjectNodeY(PntStart,1,1)
	End If
'Call debugprint(chr$(9) + "PntStart : " + X1 + " " + Y1)
	
	
	PntEnd = IntersectNodes(oBaseline,oLineEnd, INCL_CROSSINGS)

	
'#Call debugprint(chr$(9) + "PntEnd" + Objectinfo(PntEnd,OBJ_INFO_TYPE) + " " + objectinfo(PntEnd,OBJ_INFO_NPNTS))	
	if objectinfo(PntEnd,OBJ_INFO_NPNTS) = 0 then 'no intersect so find nearest end of baseline to start of lineend
'Call debugprint("PntEnd not intersect")		
		if ObjectInfo(oLineEnd,OBJ_INFO_TYPE) = OBJ_TYPE_LINE then
			X2 = ObjectGeography(oLineEnd,OBJ_GEO_LINEBEGX)
			Y2 = ObjectGeography(oLineEnd,OBJ_GEO_LINEBEGY)			
		else		
			X2 = ObjectNodeX(oLineEnd,1,1)
			Y2 = ObjectNodeY(oLineEnd,1,1)	
		end if
		if getdistance(gDTPtX(1),gDTPtY(1),X2, Y2) < getdistance(gDTPtX(i),gDTPtY(i),X2, Y2) then
			X2 = gDTPtX(1)
			Y2 = gDTPtY(1)	
		else
			X2 = gDTPtX(i)		
			Y2 = gDTPtY(i)			
		end if
	else
		X2 = ObjectNodeX(PntEnd,1,1)
		Y2 = ObjectNodeY(PntEnd,1,1)
	End If
	
'Call debugprint(chr$(9) + "PntEnd : " + X2 + " " + Y2)	

	
	for i = 1 to gDTNumPtSect(1)
		if lStart = false then
			if Sqr((gDTPtX(i)  - X1) ^2 + (gDTPtY(i) - Y1) ^ 2) <= 0.01 Then
				iStart = i
				lStart = true
			end if
		end if
		if lEnd = false then
			if Sqr((gDTPtX(i)  - X2) ^2 + (gDTPtY(i) - Y2) ^ 2) <= 0.01 then
				iEnd = i
				lEnd = true
			end if
		end if
		if lStart = true and lEnd = true then
			exit for
		end if
	next 
	
	if iStart = 0 or iEnd = 0 then
'		Call debugprint(chr$(9) + "no line found between cross lines: " + iStart + " " + iEnd) 
'		for i = 1 to gDTNumPtSect(1)
'			call debugprint(i + " " + gDTPtX(i)+ " " + gDTPtY(i))
'		Next

	else
		
		if iStart < iEnd then
			if iEnd - iStart = 1 then
				oReturn = ConvertToPline(CreateLine(gDTPtX(iStart),gDTPtY(iStart),gDTPtX(iEnd),gDTPtY(iEnd)))
			else
				Call debugprint(chr$(9) + "ExtractNodes" + iStart + " " + iEnd + " " + ubound(gDTPtX))
				oReturn = ExtractNodes(oBaseline,1, iStart, iEnd, False)			
			End If

		else
'#			Call debugprint(chr$(9) + "Build new array: " +  iStart + " "+ iEnd)
			j = Abs(iEnd - iStart)+1
			redim newPnt1X(j)
			redim newPnt1Y(j) 

			j = 0
			for i = iStart to iEnd step -1
				j = j + 1				
				newPnt1X(j) = gDTPtX(i)
				newPnt1Y(j) = gDTPtY(i)		

			next

			call ClearCoordArrays()
			redim gDTPtX(j)
			redim gDTPtY(j)
			redim gDTNumPtSect(1)
			gDTNumSect = 1
			gDTNumPtSect(1) = j
			for i = 1 to j
				gDTPtX(i) = newPnt1X(i)
				gDTPtY(i) = newPnt1Y(i)
			Next
			oReturn = BuildObject("Line")
		end if
		GetPntsAlongLineBtwnXlines = oReturn
	end if
	
Exit function
error_handler:
Call General_Errors()
end Function



'===============================================================
	'RESET - BUILD COORD ARRAYS
'===============================================================
Sub ClearCoordArrays
	'clear existing values
	redim gDTPtX(0)
	redim gDTPtY(0)
	redim gDTNumPtSect(0)
	gDTNumSect = 0
end sub
'---------------------------------------------------------------
Sub BuildCoordArrays(byval myobj as object)
dim i,j,k,icnt, iTotPts as integer
dim x,y,xlast,ylast as float
dim lDupPoints,lDupSect as logical
onerror goto error_handler
	'clear existing values
	call ClearCoordArrays
	call SetMapCoordsys(main_mapper_id,"m")
	if ObjectInfo(myobj,OBJ_INFO_TYPE) <> OBJ_TYPE_PLINE	or ObjectInfo(myobj,OBJ_INFO_TYPE)<> OBJ_TYPE_REGION	 then
		myobj= convertToPline(myobj)
	end if 

	iTotPts = ObjectInfo(myobj,OBJ_INFO_NPNTS)		'total num of points
	gDTNumSect = ObjectInfo(myobj,OBJ_INFO_NPOLYGONS) 'no of polygons or sections
	redim gDTPtX(iTotPts)
	redim gDTPtY(iTotPts)
	redim gDTNumPtSect(gDTNumSect)
	icnt =0

	for i = 1 to gDTNumSect 
		gDTNumPtSect(i)= ObjectInfo(myobj,OBJ_INFO_NPOLYGONS + i)
	
		k =0
		xlast = 0
		ylast = 0
		lDupSect = false
		for j = 1 to gDTNumPtSect(i)
			x = ObjectNodeX( myobj,i,j)
			y = ObjectNodeY( myobj,i,j)
			if x = xlast and y = ylast then	'duplicate point
				lDupPoints = True
				lDupSect = true
			else
				k = k + 1
				icnt= icnt + 1	
				gDTPtX(icnt) = x
				gDTPtY(icnt) = y					
				xlast = x
				ylast = y
				
			End If
		next
		if lDupSect then
			gDTNumPtSect(i) = k	'if duplicate points then number of points in section reduced
		end if
		
		if lOffsetPointOnly and k = 2 then	'only need find first two point to give bearing
			gDTNumSect = 1
			gDTNumPtSect(i) = 2
			exit for
		End If		
	next
	if lDupPoints then
		redim gDTPtX(icnt)
		redim gDTPtY(icnt)
	End If
exit sub
error_handler:
call general_errors()
exit sub
End sub
'---------------------------------------------------------------
Function BuildObject(byval sType as string) as object
dim newObj,finalobj as object
dim i,j,k, ipnts as integer
onerror goto error_handler

	j =1
	ipnts = ubound(gDTPtX)
'#call DebugPrint(  "BuildObject " & "gDTNumSect:" & gDTNumSect & "  totpnts" & ubound(gDTPtX))
	For i = 1 to gDTNumSect
'#Call debugprint(chr$(9) + " gDTNumPtSect(" + i + "):" & gDTNumPtSect(i) ) 
		if sType = "LINE" then
			create pline into variable NewObj 0
		else
			create Region into variable NewObj 0
		end if
		for k = 1 to gDTNumPtSect(i)	'total no points that section
		
			if j <= ipnts then	'dpw 11/05/11
				Alter object NewObj Node Add Position 1,k (gDTPtX(j),gDTPtY(j))
				j=j+1
			else
				if j = ipnts + 1 then	
					BuildObject = FinalObj
					exit function
				Else
'#					call DebugPrint("ERROR:BuildObject " & "gDTNumSect:" & gDTNumSect & "  totpnts:" & ipnts + " " + j)
	 				exit for
				end if
			end if
		next
		if i = 1 then
			FinalObj = Newobj
		else
			FinalObj = combine(FinalObj,Newobj)
		end if
	next
onerror goto noPens
	Alter object FinalObj info OBJ_INFO_PEN,DTPen
	if sType = "REGION" then
		Alter object FinalObj info OBJ_INFO_BRUSH,DTBrush
	end if

	BuildObject = FinalObj 

exit Function
noPens:
Resume next
error_handler:
call general_errors()
exit Function
End Function