PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

All OS Filled Polygon

https://www.purebasic.fr/english/viewtopic.php?t=42870

Page 1 of 1

All OS Filled Polygon

Posted: Mon Jul 12, 2010 5:42 pm
by Erlend
I found myself in need of drawing polygons on an image so I coded one, it hasn't been optimized or anything but it's all I need at the moment. Hope someone finds it useful..

EDIT!
Turns out I posted the wrong code (Convex polygon fill) so heres the one I was supposed to post:-)

Code: Select all

Structure pippoint
   x.l
   y.l
EndStructure

Procedure FilledPolygon(List points.pippoint(),color)
  NewList nodes.i()
  ;Find least and most y values to restrict area to transverse when filling..
  ResetList(points())
  miny=OutputHeight()-1
  maxy=0
  While NextElement(points())
    If points()\y<miny:miny=points()\y:EndIf
    If points()\y>maxy:maxy=points()\y:EndIf
  Wend  
  
  For cy=miny To maxy
    x.f=cx
    y.f=cy
    oddnodes=#False  
  ClearList(nodes())
  LastElement(points())
  x1.f=points()\x
  y1.f=points()\y
  ResetList(points())
  While NextElement(points())
    x2.f=points()\x
    y2.f=points()\y
      If ((y2<Y) And y1>=Y) Or (y1<Y And y2>=Y) 
      AddElement(nodes())
      nodes()=(x2+(Y-y2) / (y1-y2) * (x1-x2))
      EndIf
      x1=x2
      y1=y2
  Wend
  SortList(nodes(),#PB_Sort_Ascending)
   ResetList(nodes())
   While NextElement(nodes())
     x1=nodes()
     NextElement(nodes())
     x2=nodes()
     LineXY(x1,Y,x2,y,color)
   Wend
  Next
  FirstElement(Points())
  oldx=Points()\x
  oldy=points()\y
  While NextElement(points())
    LineXY(oldx,oldy,Points()\x,Points()\y,color)
    oldx=points()\x
    oldy=Points()\y
  Wend  
EndProcedure


NewList mpp.pippoint()

OpenWindow(0, 0, 0, 640, 480, "Filled Polygon", #PB_Window_SystemMenu)

CreateImage(0, 640, 480)
StartDrawing(ImageOutput(0))
Box(0, 0, 640, 480, 0)
StopDrawing()
ImageGadget(0, 0, 0, 640, 480, ImageID(0))

Exit = #False
Repeat
 
  Event = WaitWindowEvent()
 
  Select Event
    Case #PB_Event_Gadget
      If EventGadget() = 0
       Select EventType()
         Case #PB_EventType_RightClick
          If ListSize(mpp()) > 2
           StartDrawing(ImageOutput(0))
           filledpolygon(mpp(),RGB(Random(255),Random(255),Random(255)))
           StopDrawing()
           SetGadgetState(0, ImageID(0))
           ClearList(mpp())
          EndIf
        Case #PB_EventType_LeftClick
          x2 = WindowMouseX(0)
          y2 = WindowMouseY(0)
          If ListSize(mpp()) > 0
            SelectElement(mpp(), ListSize(mpp()) - 1)
            StartDrawing(ImageOutput(0))
            LineXY(mpp()\x, mpp()\y, x2, y2, $FFFFFF)
            StopDrawing()
            SetGadgetState(0, ImageID(0))
          EndIf
          AddElement(mpp())
          mpp()\x = x2
          mpp()\y = y2
      EndSelect
     EndIf
    Case #PB_Event_CloseWindow
      Exit = #True
  EndSelect
Until Exit

Re: All OS Filled Polygon

Posted: Mon Jul 12, 2010 9:55 pm
by Arctic Fox
Thanks for sharing this, Erlend!
Since it is crossplatform code, it is very useful! :D

Re: All OS Filled Polygon

Posted: Tue Jul 13, 2010 9:16 am
by marc_256
Thanks for sharing it with us, :)

Marc

Re: All OS Filled Polygon

Posted: Tue Jul 13, 2010 9:12 pm
by infratec
Hi Erlend,

for the new demo code:

Simply press the right mouse button to set a point.
After 3 points you can press the left mouse button to draw the polygon.

Best regards,

Bernd

Re: All OS Filled Polygon

Posted: Wed Jul 14, 2010 5:48 am
by Erlend
infratec: please note that I updated the first post as the code was all wrong.... The new one is better tested to work in most cases:-)

