bezier

freeBASIC source code examples by FbCadcam staff and interns

Moderators: yajra1219, Jayem, kitty_webb, Ywsp, joanCruz03, shela

Post Reply
owen
Site Admin
Posts: 654
Joined: Thu Apr 13, 2017 12:14 pm

bezier

Post by owen » Thu Jun 20, 2019 2:12 am

Code: Select all

'x1,y1 is the start point
'x2,y2 is the end point
'x3,y3 is the control point

Dim As Integer x1,y1,x2,y2,x3,y3
Dim As Double x,y,t
x1=100
y1=200
x2=300
y2=200
x3=200
y3=200
ScreenRes 400,400
Window (0,0)-(399,399)
Do
	Select Case InKey
		Case Chr(27),Chr(255)+"k"
			Exit Do
	End Select
	GetMouse(x3,y3)
	y3=400-y3
	ScreenLock
	Cls
	Circle(x1,y1),3,14
	Circle(x2,y2),3,13
	For t = .1 To .9 Step .1
		x = (1 - t) * (1 - t) * x1 + 2 * (1 - t) * t * x3 + t * t * x2
		y = (1 - t) * (1 - t) * y1 + 2 * (1 - t) * t * y3 + t * t * y2
		Circle(x,y),3,12
	Next
	ScreenUnLock
	Sleep 1
Loop

owen
Site Admin
Posts: 654
Joined: Thu Apr 13, 2017 12:14 pm

Re: bezier

Post by owen » Thu Jun 20, 2019 3:25 am

Code: Select all

'x1,y1 is the start point
'x2,y2 is the end point
'x3,y3 is the control point
'to make a shape while moving the mouse around press the a key  or  b key
'on your keyboard
'ax,ay is the extension point for x1,y1
'bx,by is the extension point for x2,y2
Dim As Integer x1,y1,x2,y2,x3,y3
Dim As Integer ax,ay,bx,by,px,py
Dim As Double x,y,t
x1=100
y1=200
x2=300
y2=200
x3=200
y3=200
ax=x1
ay=y1
bx=x2
by=y2
ScreenRes 400,400
Do
	Select Case InKey
		Case Chr(27),Chr(255)+"k"
			Exit Do
		Case "a"
			GetMouse(ax,ay)
		Case "b"
			GetMouse(bx,by)
	End Select
	GetMouse(x3,y3)
	ScreenLock
	Cls
	Line(x1,y1)-(ax,ay)
	Line(x2,y2)-(bx,by)
	For t = 0 To 1 Step .1
		x = (1 - t) * (1 - t) * x1 + 2 * (1 - t) * t * x3 + t * t * x2
		y = (1 - t) * (1 - t) * y1 + 2 * (1 - t) * t * y3 + t * t * y2
		PSet(x,y)
		x = (1 - t) * (1 - t) * ax + 2 * (1 - t) * t * x3 + t * t * bx
		y = (1 - t) * (1 - t) * ay + 2 * (1 - t) * t * y3 + t * t * by
		PSet(x,y)
	Next
	px=x1
	py=y1
	For t = 0 To 1 Step .1
		x = (1 - t) * (1 - t) * x1 + 2 * (1 - t) * t * x3 + t * t * x2
		y = (1 - t) * (1 - t) * y1 + 2 * (1 - t) * t * y3 + t * t * y2
		Line(px,py)-(x,y)
		px=x
		py=y
	Next
	px=ax
	py=ay
	For t = 0 To 1 Step .1
		x = (1 - t) * (1 - t) * ax + 2 * (1 - t) * t * x3 + t * t * bx
		y = (1 - t) * (1 - t) * ay + 2 * (1 - t) * t * y3 + t * t * by
		Line(px,py)-(x,y)
		px=x
		py=y
	Next
	ScreenUnLock
	Sleep 1
Loop

owen
Site Admin
Posts: 654
Joined: Thu Apr 13, 2017 12:14 pm

Re: bezier

Post by owen » Thu Jun 20, 2019 4:26 pm

Code: Select all

'to draw a bezier curve we can use three points
'point A the curve's start (x,y)
'point B the curve's end (x,y)
'point C the curve's control (x,y)

'so let's use a UDT (user defined type) approach
'instead of a simple variable approach
'something like this
Type my_bezier_curve_udt
	ax As Integer
	ay As Integer
	bx As Integer
	by As Integer
	cx As Integer
	cy As Integer
End Type

Dim mbzu As my_bezier_curve_udt
mbzu.ax=100 'curve start
mbzu.ay=200 'curve start
mbzu.bx=300 'curve end
mbzu.by=200 'curve end
'point c, the control point, is defined by the mouse (x,y)

'here is a sub routine we can call every time we want to polot the curve
Sub plot_bezier(ByVal x1 As Integer,ByVal y1 As Integer,ByVal x2 As Integer,ByVal y2 As Integer,ByVal x3 As Integer,ByVal y3 As Integer)
	Dim As Double x,y,t 'some local variable used to plot the curve
	For t = 0 To 1 Step .1
		x = (1 - t) * (1 - t) * x1 + 2 * (1 - t) * t * x3 + t * t * x2
		y = (1 - t) * (1 - t) * y1 + 2 * (1 - t) * t * y3 + t * t * y2
		Circle(x,y),3,14
	Next
End Sub

'set the screen resolution
ScreenRes 400,400

