## Curved but Linear path traversal using Catmull-rom splines..

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
relsoft
Posts: 1767
Joined: May 27, 2005 10:34
Location: Philippines
Contact:

### Curved but Linear path traversal using Catmull-rom splines..

Useful for enemy movement patterns.

Code: Select all

Type Tpoint
x           as single
y           as single
end type

function catmull_rom(byval p0 as TPoint, byval p1 as TPoint, byval p2 as TPoint, byval p3 as TPoint, byval t as single) as Tpoint

dim as single  t2 = t * t
dim as single  t3 = t2 * t
dim as Tpoint catmull_point
catmull_point.x = 0.5f * ( ( 2.0 * p1.x ) +_
( -p0.x + p2.x ) * t +_
( 2.0 * p0.x - 5.0 * p1.x + 4 * p2.x - p3.x ) * t2 +_
( -p0.x + 3.0 * p1.x - 3.0 * p2.x + p3.x ) * t3 )
catmull_point.y = 0.5 * ( ( 2.0 * p1.y ) +_
( -p0.y + p2.y ) * t +_
( 2.0 * p0.y - 5.0 * p1.y + 4 * p2.y - p3.y ) * t2 +_
( -p0.y + 3.0 * p1.y - 3.0 * p2.y + p3.y ) * t3 )

return catmull_point

end function

function cosine_spline(byval p0 as TPoint, byval p1 as TPoint, byval t as single) as Tpoint

dim as Tpoint cosine_point
dim as single ft,f
ft = t * 3.1415927
f = (1 - cos(ft)) * 0.5

cosine_point.x =  p0.x *(1-f) + p1.x *f
cosine_point.y =  p0.y *(1-f) + p1.y *f

return cosine_point

end function

function bezier(byval p0 as TPoint, byval p1 as TPoint, byval p2 as TPoint, byval p3 as TPoint, byval t as single) as Tpoint

dim as Tpoint bez
dim as single b

'A = p1
'B = p0
'C = p3
'D = p2

b = 1 - t

bez.x = p1.x*b^3 + 3*p0.x*(b^2)*t + 3*p3.x*(b)*(t^2) + p2.x*(t^3)
bez.y = p1.y*b^3 + 3*p0.y*(b^2)*t + 3*p3.y*(b)*(t^2) + p2.y*(t^3)

return bez

end function

cls
screen 18,,2

randomize timer

const as integer MAXPOINTS = 50

dim i as integer
dim points(0 to (MAXPOINTS-1)) as Tpoint
dim p as Tpoint
dim p0 as Tpoint
dim p1 as Tpoint
dim p2 as Tpoint
dim p3 as Tpoint

for i = 0 to MAXPOINTS-1
points(i).x = rnd * 640
points(i).y = rnd * 480
next i

dim current_color as integer

current_color = 2
dim index as integer
index = 1
do

for i = 0 to MAXPOINTS - 1
circle (points(i).x,points(i).y), 5, 5
next i

if index = 0 then
p0.x = points(index-1).x
p0.y = points(index-1).y
p1.x = points(index).x
p1.y = points(index).y
p2.x = points(index + 1).x
p2.y = points(index + 1).y
p3.x = points(index + 2).x
p3.y = points(index + 2).y
else
p0.x = points(index).x
p0.y = points(index).y
p1.x = points((index + 1) mod MAXPOINTS).x
p1.y = points((index + 1) mod MAXPOINTS).y
p2.x = points((index + 2) mod MAXPOINTS).x
p2.y = points((index + 2) mod MAXPOINTS).y
p3.x = points((index + 3) mod MAXPOINTS).x
p3.y = points((index + 3) mod MAXPOINTS).y
end if

for i = 0 to 99

dim as single t
t = i/100

p = catmull_rom(p0,p1,p2,p3,t)
if i = 0 then
pset (p.x,p.y), current_color
else
line -(p.x,p.y), current_color
end if

sleep 1

next i

index += 1
if index = MAXPOINTS then
index = 1
current_color =  1 + (current_color + 1) and 15
end if

loop until inkey<>""

