PureBasic Forums - English

Code: Select all

DeclareModule BezierCurve
   #Default_CurvePoints=1000           ; Default curve drawing precision (higher = better)
   #Default_FrontColor=$FFFFFFFF + 1   ; Determines if curve will be drawn with current Purebasic FrontColor
   #Default_BezierPointColor=$FFFFFF   ; Default bezier point color (if visible)
   Structure DOUBLE_POINT
      x.d
      y.d
   EndStructure
   
   Declare CalculateBezier2D(Array bezierPoints.DOUBLE_POINT(1), Array curvePoints.DOUBLE_POINT(1))
   Declare BezierCurveN(Array NPoints.DOUBLE_POINT(1), color=#Default_FrontColor, curvePoints=#Default_CurvePoints, bezierPointVisible=#False, bezierPointColor=#Default_BezierPointColor)
   Declare BezierCurve3(x1.d, y1.d, x2.d, y2.d, x3.d, y3.d, color=#Default_FrontColor, curvePoints=#Default_CurvePoints, bezierPointVisible=#False, bezierPointColor=#Default_BezierPointColor)
   Declare BezierCurve4(x1.d, y1.d, x2.d, y2.d, x3.d, y3.d, x4.d, y4.d, color=#Default_FrontColor, curvePoints=#Default_CurvePoints, bezierPointVisible=#False, bezierPointColor=#Default_BezierPointColor)
   Declare BezierCurveParse(parsedPoints.s="1,1,2,2", color=#Default_FrontColor, curvePoints=#Default_CurvePoints, bezierPointVisible=#False, bezierPointColor=#Default_BezierPointColor)
EndDeclareModule

Module BezierCurve
   EnableExplicit
   
   Global Dim FactorialLookup.d(32)
   FactorialLookup(0)=1.0
   FactorialLookup(1)=1.0
   FactorialLookup(2)=2.0
   FactorialLookup(3)=6.0
   FactorialLookup(4)=24.0
   FactorialLookup(5)=120.0
   FactorialLookup(6)=720.0
   FactorialLookup(7)=5040.0
   FactorialLookup(8)=40320.0
   FactorialLookup(9)=362880.0
   FactorialLookup(10)=3628800.0
   FactorialLookup(11)=39916800.0
   FactorialLookup(12)=479001600.0
   FactorialLookup(13)=6227020800.0
   FactorialLookup(14)=87178291200.0
   FactorialLookup(15)=1307674368000.0
   FactorialLookup(16)=20922789888000.0
   FactorialLookup(17)=355687428096000.0
   FactorialLookup(18)=6402373705728000.0
   FactorialLookup(19)=121645100408832000.0
   FactorialLookup(20)=2432902008176640000.0
   FactorialLookup(21)=ValD("51090942171709440000.0")
   FactorialLookup(22)=ValD("1124000727777607680000.0")
   FactorialLookup(23)=ValD("25852016738884976640000.0")
   FactorialLookup(24)=ValD("620448401733239439360000.0")
   FactorialLookup(25)=ValD("15511210043330985984000000.0")
   FactorialLookup(26)=ValD("403291461126605635584000000.0")
   FactorialLookup(27)=ValD("10888869450418352160768000000.0")
   FactorialLookup(28)=ValD("304888344611713860501504000000.0")
   FactorialLookup(29)=ValD("8841761993739701954543616000000.0")
   FactorialLookup(30)=ValD("265252859812191058636308480000000.0")
   FactorialLookup(31)=ValD("8222838654177922817725562880000000.0")
   FactorialLookup(32)=ValD("263130836933693530167218012160000000.0")
   
   Procedure.d Ni(n, i)
      Protected ni.d
      Protected a1.d=FactorialLookup(n)
      Protected a2.d=FactorialLookup(i)
      Protected a3.d=FactorialLookup(n - i)
      ni=a1 / (a2 * a3)
      ProcedureReturn ni
   EndProcedure
   
   ;Calculate Bernstein basis
   Procedure.d Bernstein(n, i, t.d)
      Protected basis.d
      Protected ti.d  ; t^i
      Protected tni.d ; (1 - t)^i
      
      ;/* Prevent problems With pow */
      If (t=0.0 And i=0)
         ti=1.0
      Else
         ti=Pow(t, i)
      EndIf
      
      
      If (n=i And t=1.0)
         tni=1.0
      Else
         tni=Pow((1 - t), (n - i))
      EndIf
      
      ;//Bernstein basis
      basis=Ni(n, i) * ti * tni;
      ProcedureReturn basis
   EndProcedure
   
   Procedure CalculateBezier2D(Array b.DOUBLE_POINT(1), Array c.DOUBLE_POINT(1))
      Protected npts=ArraySize(b()) + 1 ; bezier points
      Protected cpts=ArraySize(c()) + 1 ; curve points
      Protected icount=0, jcount
      Protected t.d=0, dt.d=1.0 / (cpts - 1)
      Protected i1, i
      
      ;Calculate points on curve
      For i1=0 To cpts-1
         If ((1.0 - t)<5e-6) : t=1.0 : EndIf
         jcount=0
         c(icount)\x=0.0
         c(icount)\y=0.0
         For i=0 To npts-1
            Protected basis.d=Bernstein(npts - 1, i, t)
            c(icount)\x + basis * b(jcount)\x
            c(icount)\y + basis * b(jcount)\y
            jcount + 1
         Next
         icount + 1
         t + dt
      Next
   EndProcedure
   
   Procedure DrawBezier2D(Array bezierPoints.DOUBLE_POINT(1), Array curvePoints.DOUBLE_POINT(1), color, bezierPointVisible, bezierPointColor)
      Protected i
      CalculateBezier2D(bezierPoints(), curvePoints())
      If bezierPointVisible
         For i=0 To ArraySize(bezierPoints())
            Circle(bezierPoints(i)\x, bezierPoints(i)\y, 2, bezierPointColor)
         Next
      EndIf
      If color=#Default_FrontColor
         For i=0 To ArraySize(curvePoints())-1
            LineXY(curvePoints(i)\x, curvePoints(i)\y, curvePoints(i + 1)\x, curvePoints(i + 1)\y)
         Next
      Else
         For i=0 To ArraySize(curvePoints())-1
            LineXY(curvePoints(i)\x, curvePoints(i)\y, curvePoints(i + 1)\x, curvePoints(i + 1)\y, color)
         Next
      EndIf
   EndProcedure
   
   Procedure BezierCurveN(Array bezierPoints.DOUBLE_POINT(1), color=#Default_FrontColor, curvePoints=#Default_CurvePoints, bezierPointVisible=#False, bezierPointColor=#Default_BezierPointColor)
      Protected Dim curvePoints.DOUBLE_POINT(curvePoints)
      DrawBezier2D(bezierPoints(), curvePoints(), color, bezierPointVisible, bezierPointColor)
   EndProcedure
   
   Procedure BezierCurve3(x1.d, y1.d, x2.d, y2.d, x3.d, y3.d, color=#Default_FrontColor, curvePoints=#Default_CurvePoints, bezierPointVisible=#False, bezierPointColor=#Default_BezierPointColor)
      Protected Dim bezierPoints.DOUBLE_POINT(2)
      bezierPoints(0)\x=x1 : bezierPoints(0)\y=y1
      bezierPoints(1)\x=x2 : bezierPoints(1)\y=y2
      bezierPoints(2)\x=x3 : bezierPoints(2)\y=y3
      BezierCurveN(bezierPoints(), color, curvePoints, bezierPointVisible, bezierPointColor)
   EndProcedure
   
   Procedure BezierCurve4(x1.d, y1.d, x2.d, y2.d, x3.d, y3.d, x4.d, y4.d, color=#Default_FrontColor, curvePoints=#Default_CurvePoints, bezierPointVisible=#False, bezierPointColor=#Default_BezierPointColor)
      Protected Dim bezierPoints.DOUBLE_POINT(3)
      bezierPoints(0)\x=x1 : bezierPoints(0)\y=y1
      bezierPoints(1)\x=x2 : bezierPoints(1)\y=y2
      bezierPoints(2)\x=x3 : bezierPoints(2)\y=y3
      bezierPoints(3)\x=x4 : bezierPoints(3)\y=y4
      BezierCurveN(bezierPoints(), color, curvePoints, bezierPointVisible, bezierPointColor)
   EndProcedure
   
   Procedure BezierCurveParse(parsedPoints.s="1,1,2,2", color=#Default_FrontColor, curvePoints=#Default_CurvePoints, bezierPointVisible=#False, bezierPointColor=#Default_BezierPointColor)
      Static regexSeparators
      If Not regexSeparators
         regexSeparators=CreateRegularExpression(#PB_Any, "[^\de +.-]")
      EndIf
      parsedPoints=RemoveString(ReplaceRegularExpression(regexSeparators, parsedPoints, ","), " ") ;value samples: 2.0e3,2000,-0.1,-1e-2,+11,11
      Protected Dim bezierPoints.DOUBLE_POINT(CountString(parsedPoints, ",") / 2)
      Protected i, npts
      For i=0 To ArraySize(bezierPoints())
         npts=1 + i*2
         bezierPoints(i)\x=ValD(StringField(parsedPoints, npts, ",")) : bezierPoints(i)\y=ValD(StringField(parsedPoints, npts + 1, ","))
      Next
      BezierCurveN(bezierPoints(), color, curvePoints, bezierPointVisible, bezierPointColor)
   EndProcedure
EndModule

CompilerIf #PB_Compiler_IsMainFile
   UseModule BezierCurve
   DisableExplicit
   ; ********************
   ; EXAMPLE
   ; ********************
   
   If OpenWindow(0, 0, 0, 800, 600, "2DDrawing Bezier Drawing", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
      If CreateImage(0, 800, 600, 32, RGB(0, 0, 0)) And StartDrawing(ImageOutput(0))
         BezierCurve3(50, 400, 225, 400, 400, 50, RGB(200, 60, 10), #Default_CurvePoints, #True, RGB(255, 100, 0))
         BezierCurve4(50, 400, 50, 300, 225, 50, 400, 50, RGB(0, 245, 255), #Default_CurvePoints, #True, RGB(0, 96, 255))
         BezierCurveParse("50,400,4.0e2,400, 100,380,  350,70, 50,50,400,50", RGB(206, 0, 255), #Default_CurvePoints, #True, RGB(255, 0, 219))
         StopDrawing()
         ImageGadget(0, 0, 0, 200, 200, ImageID(0))
      EndIf
      
      Repeat: Until WaitWindowEvent()=#PB_Event_CloseWindow
   EndIf
CompilerEndIf