Catmull-Rom include file for 2D + TBGL demo app

**Petr Schreiber** · 09-10-2010, 13:37

Mike posted a nice Catmull Rom demo 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

**Lionheart008** · 13-10-2010, 18:29

salve petr, I cannot open clear the zip file (error message: the zip file is not valid or damaged). It's possible to show both files here at the board. I will check if I can copy and paste this one for testing. Thanks! may be this belongs to your new windows 7 os ?

thanks, frank

**Petr Schreiber** · 13-10-2010, 18:36

Hi Frank,

thanks for reporting the problem, strange there was 8 downloads before you and no one had a problem.
Could you try to download newly attached CatmullRomPACK.ZIP to see if it is better?

When I download the file, I have trouble opening it too. If I open the original in my TBGL directory, then no problem. Could it be some problem with forum software/browser?

Petr

**Lionheart008** · 13-10-2010, 18:57

two downloads are from my side, because I have thought to make it sure, it wasn't my problem

sorry, but same problem with new zip pack. I cannot add a picture here, because of the forum board problems. it's possible to show code for both examples here at forum?

I can open zip folder and see the catmullromdemo.tbasic and unit inc file, but cannot copy it or unzip it. frank

**Petr Schreiber** · 13-10-2010, 19:35

Thanks for your assistance, my apologies but I am really not sure why this problem is here.

I listed the code in the first post of this thread.

Petr

**Lionheart008** · 13-10-2010, 22:36

thanks petr, your CatmullRomDemo works fine here! Interesting Spline example!
(I've used your first post example).

perhaps you can check if my attachments works for you. zip and rar folder with same content of your example.

bye, frank

**zak** · 14-10-2010, 07:05

yes extracting zip file gives an error using winrar v3.71, also using Alzip gives an error but can repair the file and extract the contents which runs correctly.
i guess the reason the zip file made by a recent version of winzip, i have noticed many ziped files in many forums gives an errors when openning with winrar, so i am opening it with alzip.

**Petr Schreiber** · 14-10-2010, 08:54

I used 7zip and ZipGenius 6 to make the files.
The strange thing is that they cannot open the downloaded files as well, but the versions before upload without trouble.

Petr