Skyler
Posts: 242
Joined: Sep 26, 2006 16:30
I tried to use this, substituting READ p.x, p.y for the random number generator, but it connected the dots in the wrong order. How come?
Manpcnin
Posts: 18
Joined: Feb 25, 2007 1:43
Location: N.Z.
I've done somthing very similar.

It was just a test for my spline Function but it makes a very smooth random motion. it looks like a firefly.

Code: Select all

screen 14,16
randomize timer
type p2d
x as double
y as double
end type

type spline
p1 as p2d
p2 as p2d
vert as p2d
end type

declare function spline(myspline as spline,along as double)as p2d
dim spline1 as spline

spline1.p1.x = rnd * 320
spline1.p1.y = rnd * 240
spline1.p2.x = rnd * 320
spline1.p2.y = rnd * 240
spline1.vert.x = rnd * 320
spline1.vert.y = rnd * 240

dim point1 as p2d
dim point2 as p2d
dim array(51) as p2d
do
point1 = spline(spline1,0)
point2 = point1

for i% = 0 to 100
sleep 1

point1 = spline(spline1,i%/100)

for k% = 50 to 0 step -1
line (array(k%+1).x,array(k%+1).y)-(array(k%).x,array(k%).y),rgb((50-k%)*5,(50-k%)*5,(50-k%)*5)
array(k%+1)=array(k%)
next k%
array(0) =point1
next i%

spline1.p1.x = spline1.vert.x
spline1.p1.y = spline1.vert.y
spline1.vert.x = spline1.p2.x
spline1.vert.y = spline1.p2.y
spline1.p2.x = rnd * 320
spline1.p2.y = rnd * 240

loop while inkey\$ = ""

end

function spline(myspline as spline,along as double)as p2d
dim ret as p2d
select case along
case is< 0 :f1# = 0:f2# = 1
case is> 1 : f1# = 1:f2# = 0
case else : f2# = 1-along:f1# = along
end select

tx1# = (myspline.p1.x+myspline.vert.x)/2
ty1# = (myspline.p1.y+myspline.vert.y)/2
tx2# = (myspline.p2.x+myspline.vert.x)/2
ty2# = (myspline.p2.y+myspline.vert.y)/2

