Draw arcs, polygons, pies, thick lines, no API calls

Share your advanced PureBasic knowledge/code with the community.
User avatar
idle
Always Here
Always Here
Posts: 5840
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: Draw arcs, polygons, pies, thick lines, no API calls

Post by idle »

It should really support multiple line styles, I'll try to add styles


seems to work but not perfect.

Code: Select all

;Arcs Polygons Pies
;BasicallyPure, Idle 
;3/4/13
;added line styles 12/10/13

EnableExplicit 

Structure segments
   color.i 
   len.i 
EndStructure   

Structure style 
   Array segs.segments(1)
   index.i 
   ctr.i
EndStructure   

Procedure _Line(x1, y1, x2, y2,color=0,width=1,*linestyle.style=0)
   Protected dx,dy,e2,err,sx,sy,px,py
   width = width * 2 - 2
   dx = Abs(x2-x1) : dy = Abs(y2-y1) : err = dx - dy
   
   If x1 < x2 : sx = 1 : Else : sx = -1 : EndIf
   If y1 < y2 : sy = 1 : Else : sy = -1 : EndIf
   px=x1 : py = y1
   Repeat
      If *linestyle 
         If *linestyle\index > ArraySize(*linestyle\segs()) 
            *linestyle\index = 0 
         EndIf 
         If *linestyle\segs(*linestyle\index)\color <> -1
            Circle(px, py, width, *linestyle\segs(*linestyle\index)\color)
         EndIf    
         *linestyle\ctr+1 
          If *linestyle\ctr >= (*linestyle\segs(*linestyle\index)\len * (width+1)) 
            *linestyle\index+1
             *linestyle\ctr = 0 
          EndIf           
      Else    
        Circle(px, py, width, color)
      EndIf 
      If px = x2 And py = y2 : Break : EndIf
      e2 = err << 1
      If e2 > -dy : err - dy : px + sx : EndIf
      If e2 <  dx : err + dx : py + sy : EndIf
   ForEver
   
EndProcedure