'a loop to continueously check the mouse positions
Do
	'always make sure you add a way to exit the contineous loop
	Select Case InKey
		'the user can either press ESC on their keyboard
		'or click the X in the upper right corner of the screen.
		Case Chr(27),Chr(255)+"k"
			Exit Do
	End Select
	'set the variable valuse of the curves control point to the mouse x,y
	GetMouse(mbzu.cx, mbzu.cy)
	
	ScreenLock
	Cls
	plot_bezier(mbzu.ax,mbzu.ay,mbzu.bx,mbzu.by,mbzu.cx,mbzu.cy)
	ScreenUnLock
	Sleep 1
Loop

owen
Site Admin
Posts: 654
Joined: Thu Apr 13, 2017 12:14 pm

Re: bezier

Post by owen » Thu Jun 20, 2019 4:37 pm

a cleaner coding style

Sub plot_bezier(ByVal bz As my_bezier_curve_udt)
plot_bezier(mbzu)

much better then the previous example
Sub plot_bezier(ByVal x1 As Integer,ByVal y1 As Integer,ByVal x2 As Integer,ByVal y2 As Integer,ByVal x3 As Integer,ByVal y3 As Integer)
plot_bezier(mbzu.ax,mbzu.ay,mbzu.bx,mbzu.by,mbzu.cx,mbzu.cy)

Code: Select all

Type my_bezier_curve_udt
	ax As Integer
	ay As Integer
	bx As Integer
	by As Integer
	cx As Integer
	cy As Integer
End Type

Dim mbzu As my_bezier_curve_udt
mbzu.ax=100 'curve start
mbzu.ay=200 'curve start
mbzu.bx=300 'curve end
mbzu.by=200 'curve end
'point c, the control point, is defined by the mouse (x,y)

'here is a sub routine we can call every time we want to polot the curve
Sub plot_bezier(ByVal bz As my_bezier_curve_udt)
	Dim As Double x,y,t 'some local variable used to plot the curve
	For t = 0 To 1 Step .1
		x = (1 - t) * (1 - t) * bz.ax + 2 * (1 - t) * t * bz.cx + t * t * bz.bx
		y = (1 - t) * (1 - t) * bz.ay + 2 * (1 - t) * t * bz.cy + t * t * bz.by
		Circle(x,y),3,14
	Next
End Sub

'set the screen resolution
ScreenRes 400,400

'a loop to continueously check the mouse positions
Do
	'always make sure you add a way to exit the contineous loop
	Select Case InKey
		'the user can either press ESC on their keyboard
		'or click the X in the upper right corner of the screen.
		Case Chr(27),Chr(255)+"k"
			Exit Do
	End Select
	'set the variable valuse of the curves control point to the mouse x,y
	GetMouse(mbzu.cx, mbzu.cy)
	
	ScreenLock
	Cls
	plot_bezier(mbzu)
	ScreenUnLock
	Sleep 1
Loop

owen
Site Admin
Posts: 654
Joined: Thu Apr 13, 2017 12:14 pm

Re: bezier

Post by owen » Thu Jun 20, 2019 4:55 pm

'here is an even better or cleaner code.
'this example includes a sub routine within the UDT
'that way you can call the plotting routine like this: mbzu.plot()

Code: Select all

Type my_bezier_curve_udt
	ax As Integer
	ay As Integer
	bx As Integer
	by As Integer
	cx As Integer
	cy As Integer
	Declare Sub plot()
End Type
Sub my_bezier_curve_udt.plot()
	Dim As Double x,y,t 'some local variable used to plot the curve
	For t = 0 To 1 Step .1
		x = (1 - t) * (1 - t) * ax + 2 * (1 - t) * t * cx + t * t * bx
		y = (1 - t) * (1 - t) * ay + 2 * (1 - t) * t * cy + t * t * by
		Circle(x,y),3,14
	Next
End Sub

Dim mbzu As my_bezier_curve_udt
mbzu.ax=100 'curve start
mbzu.ay=200 'curve start
mbzu.bx=300 'curve end
mbzu.by=200 'curve end

ScreenRes 400,400

Do
	Select Case InKey
		Case Chr(27),Chr(255)+"k"
			Exit Do
	End Select
	GetMouse(mbzu.cx, mbzu.cy)
	ScreenLock
	Cls
	mbzu.plot()
	ScreenUnLock
	Sleep 1
Loop

owen
Site Admin
Posts: 654
Joined: Thu Apr 13, 2017 12:14 pm

Re: bezier

Post by owen » Thu Jun 20, 2019 5:08 pm

even further abstraction:
from this:

Code: Select all

Type my_bezier_curve_udt
	ax As Integer
	ay As Integer
	bx As Integer
	by As Integer
	cx As Integer
	cy As Integer
	Declare Sub plot()
End Type
to this:

Code: Select all

Type my_bezier_curve_udt
	a As point2d
	b As point2d
	c As point2d
	Declare Sub plot()
End Type

Code: Select all

Type point2d
	x As Integer
	y As Integer
End Type
Type my_bezier_curve_udt
	a As point2d
	b As point2d
	c As point2d
	Declare Sub plot()
End Type
Sub my_bezier_curve_udt.plot()
	Dim As Double x,y,t 'some local variable used to plot the curve
	For t = 0 To 1 Step .1
		x = (1 - t) * (1 - t) * a.x + 2 * (1 - t) * t * c.x + t * t * b.x
		y = (1 - t) * (1 - t) * a.y + 2 * (1 - t) * t * c.y + t * t * b.y
		Circle(x,y),3,14
	Next
End Sub

Dim mbzu As my_bezier_curve_udt
mbzu.a.x=100 'curve start
mbzu.a.y=200 'curve start
mbzu.b.x=300 'curve end
mbzu.b.y=200 'curve end

ScreenRes 400,400

Do
	Select Case InKey
		Case Chr(27),Chr(255)+"k"
			Exit Do
	End Select
	GetMouse(mbzu.c.x, mbzu.c.y)
	ScreenLock
	Cls
	mbzu.plot()
	ScreenUnLock
	Sleep 1
Loop

owen
Site Admin
Posts: 654
Joined: Thu Apr 13, 2017 12:14 pm

Re: bezier

Post by owen » Thu Jun 20, 2019 5:37 pm

in this example i use an array in the UDT
changing it from this:

Code: Select all

Type my_bezier_curve_udt
	a As point2d
	b As point2d
	c As point2d
	Declare Sub plot()
End Type
to this:

Code: Select all

Type my_bezier_curve_udt
	p(2) As point2d
	Declare Sub plot()
End Type

Code: Select all

Type point2d
	x As Integer
	y As Integer
End Type
Type my_bezier_curve_udt
	p(2) As point2d
	Declare Sub plot()
End Type
Sub my_bezier_curve_udt.plot()
	Dim As Double x,y,t 'some local variable used to plot the curve
	For t = 0 To 1 Step .1
		x = (1 - t) * (1 - t) * p(0).x + 2 * (1 - t) * t * p(2).x + t * t * p(1).x
		y = (1 - t) * (1 - t) * p(0).y + 2 * (1 - t) * t * p(2).y + t * t * p(1).y
		Circle(x,y),3,14
	Next
End Sub

Dim mbzu As my_bezier_curve_udt
mbzu.p(0).x=100 'curve start
mbzu.p(0).y=200 'curve start
mbzu.p(1).x=300 'curve end
mbzu.p(1).y=200 'curve end

ScreenRes 400,400

Do
	Select Case InKey
		Case Chr(27),Chr(255)+"k"
			Exit Do
	End Select
	GetMouse(mbzu.p(2).x, mbzu.p(2).y)
	ScreenLock
	Cls
	mbzu.plot()
	ScreenUnLock
	Sleep 1
Loop

owen
Site Admin
Posts: 654
Joined: Thu Apr 13, 2017 12:14 pm

Re: bezier

Post by owen » Thu Jun 20, 2019 6:29 pm

personlly i kinda like to use this UDT because it makes it clearer to understand:

Code: Select all

Type my_bezier_curve_udt
	a As point2d 'point A the curve start
	b As point2d 'point B the curve end
	c As point2d 'point C the curve control
	p_res As Double 'the plotted resolution 
	Declare Sub plot()
End Type
In this example i added a variable called P_RES (the resolution of the plot) and set its value to .05
when you run this example you can see that there are twice as many plotted points along the curve compared to the previous code examples.

Code: Select all

Type point2d
	x As Integer
	y As Integer
End Type
Type my_bezier_curve_udt
	a As point2d 'point A the curve start
	b As point2d 'point B the curve end
	c As point2d 'point C the curve control
	p_res As Double 'the plotted resolution 
	Declare Sub plot()
End Type
Sub my_bezier_curve_udt.plot()
	Dim As Double x,y,t 'some local variable used to plot the curve
	For t = 0 To 1 Step p_res
		x = (1 - t) * (1 - t) * a.x + 2 * (1 - t) * t * c.x + t * t * b.x
		y = (1 - t) * (1 - t) * a.y + 2 * (1 - t) * t * c.y + t * t * b.y
		Circle(x,y),3,14
	Next
End Sub

Dim mbzu As my_bezier_curve_udt
mbzu.a.x=100 'curve start
mbzu.a.y=200 'curve start
mbzu.b.x=300 'curve end
mbzu.b.y=200 'curve end
mbzu.p_res=.05

ScreenRes 400,400

Do
	Select Case InKey
		Case Chr(27),Chr(255)+"k"
			Exit Do
	End Select
	GetMouse(mbzu.c.x, mbzu.c.y)
	ScreenLock
	Cls
	mbzu.plot()
	ScreenUnLock
	Sleep 1
Loop

owen
Site Admin
Posts: 654
Joined: Thu Apr 13, 2017 12:14 pm

Re: bezier

Post by owen » Thu Jun 20, 2019 6:46 pm

rather then drawing little tiny circles at the plotted points of the curve, let's draw a series of lines from point to point.
you can see how i do this in the sub routine:

Code: Select all

Sub my_bezier_curve_udt.plot()
	Dim As Double x,y,t 'some local variable used to plot the curve
	PSet(a.x, a.y), 14
	For t = 0 To 1 Step p_res
		x = (1 - t) * (1 - t) * a.x + 2 * (1 - t) * t * c.x + t * t * b.x
		y = (1 - t) * (1 - t) * a.y + 2 * (1 - t) * t * c.y + t * t * b.y
		Line -(x, y),14
	Next
End Sub
first is use PSET to start the process
then the LINE command using the line continuation option: see the freeBASIC help for the LINE command for details:
When Line is used as Line - (x2, y2), a line is drawn from the current cursor position to the (x2,y2) coordinates specified by Line. Alternatively, Point can be used to get the current cursor position.
Note: the help instructions say to use the POINT command, rather I use the PSET command to SET the current cursor position.

Code: Select all

Type point2d
	x As Integer
	y As Integer
End Type
Type my_bezier_curve_udt
	a As point2d 'point A the curve start
	b As point2d 'point B the curve end
	c As point2d 'point C the curve control
	p_res As Double 'the plotted resolution 
	Declare Sub plot()
End Type
Sub my_bezier_curve_udt.plot()
	Dim As Double x,y,t 'some local variable used to plot the curve
	PSet(a.x, a.y), 14
	For t = 0 To 1 Step p_res
		x = (1 - t) * (1 - t) * a.x + 2 * (1 - t) * t * c.x + t * t * b.x
		y = (1 - t) * (1 - t) * a.y + 2 * (1 - t) * t * c.y + t * t * b.y
		Line -(x, y),14
	Next
End Sub

Dim mbzu As my_bezier_curve_udt
mbzu.a.x=100 'curve start
mbzu.a.y=200 'curve start
mbzu.b.x=300 'curve end
mbzu.b.y=200 'curve end
mbzu.p_res=.05

ScreenRes 400,400

Do
	Select Case InKey
		Case Chr(27),Chr(255)+"k"
			Exit Do
	End Select
	GetMouse(mbzu.c.x, mbzu.c.y)
	ScreenLock
	Cls
	mbzu.plot()
	ScreenUnLock
	Sleep 1
Loop

owen
Site Admin
Posts: 654
Joined: Thu Apr 13, 2017 12:14 pm

Re: bezier

Post by owen » Thu Jun 20, 2019 7:47 pm

in this example i made it possible to define the START and END points of the curve.
to test this code:
1. click the mouse button
2. move the mouse, you should see a line is drawn on the screen from the point where you clicked to the mouse position
3. click the mouse button again
4. move the mouse, you should see a curve is drawn from the first click to the second click according to the mouse position
5. click the mouse a third time and it clears the screen resetting the click count to zero so you can draw the curve again using different start and end points.

Code: Select all

Type point2d
	x As Integer
	y As Integer
End Type
Type my_bezier_curve_udt
	a As point2d 'point A the curve start
	b As point2d 'point B the curve end
	c As point2d 'point C the curve control
	p_res As Double 'the plotted resolution 
	Declare Sub plot()
End Type

Sub my_bezier_curve_udt.plot()
	Dim As Double x,y,t 'some local variable used to plot the curve
	PSet(a.x, a.y), 14
	For t = 0 To 1 Step p_res
		x = (1 - t) * (1 - t) * a.x + 2 * (1 - t) * t * c.x + t * t * b.x
		y = (1 - t) * (1 - t) * a.y + 2 * (1 - t) * t * c.y + t * t * b.y
		Line -(x, y),14
	Next
End Sub

Dim mbzu As my_bezier_curve_udt
mbzu.p_res=.1

Dim As Integer mouse_x, mouse_y, mouse_wheel, mouse_button, click_count
Dim As BOOLEAN mouse_button_released

ScreenRes 400,400

Do
	Select Case InKey
		Case Chr(27),Chr(255)+"k"
			Exit Do
	End Select
	GetMouse(mouse_x, mouse_y, mouse_wheel, mouse_button)
	If mouse_button = 1 Then
		If mouse_button_released = TRUE Then
			mouse_button_released = FALSE
			click_count += 1
			Select Case click_count
				Case 1 'set the curve start
					mbzu.a.x = mouse_x
					mbzu.a.y = mouse_y
				Case 2
					mbzu.b.x = mouse_x
					mbzu.b.y = mouse_y
				Case 3
					click_count = 0
					Cls
			End Select
		EndIf
	EndIf
	If mouse_button = 0 Then mouse_button_released = TRUE
	Select Case click_count
		Case 1
			'draw a line from point A to the current mouse position
			ScreenLock
			Cls
			Line(mbzu.a.x, mbzu.a.y)-(mouse_x, mouse_y)
			ScreenUnLock
		Case 2
			mbzu.c.x = mouse_x
			mbzu.c.y = mouse_y
			ScreenLock
			Cls
			mbzu.plot()
			ScreenUnLock
	End Select
	Sleep 1
Loop

owen
Site Admin
Posts: 654
Joined: Thu Apr 13, 2017 12:14 pm

Re: bezier

Post by owen » Thu Jun 20, 2019 8:11 pm

in this example i made it possible to draw multiple curves

Code: Select all

Type point2d
	x As Integer
	y As Integer
End Type
Type my_bezier_curve_udt
	a As point2d 'point A the curve start
	b As point2d 'point B the curve end
	c As point2d 'point C the curve control
	p_res As Double 'the plotted resolution 
	Declare Sub plot()
End Type

Sub my_bezier_curve_udt.plot()
	Dim As Double x,y,t 'some local variable used to plot the curve
	PSet(a.x, a.y), 14
	For t = 0 To 1 Step p_res
		x = (1 - t) * (1 - t) * a.x + 2 * (1 - t) * t * c.x + t * t * b.x
		y = (1 - t) * (1 - t) * a.y + 2 * (1 - t) * t * c.y + t * t * b.y
		Line -(x, y),14
	Next
End Sub

Dim As my_bezier_curve_udt mbzu()
Dim As Integer curve_count
ReDim mbzu(curve_count)
mbzu(curve_count).p_res=.1

Dim As Integer mouse_x, mouse_y, mouse_wheel, mouse_button, click_count
Dim As BOOLEAN mouse_button_released

ScreenRes 400,400

Do
	Select Case InKey
		Case Chr(27),Chr(255)+"k"
			Exit Do
	End Select
	GetMouse(mouse_x, mouse_y, mouse_wheel, mouse_button)
	If mouse_button = 1 Then
		If mouse_button_released = TRUE Then
			mouse_button_released = FALSE
			click_count += 1
			Select Case click_count
				Case 1 'set the curve start
					mbzu(curve_count).a.x = mouse_x
					mbzu(curve_count).a.y = mouse_y
				Case 2
					mbzu(curve_count).b.x = mouse_x
					mbzu(curve_count).b.y = mouse_y
				Case 3
					mbzu(curve_count).c.x = mouse_x
					mbzu(curve_count).c.y = mouse_y
					click_count = 0
					curve_count += 1
					ReDim Preserve mbzu(curve_count)
					mbzu(curve_count).p_res=.1
			End Select
		EndIf
	EndIf
	If mouse_button = 0 Then mouse_button_released = TRUE
	ScreenLock
	Cls
	For i As Integer = 0 To curve_count -1
		mbzu(i).plot()
	Next
	Select Case click_count
		Case 1
			'draw a line from point A to the current mouse position
			Line(mbzu(curve_count).a.x, mbzu(curve_count).a.y)-(mouse_x, mouse_y)
		Case 2
			mbzu(curve_count).c.x = mouse_x
			mbzu(curve_count).c.y = mouse_y
			mbzu(curve_count).plot()
	End Select
	ScreenUnLock
	Sleep 1
