J'ai trouvé ça dans mes archives mais je ne sais plus qui l'a créé.
M.
Code:
Structure Pt
x.i
y.i
EndStructure
Structure PtPair
A.Pt
B.Pt
EndStructure
Structure PtPairSlopeCache Extends PtPair
yperx.d
EndStructure
Procedure MaxI(A, B)
If A > B
ProcedureReturn A
EndIf
ProcedureReturn B
EndProcedure
Procedure MinI(A, B)
If A < B
ProcedureReturn A
EndIf
ProcedureReturn B
EndProcedure
; Return the x of a line for a given y
Macro LineX(y, Line)
(line\yperx * (y-Line\A\y) + Line\A\x)
EndMacro
; Whether a ray like this crosses a line segment
; |-------------------->
; *a is the topmost point (smallest y), *b is the lowest point
Procedure XRayCrossesLine(x, y, *Line.PtPairSlopeCache)
If y <= *line\A\y
ProcedureReturn 0
ElseIf y > *line\B\y
ProcedureReturn 0
ElseIf LineX(y, *Line) > x
ProcedureReturn 1
Else
ProcedureReturn 0
EndIf
EndProcedure
; Make sure *a\y < *b\y
Procedure CorrectPointOrder(*a.pt, *b.pt)
If *a\y > *b\y
Swap *a\x, *b\x
Swap *a\y, *b\y
EndIf
EndProcedure
; Precalc line slope
Procedure.d Slope(*a.pt, *b.pt)
dx.i = (*b\x-*a\x)
dy.i = (*b\y-*a\y)
ProcedureReturn dx/dy
EndProcedure
; Make the lines conform to expectations
Procedure PrepLines(List Lines.PtPairSlopeCache())
ForEach Lines()
CorrectPointOrder(Lines()\A, Lines()\B)
Lines()\yperx = Slope(Lines()\A, Lines()\B)
Next
EndProcedure
; Convert a list of points into a list of lines
Procedure GetPolyLines(List Poly.pt(), List Lines.PtPairSlopeCache())
FirstElement(Poly())
Prev.pt = Poly()
While NextElement(Poly())
AddElement(Lines())
Lines()\A = Prev
Lines()\B = Poly()
Prev = Poly()
Wend
; Connect last point to first
AddElement(lines())
lines()\A = Prev
FirstElement(Poly())
lines()\B = Poly()
; Prep lines
PrepLines(Lines())
EndProcedure
Procedure PtInPoly(x, y, List Lines.PtPairSlopeCache())
Protected Intersections = 0
FirstElement(Lines())
ForEach Lines()
Intersections + XRayCrossesLine(x, y, @Lines())
Next
ProcedureReturn Intersections & 1
EndProcedure
Procedure GetPolyExtents(List Poly.Pt(), *TopLeft.Pt, *BtmRight.Pt)
ForEach Poly()
*TopLeft\x = MinI(*TopLeft\x, Poly()\x)
*TopLeft\y = MinI(*TopLeft\y, Poly()\y)
*BtmRight\x = MaxI(*BtmRight\x, Poly()\x)
*BtmRight\y = MaxI(*BtmRight\y, Poly()\y)
Next
EndProcedure
Procedure FillPolygonWithCache(xoff, yoff, List Poly.Pt(), List Lines.PtPairSlopeCache(), color)
GetPolyExtents(Poly(), TopLeft.Pt, BtmRight.Pt)
w = BtmRight\x - TopLeft\x
h = BtmRight\y - TopLeft\y
For x = TopLeft\x To w
For y = TopLeft\y To h
If PtInPoly(x, y, Lines())
Plot(x+xoff, y+yoff, color)
EndIf
Next
Next
EndProcedure
Procedure FillPolygon(xoff, yoff, List Poly.Pt(), color=255)
Protected NewList Lines.PtPairSlopeCache()
GetPolyLines(Poly(), Lines())
FillPolygonWithCache(xoff, yoff, Poly(), Lines(), color)
EndProcedure
Procedure OutlinePolygonWithCache(xoff, yoff, List Poly.Pt(), List Lines.PtPairSlopeCache(), color)
ForEach Lines()
LineXY(Lines()\A\x + xoff, Lines()\A\y + yoff, Lines()\B\x + xoff, Lines()\B\y + yoff, color)
Next
EndProcedure
Procedure OutlinePolygon(xoff, yoff, List Poly.Pt(), color=0)
Protected NewList Lines.PtPairSlopeCache()
GetPolyLines(Poly(), Lines())
OutlinePolygonWithCache(xoff, yoff, Poly(), Lines(), color)
EndProcedure
Procedure RenderPolygon(xoff, yoff, List Poly.Pt(), FillColor=255, OutlineColor=0)
Protected NewList Lines.PtPairSlopeCache()
GetPolyLines(Poly(), Lines())
FillPolygonWithCache(xoff, yoff, Poly(), Lines(), FillColor)
OutlinePolygonWithCache(xoff, yoff, Poly(), Lines(), OutlineColor)
EndProcedure
;- Test code:
Procedure MyPatternPainter(x, y, src, target)
r = 255-(((x/4)&1) | ((y/4)&1))*255
ProcedureReturn RGB(r, x*y, r)
EndProcedure
OpenWindow(0, 0, 0, 512, 384, "", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_SizeGadget)
Macro AddPt(l, _x, _y)
AddElement(l)
l\x = _x
l\y = _y
EndMacro
NewList rect.pt()
AddPt(rect(), 10, 10)
AddPt(rect(), 125, 15)
AddPt(rect(), 120, 100)
AddPt(rect(), 15, 90)
NewList Star.Pt()
AddPt(Star(), 0, 13)
AddPt(Star(), 15, 13)
AddPt(Star(), 20, 0)
AddPt(Star(), 25, 13)
AddPt(Star(), 40, 13)
AddPt(Star(), 27, 22)
AddPt(Star(), 32, 35)
AddPt(Star(), 20, 27)
AddPt(Star(), 7, 35)
AddPt(Star(), 12, 22)
ForEach Star()
Star()\x = Star()\x * 4 + 130
Star()\y = Star()\y * 4 + 30
Next
w = 512
h = 384
CreateImage(0, w, h, 24)
t = ElapsedMilliseconds()
StartDrawing(ImageOutput(0))
Box(0, 0, w, h, RGB(255, 255, 255))
; Show our box
RenderPolygon(0, 0, rect(), RGB(255, 128, 32), RGB(128, 64, 16))
; Advanced: gradient fill (of star)
DrawingMode(#PB_2DDrawing_Gradient)
CircularGradient(200, 100, 100)
RandomSeed(63)
For I = 0 To 20
GradientColor(I/20, RGB(Random(255), Random(255), Random(255)))
Next
FillPolygon(0, 0, star())
DrawingMode(#PB_2DDrawing_Default)
OutlinePolygon(0, 0, Star())
; Advanced: pattern fill (with custom callback)
DrawingMode(#PB_2DDrawing_CustomFilter)
CustomFilterCallback(@MyPatternPainter())
FillPolygon(0, 200, rect())
DrawingMode(#PB_2DDrawing_Default)
OutlinePolygon(0, 200, rect(), RGB(0, 255, 0))
StopDrawing()
t = ElapsedMilliseconds()-t
; MessageRequester("", Str(t))
ImageGadget(0, 0, 0, 0, 0, ImageID(0))
Repeat
Event = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow