Filled polygons

[Trond]

I made crossplatform filled polygons. They are a bit slow, but they work, and the code is readable. Feel free to speed it up if you understand why it's slow.

Code: Select all

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

[IdeasVacuum]

The sample is not slow on my WinXP PC - all three items are rendered in an instant.

[WilliamL]

Instantaneous on my Mac! Well, actually t=471...

[Vera]

Takes its time on (my Laptop) Linux - wavering between e.g. t=839 ... 1163

thanks for sharing

cheers ~ Vera

[PMV]

t < 16
looks good

[Trond]

Instantaneous on my Mac! Well, actually t=471...

Takes its time on (my Laptop) Linux - wavering between e.g. t=839 ... 1163

Try without the debugger. It should be around 32 for William and 100 for Vera. The debugger is slowing it down tremendously.

[KJ67]

Very nice.

Using a high resolution timer I end up ~14.2-14.8 msec om a 2.4 GHz C2D laptop with on-board graphics.
That is not slow for me, especially considering that you use gradient filling.

[Vera]

Try without the debugger.

That reduces it down to average 'round t=140 [117 - 167] (on 1.5 GHz monocore)

btw: now I got why you used a messagebox, and next time I'll understand it as a hint

[netmaestro]

Using hires timing and no debugger I'm getting avg. 2.6 milliseconds execution time. This with crappy onboard video on a cheap computer. Nice work!

[WilliamL]

Damn, I forgot to turn off the Debugger...

So I turn off the debugger and it crashes. (yeah, it's a Mac)

Rem out these lines and I get a 5 but no polygons. The Purifier doesn't put any messages in the PBEditorOutput box... and it runs fine (because the debugger is on). See note two lines down...

Code: Select all

Procedure FillPolygon(xoff, yoff, List Poly.Pt(), color=255)
;   Protected NewList Lines.PtPairSlopeCache() ; <<< un-rem this line and crash!
;   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

[netmaestro]

Can't make it crash here, but I'm on Windows. You're on Mac, right? See if the purifier is happy.

[electrochrisso]

Works good here Trond on my crappy old laptop with xp home 256ram and 32meg stealing graphics.
Displays in less than a second.

[luis]

I needed something like this, great work and thank you.