Loop

owen
Site Admin
Posts: 654
Joined: Thu Apr 13, 2017 12:14 pm

Re: bezier

Post by owen » Thu Jun 20, 2019 8:42 pm

that last example used a FOR NEXT loop to redraw all of the curves which is kinda terrible to do that every split second within the main loop
so here is a better way to go about it.

i use freeBASIC's graphic buffer
ScreenRes 400,400,,2
The 2 on the end there creates two (2) screen buffers
Then i use the commands SCREENSET and SCREENCOPY in order to take advantage of the buffers.

So now rather then redrawing all the curves, I simply draw the current curve (upon the third mouse click) on screen buffer 0
then in the main loop i don't clear the screen anymore ie CLS, instead i SCREENCOPY 0 to 1

note: also i changed the curve resolution during design to a low res and when finalizing it i draw it in a higher res on screen 0

Code: Select all

Type point2d
	x As Integer
	y As Integer
End Type
Type my_bezier_curve_udt
	a As point2d 'point A the curve start
	b As point2d 'point B the curve end
	c As point2d 'point C the curve control
	p_res As Double 'the plotted resolution 
	Declare Sub plot()
End Type

Sub my_bezier_curve_udt.plot()
	Dim As Double x,y,t 'some local variable used to plot the curve
	PSet(a.x, a.y), 14
	For t = 0 To 1 Step p_res
		x = (1 - t) * (1 - t) * a.x + 2 * (1 - t) * t * c.x + t * t * b.x
		y = (1 - t) * (1 - t) * a.y + 2 * (1 - t) * t * c.y + t * t * b.y
		Line -(x, y),14
	Next
End Sub

Dim As my_bezier_curve_udt mbzu()
Dim As Integer curve_count
ReDim mbzu(curve_count)
mbzu(curve_count).p_res=.25

Dim As Integer mouse_x, mouse_y, mouse_wheel, mouse_button, click_count
Dim As BOOLEAN mouse_button_released

ScreenRes 400,400,,2
ScreenSet 1,1
Do
	Select Case InKey
		Case Chr(27),Chr(255)+"k"
			Exit Do
	End Select
	GetMouse(mouse_x, mouse_y, mouse_wheel, mouse_button)
	If mouse_button = 1 Then
		If mouse_button_released = TRUE Then
			mouse_button_released = FALSE
			click_count += 1
			Select Case click_count
				Case 1 'set the curve start
					mbzu(curve_count).a.x = mouse_x
					mbzu(curve_count).a.y = mouse_y
				Case 2
					mbzu(curve_count).b.x = mouse_x
					mbzu(curve_count).b.y = mouse_y
				Case 3
					mbzu(curve_count).c.x = mouse_x
					mbzu(curve_count).c.y = mouse_y
					ScreenSet 0,1
					mbzu(curve_count).p_res=.05
					mbzu(curve_count).plot()
					ScreenSet 1,1
					click_count = 0
					curve_count += 1
					ReDim Preserve mbzu(curve_count)
					mbzu(curve_count).p_res=.25
			End Select
		EndIf
	EndIf
	If mouse_button = 0 Then mouse_button_released = TRUE
	ScreenLock
	ScreenCopy 0,1
	Select Case click_count
		Case 1
			'draw a line from point A to the current mouse position
			Line(mbzu(curve_count).a.x, mbzu(curve_count).a.y)-(mouse_x, mouse_y)
		Case 2
			mbzu(curve_count).c.x = mouse_x
			mbzu(curve_count).c.y = mouse_y
			mbzu(curve_count).plot()
	End Select
	ScreenUnLock
	Sleep 1
Loop

owen
Site Admin
Posts: 654
Joined: Thu Apr 13, 2017 12:14 pm

Re: bezier

Post by owen » Thu Jun 20, 2019 8:59 pm

using this concept of screen buffers, your keen observation should be:
well, in this case we don't need to use an array of curves any more, and you would be right.

however:
what if we wanted to keep track of the start, end and control points of each curve so that we could do something like snap to these point
for the purpose of drawing nice looking continuous curves.

well in that case having the arrays of curves would be needed.

owen
Site Admin
Posts: 654
Joined: Thu Apr 13, 2017 12:14 pm

Re: bezier

Post by owen » Thu Jun 20, 2019 9:37 pm

in this example you can snap to the end points of previously drawn curves.
note: added right mouse click to cancel drawing a curve
note: also corrected drawing the curve in hi res to point b

Code: Select all

Type point2d
	x As Integer
	y As Integer
End Type
Type my_bezier_curve_udt
	a As point2d 'point A the curve start
	b As point2d 'point B the curve end
	c As point2d 'point C the curve control
	p_res As Double 'the plotted resolution 
	Declare Sub plot()
End Type

Sub my_bezier_curve_udt.plot()
	Dim As Double x,y,t 'some local variable used to plot the curve
	PSet(a.x, a.y), 14
	For t = 0 To 1 Step p_res
		x = (1 - t) * (1 - t) * a.x + 2 * (1 - t) * t * c.x + t * t * b.x
		y = (1 - t) * (1 - t) * a.y + 2 * (1 - t) * t * c.y + t * t * b.y
		Line -(x, y),14
	Next
	Line -(b.x, b.y), 14
End Sub

Dim As my_bezier_curve_udt mbzu()
Dim As Integer curve_count
ReDim mbzu(curve_count)
mbzu(curve_count).p_res=.25

Dim As Integer mouse_x, mouse_y, mouse_wheel, mouse_button, click_count
Dim As BOOLEAN mouse_button_released,snap

ScreenRes 400,400,,2
ScreenSet 1,1
Do
	Select Case InKey
		Case Chr(27),Chr(255)+"k"
			Exit Do
	End Select
	GetMouse(mouse_x, mouse_y, mouse_wheel, mouse_button)
	snap=FALSE
	For i As Integer = 0 To curve_count - 1
		Select Case mouse_x
			Case mbzu(i).a.x - 5 To mbzu(i).a.x + 5
				Select Case mouse_y
					Case mbzu(i).a.y - 5 To  mbzu(i).a.y + 5
						mouse_x = mbzu(i).a.x
						mouse_y = mbzu(i).a.y
						snap = TRUE
						Exit For
				End Select
			Case mbzu(i).b.x - 5 To mbzu(i).b.x + 5
				Select Case mouse_y
					Case mbzu(i).b.y - 5 To  mbzu(i).b.y + 5
						mouse_x = mbzu(i).b.x
						mouse_y = mbzu(i).b.y
						snap = TRUE
						Exit For
				End Select
		End Select
	Next
	Select Case mouse_button
		Case 1
			If mouse_button_released = TRUE Then
				mouse_button_released = FALSE
				click_count += 1
				Select Case click_count
					Case 1 'set the curve start
						mbzu(curve_count).a.x = mouse_x
						mbzu(curve_count).a.y = mouse_y
					Case 2
						mbzu(curve_count).b.x = mouse_x
						mbzu(curve_count).b.y = mouse_y
					Case 3
						mbzu(curve_count).c.x = mouse_x
						mbzu(curve_count).c.y = mouse_y
						ScreenSet 0,1
						mbzu(curve_count).p_res=.05
						mbzu(curve_count).plot()
						ScreenSet 1,1
						click_count = 0
						curve_count += 1
						ReDim Preserve mbzu(curve_count)
						mbzu(curve_count).p_res=.25
				End Select
			EndIf
		Case 2
			click_count = 0
	End Select
	If mouse_button = 0 Then mouse_button_released = TRUE
	ScreenLock
	ScreenCopy 0,1
	If snap=TRUE Then Circle(mouse_x, mouse_y),5,13,,,,f
	Select Case click_count
		Case 1
			'draw a line from point A to the current mouse position
			Line(mbzu(curve_count).a.x, mbzu(curve_count).a.y)-(mouse_x, mouse_y)
		Case 2
			mbzu(curve_count).c.x = mouse_x
			mbzu(curve_count).c.y = mouse_y
			mbzu(curve_count).plot()
	End Select
	ScreenUnLock
	Sleep 1
Loop

owen
Site Admin
Posts: 654
Joined: Thu Apr 13, 2017 12:14 pm

Re: bezier

Post by owen » Wed Jan 01, 2020 6:03 am

curve tracks the mouse pointer

Code: Select all

Type point2d
	x As Integer
	y As Integer
End Type
Type my_bezier_curve_udt
	a As point2d 'point A the curve start
	b As point2d 'point B the curve end
	c As point2d 'point C the curve control
	p_res As Double 'the plotted resolution 
	Declare Sub plot()
End Type

Sub my_bezier_curve_udt.plot()
	Dim As Double x,y,t 'some local variable used to plot the curve
	c.y+=(.5*((c.y-a.y)+(c.y-b.y)))
	c.x+=(.5*((c.x-a.x)+(c.x-b.x)))
	PSet(a.x, a.y), 14
	For t = 0 To 1 Step p_res
		x =  (a.x + t*(c.x - a.x)) +   t* ((c.x + t*(b.x - c.x))  -  (a.x + t*(c.x - a.x)))
		y =  (a.y + t*(c.y - a.y)) +   t* ((c.y + t*(b.y - c.y))  -  (a.y + t*(c.y - a.y)))
		Line -(x, y),14
	Next
	Line -(b.x, b.y), 14
End Sub

Dim As my_bezier_curve_udt mbzu()
Dim As Integer curve_count
ReDim mbzu(curve_count)
mbzu(curve_count).p_res=.1

Dim As Integer mouse_x, mouse_y, mouse_wheel, mouse_button, click_count
Dim As BOOLEAN mouse_button_released,snap

