What I need to do is identify the points along the path where a "bend" occurs.
So, if this is the path:
then I would want the code to identify the following points:
I have written a procedure - GetPathBends - but it doesn't work very well. It works by going along the path and, for every pixel, looking backwards along the path and forwards along the path by #JudgeDistancePixels, getting the angle
Here is a demo. You need to draw a path with the mouse. A procedure will join up the dots to make it a continuous path, and then the GetPathBends procedure will be run and the bends will be illustrated with red circles.
Code: Select all
Macro R(t)
MessageRequester("Report",t,0)
EndMacro
Procedure.d Beat(a.d,b.d)
If a>b
ProcedureReturn a
Else
ProcedureReturn b
EndIf
EndProcedure
Procedure.d Defeat(a.d,b.d)
If a<b
ProcedureReturn a
Else
ProcedureReturn b
EndIf
EndProcedure
Macro DefeatThis(a,b)
If a>b
a=b
EndIf
;a = Defeat(a,b)
EndMacro
Macro BeatThis(a,b)
If b>a
a=b
EndIf
;a = Beat(a,b)
EndMacro
Procedure.d Difference(a.d,b.d)
If a=b
ProcedureReturn 0
EndIf
If a>b
ProcedureReturn a-b
EndIf
ProcedureReturn b-a
EndProcedure
Structure PointD
x.d
y.d
EndStructure
Structure PointI
x.i
y.i
EndStructure
Procedure.d DegreeAngleBetweenTwoPoints(*o.PointD,*b.PointD)
calcAngle.d = Degree(ATan2(*b\x-*o\x,*b\y-*o\y))
If calcAngle<0
calcAngle = 360-Abs(calcAngle)
EndIf
ProcedureReturn calcAngle
EndProcedure
Macro CopyPoint(p1,p2)
p2\x = p1\x
p2\y = p1\y
EndMacro
Macro MoreThanOnePixelAway(x1,y1,x2,y2)
( Difference(x1,x2)>1 Or Difference(y1,y2)>1 )
EndMacro
Procedure.b IPointsOnePixelApart(*p1.PointI,*p2.PointI)
xdif.i = Difference(*p1\x,*p2\x)
ydif.i = Difference(*p1\y,*p2\y)
If xdif=1 And ydif=1
ProcedureReturn #True
EndIf
If xdif=1 And ydif=0
ProcedureReturn #True
EndIf
If xdif=0 And ydif=1
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure.i BresenhamLine(Array pnt.PointI(1),*ip1.PointI,*ip2.PointI)
; Line drawing algorithm in Pascal -> http://www.gamedev.net/
; A general-purpose implementation of Bresenham's line algorithm.
; By Mark Feldman.
bplot_x1.i = *ip1\x
bplot_y1.i = *ip1\y
bplot_x2.i = *ip2\x
bplot_y2.i = *ip2\y
;deltax and deltay
bdx = Abs(bplot_x2 - bplot_x1)
bdy = Abs(bplot_y2 - bplot_y1)
;always 1
bx2 = 1
by2 = 1
;initialize vars based on which is the independent variable
If bdx >= bdy ;x is independent variable
bnp = bdx + 1
bd1 = bdy << 1
bdi = bd1 - bdx
bd2 = (bdy - bdx) << 1
bx1 = 1
by1 = 0
Else ;y is independent variable
bnp = bdy + 1
bd1 = bdx << 1
bdi = bd1 - bdy
bd2 = (bdx - bdy) << 1
bx1 = 0
by1 = 1
EndIf
;make sure x and y move in the right directions
If bplot_x1 > bplot_x2
bx1 = -bx1
bx2 = -bx2
EndIf
If bplot_y1 > bplot_y2
by1 = -by1
by2 = -by2
EndIf
;start drawing at
bxi = bplot_x1
byi = bplot_y1
;draw the pixels
pnts.i = 0
ReDim pnt(bnp)
For bli = 1 To bnp
pnts+1
pnt(pnts)\x = bxi
pnt(pnts)\y = byi
;PlotPixel(bxi, byi, bclr)
If bdi < 0
bdi = bdi + bd1
bxi = bxi + bx1
byi = byi + by1
Else
bdi = bdi + bd2
bxi = bxi + bx2
byi = byi + by2
EndIf
Next bli
ProcedureReturn pnts
EndProcedure
Macro PointsIdentical(p1,p2)
Bool(p1\x=p2\x And p1\y=p2\y)
EndMacro
Procedure.i JoinUpDots(pathpoints,Array pnt.PointI(1))
;R("pathpoints: "+Str(pathpoints))
Dim pxl.PointI(pathpoints*4)
pxls.i = 1
CopyPoint(pnt(1),pxl(pxls))
For p = 2 To pathpoints
If IPointsOnePixelApart(pnt(p-1),pnt(p))
pxls+1
CopyPoint(pnt(p),pxl(pxls))
EndIf
If MoreThanOnePixelAway(pnt(p-1)\x,pnt(p)\x,pnt(p-1)\y,pnt(p)\y)
Dim np.PointI(10)
newpoints = BresenhamLine(np(),pnt(p-1),pnt(p))
ReDim pxl(ArraySize(pxl())+newpoints+10)
For n = 1 To newpoints
pxls+1
CopyPoint(np(n),pxl(pxls))
Next n
Else
pxls+1
CopyPoint(pnt(p),pxl(pxls))
EndIf
Next p
ReDim pnt(pxls)
lp.i = 1
npxls.i = 1
CopyPoint(pxl(lp),pnt(npxls))
For p = 2 To pxls
If PointsIdentical(pxl(lp),pxl(p))
Continue
EndIf
npxls+1
CopyPoint(pxl(p),pnt(npxls))
lp = p
Next p
ReDim pnt(npxls)
ProcedureReturn npxls
;Debug "CORRECTION COMPLETE."
EndProcedure
Procedure.b GetPathBends(pathpoints.i,Array ipathpnt.PointI(1),List bend.i())
; convert from integers to doubles, so that we can do Math operations
Dim pathpnt.PointD(pathpoints)
For p = 1 To pathpoints
CopyPoint(ipathpnt(p),pathpnt(p))
Next p
; for every point along the path, jump backward #JudgeDistance points and forward #JudgeDistance points and compare the two angles (current point being the central one of three points)
; if the difference between the two angles is greater than 50 degrees, mark it as a bend point
Dim rawbend.b(pathpoints)
#JudgeDistance = 50
For p = #JudgeDistance+1 To pathpoints-#JudgeDistance
ang1.d = DegreeAngleBetweenTwoPoints(@pathpnt(p-#JudgeDistance),@pathpnt(p))
ang2.d = DegreeAngleBetweenTwoPoints(@pathpnt(p),@pathpnt(p+#JudgeDistance))
dif.d = Difference(ang1,ang2)
If dif>50
rawbend(p) = #True
EndIf
Next p
; since the code above tends to find clusters of "bendpoints", we need to look at each cluster and calculate the middle point - where the bend actually happens
Dim majorbend.b(pathpoints)
close_together_bends = 0
consecutive_straights = 0
bendchainstart = 0
For p = 1 To pathpoints
If rawbend(p)
consecutive_straights = 0
If Not bendchainstart
bendchainstart = p
EndIf
bendchainend = p
close_together_bends + 1
Else
consecutive_straights + 1
If consecutive_straights>25
;Debug "CTB: "+Str(close_together_bends)
If close_together_bends>2
p = bendchainstart + ((bendchainend-bendchainstart)/2)
;Debug "MAJOR BEND: "+Str(p)
majorbend(p) = #True
close_together_bends = 0
consecutive_straights = 0
bendchainstart = 0
bendchainend = 0
EndIf
EndIf
EndIf
Next p
ClearList(bend())
For p = 1 To pathpoints
If majorbend(p)
AddElement(bend())
bend() = p
EndIf
Next p
EndProcedure
ww = 1000
wh = 700
win = OpenWindow(#PB_Any,0,0,ww,wh,"",#PB_Window_ScreenCentered|#PB_Window_BorderLess)
cnv = CanvasGadget(#PB_Any,0,0,ww,wh)
StartDrawing(CanvasOutput(cnv))
Box(0,0,ww,wh,RGB(255,255,192))
StopDrawing()
pnts=0
Dim pathpnt.PointI(5000)
NewList bend.i()
Repeat
we = WindowEvent()
Select we
Case #PB_Event_Gadget
Select EventGadget()
Case cnv
Select EventType()
Case #PB_EventType_LeftButtonDown
tracking = #True
StartDrawing(CanvasOutput(cnv))
Box(0,0,ww,wh,RGB(255,255,192))
StopDrawing()
Case #PB_EventType_LeftButtonUp
tracking = #False
pnts = JoinUpDots(pnts,pathpnt())
GetPathBends(pnts,pathpnt(),bend())
StartDrawing(CanvasOutput(cnv))
Box(0,0,ww,wh,RGB(255,255,192))
; draw the path
For p = 1 To pnts
Plot(pathpnt(p)\x,pathpnt(p)\y,#Black)
Next p
; illustrate the bends
ForEach bend()
p = bend()
Circle(pathpnt(p)\x,pathpnt(p)\y,5,#Red)
Next
StopDrawing()
pnts=0
Case #PB_EventType_MouseMove
If tracking
x = GetGadgetAttribute(cnv,#PB_Canvas_MouseX)
y = GetGadgetAttribute(cnv,#PB_Canvas_MouseY)
If pnts=0 Or x<>pathpnt(pnts)\x Or y<>pathpnt(pnts)\y
;Debug Str(x)+","+Str(y)
pnts+1
pathpnt(pnts)\x = x
pathpnt(pnts)\y = y
StartDrawing(CanvasOutput(cnv))
Circle(pathpnt(pnts)\x,pathpnt(pnts)\y,3,#Black)
StopDrawing()
EndIf
EndIf
EndSelect
EndSelect
EndSelect
Delay(5)
Until GetAsyncKeyState_(#VK_ESCAPE)
Any help people could give me with this would be appreciated.