CompilerIf Not Defined(point,#PB_Structure) 
 Structure Point
   x.i
   y.i
 EndStructure   
CompilerEndIf 

Structure ArcData
  astart.point
  aend.point
EndStructure

#Arc_Mode_Arc = 0
#Arc_Mode_Polygon = 1

Procedure _Arc(x,y,degrees.i,majoraxis.i,minoraxis.i=0,orient.i=0,color=0,thickness=1,mode=#Arc_Mode_Arc,*arc.ArcData=0,Fill=0,FillColor=$FFFFFF,*linestyle=0)
   ; BasicallyPure 3.31.2013
   ; Idle added eliptic,orientation,bresenham,thickness
   ; purpose: draw an arc or regular polygon
   ; this procedure must be used inside a StartDrawing() StopDrawing() block.
   ;
   ; Syntax: Arc(x,y,degrees,MajorAxis, MinorAxis, [Orient], [color],[thickness],[mode],[*arc])
   ;
   ; x, y      |  the center location of the arc or polygon.
   ; Degrees   |  degree of arc or the number of sides of a polygon 
   ;           |   if mode = #Arc_Mode_Arc: how many degrees of the arc.
   ;           |   if mode = #Arc_Mode_Polygon: number of polygon sides.
   ; MajorAxis |  width of elliptic
   ; MinorAxis |  Height of elliptic
   ; Orient    |  Orientation of 0 to 360 
   ; color     |  optional, sets the line color (default is black).
   ; thickness |  optional, Line thickness
   ; mode      |  optional, draws arc or polygon (default is Arc).
   ; *arc      |  optional, pointer to arcdata structure to store start and end points
   
   Protected xx, yy, px, py, inc.f, ang.f, fin.f
   Protected ndx.f,ndy.f,dy.f,dx.f,dx1,dy1,cosOrient.f,SinOrient.f
   Protected start.i,finish.i
   start = 0 : finish=degrees 
   
   Select mode
      Case #Arc_Mode_Arc
         If start > finish : Swap start, finish : EndIf
         If finish - start > 360 : finish = start + 360 : EndIf
         inc = 0.1 ; arc smoothness
      Case #Arc_Mode_Polygon
         If finish < 3 : finish = 3 : EndIf
         If finish > 64 : finish = 64 : EndIf
         inc = Radian(360 / finish)
         finish = start + 360
      Default
         ProcedureReturn 0
   EndSelect
         
   
   ang = Radian(start)
   fin = Radian(finish)
   cosOrient = Sin(Radian(orient-180)) ;0 To 360
   sinOrient = Cos(Radian(orient-180))  
   dx = x + (Cos(ang) * majoraxis) 
   dy = y + (Sin(ang) * minoraxis) 
   dx1 = dx - x 
   dy1 = dy - y
   px = x + (dx1 * sinOrient - dy1 * cosOrient) ;rotate elipse
   py = y + (dx1 * cosOrient + dy1 * sinOrient)
   
   If *arc 
      *arc\astart\x = px
      *arc\astart\y = py
   EndIf  
    ;draw elipse 
   Repeat 
     ang + inc  
     If ang > fin : ang = fin : EndIf
     dx = x + (Cos(ang) * majoraxis) 
     dy = y + (Sin(ang) * minoraxis) 
     dx1 = dx - x 
     dy1 = dy - y
     ndx = x + (dx1 * sinOrient - dy1 * cosorient) ;rotate elipse
     ndy = y + (dx1 * cosOrient + dy1 * sinorient)
     
     _Line(px,py,ndx,ndy,0,thickness,*linestyle)
    
     px = ndx
     py = ndy
   Until ang = fin
   
   If *arc
      *arc\aend\x = px
      *arc\aend\y = py 
   EndIf    
   
   If Fill 
     If mode = #Arc_Mode_Polygon
        FillArea(x,y,color,FillColor)
     EndIf 
   EndIf   
   
EndProcedure
;-Public Helper functions  
Procedure Arc(x,y,degrees.i,majoraxis.i,minoraxis.i,orient.i,color=0,thickness=1,*linestyle.style=0) 
  _arc(x,y,degrees,majoraxis,minoraxis,orient,color,thickness,#Arc_Mode_Arc,0,0,$ffffff,*linestyle) 
EndProcedure 

Procedure Polygon(x,y,sides.i,majoraxis.i,minoraxis.i=0,orient.i=0,color=0,thickness=1,Fill=0,FillColor=$FFFFFF,*linestyle.style=0)
   _arc(x,y,sides,majoraxis,minoraxis,orient,color,thickness,#Arc_Mode_Polygon,0,Fill,FillColor,*linestyle) 
EndProcedure    

Procedure Pie(x,y,degrees.i,radius.i,orient.i=0,color=0,thickness=1,Fill=0,FillColor=$FFFFFF,*linestyle.style=0)  
   Protected pts.ArcData,ang.f,dx.f,dy.f,dx1.f,dy1.f,px,py,cosOrient.f,sinOrient.f 
   _arc(x,y,degrees,radius,radius,orient,color,thickness,#Arc_Mode_Arc,@pts,0,$FFFFFF,*linestyle) 
   _Line(x,y,pts\astart\x,pts\astart\y,color,thickness,*linestyle)
   _Line(x,y,pts\aend\x,pts\aend\y,color,thickness,*linestyle)
   If Fill 
      ang = Radian(degrees/2) 
      cosOrient = Sin(Radian(orient-180)) ;0 To 360
      sinOrient = Cos(Radian(orient-180))  
      dx = x + (Cos(ang) * radius/2) 
      dy = y + (Sin(ang) * radius/2) 
      dx1 = dx - x 
      dy1 = dy - y
      px = x + (dx1 * sinOrient - dy1 * cosOrient) ;rotate elipse
      py = y + (dx1 * cosOrient + dy1 * sinOrient)
      FillArea(px,py,color,FillColor)
   EndIf 
EndProcedure    

Procedure BLine(x1,y1,x2,y2,color=0,thickness=1,*linestyle.style=0)
   _Line(x1,y1,x2,y2,color,thickness,*linestyle)
EndProcedure    


;-<><><> and now a demonstration <><><>
Enumeration 1 
  #image 
  #Orient 
  #MajorAxis
  #MinorAxis 
  #Degrees
  #Arc
  #Poly
  #Pie
  #thick
  #SOrient
  #SMajor
  #SMinor
  #sDegrees
  #SFinish
  
EndEnumeration  
  
Procedure  InitGUI()
   Global  degrees = 180, f = 180, majoraxis = 150, minoraxis=150, orient=0, thickness=1
   
   If Not OpenWindow(0, 200, 100, 800, 630, "ARC & POLYGON DEMO") : End : EndIf
   
   ImageGadget(#image,0,0,800,450,0)
   TrackBarGadget(#Orient, 60, 500, 600, 25, 0, 360) : SetGadgetState(#Orient, orient) ; orient
   TrackBarGadget(#MajorAxis, 60,530, 600, 25, 0, 300) : SetGadgetState(#MajorAxis, majoraxis) ; majoraxis
   TrackBarGadget(#MinorAxis, 60, 560, 600, 25, 0, 300) : SetGadgetState(#MinorAxis, minoraxis) ; minoraxis  
   TrackBarGadget(#Degrees, 60, 590, 600, 25, 0, 720) : SetGadgetState(#Degrees, degrees+360) ; start
  
   
   TextGadget(#PB_Any,10, 470, 45, 25, "Mode")
   TextGadget(#PB_Any,10, 500, 45, 25, "Orient")
   TextGadget(#PB_Any,10, 530, 45, 25, "MajorAxis")
   TextGadget(#PB_Any,10, 560, 45, 25, "MinorAxis")
   
   TextGadget(#PB_Any,10, 590, 45, 25, "Degrees")
  
   
   StringGadget(#SOrient, 670, 500, 45, 25, Str(orient))
   StringGadget(#SMajor, 670, 530, 45, 25, Str(majoraxis))
   StringGadget(#SMinor, 670, 560, 45, 25, Str(minoraxis))
   StringGadget(#sDegrees, 670, 590, 45, 25, Str(degrees))
  
   
   OptionGadget(#arc, 60, 470, 45, 25, "Arc") : SetGadgetState(#arc,1)
   OptionGadget(#poly, 115, 470, 65, 25, "Polygon")
   OptionGadget(#pie, 190, 470, 65, 25, "Pie")
   TextGadget(#PB_Any,256,470,65,25,"Thickness")
   SpinGadget(#thick,336,470,60,25,1,20,#PB_Spin_Numeric) : SetGadgetState(#thick,1)
   
   
EndProcedure


Procedure DrawObject()
    Protected st.style 
   Static img 
   If Not img 
      img = CreateImage(#PB_Any,800,450)
   EndIf    
   StartDrawing(ImageOutput(img))
   Box(0,0,800,450, $0B94CB)
   If GetGadgetState(#Arc)
      ReDim st\segs(4)                        
      st\segs(0)\color = 0 
      st\segs(0)\len = 10 
      st\segs(1)\color = -1 
      st\segs(1)\len = 5 
      st\segs(2)\color = $FF0000
      st\segs(2)\len = 10 
      st\segs(3)\color = -1 
      st\segs(3)\len = 5  
      
      arc(400, 225,degrees,majoraxis,minoraxis,orient,0,thickness,@st)
   ElseIf GetGadgetState(#Poly)
      ReDim st\segs(2) 
      st\segs(0)\color = 0 
      st\segs(0)\len = 50 
      st\segs(1)\color = -1
      st\segs(1)\len = 20  
      Polygon(400,225,degrees,majoraxis,minoraxis,orient,0,thickness,0,0,@st)
   Else 
      pie(400, 225,degrees,majoraxis,orient,0,thickness,1) 
   EndIf
   StopDrawing()
   SetGadgetState(#image,ImageID(img))
EndProcedure


Procedure EventLoop()
   
   Repeat
      Select WaitWindowEvent()
         Case #PB_Event_Gadget
            Select EventGadget()
               Case #Orient 
                  orient = GetGadgetState(#Orient)
                  SetGadgetText(#SOrient,Str(orient))
                  DrawObject()
               Case #MajorAxis ; radius
                  majoraxis = GetGadgetState(#MajorAxis)
                  SetGadgetText(#SMajor, Str(majoraxis))
                  DrawObject()
               Case #MinorAxis ; minor
                  minoraxis = GetGadgetState(#MinorAxis)
                  SetGadgetText(#SMinor, Str(minoraxis))
                  DrawObject()   
               Case #Degrees ; start
                  degrees = GetGadgetState(#Degrees) - 360
                  If GetGadgetState(#Poly)
                     degrees = Abs(degrees) / 12
                  EndIf
                  SetGadgetText(#sDegrees, Str(degrees))
                  DrawObject()
              Case #Arc ; Arc mode
                  degrees = GetGadgetState(#Degrees) - 360
                  SetGadgetText(#SDegrees, Str(degrees))
                  DrawObject()
               Case #poly ; polygon mode
                  degrees = Abs(degrees) / 12
                  SetGadgetText(#sDegrees, Str(degrees))
                  DrawObject()
               Case #Pie
                  degrees = GetGadgetState(#Degrees) - 360
                  SetGadgetText(#SDegrees, Str(degrees))
                  DrawObject()
               Case #thick 
                  thickness = GetGadgetState(#thick) 
                  DrawObject()
            EndSelect
         Case #PB_Event_CloseWindow
            Break
      EndSelect
   ForEver
EndProcedure

InitGUI()
DrawObject()
EventLoop()

End
Windows 11, Manjaro, Raspberry Pi OS
Image
User avatar
BasicallyPure
Enthusiast
Enthusiast
Posts: 539
Joined: Thu Mar 24, 2011 12:40 am
Location: Iowa, USA

Re: Draw arcs, polygons, pies, thick lines, no API calls

Post by BasicallyPure »

[blendman] wrote:I would to know I could add a sort of "pass" like in photoshop ?
The pass = the space between two circle
if the pass = 50, the line is made by dot with distance between dots = 50 pixels for example.
Maybe this will work for you?

Code: Select all

Procedure ThickLine(x1, y1, x2, y2, width, color, dash = 0)
   ; dash is space between dots for dotted lines.
   ; default dash = 0 is for solid lines.
   
   Protected dx, dy, e2, err, sx, sy, pStep, n
   
   If width < 1 : width = 1 : EndIf
   If dash : pStep = width << 1 + dash : n = pStep : EndIf
   
   width - 1
   dx = Abs(x2-x1) : dy = Abs(y2-y1) : err = dx - dy
   
   If x1 < x2 : sx = 1 : Else : sx = -1 : EndIf
   If y1 < y2 : sy = 1 : Else : sy = -1 : EndIf
   
   Repeat
      If dash
         If n < pStep : n + 1
         Else : Circle(x1, y1, width, color) : n = width >> 1
         EndIf
      Else
         Circle(x1, y1, width, color)
      EndIf
   
      If x1 = x2 And y1 = y2 : Break : EndIf
      e2 = err << 1
      If e2 > -dy : err - dy : x1 + sx : EndIf
      If e2 <  dx : err + dx : y1 + sy : EndIf
   ForEver
EndProcedure

Procedure RndLines(dash = 0)
   Protected n, w = 800 , h = 600
   StartDrawing(CanvasOutput(0))
      Box(0,0,w,h,0)
      For n = 1 To Random(20) + 5
         ThickLine(Random(w),Random(h),Random(w),Random(h),Random(6),Random($FFFFFF), dash)
      Next n
   StopDrawing()
EndProcedure

Define cd, pass

If OpenWindow(0, 0, 0, 800, 640, "ThickLine Demo")
   CanvasGadget(0, 0, 0, 800, 600)
   StringGadget(1, 340, 610, 25, 25, "0")
   TextGadget(#PB_Any, 370, 615, 160, 25, "Pass value; use 0 for solid line.")
   RndLines()
   
   Repeat
      Select WaitWindowEvent()
         Case #PB_Event_CloseWindow
            Break
         Case #WM_MOUSEMOVE
            If WindowMouseY(0) < 600 : cd -1
               If cd < 1
                  cd = 20
                  RndLines(pass)
               EndIf
            EndIf
         Case #PB_Event_Gadget
            If EventGadget() = 1 And EventType() = #PB_EventType_Change
               pass = Val(GetGadgetText(1))
               RndLines(pass)
            EndIf
      EndSelect
   ForEver
EndIf
BasicallyPure
Until you know everything you know nothing, all you have is what you believe.
User avatar
[blendman]
Enthusiast
Enthusiast
Posts: 297
Joined: Thu Apr 07, 2011 1:14 pm
Location: 3 arks
Contact:

Re: Draw arcs, polygons, pies, thick lines, no API calls

Post by [blendman] »

Hi BP

It's great ! It work perfectly with my application.
Thanks you very much !

In my application (painting app) :
Image

PS : I have found a procedure for rotate the brush (image) I use. But it's window only (use api).
By chance, do you have an idea how to do a rotation which doesn't use api ?

Thanks a lot ;).
User avatar
idle
Always Here
Always Here
Posts: 5840
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: Draw arcs, polygons, pies, thick lines, no API calls

Post by idle »

Windows 11, Manjaro, Raspberry Pi OS
Image
Post Reply