ScreenRes 400,400,,2
ScreenSet 1,1
Do
	Select Case InKey
		Case Chr(27),Chr(255)+"k"
			Exit Do
	End Select
	GetMouse(mouse_x, mouse_y, mouse_wheel, mouse_button)
	snap=FALSE
	For i As Integer = 0 To curve_count - 1
		Select Case mouse_x
			Case mbzu(i).a.x - 5 To mbzu(i).a.x + 5
				Select Case mouse_y
					Case mbzu(i).a.y - 5 To  mbzu(i).a.y + 5
						mouse_x = mbzu(i).a.x
						mouse_y = mbzu(i).a.y
						snap = TRUE
						Exit For
				End Select
			Case mbzu(i).b.x - 5 To mbzu(i).b.x + 5
				Select Case mouse_y
					Case mbzu(i).b.y - 5 To  mbzu(i).b.y + 5
						mouse_x = mbzu(i).b.x
						mouse_y = mbzu(i).b.y
						snap = TRUE
						Exit For
				End Select
		End Select
	Next
	Select Case mouse_button
		Case 1
			If mouse_button_released = TRUE Then
				mouse_button_released = FALSE
				click_count += 1
				Select Case click_count
					Case 1 'set the curve start
						mbzu(curve_count).a.x = mouse_x
						mbzu(curve_count).a.y = mouse_y
					Case 2
						mbzu(curve_count).b.x = mouse_x
						mbzu(curve_count).b.y = mouse_y
					Case 3
						mbzu(curve_count).c.x = mouse_x
						mbzu(curve_count).c.y = mouse_y
						ScreenSet 0,1
						mbzu(curve_count).p_res=.05
						mbzu(curve_count).plot()
						ScreenSet 1,1
						click_count = 0
						curve_count += 1
						ReDim Preserve mbzu(curve_count)
						mbzu(curve_count).p_res=.1
				End Select
			EndIf
		Case 2
			click_count = 0
	End Select
	If mouse_button = 0 Then mouse_button_released = TRUE
	ScreenLock
	ScreenCopy 0,1
	If snap=TRUE Then Circle(mouse_x, mouse_y),5,13,,,,f
	Select Case click_count
		Case 1
			'draw a line from point A to the current mouse position
			Line(mbzu(curve_count).a.x, mbzu(curve_count).a.y)-(mouse_x, mouse_y)
		Case 2
			mbzu(curve_count).c.x = mouse_x
			mbzu(curve_count).c.y = mouse_y
			mbzu(curve_count).plot()
	End Select
	ScreenUnLock
	Sleep 1
Loop


owen
Site Admin
Posts: 654
Joined: Thu Apr 13, 2017 12:14 pm

Re: bezier

Post by owen » Sun Jan 05, 2020 8:38 am

snap to nearest point on the curve

Code: Select all

Type point2d
	x As double
	y As double
End Type
Type my_bezier_curve_udt
	a As point2d 'point A the curve start
	b As point2d 'point B the curve end
	c As point2d 'point C the curve control
	d As double 'distance to nearest point on the curve
	n As point2d 'nearest point on the curve
	Declare Sub nearest_pt(mx as integer, my as integer)
	Declare Sub plot(p_res as integer)
	Declare function pt_x(t as double) as double
	Declare function pt_y(t as double) as double
End Type
Sub my_bezier_curve_udt.nearest_pt(mx as integer, my as integer)
	dim as double dist,x,y,t
	dim as integer pres=100
	d=sqr((mx-a.x)*(mx-a.x)+(my-a.y)*(my-a.y))
	n=a
	For i as integer = 1 To pres
		t=i/pres
		x=pt_x(t)
		y=pt_y(t)
		dist=sqr((mx-x)*(mx-x)+(my-y)*(my-y))
		if dist<d then
			d=dist
			n.x=x
			n.y=y
		EndIf
	Next
	
End Sub
Sub my_bezier_curve_udt.plot(p_res as integer)
	Dim As Double x,y,t 'some local variable used to plot the curve
	c.y+=(.5*((c.y-a.y)+(c.y-b.y)))
	c.x+=(.5*((c.x-a.x)+(c.x-b.x)))
	PSet(a.x, a.y), 14
	For i as integer = 1 To p_res-1
		t=i/p_res
		Line -(pt_x(t), pt_y(t)),14
	Next
	Line -(b.x, b.y), 14
End Sub

function my_bezier_curve_udt.pt_x(t as double) as double
	return (a.x + t*(c.x - a.x)) +   t* ((c.x + t*(b.x - c.x))  -  (a.x + t*(c.x - a.x)))
End Function
function my_bezier_curve_udt.pt_y(t as double) as double
	return (a.y + t*(c.y - a.y)) +   t* ((c.y + t*(b.y - c.y))  -  (a.y + t*(c.y - a.y)))
End Function


Dim As my_bezier_curve_udt mbzu()
Dim As Integer curve_count
ReDim mbzu(curve_count)

Dim As Integer mouse_x, mouse_y, mouse_wheel, mouse_button, click_count
Dim As BOOLEAN mouse_button_released,snap

