Yet another Bezier curve implementation

[Lunasole]

Here is some example of code bulding smooth lines (Bezier curve). One of classical CGI algorithms.

Code: Select all

EnableExplicit

; forms Bezier curve
; Points()		array of source points
; BStep			detalization level, can be from 0.0 [error] to 1.0
;            	the lesser it is, the more out points are generated
; RETURN:		none, result stored inside Points array
Procedure GetBezier(Array Points.POINT(1), BStep.d)
	Protected Dim OutPoints.POINT (1 + Int(1 / bStep)), OutNum
	Protected ax, bx, cx, ay, by, cy
	Protected.d t, xt, yt
	
	; prepare starting points
	; the code here can be continued to accept more than 4 points, but didn't tried yet
	cx = 3 * (Points(1)\x - Points(0)\x)
	bx = 3 * (Points(2)\x - Points(1)\x) - cx
	ax = Points(3)\x - Points(0)\x - cx - bx
	
	cy = 3 * (Points(1)\y - Points(0)\y)
	by = 3 * (Points(2)\y - Points(1)\y) - cy
	ay = Points(3)\y - Points(0)\y - cy - by
	
	; generate output curves
	While t < 1.0
		xt = ax * Pow(t, 3) + bx * Pow(t, 2) + cx * t + Points(0)\x
		yt = ay * Pow(t, 3) + by * Pow(t, 2) + cy * t + Points(0)\y
		
		OutPoints(OutNum)\x = xt
		OutPoints(OutNum)\y = yt
		OutNum = OutNum + 1
		t + BStep
	Wend
	
	; return
	ReDim OutPoints(OutNum - 1)
	CopyArray(OutPoints(), Points())
EndProcedure


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Some example

; define starting points - a rough polyline drawed through following coordinates (X,Y) - [0,0 : 50,20 : 100,50 : 150,10]
Global Dim Test.POINT (3)
Test(0)\x = 0
Test(0)\y = 10

Test(1)\x = 50
Test(1)\y = 20

Test(2)\x = 100
Test(2)\y = 50

Test(3)\x = 150
Test(3)\y = 10

; now getting this line to be smooth
; step 0.01 will produce 100 points from starting 4 points, 0.001 will result to whole 1000 points and so on)
GetBezier(Test(), 0.01)


Define t
For t = 0 To ArraySize(Test())
	; printing point # and new coordinates of extrapolated line  points
	Debug Str(t) + " |  X,Y = " + Str(Test(t)\x) + ", " + Str(Test(t)\y)
Next t

