Intersect VectorDrawing lib Curves

Share your advanced PureBasic knowledge/code with the community.
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4954
Joined: Sun Apr 12, 2009 6:27 am

Intersect VectorDrawing lib Curves

Post by RASHAD »

#1 :
Using workaround
Very Fast

Code: Select all

Structure coordinate
  x.d
  y.d
EndStructure

Global Dim c.coordinate(0)

Procedure Intersect()

    MovePathCursor(50,100)
    VectorSourceColor(RGBA(255,0,0,255))
    AddPathCurve(90, 30, 250, 180, 350, 100)
    StrokePath(2)
    
    MovePathCursor(100,70)
    VectorSourceColor(RGBA(0,255,0,100))
    AddPathCurve(150,150,250,50,350,170)
    StrokePath(2)
    
    acolor = AlphaBlend(RGBA(0,255,0,100),RGBA(255,0,0,255))
    acolor = acolor & $ffffff
    
    StartDrawing(CanvasOutput(0))
      For y = 0 To GadgetHeight(0)-1
        For x = 0 To GadgetWidth(0)-1
          color = Point(x,y)
          If color = acolor
            c(item)\x = x : c(item)\y = y
            item + 1 
            ReDim c(item)
          EndIf    
        Next  
      Next
    StopDrawing()
     
    VectorSourceColor(RGBA(0, 0, 0, 255))
    VectorFont(FontID(0), 14)
    AddPathCircle(c(0)\x,c(0)\y,3)
    MovePathCursor(c(0)\x-15,c(0)\y+10)
    DrawVectorText("x : "+Str(c(0)\x)+#CRLF$+"y : "+Str(c(0)\y))
    For i = 1 To item-1
      If c(i)\x > c(i-1)\x+1 Or c(i)\y > c(i-1)\y+1
          AddPathCircle(c(i)\x,c(i)\y,3)
          MovePathCursor(c(i)\x-15,c(i)\y+10)
          DrawVectorText("x : "+Str(c(i)\x)+#CRLF$+"y : "+Str(c(i)\y))
      EndIf
    Next
    FillPath()  
EndProcedure


w = 400
h = 300
LoadFont(0, "Consalos", 20)

OpenWindow(0, 0, 0, w,h, "", #PB_Window_SystemMenu |#PB_Window_ScreenCentered)
CanvasGadget(0,0,0,w,h)

If StartVectorDrawing(CanvasVectorOutput(0))
    Intersect()   
    StopVectorDrawing()
EndIf

Repeat
  Event = WaitWindowEvent() 
Until Event = #PB_Event_CloseWindow
#2 :
Using VectorDrawing lib
Slow

Code: Select all

Structure coordinate
  x.d
  y.d
EndStructure

Structure coordinate2
  x.d
  y.d
EndStructure

Global Dim c1.coordinate(0),Dim c2.coordinate2(10)

Procedure Intersect()
StartVectorDrawing(CanvasVectorOutput(0))
    MovePathCursor(50,100)
    VectorSourceColor(RGBA(255,0,0,255))
    AddPathCurve(90, 30, 250, 180, 350, 100)
       
    For x = 50 To 350
      For y = 30 To 180
        If IsInsideStroke(x, y, 1, #PB_Path_Default, #PB_Coordinate_Output)
          c1(item)\x = x : c1(item)\y = y
          item + 1 
          ReDim c1(item)
        EndIf    
      Next  
    Next
    StrokePath(1)
    For i = 0 To item - 1
      Debug "x : "+Str(c1(i)\x)+"  y : "+Str(c1(i)\y)
    Next
    
    MovePathCursor(100,70)
    VectorSourceColor(RGBA(0,255,0,100))
    AddPathCurve(150,150,250,50,350,170)
    
    For i = 0 To item - 1
      If IsInsideStroke(c1(i)\x, c1(i)\y, 1, #PB_Path_Default, #PB_Coordinate_Output)
          c2(ii)\x = c1(i)\x : c2(ii)\y = c1(i)\y
          Debug Str(c2(ii)\x)+"   "+Str(c2(ii)\y)
          ii+1          
      EndIf
    Next
    StrokePath(1)
    VectorSourceColor(RGBA(0,0,0,255))
    AddPathCircle(c2(0)\x,c2(0)\y,2)
    FillPath()
    For inter = 1 To ii
      AddPathCircle(c2(inter)\x,c2(inter)\y,2) 
      FillPath()
    Next
StopVectorDrawing()
EndProcedure

w = 400
h = 300

OpenWindow(0, 0, 0, w,h, "", #PB_Window_SystemMenu |#PB_Window_ScreenCentered)
CanvasGadget(0,0,0,w,h)
Intersect() 

Repeat
  Event = WaitWindowEvent() 
Until Event = #PB_Event_CloseWindow
Egypt my love
User avatar
RSBasic
Moderator
Moderator
Posts: 1228
Joined: Thu Dec 31, 2009 11:05 pm
Location: Gernsbach (Germany)
Contact:

Re: Intersect VectorDrawing lib Curves

Post by RSBasic »

Image
Image
Image
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4954
Joined: Sun Apr 12, 2009 6:27 am

Re: Intersect VectorDrawing lib Curves

Post by RASHAD »

Hi RSBasic
Thanks mate
Now very fast and accurate

Code: Select all

Structure coordinate
  x.d
  y.d
EndStructure

Structure coordinate2
  x.d
  y.d
EndStructure

Global i.f,n
Global Dim c1.coordinate(0),Dim c2.coordinate2(10)

Procedure.f BezierBox(x1,y1,x2,y2,x3,y3,x4,y4,approx.f)  
  cx.f=3*(x2-x1)
  bx.f=3*(x3-x2)-cx
  ax.f=x4-x1-cx-bx
  cy.f=3*(y2-y1)
  by.f=3*(y3-y2)-cy
  ay.f=y4-y1-cy-by
  n = 0 :i = 0
  Repeat
    i+approx
    x=((ax*i+bx)*i+cx)*i+x1
    If x <> xx
      y=((ay*i+by)*i+cy)*i+y1
      c1(n)\x = x 
      c1(n)\y = y
      n+1
      xx = x
      ReDim c1(n)
    EndIf
  Until i > 1
EndProcedure

Procedure Intersect()
StartVectorDrawing(CanvasVectorOutput(0))
  
  MovePathCursor(50,100)
  VectorSourceColor(RGBA(255,0,0,255))
  AddPathCurve(90, 30, 250, 180, 350, 100)
  StrokePath(1)
  ResetPath() 
  BezierBox(50,100,90,30,250,180,350,100,0.002)   
   
  MovePathCursor(100,70)
  VectorSourceColor(RGBA(0,255,0,255))
  AddPathCurve(150,150,250,50,350,170)
  
  For it = 0 To n - 1
    If IsInsideStroke(c1(it)\x, c1(it)\y, 1, #PB_Path_Default, #PB_Coordinate_Output)
        c2(ii)\x = c1(it)\x : c2(ii)\y = c1(it)\y
        Debug Str(c2(ii)\x)+"   "+Str(c2(ii)\y)
        ii+1          
    EndIf
  Next
  StrokePath(1)
  VectorSourceColor(RGBA(0,0,0,255))
  AddPathCircle(c2(0)\x,c2(0)\y,2)
  FillPath()
  For inter = 1 To ii
    AddPathCircle(c2(inter)\x,c2(inter)\y,2) 
    FillPath()
  Next
StopVectorDrawing()
EndProcedure

w = 400
h = 300

OpenWindow(0, 0, 0, w,h, "", #PB_Window_SystemMenu |#PB_Window_ScreenCentered)
CanvasGadget(0,0,0,w,h)
Intersect() 

Repeat
  Event = WaitWindowEvent() 
Until Event = #PB_Event_CloseWindow
Egypt my love
User avatar
[blendman]
Enthusiast
Enthusiast
Posts: 297
Joined: Thu Apr 07, 2011 1:14 pm
Location: 3 arks
Contact:

Re: Intersect VectorDrawing lib Curves

Post by [blendman] »

Excellent, thanks a lot ;)
Post Reply