ScreenRes 400,400,,2
ScreenSet 1,1
Do
	Select Case InKey
		Case Chr(27),Chr(255)+"k"
			Exit Do
	End Select
	GetMouse(mouse_x, mouse_y, mouse_wheel, mouse_button)
	snap=FALSE
	For i As Integer = 0 To curve_count - 1
		Select Case mouse_x
			Case mbzu(i).a.x - 7 To mbzu(i).a.x + 7
				Select Case mouse_y
					Case mbzu(i).a.y - 7 To  mbzu(i).a.y + 7
						mouse_x = mbzu(i).a.x
						mouse_y = mbzu(i).a.y
						snap = TRUE
						Exit For
				End Select
			Case mbzu(i).b.x - 7 To mbzu(i).b.x + 7
				Select Case mouse_y
					Case mbzu(i).b.y - 7 To  mbzu(i).b.y + 7
						mouse_x = mbzu(i).b.x
						mouse_y = mbzu(i).b.y
						snap = TRUE
						Exit For
				End Select
		End Select
	Next
	if snap=false then
		'find nearest point on nearest curve
		For i As Integer = 0 To curve_count - 1
			mbzu(i).nearest_pt(mouse_x, mouse_y)
			Select Case mouse_x
				Case mbzu(i).n.x - 5 To mbzu(i).n.x + 5
					Select Case mouse_y
						Case mbzu(i).n.y - 5 To  mbzu(i).n.y + 5
							mouse_x = mbzu(i).n.x
							mouse_y = mbzu(i).n.y
							snap = TRUE
							Exit For
					End Select
			End Select
		Next
	EndIf
	Select Case mouse_button
		Case 1
			If mouse_button_released = TRUE Then
				mouse_button_released = FALSE
				click_count += 1
				Select Case click_count
					Case 1 'set the curve start
						mbzu(curve_count).a.x = mouse_x
						mbzu(curve_count).a.y = mouse_y
					Case 2
						mbzu(curve_count).b.x = mouse_x
						mbzu(curve_count).b.y = mouse_y
					Case 3
						mbzu(curve_count).c.x = mouse_x
						mbzu(curve_count).c.y = mouse_y
						ScreenSet 0,1
						mbzu(curve_count).plot(100)
						ScreenSet 1,1
						click_count = 0
						curve_count += 1
						ReDim Preserve mbzu(curve_count)
				End Select
			EndIf
		Case 2
			click_count = 0
	End Select
	If mouse_button = 0 Then mouse_button_released = TRUE
	ScreenLock
	ScreenCopy 0,1
	If snap=TRUE Then Circle(mouse_x, mouse_y),5,13,,,,f
	Select Case click_count
		Case 1
			'draw a line from point A to the current mouse position
			Line(mbzu(curve_count).a.x, mbzu(curve_count).a.y)-(mouse_x, mouse_y)
		Case 2
			mbzu(curve_count).c.x = mouse_x
			mbzu(curve_count).c.y = mouse_y
			mbzu(curve_count).plot(20)
	End Select
	ScreenUnLock
	Sleep 1
Loop



owen
Site Admin
Posts: 654
Joined: Thu Apr 13, 2017 12:14 pm

Re: bezier

Post by owen » Fri Jan 10, 2020 4:05 am

multiple control points

Code: Select all

Type point2d
	x As double
	y As double
End Type
Type bezier
	as integer n=-1
	pt(any) As point2d 'anchors and control points (p0 thru pN)
	declare sub append_pt(x as double, y as double)
	declare sub delete_pt(d as integer)
	declare sub plot(pres as integer)
End Type
sub bezier.append_pt(x as double, y as double)
	n+=1
	redim preserve pt(n)
	pt(n).x=x
	pt(n).y=y
End Sub
sub bezier.delete_pt(d as integer)
	for i as integer = d to n-1
		pt(i)=pt(i+1)
	Next
	n-=1
	redim preserve pt(n)
End Sub
sub bezier.plot(pres as integer)
	dim as point2d c(n,n)
	dim as double x_range,y_range
	pset(pt(0).x,pt(0).y)
	for t as integer = 1 to pres
		for i as integer = 0 to n-1
			x_range=pt(i+1).x - pt(i).x
			y_range=pt(i+1).y - pt(i).y
			c(i,0).x=pt(i).x+x_range*t/pres
			c(i,0).y=pt(i).y+y_range*t/pres
		Next
		for k as integer = 0 to n
			for i as integer = 0 to n-(k+2)
				x_range=c(i+1,k).x - c(i,k).x
				y_range=c(i+1,k).y - c(i,k).y
				c(i,k+1).x=c(i,k).x+x_range*t/pres
				c(i,k+1).y=c(i,k).y+y_range*t/pres
				if n<(k+3) then line -(c(i,k+1).x,c(i,k+1).y)
			Next
		Next
	next
End Sub
sub updatebz(pres as integer,byref bz as bezier)
	screenlock
	ScreenSet 0,1
	cls
	with bz
		for i as integer=0 to bz.n
			circle(.pt(i).x,.pt(i).y),6
		Next
		select case .n
			case 1
				line(.pt(0).x,.pt(0).y)-(.pt(1).x,.pt(1).y)
			case is > 1
				.plot(pres)
		End Select
	end with
	screencopy 0,1
	screenset 1,1
	screenunlock
End Sub



Dim As bezier bz
Dim As Integer mouse_x, mouse_y, mouse_wheel, mouse_button, click_count
dim as integer selected_point
Dim As BOOLEAN mouse_button_released,snap,edit
ScreenRes 400,400,,2
ScreenSet 1,1
Do
	Select Case InKey
		Case Chr(27),Chr(255)+"k"
			Exit Do
	End Select
	GetMouse(mouse_x, mouse_y, mouse_wheel, mouse_button)
	if edit=false then
		snap=false
		screencopy 0,1
		for i as integer=0 to bz.n
			with bz
				select case mouse_x
					case .pt(i).x -3 to .pt(i).x+3
						select case mouse_y
							case .pt(i).y -3 to .pt(i).y+3
								snap=true
								selected_point=i
								screenset 1,1
								circle(.pt(i).x,.pt(i).y),6,3,,,,f
								exit for
						End Select
				End Select
			End With
		Next
	endif
	Select Case mouse_button
		case 0
			mouse_button_released = TRUE
			if edit=true then
				edit=false
				updatebz(100,bz)
			EndIf
		Case 1
			If mouse_button_released = TRUE Then
				mouse_button_released = FALSE
				if snap=true then
					edit=true
				else
					bz.append_pt(mouse_x,mouse_y)
					updatebz(100,bz)
				EndIf
			endif
		case 2
			If mouse_button_released = TRUE Then
				mouse_button_released = FALSE
				if snap=true then
					snap=false
					bz.delete_pt(selected_point)
					updatebz(100,bz)
				EndIf
			endif
	End Select
	if edit=true then
		with bz
			.pt(selected_point).x=mouse_x
			.pt(selected_point).y=mouse_y
		end with
		updatebz(10,bz)
	EndIf
	Sleep 1
Loop



Post Reply