## bezier

freeBASIC source code examples by FbCadcam staff and interns

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

owen
Posts: 656
Joined: Thu Apr 13, 2017 12:14 pm

### bezier

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
Posts: 656
Joined: Thu Apr 13, 2017 12:14 pm

### Re: bezier

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
'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
Posts: 656
Joined: Thu Apr 13, 2017 12:14 pm

### Re: bezier

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
Posts: 656
Joined: Thu Apr 13, 2017 12:14 pm

### Re: bezier

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
Posts: 656
Joined: Thu Apr 13, 2017 12:14 pm

### Re: bezier

'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
Posts: 656
Joined: Thu Apr 13, 2017 12:14 pm

### Re: bezier

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
Posts: 656
Joined: Thu Apr 13, 2017 12:14 pm

### Re: bezier

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
Posts: 656
Joined: Thu Apr 13, 2017 12:14 pm

### Re: bezier

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
Posts: 656
Joined: Thu Apr 13, 2017 12:14 pm

### Re: bezier

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
Posts: 656
Joined: Thu Apr 13, 2017 12:14 pm

### Re: bezier

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
Posts: 656
Joined: Thu Apr 13, 2017 12:14 pm

### Re: bezier

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
Posts: 656
Joined: Thu Apr 13, 2017 12:14 pm

### Re: bezier

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
Posts: 656
Joined: Thu Apr 13, 2017 12:14 pm

### Re: bezier

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
Posts: 656
Joined: Thu Apr 13, 2017 12:14 pm

### Re: bezier

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
Posts: 656
Joined: Thu Apr 13, 2017 12:14 pm

### Re: bezier

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
Posts: 656
Joined: Thu Apr 13, 2017 12:14 pm

### Re: bezier

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
Posts: 656
Joined: Thu Apr 13, 2017 12:14 pm

### Re: bezier

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