PureBasic Forums - English

Posted: **Sun Jan 27, 2019 12:28 pm**

Hi all,

I have a programme that usrs can use to draw objects on a canvas. One request is to be able to draw regular polygons.

Step 1 Click to set top left corner

step 2 Drag mouse with left button down to set size

Step 3 Release mouse button to finish drawing.

All that works well.

Just how do you draw a regular polygon inside a bounding rectangle? Ok to draw in a bounding circle but when using a rectangle not all poygons touch all sides!

Great if it could be expressed as a path for vector drawing as it would then be scaleable.

Will knock up some quick test code if anyone needs it.

regards

CD

Posted: **Sun Jan 27, 2019 2:34 pm**

A regular polygon can only fit in a square rectangle.
It will never fit to all sizes of a non square rectangle.

So you need to decide what you want.

1. regular polygon -> only in circle or square rectangle
2. non square rectangle -> malformed 'regular' polygone

Posted: **Sun Jan 27, 2019 2:41 pm**

Get the box center. Divide a full 360° circle by n (for an nth-ploygon). Draw lines from each partition to the next around center..
Use mousemove to resize and mousewheel to rotate.

Code: Select all

EnableExplicit
Define ww, wh, style, win, canvas, event, quit

ww=800
wh=600
style | #PB_Window_ScreenCentered
style | #PB_Window_SystemMenu
style | #PB_Window_MinimizeGadget