; show it all
If OpenWindow(0, 0, 0, 500, 500, "Lunasole's Bezier Curve visualized by Keya", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
	Define lastx = Test(0)\x, lasty = Test(0)\y
	If CreateImage(0, 500, 500, 32, 0) And StartDrawing(ImageOutput(0)) 
		Plot(lastx,lasty, RGB(0,255,0))
		For t = 1 To ArraySize(Test())
			LineXY(lastx, lasty, Test(t)\x, Test(t)\y, RGB(0,255,0))  ;lines
	
			; Plot(Test(t)\x, Test(t)\y, RGB(0,255,0))                 ;or dots
			lastx = Test(t)\x:  lasty = Test(t)\y
		Next t
		StopDrawing() 
		ImageGadget(0, 0, 0, 500, 500, ImageID(0))
	EndIf
	
	Repeat
		Define Event = WaitWindowEvent()
	Until Event = #PB_Event_CloseWindow
EndIf

[Lunasole]

Here also just made modified version, to work with dynamic amount of starting points (instead of fixed 4).
It seems working nice, but needs some real-case testing to see if really makes a difference ^_^

Code: Select all

EnableExplicit

; forms Bezier curve [enchanted version, to accept any amount of source points]
; Points()		array of source points
; BStep			detalization level, can be from 0.0 [error] to 1.0
;            	the lesser it is, the more out points are generated
; RETURN:		none, result stored inside Points array
Procedure GetBezierX(Array Points.POINT(1), BStep.d)
	Protected Dim OutPoints.POINT (1 + Int(1 / bStep)), OutNum
	Protected.d t, xt, yt
	
	; prepare starting points
	Protected Dim CPoints.POINT(0)
	CopyArray(Points(), CPoints())
	Protected Cnt, AllX, AllY, Max = ArraySize(CPoints())
	For Cnt = 1 To Max - 1
		CPoints(Cnt)\x = Max * (Points(Cnt)\x - Points(Cnt-1)\x) - AllX
		CPoints(Cnt)\y = Max * (Points(Cnt)\y - Points(Cnt-1)\y) - AllY
		ALLX + CPoints(Cnt)\x
		ALLY + CPoints(Cnt)\y
	Next cnt
	CPoints(Max)\x = (Points(Max)\x - Points(0)\x) - AllX
	CPoints(Max)\y = (Points(Max)\y - Points(0)\y) - AllY
	
	
	; generate output curves
	While t < 1.0
		xt = 0
		yt = 0
		For Cnt = Max To 1 Step -1
			xt + CPoints(Cnt)\x * Pow(t, Cnt)
			yt + CPoints(Cnt)\y * Pow(t, Cnt)
		Next Cnt
		xt + Points(0)\x
		yt + Points(0)\y
		
		OutPoints(OutNum)\x = xt
		OutPoints(OutNum)\y = yt
		OutNum + 1
		t + BStep
	Wend
	
	; return
	ReDim OutPoints(OutNum - 1)
	CopyArray(OutPoints(), Points())
EndProcedure


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Some example

; define starting points - a rough polyline drawed through following coordinates (X,Y):
Global Dim Test.POINT (5)
Test(0)\x = 0
Test(0)\y = 10

Test(1)\x = 30
Test(1)\y = 30

Test(2)\x = 60
Test(2)\y = 80

Test(3)\x = 90
Test(3)\y = 10

Test(4)\x = 120
Test(4)\y = 60

Test(5)\x = 150
Test(5)\y = 20

; now getting this line to be smooth
; step 0.01 will produce 100 points from starting points, 0.001 will result to whole 1000 points and so on)
GetBezierX(Test(), 0.01)

Define t
For t = 0 To ArraySize(Test())
	; printing point # and new coordinates of extrapolated line points
	Debug Str(t) + " |  X,Y = " + Str(Test(t)\x) + ", " + Str(Test(t)\y)
Next t

; show it all
If OpenWindow(0, 0, 0, 500, 500, "Lunasole's Bezier Curve [X] visualized by Keya", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
	Define lastx = Test(0)\x, lasty = Test(0)\y
	If CreateImage(0, 500, 500, 32, 0) And StartDrawing(ImageOutput(0)) 
		Plot(lastx,lasty, RGB(0,255,0))
		For t = 1 To ArraySize(Test())
			LineXY(lastx, lasty, Test(t)\x, Test(t)\y, RGB(0,255,0))  ;lines
	
			; Plot(Test(t)\x, Test(t)\y, RGB(0,255,0))                 ;or dots
			lastx = Test(t)\x:  lasty = Test(t)\y
		Next t
		StopDrawing() 
		ImageGadget(0, 0, 0, 500, 500, ImageID(0))
	EndIf
	
	Repeat
		Define Event = WaitWindowEvent()
	Until Event = #PB_Event_CloseWindow
EndIf

[Keya]

Code: Select all

IncludeFile("lunasole_bezier.pbi")

If OpenWindow(0, 0, 0, 500, 500, "Lunasole's Bezier Curve", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  Define lastx, lasty
  If CreateImage(0, 500, 500, 24, 0) And StartDrawing(ImageOutput(0))    
    For t = 0 To ArraySize(Test())
      LineXY(lastx, lasty, Test(t)\x, Test(t)\y, RGB(0,255,0))  ;lines
      ;Plot(Test(t)\x, Test(t)\y, RGB(0,255,0))                 ;or dots
      lastx = Test(t)\x:  lasty = Test(t)\y
    Next t    
    StopDrawing() 
    ImageGadget(0, 0, 0, 200, 200, ImageID(0))
  EndIf
  
  Repeat
    Define Event = WaitWindowEvent()
  Until Event = #PB_Event_CloseWindow
EndIf

ooooh i see, cool

[Lunasole]

@Keya thanks for GUI, attached it to examples :)

[idle]

thanks for sharing.