Re: All OS Filled Polygon

Posted: Wed Jul 14, 2010 6:52 am
by infratec
Hi Erlend,

thank you very much :!:

Now it makes more sense :mrgreen:

And here it is a slightly improved version:

Code: Select all

CompilerSelect #PB_Compiler_OS
  CompilerCase #PB_OS_Windows
    #PB_Event_WindowsMouseMove = $200
  CompilerCase #PB_OS_Linux
    #PB_Event_WindowsMouseMove = -1
  CompilerCase #PB_OS_MacOS
    #PB_Event_WindowsMouseMove = 0
CompilerEndSelect
 

Structure pippoint
   x.l
   y.l
EndStructure

Procedure FilledPolygon(List points.pippoint(),color)
  NewList nodes.i()
  ;Find least and most y values to restrict area to transverse when filling..
  ResetList(points())
  miny=OutputHeight()-1
  maxy=0
  While NextElement(points())
    If points()\y<miny:miny=points()\y:EndIf
    If points()\y>maxy:maxy=points()\y:EndIf
  Wend

  For cy=miny To maxy
    x.f=cx
    y.f=cy
    oddnodes=#False
  ClearList(nodes())
  LastElement(points())
  x1.f=points()\x
  y1.f=points()\y
  ResetList(points())
  While NextElement(points())
    x2.f=points()\x
    y2.f=points()\y
      If ((y2<Y) And y1>=Y) Or (y1<Y And y2>=Y)
      AddElement(nodes())
      nodes()=(x2+(Y-y2) / (y1-y2) * (x1-x2))
      EndIf
      x1=x2
      y1=y2
  Wend
  SortList(nodes(),#PB_Sort_Ascending)
   ResetList(nodes())
   While NextElement(nodes())
     x1=nodes()
     NextElement(nodes())
     x2=nodes()
     LineXY(x1,Y,x2,y,color)
   Wend
  Next
  FirstElement(Points())
  oldx=Points()\x
  oldy=points()\y
  While NextElement(points())
    LineXY(oldx,oldy,Points()\x,Points()\y,color)
    oldx=points()\x
    oldy=Points()\y
  Wend
EndProcedure


NewList mpp.pippoint()

OpenWindow(0, 0, 0, 640, 480, "Filled Polygon", #PB_Window_SystemMenu)

CreateImage(0, 640, 480)
StartDrawing(ImageOutput(0))
Box(0, 0, 640, 480, 0)
StopDrawing()
ImageGadget(0, 0, 0, 640, 480, ImageID(0))

Exit = #False
Repeat

  Event = WaitWindowEvent()
  
;  Debug Event
  
  Select Event
    Case #PB_Event_WindowsMouseMove
      If ListSize(mpp()) > 0
       SelectElement(mpp(), ListSize(mpp()) - 1)
       StartDrawing(ImageOutput(0))
       LineXY(mpp()\x, mpp()\y, MouseX, MouseY, $0)
       MouseX = WindowMouseX(0)
       MouseY = WindowMouseY(0)       
       LineXY(mpp()\x, mpp()\y, MouseX, MouseY, $FFFFFF)
       
       If ListSize(mpp()) > 1         
         SelectElement(mpp(), 0)
         HelpX = mpp()\x
         HelpY = mpp()\y
         While NextElement(mpp())
           LineXY(HelpX, HelpY, mpp()\x, mpp()\y, $FFFFFF)
           HelpX = mpp()\x
           HelpY = mpp()\y
         Wend
       EndIf
       
       StopDrawing()
       SetGadgetState(0, ImageID(0))
      Else
       MouseX = WindowMouseX(0)
       MouseY = WindowMouseY(0)
     EndIf
     
    Case #PB_Event_Gadget
      If EventGadget() = 0
       Select EventType()
         Case #PB_EventType_RightClick
          If ListSize(mpp()) > 2
           StartDrawing(ImageOutput(0))
           SelectElement(mpp(), ListSize(mpp()) - 1)
           LineXY(mpp()\x, mpp()\y, MouseX, MouseY, $0)
           filledpolygon(mpp(),RGB(Random(220) + 35, Random(220) + 35, Random(220) + 35))
           StopDrawing()
           SetGadgetState(0, ImageID(0))
           ClearList(mpp())
          EndIf
        Case #PB_EventType_LeftClick
          MouseX = WindowMouseX(0)
          MouseY = WindowMouseY(0)
          If ListSize(mpp()) > 0
            SelectElement(mpp(), ListSize(mpp()) - 1)
            StartDrawing(ImageOutput(0))
            LineXY(mpp()\x, mpp()\y, MouseX, MouseY, $FFFFFF)
            StopDrawing()
            SetGadgetState(0, ImageID(0))
          EndIf
          AddElement(mpp())
          mpp()\x = MouseX
          mpp()\y = MouseY
      EndSelect
     EndIf
    Case #PB_Event_CloseWindow
      Exit = #True
  EndSelect
Until Exit
I don't own a Mac, so I can not test what's the right event. :cry:
I tested it with Linux, with -1 as event and it works, but if you move the mouse to quick
after setting a point, the click event comes after the next mouemove event :!:
But I was testing this in a VirtualBox, so maybe the emulation is to slow.

Bernd

Re: All OS Filled Polygon

Posted: Wed Jul 14, 2010 11:33 am
by Vera
Hello you 2

thanks for sharing and emproving :D

@ infratec
As for the quick mousemove and not showing the first line, happens as well on a standard installed Linux version. Showing these helplines is fine but it's a double-faced feature. Hovering over an existing polygon it destroys the drawing underneath. This way you could either use it as eraser or as further feature to place rays or starbursts ;)
[I can't recall if this happened with your first code example as well, but I don't think so.]
Concering this, it's not really bad that the first line doesn't show, when your quick enough.

greetings ~ Vera

Re: All OS Filled Polygon

Posted: Wed Jul 14, 2010 11:53 am
by infratec
Hi Vera,

especially for you, I updated my posting above.
Now you can't play Eraser anymore :mrgreen:

Only if you place one polygon above an other.

But that's artwork :lol: :lol: :lol:

Bernd

Re: All OS Filled Polygon

Posted: Wed Jul 14, 2010 12:31 pm
by Vera
Hi,

mind you - I still can :mrgreen:
I think it's no miracle, as the helpines are drawn within one and the same drawing procedure and the underlying color simply get's 'forgotten'. To pevent this, I estimate you'd have to work with two pictures, applying the second onto the first after finishing the new polygon.
But for me, you don't need to bother - I like the effects you can make with it.

btw: nice to know
infratec wrote:that's artwork :lol: :lol: :lol:
cheers ~ Vera

Re: All OS Filled Polygon

Posted: Wed Jul 14, 2010 3:09 pm
by Demivec
@infratec, Vera: here's a change that may be closer to what you were thinking. It still uses only one image but makes use of the Xor drawing mode. Only a few changes are necessary, most of them involve the removal of code.

Code: Select all

CompilerSelect #PB_Compiler_OS
  CompilerCase #PB_OS_Windows
    #PB_Event_WindowsMouseMove = $200
  CompilerCase #PB_OS_Linux
    #PB_Event_WindowsMouseMove = -1
  CompilerCase #PB_OS_MacOS
    #PB_Event_WindowsMouseMove = 0
CompilerEndSelect


Structure pippoint
  x.l
  y.l
EndStructure

Procedure FilledPolygon(List points.pippoint(),Color)
  NewList nodes.i()
  ;Find least and most y values to restrict area to transverse when filling..
  ResetList(points())
  miny=OutputHeight()-1
  maxy=0
  While NextElement(points())
    If points()\y<miny:miny=points()\y:EndIf
    If points()\y>maxy:maxy=points()\y:EndIf
  Wend
  
  For cy=miny To maxy
    x.f=cx
    y.f=cy
    oddnodes=#False
    ClearList(nodes())
    LastElement(points())
    x1.f=points()\x
    y1.f=points()\y
    ResetList(points())
    While NextElement(points())
      x2.f=points()\x
      y2.f=points()\y
      If ((y2<y) And y1>=y) Or (y1<y And y2>=y)
        AddElement(nodes())
        nodes()=(x2+(y-y2) / (y1-y2) * (x1-x2))
      EndIf
      x1=x2
      y1=y2
    Wend
    SortList(nodes(),#PB_Sort_Ascending)
    ResetList(nodes())
    While NextElement(nodes())
      x1=nodes()
      NextElement(nodes())
      x2=nodes()
      LineXY(x1,y,x2,y,Color)
    Wend
  Next
  FirstElement(points())
  oldx=points()\x
  oldy=points()\y
  While NextElement(points())
    LineXY(oldx,oldy,points()\x,points()\y,Color)
    oldx=points()\x
    oldy=points()\y
  Wend
EndProcedure


NewList mpp.pippoint()

OpenWindow(0, 0, 0, 640, 480, "Filled Polygon", #PB_Window_SystemMenu)

CreateImage(0, 640, 480)
StartDrawing(ImageOutput(0))
  Box(0, 0, 640, 480, 0)
StopDrawing()
ImageGadget(0, 0, 0, 640, 480, ImageID(0))

exit = #False
Repeat
  
  event = WaitWindowEvent()
  
  ;  Debug Event
  
  Select event
    Case #PB_Event_WindowsMouseMove
      If ListSize(mpp()) > 0
        SelectElement(mpp(), ListSize(mpp()) - 1)
        StartDrawing(ImageOutput(0))
          DrawingMode(#PB_2DDrawing_XOr)
          LineXY(mpp()\x, mpp()\y, MouseX, MouseY, $FFFFFF) ;remove last line drawn
          MouseX = WindowMouseX(0)
          MouseY = WindowMouseY(0)       
          LineXY(mpp()\x, mpp()\y, MouseX, MouseY, $FFFFFF) ;add a new line
        StopDrawing()
        SetGadgetState(0, ImageID(0))
      Else
        MouseX = WindowMouseX(0)
        MouseY = WindowMouseY(0)
      EndIf
      
    Case #PB_Event_Gadget
      If EventGadget() = 0
        Select EventType()
          Case #PB_EventType_RightClick
            If ListSize(mpp()) > 2
              StartDrawing(ImageOutput(0))
                SelectElement(mpp(), ListSize(mpp()) - 1)
                ;DrawingMode(#PB_2DDrawing_XOr) ;uncomment this line for an interesting visual effect
                LineXY(mpp()\x, mpp()\y, MouseX, MouseY, $0)
                FilledPolygon(mpp(),RGB(Random(220) + 35, Random(220) + 35, Random(220) + 35))
              StopDrawing()
              SetGadgetState(0, ImageID(0))
              ClearList(mpp())
            EndIf
          Case #PB_EventType_LeftClick
            MouseX = WindowMouseX(0)
            MouseY = WindowMouseY(0)
            If ListSize(mpp()) > 0
              SetGadgetState(0, ImageID(0))
            EndIf
            AddElement(mpp())
            mpp()\x = MouseX
            mpp()\y = MouseY
        EndSelect
      EndIf
    Case #PB_Event_CloseWindow
      exit = #True
  EndSelect
Until exit

Re: All OS Filled Polygon

Posted: Wed Jul 14, 2010 7:07 pm
by Vera
Thanks Demivec
['though it corrupts that artwork thing :twisted: ]
and a good lesson to learn. :wink:

And not believing in coincidences - SoS posted this the afternoon in the german forum: filled triangle inclusive clipping (runs as well on Linux (if you declare #White) and Mac)
it might not fit neatly in here - but it was surprising to view hereafter and made me laugh :)

cheers ~ Vera
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited