QuickHull
Реализация простенького алгоритма QuickHull на блице.
Управление в примере:
Нажатием мыши - ставим точки
Пробел - сгенерировать оболочку
Код:
Function Bank_Add(Bank, Value)
Local Size=BankSize(Bank)
ResizeBank(Bank, Size+4)
PokeInt Bank, Size, Value
Return Size/4
End Function
Function Bank_Remove(Bank, Index)
Local Size=BankSize(Bank)-4
Local NewBank=CreateBank(Size)
Local Offset=Index*4
If Offset
CopyBank Bank, 4, NewBank, 0, Size
Else If Offset=Size
CopyBank Bank, 0, NewBank, 0, Size
Else
CopyBank Bank, 0, NewBank, 0, Offset
CopyBank Bank, Offset+4, NewBank, Offset, Size-Offset
EndIf
FreeBank Bank
Return NewBank
End Function
Function Mouse_X()
Return MouseX()-OX
End Function
Function Mouse_Y()
Return MouseY()-OY
End Function
Global Count
Type TPoint
Field X#, Y#
Field C[3]
Field Name$
End Type
Type TSegment
Field A.TPoint, B.TPoint, Top.TPoint
Field XW#, YW#
Field PBank, PCount
End Type
Global OX=GraphicsWidth()/2, OY=GraphicsHeight()/2
Global EdgeA.TPoint, EdgeB.TPoint
Function NewPoint.TPoint(X#, Y#, R=255, G=255, B=255, Name$="")
Local P.TPoint=New TPoint
P\X=X
P\Y=Y
P\C[0]=R
P\C[1]=G
P\C[2]=B
P\Name=Name
Count=Count+1
Return P
End Function
Function FindEdges()
Local MinX#=9999999
Local MaxX#=-99999999
For P.TPoint=Each TPoint
If P\X<MinX
MinX=P\X
EdgeA=P
EndIf
If P\X>MaxX
MaxX=P\X
EdgeB=P
EndIf
Next
If EdgeA=Null Then Return
EdgeA\C[0]=0
EdgeA\C[1]=0
EdgeB\C[1]=0
EdgeB\C[2]=0
End Function
Function Build()
FindEdges()
;Build first segment
Local AXW#=EdgeB\X-EdgeA\X
Local AYW#=EdgeB\Y-EdgeA\Y
;Up direction
Local U.TSegment=New TSegment
U\A=EdgeA
U\B=EdgeB
U\XW=AXW
U\YW=AYW
U\PBank=CreateBank(0)
;Down direction
Local D.TSegment=New TSegment
D\A=EdgeB
D\B=EdgeA
D\XW=-AXW
D\YW=-AYW
D\PBank=CreateBank(0)
Local MaxW#=0
Local MinW#=0
For P.TPoint=Each TPoint
If P<>EdgeA And P<>EdgeB
Local XW#=P\X-EdgeA\X
Local YW#=P\Y-EdgeA\Y
Local W#=XW*AYW-YW*AXW
If W>=0
Bank_Add(U\PBank, Handle(P))
U\PCount=U\PCount+1
Else
Bank_Add(D\PBank, Handle(P))
D\PCount=D\PCount+1
EndIf
If W>MaxW
U\Top=P
MaxW=W
Else If W<MinW
D\Top=P
MinW=W
EndIf
EndIf
Next
Extend()
End Function
Function Extend()
Repeat
Local Clear=True
Local Segment.TSegment
For Segment=Each TSegment
If Segment\PCount<>0
Clear=False
Local Top.TPoint=Segment\Top
;Left
Local L.TSegment=New TSegment
L\A=Segment\A
L\B=Top
L\XW=L\B\X-L\A\X
L\YW=L\B\Y-L\A\Y
L\PBank=CreateBank(0)
;Right
Local R.TSegment=New TSegment
R\A=Top
R\B=Segment\B
R\XW=R\B\X-R\A\X
R\YW=R\B\Y-R\A\Y
R\PBank=CreateBank(0)
Local P.TPoint
Local LMaxW#=0, RMaxW#=0
For Index=0 To Segment\PCount-1
P=Object.TPoint(PeekInt(Segment\PBank, Index*4))
If P<>Top And P<>Segment\A And P<>Segment\B
Local LXW#=P\X-L\A\X
Local LYW#=P\Y-L\A\Y
Local LW#=LXW*L\YW-LYW*L\XW
Local RXW#=P\X-R\A\X
Local RYW#=P\Y-R\A\Y
Local RW#=RXW*R\YW-RYW*R\XW
If LW>0
Bank_Add(L\PBank, Handle(P))
L\PCount=L\PCount+1
If LW>LMaxW
L\Top=P
LMaxW=LW
EndIf
Else If RW>0
Bank_Add(R\PBank, Handle(P))
R\PCount=R\PCount+1
If RW>RMaxW
R\Top=P
RMaxW=RW
EndIf
EndIf
EndIf
Next
;Delete segment
FreeBank Segment\PBank
Delete Segment
Render()
Flip:Cls
;Stop
EndIf
Next
If Clear Then Exit
Forever
End Function
Function FindTop.TPoint(Segment.TSegment)
Local MaxW=-1
Local P.TPoint
Local Top.TPoint
For Index=0 To Segment\PCount-1
P=Object.TPoint(PeekInt(Segment\PBank, Index*4))
Local XW#=P\X-Segment\A\X
Local YW#=P\Y-Segment\A\Y
Local W#=XW*Segment\YW-YW*Segment\XW
If W>MaxW
MaxW=W
Top=P
EndIf
Next
Top\C[0]=0
Top\C[2]=0
Return Top
End Function
Function Render()
For P.TPoint=Each TPoint
Color P\C[0], P\C[1], P\C[2]
Text OX+P\X, OY+P\Y, "+", True, True
Color 255, 255, 255
Text OX+P\X, OY+P\Y+20, P\Name, True, True
Next
For S.TSegment=Each TSegment
Line OX+S\A\X, OY+S\A\Y, OX+S\B\X, OY+S\B\Y
Next
End Function
Graphics 1024, 768, 32, 2
SetBuffer BackBuffer()
OX=GraphicsWidth()/2
OY=GraphicsHeight()/2
While Not KeyHit(1)
If MouseHit(1)
NewPoint(Mouse_X(), Mouse_Y())
EndIf
If KeyHit(57)
Build()
EndIf
Render()
Flip:Cls
Wend
End
|