win = OpenWindow(#PB_Any, 50,100, ww,wh, "use mousemove / mousewheel", style)
AddKeyboardShortcut(win, #PB_Shortcut_Escape, 10)
canvas = CanvasGadget(#PB_Any, 0, 0, ww, wh, #PB_Canvas_Keyboard)
SetActiveGadget(canvas)

Define w, h
Define angle.f

Procedure draw(x, y, w, h, n, a.f)
  Protected xr, yr, xc, yc, i, x1, y1, x2, y2
  Protected a2.f
  DrawingMode(#PB_2DDrawing_AlphaBlend | #PB_2DDrawing_Outlined)
  Box(x, y, w, h, $6600ff00)
  ; radius
  xr = (w / 2)
  yr = (h / 2)
  ; center
  xc = x + xr
  yc = y + yr
  For i=0 To n
    a2.f = Radian(i * 360.0 / n) + Radian(a)
    x1 = xc - xr * Cos(a2)
    y1 = yc - yr * Sin(a2)
    If i > 0
      LineXY(x1, y1, x2, y2, $ff00ff00)
    EndIf
    x2 = x1
    y2 = y1
  Next
EndProcedure

Procedure redraw()
  Shared w, h, angle, canvas
  StartDrawing(CanvasOutput(canvas))
  DrawingMode(#PB_2DDrawing_AllChannels)
  Box(0, 0, OutputWidth(), OutputHeight(), $00000000)
  draw(  0,   0, w, h, 3, angle)
  draw(200,   0, w, h, 4, angle)
  draw(400,   0, w, h, 5, angle)
  draw(  0, 200, w, h, 6, angle)
  draw(200, 200, w, h, 12, angle)
  draw(400, 200, w, h, 30, angle)
  StopDrawing()
EndProcedure

Repeat
  If IsWindow(win) ;{
    Repeat
      event   = WaitWindowEvent(10)
      Select event
        Case #PB_Event_CloseWindow
          quit = #True
        Case #PB_Event_Menu
          Select EventMenu()
            Case 10
              quit = #True
          EndSelect
        Case #PB_Event_Gadget
          Select EventGadget()
            Case canvas
              Select EventType()
                Case #PB_EventType_MouseWheel
                  angle + 4 * GetGadgetAttribute(canvas, #PB_Canvas_WheelDelta)
                  redraw()
                Case #PB_EventType_MouseMove
                  w = GetGadgetAttribute(canvas, #PB_Canvas_MouseX)
                  h = GetGadgetAttribute(canvas, #PB_Canvas_MouseY)
                  redraw()
              EndSelect
          EndSelect
      EndSelect
    Until Not event
    ;}
  EndIf
Until quit

Posted: **Sun Jan 27, 2019 3:39 pm**

Hi and Thankyou,

Brilliant more new ideas.

Raised my thinking a little.

Looked again at the problem and found that not all regular polygons fit in a square the pentagon and heptagon need oblongs.

I need the drawn figure to be repeatable based soley on width, height and number of sides also for the bouding rectangle to be based on width and height.

Took a look at PathSegments() in vector drawing library.

Created heptagon in the normal way from a centre point rotating coordinates in a 100 X 100 grid. then used debug PathSegments() to output the path segments used.

I then plugged this into an old routine of mine DrawPath() which adds scaling and allows the figure to be drawn anywhere on the page and it seems to work!!

The drawpath procedure is stripped down to lines only but has to cope with images text and paragraphs plus other stuff so need to keep.

I converted all to integer values maybe more accurate to use floats will try later.

Not done rotation from mousewheel yet have to get my head around that.

It will produce regular polygons but whenh plugged into drawing programme produces malformed 'Regular' polygons when drawing area defined by mousemove is not square.

Here is the test code I have knocked up. It draws the polygon and a bounding rectangle.

Code: Select all

  Procedure DrawPath(Top.i,Left.i,Width.i,Height.i,Path.s)

    Dim Args.f(20)
    Define NumArgs.i
    Define DrawColour.i,DrawTrans.i,Scale.d
    Define i.i
    Define Bottom.i,Right.i,Path.s
    Define CentreX.i,CentreY.i

    If Width < 10
      Width = 10
    EndIf
    If Height < 10
      Height = 10
    EndIf
    
    CentreX = (Width/2) + Left
    CentreY = (Height/2) + Top
    
    For i = 1 To CountString(Path, ",") + 1
        
    Select StringField(Path, i, ",")
      Case "M"
        NumArgs = 0
        i = i + 1
        Args(NumArgs) = Val(StringField(Path, i, ","))
        i = i + 1
        NumArgs = NumArgs + 1
        Args(NumArgs) = Val(StringField(Path, i, ","))       
        MovePathCursor(((Args(0)/100) * Width) + Left ,((Args(1)/100) * Height) + Top)

      Case "L"
        
        NumArgs = 0       
        i = i + 1
        Args(NumArgs) = Val(StringField(Path, i, ","))
        i = i + 1
        NumArgs = NumArgs + 1
        Args(NumArgs) = Val(StringField(Path, i, ","))
        AddPathLine(((Args(0)/100) * Width) + Left ,((Args(1)/100) * Height) + Top)

      Case "E"      
    
        NumArgs = 0       
        i = i + 1
        Args(NumArgs) = Val(StringField(Path, i, ","))
        i = i + 1
        NumArgs = NumArgs + 1        
        Args(NumArgs) = Val(StringField(Path, i, ",")) 
        VectorSourceColor(RGBA(0,0,0,255))
        AddPathEllipse(CentreX,CentreY,Abs(Width/2),Abs(Height/2))
        StrokePath(1)
        
      Case "S"    ;Story
        i = i + 1       
        i = i + 1
        MyFont.s = StringField(Path, 2, ",") 
        MyFontSize =  Val(StringField(Path, 3, ",") )
        MyText.s =  StringField(Path, 4, ",")        
        
        LoadFont(0, MyFont, MyFontSize) 
        VectorFont(FontID(0))

        MovePathCursor(Left,Top)
        DrawVectorParagraph(MyText,Width,Height)

      Case "Z"

        ClosePath()
        StrokePath(1)
    
    EndSelect 
    
  Next i
  
  StrokePath(1)
  
EndProcedure
  
Global Window_0

Global Canvas_0

Define Top.i,Left.i,Width.i,Height.i,MyPath.s

  Window_0 = OpenWindow(#PB_Any, 0, 0, 600, 400, "", #PB_Window_SystemMenu)
  Canvas_0 = CanvasGadget(#PB_Any, 110, 30, 300, 300)
  
  StartVectorDrawing(CanvasVectorOutput(Canvas_0,#PB_Unit_Pixel ))

  ;Path Segments for a Heptagon based on a 100 X 100 grid for scaling
  MyPath = "M,50,0,L,90,19,L,100,62,L,73,99,L,28,99,L,1,62,L,11,19,Z"
    
    ;Set These with mouse click and mousemove to make it dynamic
    Top = 0
    Left = 0
    Width = 200
    height = 200
 
    Drawpath(Top,Left,Width,Height,MyPath)
    AddPathBox(Top,Left,Width,Height)
    StrokePath(1) 
    StopVectorDrawing()
  
Repeat
    
    Event = WaitWindowEvent()
    Select Event
      Case #PB_Event_CloseWindow
        End

    Case #PB_Event_Menu
      Select EventMenu()
      EndSelect

    Case #PB_Event_Gadget
      Select EventGadget()
      EndSelect
  EndSelect
  
  ForEver

All I have to do now is get the paths for the other polygons required.

This will not accept a number of points but removes the annoying blank space around a defining rectangle.

Regards

collectordave

Posted: **Sun Jan 27, 2019 8:07 pm**

Not so perfect
Needs more calculations

Code: Select all

;Rectangle 100*100
h = 50
no = 5
angle.f =360/no/2
s = h*Sin(Radian(angle))/Sin(Radian(90-angle))
  
If OpenWindow(0, 0, 0, 400, 200, "VectorDrawing", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  CanvasGadget(0, 0, 0, 400, 200)

  If StartVectorDrawing(CanvasVectorOutput(0))    
    ResetCoordinates()
    AddPathBox(100+s/2, 50, 100, 100)
    VectorSourceColor(RGBA(255, 0, 0, 255))
    StrokePath(1)
    VectorSourceColor($FFE7E7B7)
    AddPathBox(150, 50, s, 100)
    FillPath()
    x = 150 + s/2
    For path = 1 To no - 1
      RotateCoordinates(x, 100, angle)
      AddPathBox(150, 50, s, 100)
      FillPath()
    Next
    StopVectorDrawing()
  EndIf
  
  Repeat
    Event = WaitWindowEvent()
  Until Event = #PB_Event_CloseWindow
EndIf

Posted: **Mon Jan 28, 2019 9:05 pm**

I tried a bit more..
Now I store the coords first, get the actual bounding box, shift them, scale them, shift them back, so they fit the given box. Second row on screen is scaled, first row is unscaled.

Code: Select all


EnableExplicit
Define ww, wh, style, win, canvas, event, quit

ww=1000
wh=600
style | #PB_Window_ScreenCentered
style | #PB_Window_SystemMenu
style | #PB_Window_MinimizeGadget

win = OpenWindow(#PB_Any, 50,100, ww,wh, "use mousemove / mousewheel", style)
AddKeyboardShortcut(win, #PB_Shortcut_Escape, 10)
canvas = CanvasGadget(#PB_Any, 0, 0, ww, wh, #PB_Canvas_Keyboard)
SetActiveGadget(canvas)

Define w, h
Define angle.f

Procedure draw(x.f, y.f, w.f, h.f, n, a.f, scaleTofit = #False)
  Protected.f xr, yr
  Protected.f xc, yc
  Protected.f xp, yp
  Protected Dim p.f(n, 1) ; (0 = x, 1 = y)
  Protected.f xmin = 9999999
  Protected.f xmax = -9999999
  Protected.f ymin = 9999999
  Protected.f ymax = -9999999
  Protected.f wPoly, hPoly
  Protected.f wr, hr
  Protected.f x1, y1, x2, y2
  Protected i
  Protected.f a2
  
  DrawingMode(#PB_2DDrawing_AlphaBlend | #PB_2DDrawing_Outlined)
  
  ; draw given bounding box (red)
  Box(x, y, w, h, $aa0000ff)
  
  ; radius
  xr = (w / 2)
  yr = (h / 2)
  
  ; center
  xc = x + xr
  yc = y + yr
  
  ; get points and actual polygon boundary box (min/max)
  For i=0 To n
    a2.f = Radian(i * 360.0 / n) + Radian(a)
    xp = xc + xr * Cos(a2)
    yp = yc + yr * Sin(a2)
    
    p(i, 0) = xp
    p(i, 1) = yp
    
    If xp < xmin : xmin = xp : EndIf
    If xp > xmax : xmax = xp : EndIf
    If yp < ymin : ymin = yp : EndIf
    If yp > ymax : ymax = yp : EndIf
  Next
  
  If scaleTofit = #False
    
    ; draw unscaled polygon (purple)
    For i=1 To n
      x1 = p(i-1, 0)
      y1 = p(i-1, 1)
      x2 = p(i  , 0)
      y2 = p(i  , 1)
      LineXY(x1, y1, x2, y2, $aaffbbbb)
    Next
    
    ; draw bounding box/circle (purple)
    ;Ellipse(xc, yc, xr, yr, $aaffbbbb)
    ;Box( (xmin), (ymin), (xmax - xmin), (ymax - ymin), $aaffbbbb)
    
  Else
    
    ; shift points to zero
    For i=0 To n
      p(i, 0) - xmin
      p(i, 1) - ymin
    Next
    
    ; actual size needed for polygon
    wPoly = (xmax - xmin) + 1
    hPoly = (ymax - ymin) + 1
    
    ; get ratio from given box to needed box
    wr = w / wPoly
    hr = h / hPoly
    
    ; scale points
    For i=0 To n
      p(i, 0) * wr
      p(i, 1) * hr
    Next
    
    ; shift points back to given origin
    For i=0 To n
      p(i, 0) + x
      p(i, 1) + y
    Next
    
    ; draw scaled polygon (green)
    For i=1 To n
      x1 = p(i-1, 0)
      y1 = p(i-1, 1)
      x2 = p(i  , 0)
      y2 = p(i  , 1)
      LineXY(x1, y1, x2, y2, $ff66ff66)
    Next
    
  EndIf
  
EndProcedure

Procedure redraw()
  Shared w, h, angle, canvas
  StartDrawing(CanvasOutput(canvas))
  DrawingMode(#PB_2DDrawing_AllChannels)
  Box(0, 0, OutputWidth(), OutputHeight(), $00000000)
  
  draw(  0,   0, w, h,  3, angle)
  draw(200,   0, w, h,  4, angle)
  draw(400,   0, w, h,  5, angle)
  draw(600,   0, w, h,  6, angle)
  draw(800,   0, w, h, 12, angle)
  
  draw(  0, 200, w, h,  3, angle, #True)
  draw(200, 200, w, h,  4, angle, #True)
  draw(400, 200, w, h,  5, angle, #True)
  draw(600, 200, w, h,  6, angle, #True)
  draw(800, 200, w, h, 12, angle, #True)
  
  StopDrawing()
EndProcedure

Repeat
  If IsWindow(win) ;{
    Repeat
      event   = WaitWindowEvent(10)
      Select event
        Case #PB_Event_CloseWindow
          quit = #True
        Case #PB_Event_Menu
          Select EventMenu()
            Case 10
              quit = #True
          EndSelect
        Case #PB_Event_Gadget
          Select EventGadget()
            Case canvas
              Select EventType()
                Case #PB_EventType_MouseWheel
                  angle + 4 * GetGadgetAttribute(canvas, #PB_Canvas_WheelDelta)
                  redraw()
                Case #PB_EventType_MouseMove
                  w = GetGadgetAttribute(canvas, #PB_Canvas_MouseX)
                  h = GetGadgetAttribute(canvas, #PB_Canvas_MouseY)
                  redraw()
              EndSelect
          EndSelect
      EndSelect
    Until Not event
    ;}
  EndIf
Until quit

Posted: **Fri Feb 01, 2019 5:17 am**

Absolutly brilliant,

Thankyou.

Used this to get path coords then draw with a path using the vector lib means I can now draw any shape any size.

Thanks again

PureBasic Forums - English

draw Regular Polygon

draw Regular Polygon

Re: draw Regular Polygon

Re: draw Regular Polygon

Re: draw Regular Polygon

Re: draw Regular Polygon

Re: draw Regular Polygon

Re: draw Regular Polygon