Petr Schreiber
09-10-2010, 13:37
Mike posted a nice Catmull Rom demo (http://community.thinbasic.com/index.php?topic=3096.msg23312#msg23312) past year,
I arranged the code to be general purpose for any number of points, you can even instance multiple CR splines (this is not part of the demo) and dynamically delete them as well.
I post this demo to show one approach which serves me well in many projects and I thought it could be good to share:
create independent include file
describe the properties of the functionality using TYPE
describe the actions of the functionality using functions which take the type as first parameter
Define Create/Destroy procedures, which allow dynamic memory handling (instancing) of the functionality
In fact, this approach is some kind of OOP emulation.
I hope you will find it useful, maybe Mike can use it as base for implementation in his TBAI, who knows :)
Petr
For those having problem with download:
unit_CatmullRomSpline.inc
'
' Catmull Rom spline object
' Petr Schreiber 2010
'
Alias Long As gPointer ' Generic pointer
Alias gPointer As CRSpline
Type CatmullRomDescriptor
pData As gPointer
pointCount As Long
End Type
Type Point2D
x As Single
y As Single
End Type
' -- Creates new instance of CatmullRom
Function CatmullRom_Create() As gPointer
Dim pDescriptor As Long = HEAP_Alloc(SizeOf(CatmullRomDescriptor))
Dim Descriptor As CatmullRomDescriptor At pDescriptor
Descriptor.pData = 0 ' -- It does not point to any data yet
Descriptor.pointCount = 0 ' -- No points are in
Return pDescriptor
End Function
' -- Frees the data
Function CatmullRom_Erase(ByRef pDescriptor As gPointer)
Dim Descriptor As CatmullRomDescriptor At pDescriptor
HEAP_Free(Descriptor.pData)
Descriptor.pData = 0
Descriptor.pointCount = 0 ' -- No points are in
End Function
' -- Frees complete memory occupied by CatmullRom
Function CatmullRom_Destroy(ByRef pDescriptor As gPointer)
Dim Descriptor As CatmullRomDescriptor At pDescriptor
HEAP_Free(Descriptor.pData) ' -- Erase data
HEAP_Free(pDescriptor) ' -- Now we free the descriptor and set it to zero
pDescriptor = 0
End Function
' -- Adds new point to the spline
Function CatmullRom_AddPoint(ByRef pDescriptor As gPointer, x As Single, y As Single)
Dim Descriptor As CatmullRomDescriptor At pDescriptor
Dim oldSize As Long
If Descriptor.pData = 0 Then
Descriptor.pData = HEAP_Alloc(SizeOf(Point2D))
Else
oldSize = HEAP_Size(Descriptor.pData)
Descriptor.pData = HEAP_Realloc(Descriptor.pData, oldSize + SizeOf(Point2D))
End If
Descriptor.pointCount += 1
Dim LastPointPointer As Long = CatmullRom_GetPointAddress(pDescriptor, Descriptor.pointCount)
Dim p As Point2D At LastPointPointer
p.x = x
p.y = y
End Function
' -- Removes last point from the spline
Function CatmullRom_RemoveLastPoint(ByRef pDescriptor As gPointer)
Dim Descriptor As CatmullRomDescriptor At pDescriptor
Dim oldSize As Long
If Descriptor.pointCount < 1 Then Exit Function
oldSize = HEAP_Size(Descriptor.pData)
Descriptor.pData = HEAP_Realloc(Descriptor.pData, oldSize - SizeOf(Point2D))
Descriptor.pointCount -= 1
End Function
Function CatmullRom_GetPointAddress(ByRef pDescriptor As gPointer, index As Long) As gPointer
Dim Descriptor As CatmullRomDescriptor At pDescriptor
Return Descriptor.pData + (index-1) * SizeOf(Point2D)
End Function
' -- Interpolation routine
Function CatmullRom_GetPointOnSpline(ByRef pDescriptor As gPointer, pn As Point2D, t As Single, p0index As Long, p1index As Long, p2index As Long, p3index As Long)
Dim Descriptor As CatmullRomDescriptor At pDescriptor
Dim p0 As point2D At CatmullRom_GetPointAddress(pDescriptor, p0index)
Dim p1 As point2D At CatmullRom_GetPointAddress(pDescriptor, p1index)
Dim p2 As point2D At CatmullRom_GetPointAddress(pDescriptor, p2index)
Dim p3 As point2D At CatmullRom_GetPointAddress(pDescriptor, p3index)
Dim t2, t3 As Single
t2 = t * t
t3 = t2 * t
pn.x = 0.5 * ( ( 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 )
pn.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 )
End Function
' -- Draws the spline
Function CatmullRom_Render(ByRef pDescriptor As gPointer, pointStep As Long)
Dim Descriptor As CatmullRomDescriptor At pDescriptor
Dim i, j As Long
Dim dt As Single
Dim dp As Point2D
Dim points(Descriptor.pointCount) As Point2D At Descriptor.pData
If (Descriptor.pointCount > 3) Then
' -- Draw the curve
TBGL_Color 255,255,255
TBGL_BeginPoly %GL_POINTS
For i = 1 To pointStep
dt = i/pointStep
CatmullRom_GetPointOnSpline(pDescriptor, dp, dt, 1, 1, 2, 3)
TBGL_Vertex(dp.x, dp.y)
j = 0
While j+3 <> Descriptor.pointCount
j+= 1
CatmullRom_GetPointOnSpline(pDescriptor, dp, dt, j, j+1, j+2, j+3)
TBGL_Vertex(dp.x, dp.y)
Wend
CatmullRom_GetPointOnSpline(pDescriptor, dp, dt, Descriptor.pointCount-2, Descriptor.pointCount-1, Descriptor.pointCount, Descriptor.pointCount)
TBGL_Vertex(dp.x, dp.y)
Next
TBGL_EndPoly
End If
If (Descriptor.pointCount > 0) Then
' -- Draw some red points for the six points of the curve
TBGL_Color 255,0,0
For i = 1 To UBound(points)
TBGL_NGon(points(i).x, points(i).y, 5,16)
Next
TBGL_Color 255,255,255
End If
End Function
CatmullRomDemo.tBasic
'
' The most basic skeleton for TBGL
' Suitable for developing editor apps
' , started on 10-09-2010
'
Uses "UI", "TBGL"
#INCLUDE "unit_CatmullRomSpline.inc"
' -- ID numbers of controls
Begin Const
%lCanvas = %WM_USER + 1
%lHelp
%bClose
%bErase
%lCurve = 1
End Const
Dim spline As CRSpline = CatmullRom_Create()
Function TBMain()
Local hDlg As DWord
Dialog New 0, "Catmull Rom Demo",-1,-1, 320, 320, _
%WS_POPUP Or %WS_VISIBLE Or _
%WS_CLIPCHILDREN Or %WS_CAPTION Or _
%WS_SYSMENU Or %WS_MINIMIZEBOX, 0 To hDlg
' -- Place controls here
Control Add Label, hDlg, %lCanvas, "", 5, 5, 310, 280
Control Set Color hDlg, %lCanvas, %BLACK, %BLACK
Control Add Label, hDlg, %lHelp, "Left click to add, right click to remove last point", 70, 300, 180, 14, %ss_center or %SS_CENTERIMAGE Or %WS_BORDER
Control Add Button, hDlg, %bErase, "Erase", 5, 300, 60, 14
Control Add Button, hDlg, %bClose, "Close", 255, 300, 60, 14
Dialog Show Modal hDlg, Call dlgCallback
End Function
CallBack Function dlgCallback()
Static hCtrl As DWord
Select Case CBMSG
Case %WM_INITDIALOG
Control Handle CBHNDL, %lCanvas To hCtrl
' -- Init OpenGL
TBGL_BindCanvas(hCtrl)
TBGL_BackColor 32, 64, 128
Case %WM_PAINT
RenderMyImage(hCtrl)
Case %WM_LBUTTONDOWN
CatmullRom_AddPoint(spline, TBGL_MouseGetPosX, TBGL_MouseGetPosY)
TBGL_DeleteList %lCurve
TBGL_NewList %lCurve
CatmullRom_Render(spline, 25)
TBGL_EndList
RenderMyImage(hCtrl)
Case %WM_RBUTTONDOWN
CatmullRom_RemoveLastPoint(spline)
TBGL_DeleteList %lCurve
TBGL_NewList %lCurve
CatmullRom_Render(spline, 25)
TBGL_EndList
RenderMyImage(hCtrl)
Case %WM_CLOSE
CatmullRom_Destroy(spline)
TBGL_ReleaseCanvas(hCtrl)
Case %WM_COMMAND
Select Case CBCTL
Case %bErase
If CBCTLMSG = %BN_CLICKED Then
CatmullRom_Erase(spline)
TBGL_DeleteList %lCurve
RenderMyImage(hCtrl)
End If
Case %bClose
If CBCTLMSG = %BN_CLICKED Then
Dialog End CBHNDL
End If
End Select
End Select
End Function
Function RenderMyImage( hCtrl As DWord )
Static FrameRate As Double
Static width, height As Long
If TBGL_CanvasBound(hCtrl) Then
TBGL_GetWindowClient(hCtrl, width, height)
FrameRate = TBGL_GetFrameRate
TBGL_ClearFrame
TBGL_RenderMatrix2D (0,height,width,0)
' -- Draw grid for fun
RenderGrid(width, height, 50)
' -- Draw the line
TBGL_CallList %lCurve
TBGL_DrawFrame
End If
End Function
Function RenderGrid( fillX As Long, fillY As Long, fillStep As Long)
Dim x, y As Long
TBGL_PushStateProtect %TBGL_DEPTHMASK
TBGL_Color 128, 128, 128
TBGL_BeginPoly %GL_LINES
For x = 0 To fillX Step fillStep
TBGL_Vertex x, 0
TBGL_Vertex x, fillY
Next
For y = 0 To fillY Step fillStep
TBGL_Vertex 0, y
TBGL_Vertex fillX, y
Next
TBGL_EndPoly
TBGL_Color 255, 255, 255
TBGL_PopStateProtect
End Function
EDIT: Image did not uploaded, probably because of recent forum DB problem
I arranged the code to be general purpose for any number of points, you can even instance multiple CR splines (this is not part of the demo) and dynamically delete them as well.
I post this demo to show one approach which serves me well in many projects and I thought it could be good to share:
create independent include file
describe the properties of the functionality using TYPE
describe the actions of the functionality using functions which take the type as first parameter
Define Create/Destroy procedures, which allow dynamic memory handling (instancing) of the functionality
In fact, this approach is some kind of OOP emulation.
I hope you will find it useful, maybe Mike can use it as base for implementation in his TBAI, who knows :)
Petr
For those having problem with download:
unit_CatmullRomSpline.inc
'
' Catmull Rom spline object
' Petr Schreiber 2010
'
Alias Long As gPointer ' Generic pointer
Alias gPointer As CRSpline
Type CatmullRomDescriptor
pData As gPointer
pointCount As Long
End Type
Type Point2D
x As Single
y As Single
End Type
' -- Creates new instance of CatmullRom
Function CatmullRom_Create() As gPointer
Dim pDescriptor As Long = HEAP_Alloc(SizeOf(CatmullRomDescriptor))
Dim Descriptor As CatmullRomDescriptor At pDescriptor
Descriptor.pData = 0 ' -- It does not point to any data yet
Descriptor.pointCount = 0 ' -- No points are in
Return pDescriptor
End Function
' -- Frees the data
Function CatmullRom_Erase(ByRef pDescriptor As gPointer)
Dim Descriptor As CatmullRomDescriptor At pDescriptor
HEAP_Free(Descriptor.pData)
Descriptor.pData = 0
Descriptor.pointCount = 0 ' -- No points are in
End Function
' -- Frees complete memory occupied by CatmullRom
Function CatmullRom_Destroy(ByRef pDescriptor As gPointer)
Dim Descriptor As CatmullRomDescriptor At pDescriptor
HEAP_Free(Descriptor.pData) ' -- Erase data
HEAP_Free(pDescriptor) ' -- Now we free the descriptor and set it to zero
pDescriptor = 0
End Function
' -- Adds new point to the spline
Function CatmullRom_AddPoint(ByRef pDescriptor As gPointer, x As Single, y As Single)
Dim Descriptor As CatmullRomDescriptor At pDescriptor
Dim oldSize As Long
If Descriptor.pData = 0 Then
Descriptor.pData = HEAP_Alloc(SizeOf(Point2D))
Else
oldSize = HEAP_Size(Descriptor.pData)
Descriptor.pData = HEAP_Realloc(Descriptor.pData, oldSize + SizeOf(Point2D))
End If
Descriptor.pointCount += 1
Dim LastPointPointer As Long = CatmullRom_GetPointAddress(pDescriptor, Descriptor.pointCount)
Dim p As Point2D At LastPointPointer
p.x = x
p.y = y
End Function
' -- Removes last point from the spline
Function CatmullRom_RemoveLastPoint(ByRef pDescriptor As gPointer)
Dim Descriptor As CatmullRomDescriptor At pDescriptor
Dim oldSize As Long
If Descriptor.pointCount < 1 Then Exit Function
oldSize = HEAP_Size(Descriptor.pData)
Descriptor.pData = HEAP_Realloc(Descriptor.pData, oldSize - SizeOf(Point2D))
Descriptor.pointCount -= 1
End Function
Function CatmullRom_GetPointAddress(ByRef pDescriptor As gPointer, index As Long) As gPointer
Dim Descriptor As CatmullRomDescriptor At pDescriptor
Return Descriptor.pData + (index-1) * SizeOf(Point2D)
End Function
' -- Interpolation routine
Function CatmullRom_GetPointOnSpline(ByRef pDescriptor As gPointer, pn As Point2D, t As Single, p0index As Long, p1index As Long, p2index As Long, p3index As Long)
Dim Descriptor As CatmullRomDescriptor At pDescriptor
Dim p0 As point2D At CatmullRom_GetPointAddress(pDescriptor, p0index)
Dim p1 As point2D At CatmullRom_GetPointAddress(pDescriptor, p1index)
Dim p2 As point2D At CatmullRom_GetPointAddress(pDescriptor, p2index)
Dim p3 As point2D At CatmullRom_GetPointAddress(pDescriptor, p3index)
Dim t2, t3 As Single
t2 = t * t
t3 = t2 * t
pn.x = 0.5 * ( ( 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 )
pn.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 )
End Function
' -- Draws the spline
Function CatmullRom_Render(ByRef pDescriptor As gPointer, pointStep As Long)
Dim Descriptor As CatmullRomDescriptor At pDescriptor
Dim i, j As Long
Dim dt As Single
Dim dp As Point2D
Dim points(Descriptor.pointCount) As Point2D At Descriptor.pData
If (Descriptor.pointCount > 3) Then
' -- Draw the curve
TBGL_Color 255,255,255
TBGL_BeginPoly %GL_POINTS
For i = 1 To pointStep
dt = i/pointStep
CatmullRom_GetPointOnSpline(pDescriptor, dp, dt, 1, 1, 2, 3)
TBGL_Vertex(dp.x, dp.y)
j = 0
While j+3 <> Descriptor.pointCount
j+= 1
CatmullRom_GetPointOnSpline(pDescriptor, dp, dt, j, j+1, j+2, j+3)
TBGL_Vertex(dp.x, dp.y)
Wend
CatmullRom_GetPointOnSpline(pDescriptor, dp, dt, Descriptor.pointCount-2, Descriptor.pointCount-1, Descriptor.pointCount, Descriptor.pointCount)
TBGL_Vertex(dp.x, dp.y)
Next
TBGL_EndPoly
End If
If (Descriptor.pointCount > 0) Then
' -- Draw some red points for the six points of the curve
TBGL_Color 255,0,0
For i = 1 To UBound(points)
TBGL_NGon(points(i).x, points(i).y, 5,16)
Next
TBGL_Color 255,255,255
End If
End Function
CatmullRomDemo.tBasic
'
' The most basic skeleton for TBGL
' Suitable for developing editor apps
' , started on 10-09-2010
'
Uses "UI", "TBGL"
#INCLUDE "unit_CatmullRomSpline.inc"
' -- ID numbers of controls
Begin Const
%lCanvas = %WM_USER + 1
%lHelp
%bClose
%bErase
%lCurve = 1
End Const
Dim spline As CRSpline = CatmullRom_Create()
Function TBMain()
Local hDlg As DWord
Dialog New 0, "Catmull Rom Demo",-1,-1, 320, 320, _
%WS_POPUP Or %WS_VISIBLE Or _
%WS_CLIPCHILDREN Or %WS_CAPTION Or _
%WS_SYSMENU Or %WS_MINIMIZEBOX, 0 To hDlg
' -- Place controls here
Control Add Label, hDlg, %lCanvas, "", 5, 5, 310, 280
Control Set Color hDlg, %lCanvas, %BLACK, %BLACK
Control Add Label, hDlg, %lHelp, "Left click to add, right click to remove last point", 70, 300, 180, 14, %ss_center or %SS_CENTERIMAGE Or %WS_BORDER
Control Add Button, hDlg, %bErase, "Erase", 5, 300, 60, 14
Control Add Button, hDlg, %bClose, "Close", 255, 300, 60, 14
Dialog Show Modal hDlg, Call dlgCallback
End Function
CallBack Function dlgCallback()
Static hCtrl As DWord
Select Case CBMSG
Case %WM_INITDIALOG
Control Handle CBHNDL, %lCanvas To hCtrl
' -- Init OpenGL
TBGL_BindCanvas(hCtrl)
TBGL_BackColor 32, 64, 128
Case %WM_PAINT
RenderMyImage(hCtrl)
Case %WM_LBUTTONDOWN
CatmullRom_AddPoint(spline, TBGL_MouseGetPosX, TBGL_MouseGetPosY)
TBGL_DeleteList %lCurve
TBGL_NewList %lCurve
CatmullRom_Render(spline, 25)
TBGL_EndList
RenderMyImage(hCtrl)
Case %WM_RBUTTONDOWN
CatmullRom_RemoveLastPoint(spline)
TBGL_DeleteList %lCurve
TBGL_NewList %lCurve
CatmullRom_Render(spline, 25)
TBGL_EndList
RenderMyImage(hCtrl)
Case %WM_CLOSE
CatmullRom_Destroy(spline)
TBGL_ReleaseCanvas(hCtrl)
Case %WM_COMMAND
Select Case CBCTL
Case %bErase
If CBCTLMSG = %BN_CLICKED Then
CatmullRom_Erase(spline)
TBGL_DeleteList %lCurve
RenderMyImage(hCtrl)
End If
Case %bClose
If CBCTLMSG = %BN_CLICKED Then
Dialog End CBHNDL
End If
End Select
End Select
End Function
Function RenderMyImage( hCtrl As DWord )
Static FrameRate As Double
Static width, height As Long
If TBGL_CanvasBound(hCtrl) Then
TBGL_GetWindowClient(hCtrl, width, height)
FrameRate = TBGL_GetFrameRate
TBGL_ClearFrame
TBGL_RenderMatrix2D (0,height,width,0)
' -- Draw grid for fun
RenderGrid(width, height, 50)
' -- Draw the line
TBGL_CallList %lCurve
TBGL_DrawFrame
End If
End Function
Function RenderGrid( fillX As Long, fillY As Long, fillStep As Long)
Dim x, y As Long
TBGL_PushStateProtect %TBGL_DEPTHMASK
TBGL_Color 128, 128, 128
TBGL_BeginPoly %GL_LINES
For x = 0 To fillX Step fillStep
TBGL_Vertex x, 0
TBGL_Vertex x, fillY
Next
For y = 0 To fillY Step fillStep
TBGL_Vertex 0, y
TBGL_Vertex fillX, y
Next
TBGL_EndPoly
TBGL_Color 255, 255, 255
TBGL_PopStateProtect
End Function
EDIT: Image did not uploaded, probably because of recent forum DB problem