tx1# = ((tx1#*f2#)+(myspline.vert.x*f1#))
ty1# = ((ty1#*f2#)+(myspline.vert.y*f1#))
tx2# = ((tx2#*f1#)+(myspline.vert.x*f2#))
ty2# = ((ty2#*f1#)+(myspline.vert.y*f2#))
ret.x = ((tx1#*f2#)+(tx2#*f1#))
ret.y = ((ty1#*f2#)+(ty2#*f1#))
spline = ret
return
end function
relsoft
Posts: 1767
Joined: May 27, 2005 10:34
Location: Philippines
Contact:
Skyler wrote:I tried to use this, substituting READ p.x, p.y for the random number generator, but it connected the dots in the wrong order. How come?

Code?
Skyler
Posts: 242
Joined: Sep 26, 2006 16:30

Code: Select all

declare sub phaser(x as integer, y as integer)
declare sub brush(x as integer, y as integer, c as integer)
declare sub cut(x as double, y as double, x2 as integer, y2 as integer, c as integer)

Type Tpoint
x           As Single
y           As Single
End Type

Function catmull_rom(Byval p0 As TPoint, Byval p1 As TPoint, Byval p2 As TPoint, Byval p3 As TPoint, Byval t As Single) As Tpoint

Dim As Single  t2 = t * t
Dim As Single  t3 = t2 * t
Dim As Tpoint catmull_point
catmull_point.x = 0.5f * ( ( 2.0 * p1.x ) +_
( -p0.x + p2.x ) * t +_
( 2.0 * p0.x - 5.0 * p1.x + 4 * p2.x - p3.x ) * t2 +_
( -p0.x + 3.0 * p1.x - 3.0 * p2.x + p3.x ) * t3 )
catmull_point.y = 0.5 * ( ( 2.0 * p1.y ) +_
( -p0.y + p2.y ) * t +_
( 2.0 * p0.y - 5.0 * p1.y + 4 * p2.y - p3.y ) * t2 +_
( -p0.y + 3.0 * p1.y - 3.0 * p2.y + p3.y ) * t3 )

Return catmull_point

End Function

Function cosine_spline(Byval p0 As TPoint, Byval p1 As TPoint, Byval t As Single) As Tpoint

Dim As Tpoint cosine_point
Dim As Single ft,f
ft = t * 3.1415927
f = (1 - Cos(ft)) * 0.5

cosine_point.x =  p0.x *(1-f) + p1.x *f
cosine_point.y =  p0.y *(1-f) + p1.y *f

Return cosine_point

End Function

Function bezier(Byval p0 As TPoint, Byval p1 As TPoint, Byval p2 As TPoint, Byval p3 As TPoint, Byval t As Single) As Tpoint

Dim As Tpoint bez
Dim As Single b

'A = p1
'B = p0
'C = p3
'D = p2

b = 1 - t

bez.x = p1.x*b^3 + 3*p0.x*(b^2)*t + 3*p3.x*(b)*(t^2) + p2.x*(t^3)
bez.y = p1.y*b^3 + 3*p0.y*(b^2)*t + 3*p3.y*(b)*(t^2) + p2.y*(t^3)

Return bez

End Function

sub phaser(x as integer, y as integer)
line (1, 1)-(int(x), int(y)), 4
line (2, 1)-(int(x), int(y) - 1), 14
line (1, 2)-(int(x) - 1, int(y)), 14
sleep 10
line (1, 1)-(int(x), int(y)), 14
line (2, 1)-(int(x), int(y) - 1), 4
line (1, 2)-(int(x) - 1, int(y)), 4
sleep 10
end sub

sub brush(x as integer, y as integer, c as integer)
pset (x, y), c
pset (x+1, y), c
pset (x-1, y), c
pset (x, y+1), c
pset (x, y-1), c
end sub

sub cut(x as double, y as double, x2 as integer, y2 as integer, c as integer)
dim i as integer
dim d as integer
dim a as double
dim dx as integer, dy as integer
dim fx as double, fy as double
dim sprite(256, 256) as integer

dx = x2 - x
dy = y2 - y
d = sqr(dx^2 + dy^2)
fx = dx / d
fy = dy / d

for i = 1 to d
x = x + fx
y = y + fy
get (0,0)-(x, y), sprite
phaser(x, y)
sleep 10
put (0, 0), sprite, pset
brush(x, y, c)
next i
end sub

Cls
Screen 18,,2

Randomize Timer

Const As Integer MAXPOINTS = 4

Dim i As Integer
Dim points(0 To (MAXPOINTS-1)) As Tpoint
Dim p As Tpoint
dim oldp as Tpoint
Dim p0 As Tpoint
Dim p1 As Tpoint
Dim p2 As Tpoint
Dim p3 As Tpoint

For i = 0 To MAXPOINTS-1
Next i

Dim current_color As Integer

current_color = 2
Dim index As Integer
index = 1
Do

For i = 0 To MAXPOINTS - 1
Circle (points(i).x,points(i).y), 5, 5
Next i

If index = 0 Then
p0.x = points(index - 1).x
p0.y = points(index - 1).y
p1.x = points(index).x
p1.y = points(index).y
p2.x = points(index + 1).x
p2.y = points(index + 1).y
p3.x = points(index + 2).x
p3.y = points(index + 2).y
Else
p0.x = points(index).x
p0.y = points(index).y
p1.x = points((index + 1) Mod MAXPOINTS).x
p1.y = points((index + 1) Mod MAXPOINTS).y
p2.x = points((index + 2) Mod MAXPOINTS).x
p2.y = points((index + 2) Mod MAXPOINTS).y
p3.x = points((index + 3) Mod MAXPOINTS).x
p3.y = points((index + 3) Mod MAXPOINTS).y
End If

For i = 0 To 99

Dim As Single t
t = i/100
oldp = p
p = catmull_rom(p0,p1,p2,p3,t)
If i = 0 Then
cut (p.x, p.y, p.x, p.y, current_color)
Else
cut (oldp.x, oldp.y, p.x, p.y, current_color)
End If

Sleep 1

Next i

index += 1
If index = MAXPOINTS Then
index = 1
current_color =  1 + (current_color + 1) And 15
End If

Loop Until inkey<>""

data 100, 100
data 100, 150
data 112, 125
data 125, 150
Pritchard
Posts: 5485
Joined: Sep 12, 2005 20:06
Location: Ohio, USA
Oooh boy, this is amazing :D I never actually compiled this code ._. Glad I took a look at it.
relsoft
Posts: 1767
Joined: May 27, 2005 10:34
Location: Philippines
Contact:
Skyler: Please use a newer FB build. (What are you using 15b?)

Code: Select all

Declare Sub phaser(x As single, y As single)
Declare Sub brush(x As single, y As single, c As Integer)
Declare Sub cut(x As single, y As single, x2 As single, y2 As single, c As Integer)

Type Tpoint
x           As Single
y           As Single
End Type

Function catmull_rom(Byval p0 As TPoint, Byval p1 As TPoint, Byval p2 As TPoint, Byval p3 As TPoint, Byval t As Single) As Tpoint

Dim As Single  t2 = t * t
Dim As Single  t3 = t2 * t
Dim As Tpoint catmull_point
catmull_point.x = 0.5f * ( ( 2.0 * p1.x ) +_
( -p0.x + p2.x ) * t +_
( 2.0 * p0.x - 5.0 * p1.x + 4 * p2.x - p3.x ) * t2 +_
( -p0.x + 3.0 * p1.x - 3.0 * p2.x + p3.x ) * t3 )
catmull_point.y = 0.5 * ( ( 2.0 * p1.y ) +_
( -p0.y + p2.y ) * t +_
( 2.0 * p0.y - 5.0 * p1.y + 4 * p2.y - p3.y ) * t2 +_
( -p0.y + 3.0 * p1.y - 3.0 * p2.y + p3.y ) * t3 )

Return catmull_point

End Function

Function cosine_spline(Byval p0 As TPoint, Byval p1 As TPoint, Byval t As Single) As Tpoint

Dim As Tpoint cosine_point
Dim As Single ft,f
ft = t * 3.1415927
f = (1 - Cos(ft)) * 0.5

cosine_point.x =  p0.x *(1-f) + p1.x *f
cosine_point.y =  p0.y *(1-f) + p1.y *f

Return cosine_point

End Function

Function bezier(Byval p0 As TPoint, Byval p1 As TPoint, Byval p2 As TPoint, Byval p3 As TPoint, Byval t As Single) As Tpoint

Dim As Tpoint bez
Dim As Single b

'A = p1
'B = p0
'C = p3
'D = p2

b = 1 - t

bez.x = p1.x*b^3 + 3*p0.x*(b^2)*t + 3*p3.x*(b)*(t^2) + p2.x*(t^3)
bez.y = p1.y*b^3 + 3*p0.y*(b^2)*t + 3*p3.y*(b)*(t^2) + p2.y*(t^3)

Return bez

End Function

Sub phaser(x As single, y As single)
Line (1, 1)-(Int(x), Int(y)), 4
Line (2, 1)-(Int(x), Int(y) - 1), 14
Line (1, 2)-(Int(x) - 1, Int(y)), 14
Sleep 10
Line (1, 1)-(Int(x), Int(y)), 14
Line (2, 1)-(Int(x), Int(y) - 1), 4
Line (1, 2)-(Int(x) - 1, Int(y)), 4
Sleep 10
End Sub

Sub brush(x As single, y As single, c As Integer)
Pset (x, y), c
Pset (x+1, y), c
Pset (x-1, y), c
Pset (x, y+1), c
Pset (x, y-1), c
End Sub

Sub cut(x As single, y As single, x2 As single, y2 As single, c As Integer)
Dim i As Integer
Dim d As Integer
Dim a As Double
Dim dx As Integer, dy As Integer
Dim fx As Double, fy As Double
Dim sprite(256, 256) As Integer

dx = x2 - x
dy = y2 - y
d = Sqr(dx^2 + dy^2)
fx = dx / d
fy = dy / d

For i = 1 To d
x = x + fx
y = y + fy
Get (0,0)-(x, y), sprite
phaser(x, y)
Sleep 10
Put (0, 0), sprite, Pset
brush(x, y, c)
Next i
End Sub

Cls
Screen 18,,2

Randomize Timer

Const As Integer MAXPOINTS = 4

Dim i As Integer
Dim points(0 To (MAXPOINTS-1)) As Tpoint
Dim p As Tpoint
Dim oldp As Tpoint
Dim p0 As Tpoint
Dim p1 As Tpoint
Dim p2 As Tpoint
Dim p3 As Tpoint

For i = 0 To MAXPOINTS-1
Next i

Dim current_color As Integer

current_color = 2
Dim index As Integer
index = 1
Do

For i = 0 To MAXPOINTS - 1
Circle (points(i).x,points(i).y), 5, 5
Next i

If index = 0 Then
p0.x = points(index - 1).x
p0.y = points(index - 1).y
p1.x = points(index).x
p1.y = points(index).y
p2.x = points(index + 1).x
p2.y = points(index + 1).y
p3.x = points(index + 2).x
p3.y = points(index + 2).y
Else
p0.x = points(index).x
p0.y = points(index).y
p1.x = points((index + 1) Mod MAXPOINTS).x
p1.y = points((index + 1) Mod MAXPOINTS).y
p2.x = points((index + 2) Mod MAXPOINTS).x
p2.y = points((index + 2) Mod MAXPOINTS).y
p3.x = points((index + 3) Mod MAXPOINTS).x
p3.y = points((index + 3) Mod MAXPOINTS).y
End If

For i = 0 To 99

Dim As Single t
t = i/100
oldp = p
p = catmull_rom(p0,p1,p2,p3,t)
If i = 0 Then
cut (p.x, p.y, p.x, p.y, current_color)
Else
cut (oldp.x, oldp.y, p.x, p.y, current_color)
End If

Sleep 1

Next i

index += 1
If index = MAXPOINTS Then
index = 1
current_color =  1 + (current_color + 1) And 15
End If

Loop Until inkey<>""

Data 100, 100
Data 200, 150
Data 312, 225
Data 25, 320
Skyler
Posts: 242
Joined: Sep 26, 2006 16:30
I've got 17b, I think.

EDIT: Just checked. Most definitely 17b.

EDIT2: Your code is connecting the dots in this order:
3, 4, 1, 2.
relsoft
Posts: 1767
Joined: May 27, 2005 10:34
Location: Philippines
Contact:
Skyler wrote:I've got 17b, I think.

EDIT: Just checked. Most definitely 17b.

EDIT2: Your code is connecting the dots in this order:
3, 4, 1, 2.

Starts from 2. 1st cpoint is needed for control and it would be used as last controlpointsegment.

Must I do everything for you?

Code: Select all

Declare Sub phaser(x As Single, y As Single)
Declare Sub brush(x As Single, y As Single, c As Integer)
Declare Sub cut(x As Single, y As Single, x2 As Single, y2 As Single, c As Integer)

Type Tpoint
x           As Single
y           As Single
End Type

Function catmull_rom(Byval p0 As TPoint, Byval p1 As TPoint, Byval p2 As TPoint, Byval p3 As TPoint, Byval t As Single) As Tpoint

Dim As Single  t2 = t * t
Dim As Single  t3 = t2 * t
Dim As Tpoint catmull_point
catmull_point.x = 0.5f * ( ( 2.0 * p1.x ) +_
( -p0.x + p2.x ) * t +_
( 2.0 * p0.x - 5.0 * p1.x + 4 * p2.x - p3.x ) * t2 +_
( -p0.x + 3.0 * p1.x - 3.0 * p2.x + p3.x ) * t3 )
catmull_point.y = 0.5 * ( ( 2.0 * p1.y ) +_
( -p0.y + p2.y ) * t +_
( 2.0 * p0.y - 5.0 * p1.y + 4 * p2.y - p3.y ) * t2 +_
( -p0.y + 3.0 * p1.y - 3.0 * p2.y + p3.y ) * t3 )

Return catmull_point

End Function

Function cosine_spline(Byval p0 As TPoint, Byval p1 As TPoint, Byval t As Single) As Tpoint

Dim As Tpoint cosine_point
Dim As Single ft,f
ft = t * 3.1415927
f = (1 - Cos(ft)) * 0.5

cosine_point.x =  p0.x *(1-f) + p1.x *f
cosine_point.y =  p0.y *(1-f) + p1.y *f

Return cosine_point

End Function

Function bezier(Byval p0 As TPoint, Byval p1 As TPoint, Byval p2 As TPoint, Byval p3 As TPoint, Byval t As Single) As Tpoint

Dim As Tpoint bez
Dim As Single b

'A = p1
'B = p0
'C = p3
'D = p2

b = 1 - t

bez.x = p1.x*b^3 + 3*p0.x*(b^2)*t + 3*p3.x*(b)*(t^2) + p2.x*(t^3)
bez.y = p1.y*b^3 + 3*p0.y*(b^2)*t + 3*p3.y*(b)*(t^2) + p2.y*(t^3)

Return bez

End Function

Sub phaser(x As Single, y As Single)
Line (1, 1)-(Int(x), Int(y)), 4
Line (2, 1)-(Int(x), Int(y) - 1), 14
Line (1, 2)-(Int(x) - 1, Int(y)), 14
Sleep 10
Line (1, 1)-(Int(x), Int(y)), 14
Line (2, 1)-(Int(x), Int(y) - 1), 4
Line (1, 2)-(Int(x) - 1, Int(y)), 4
Sleep 10
End Sub

Sub brush(x As Single, y As Single, c As Integer)
Pset (x, y), c
Pset (x+1, y), c
Pset (x-1, y), c
Pset (x, y+1), c
Pset (x, y-1), c
End Sub

Sub cut(x As Single, y As Single, x2 As Single, y2 As Single, c As Integer)
Dim i As Integer
Dim d As Integer
Dim a As Double
Dim dx As Integer, dy As Integer
Dim fx As Double, fy As Double
Dim sprite(256, 256) As Integer

dx = x2 - x
dy = y2 - y
d = Sqr(dx^2 + dy^2)
fx = dx / d
fy = dy / d

For i = 1 To d
x = x + fx
y = y + fy
Get (0,0)-(x, y), sprite
phaser(x, y)
Sleep 10
Put (0, 0), sprite, Pset
brush(x, y, c)
Next i
End Sub

Cls
Screen 18,,2

Randomize Timer

Const As Integer MAXPOINTS = 4

Dim i As Integer
Dim points(0 To (MAXPOINTS-1)) As Tpoint
Dim p As Tpoint
Dim oldp As Tpoint
Dim p0 As Tpoint
Dim p1 As Tpoint
Dim p2 As Tpoint
Dim p3 As Tpoint

For i = 0 To MAXPOINTS-1
Next i

Dim current_color As Integer

current_color = 2
Dim index As Integer
index = 0
Do

For i = 0 To MAXPOINTS - 1
Circle (points(i).x,points(i).y), 5, 5
Next i

p0.x = points(index).x
p0.y = points(index).y
p1.x = points((index + 1) Mod MAXPOINTS).x
p1.y = points((index + 1) Mod MAXPOINTS).y
p2.x = points((index + 2) Mod MAXPOINTS).x
p2.y = points((index + 2) Mod MAXPOINTS).y
p3.x = points((index + 3) Mod MAXPOINTS).x
p3.y = points((index + 3) Mod MAXPOINTS).y

For i = 0 To 99

Dim As Single t
t = i/100
oldp = p
p = catmull_rom(p0,p1,p2,p3,t)
If i = 0 Then
cut (p.x, p.y, p.x, p.y, current_color)
Else
cut (oldp.x, oldp.y, p.x, p.y, current_color)
End If

Sleep 1

Next i

index += 1
If index = MAXPOINTS Then
index = 0
current_color =  1 + (current_color + 1) And 15
End If

Loop Until inkey<>""

Data 100, 100
Data 200, 150
Data 312, 225
Data 25, 320
Skyler
Posts: 242
Joined: Sep 26, 2006 16:30
Relsoft, please. I'm just trying to understand your code, not insult your programming skills. And my code was intended to produce a lowercase h, not something else. I'm trying to write letters in cursive.

### Who is online

Users browsing this forum: No registered users and 2 guests