Code : Tout sélectionner
; This source file is part of OGRE
; (Object-oriented Graphics Rendering Engine)
; For the latest info, see http://www.ogre3d.org/
;
; Copyright (c) 2000-2009 Torus Knot Software Ltd
InitSprite()
InitKeyboard()
InitMouse()
ExamineDesktops()
Scx = DesktopWidth(0)
Scy = DesktopHeight(0)
OpenScreen(Scx, Scy, DesktopDepth(0), "spline")
Structure Vector3
x.f
y.f
z.f
EndStructure
Macro CopyVector3(a, b)
a\x = b\x
a\y = b\y
a\z = b\z
EndMacro
Global Dim mCoeffs.f(3,3)
Global mAutoCalc = #True
Global NewList lPoints.Vector3()
Global Dim mPoints.Vector3(0)
Global Dim mTangents.Vector3(0)
Declare recalcTangents()
Declare interpolate2(*pos.Vector3, fromIndex, t.f)
; Set up matrix
; Hermite polynomial
mCoeffs(0,0) = 2
mCoeffs(0,1) = -2
mCoeffs(0,2) = 1
mCoeffs(0,3) = 1
mCoeffs(1,0) = -3
mCoeffs(1,1) = 3
mCoeffs(1,2) = -2
mCoeffs(1,3) = -1
mCoeffs(2,0) = 0
mCoeffs(2,1) = 0
mCoeffs(2,2) = 1
mCoeffs(2,3) = 0
mCoeffs(3,0) = 1
mCoeffs(3,1) = 0
mCoeffs(3,2) = 0
mCoeffs(3,3) = 0
Procedure concatenate(Array r.f(2), Array m.f(2), Array m2.f(2))
r(0,0) = m(0,0) * m2(0,0) + m(0,1) * m2(1,0) + m(0,2) * m2(2,0) + m(0,3) * m2(3,0);
r(0,1) = m(0,0) * m2(0,1) + m(0,1) * m2(1,1) + m(0,2) * m2(2,1) + m(0,3) * m2(3,1);
r(0,2) = m(0,0) * m2(0,2) + m(0,1) * m2(1,2) + m(0,2) * m2(2,2) + m(0,3) * m2(3,2);
r(0,3) = m(0,0) * m2(0,3) + m(0,1) * m2(1,3) + m(0,2) * m2(2,3) + m(0,3) * m2(3,3);
r(1,0) = m(1,0) * m2(0,0) + m(1,1) * m2(1,0) + m(1,2) * m2(2,0) + m(1,3) * m2(3,0);
r(1,1) = m(1,0) * m2(0,1) + m(1,1) * m2(1,1) + m(1,2) * m2(2,1) + m(1,3) * m2(3,1);
r(1,2) = m(1,0) * m2(0,2) + m(1,1) * m2(1,2) + m(1,2) * m2(2,2) + m(1,3) * m2(3,2);
r(1,3) = m(1,0) * m2(0,3) + m(1,1) * m2(1,3) + m(1,2) * m2(2,3) + m(1,3) * m2(3,3);
r(2,0) = m(2,0) * m2(0,0) + m(2,1) * m2(1,0) + m(2,2) * m2(2,0) + m(2,3) * m2(3,0);
r(2,1) = m(2,0) * m2(0,1) + m(2,1) * m2(1,1) + m(2,2) * m2(2,1) + m(2,3) * m2(3,1);
r(2,2) = m(2,0) * m2(0,2) + m(2,1) * m2(1,2) + m(2,2) * m2(2,2) + m(2,3) * m2(3,2);
r(2,3) = m(2,0) * m2(0,3) + m(2,1) * m2(1,3) + m(2,2) * m2(2,3) + m(2,3) * m2(3,3);
r(3,0) = m(3,0) * m2(0,0) + m(3,1) * m2(1,0) + m(3,2) * m2(2,0) + m(3,3) * m2(3,0);
r(3,1) = m(3,0) * m2(0,1) + m(3,1) * m2(1,1) + m(3,2) * m2(2,1) + m(3,3) * m2(3,1);
r(3,2) = m(3,0) * m2(0,2) + m(3,1) * m2(1,2) + m(3,2) * m2(2,2) + m(3,3) * m2(3,2);
r(3,3) = m(3,0) * m2(0,3) + m(3,1) * m2(1,3) + m(3,2) * m2(2,3) + m(3,3) * m2(3,3);
EndProcedure
Procedure Multiplication(Array r.f(1), Array v.f(1), Array m.f(2))
r(0) = m(0,0) * v(0) + m(1,0) * v(1) + m(2,0) * v(2) + m(3,0) * v(3)
r(1) = m(0,1) * v(0) + m(1,1) * v(1) + m(2,1) * v(2) + m(3,1) * v(3)
r(2) = m(0,2) * v(0) + m(1,2) * v(1) + m(2,2) * v(2) + m(3,2) * v(3)
r(3) = m(0,3) * v(0) + m(1,3) * v(1) + m(2,3) * v(2) + m(3,3) * v(3)
EndProcedure
Procedure addPoint(*p.Vector3)
AddElement(lPoints())
lPoints()\x = *p\x
lPoints()\y = *p\y
lPoints()\z = *p\z
Dim mPoints(ListSize(lPoints()))
i = 0
ForEach lPoints()
mPoints(i) = lPoints()
i + 1
Next
If (mAutoCalc)
recalcTangents()
EndIf
EndProcedure
Procedure interpolate(*pos.Vector3, t.f)
;Currently assumes points are evenly spaced, will cause velocity
;change where this is Not the Case
;TODO: base on arclength?
; Work out which segment this is in
fSeg.f = t * (ListSize(lPoints()) - 1)
segIdx = Int(fSeg)
; Apportion t
t = fSeg - segIdx
interpolate2(*pos, segIdx, t)
EndProcedure
Procedure interpolate2(*pos.Vector3, fromIndex, t.f)
;// Bounds check
;assert (fromIndex < mPoints.size() && "fromIndex out of bounds")
If ListSize(lPoints()) = 0 Or fromIndex >= ListSize(lPoints())
ProcedureReturn
EndIf
If (fromIndex + 1) = ListSize(lPoints())
;// Duff request, cannot blend To nothing
;// Just Return source
CopyVector3(*pos, mPoints(fromIndex))
ProcedureReturn
EndIf
;// Fast special cases
If t = 0.0
CopyVector3(*pos, mPoints(fromIndex))
ProcedureReturn
ElseIf t = 1.0
CopyVector3(*pos, mPoints(fromIndex + 1))
ProcedureReturn
EndIf
;// Real interpolation
;// Form a vector of powers of t
Define.f t2, t3
t2 = t * t
t3 = t2 * t
Dim powers.f(3)
powers(0) = t3
powers(1) = t2
powers(2) = t
powers(3) = 1
;// Algorithm is ret = powers * mCoeffs * Matrix4(point1, point2, tangent1, tangent2)
Define.Vector3 point1, point2, tan1, tan2
CopyVector3(point1, mPoints(fromIndex))
CopyVector3(point2, mPoints(fromIndex+1))
CopyVector3(tan1 , mTangents(fromIndex))
CopyVector3(tan2 , mTangents(fromIndex+1))
Dim pt.f(3,3)
pt(0,0) = point1\x
pt(0,1) = point1\y
pt(0,2) = point1\z
pt(0,3) = 1.0
pt(1,0) = point2\x
pt(1,1) = point2\y
pt(1,2) = point2\z
pt(1,3) = 1.0
pt(2,0) = tan1\x
pt(2,1) = tan1\y
pt(2,2) = tan1\z
pt(2,3) = 1.0
pt(3,0) = tan2\x
pt(3,1) = tan2\y
pt(3,2) = tan2\z
pt(3,3) = 1.0
Dim ret.f(3)
Dim r.f(3,3)
;ret = powers * mCoeffs * pt;
concatenate(r(), mCoeffs(), pt())
Multiplication(ret(), powers(), r())
*pos\x = ret(0)
*pos\y = ret(1)
*pos\z = ret(2)
;ProcedureReturn Vector3(ret.x, ret.y, ret.z);
EndProcedure
Procedure recalcTangents()
; // Catmull-Rom approach
; //
; // tangent[i] = 0.5 * (point[i+1] - point[i-1])
; //
; // Assume endpoint tangents are parallel With line With neighbour
Define.i i, numPoints, isClosed
numPoints = ListSize(lPoints())
If numPoints < 2
; Can't do anything yet
ProcedureReturn
EndIf
; Closed Or open?
If mPoints(0) = mPoints(numPoints-1)
isClosed = #True
Else
isClosed = #False
EndIf
Dim mTangents.Vector3(numPoints)
For i = 0 To numPoints-1
If i =0
; Special Case start
If isClosed
; Use numPoints-2 since numPoints-1 is the last point And == [0]
mTangents(i)\x = 0.5 * (mPoints(1)\x - mPoints(numPoints-2)\x)
mTangents(i)\y = 0.5 * (mPoints(1)\y - mPoints(numPoints-2)\y)
mTangents(i)\z = 0.5 * (mPoints(1)\z - mPoints(numPoints-2)\z)
Else
mTangents(i)\x = 0.5 * (mPoints(1)\x - mPoints(0)\x)
mTangents(i)\y = 0.5 * (mPoints(1)\y - mPoints(0)\y)
mTangents(i)\z = 0.5 * (mPoints(1)\z - mPoints(0)\z)
EndIf
ElseIf i = numPoints-1
; Special Case End
If isClosed
; Use same tangent As already calculated For [0]
mTangents(i)\x = mTangents(0)\x
mTangents(i)\y = mTangents(0)\y
mTangents(i)\z = mTangents(0)\z
Else
mTangents(i)\x = 0.5 * (mPoints(i)\x - mPoints(i-1)\x)
mTangents(i)\y = 0.5 * (mPoints(i)\y - mPoints(i-1)\y)
mTangents(i)\z = 0.5 * (mPoints(i)\z - mPoints(i-1)\z)
EndIf
Else
mTangents(i)\x = 0.5 * (mPoints(i+1)\x - mPoints(i-1)\x)
mTangents(i)\y = 0.5 * (mPoints(i+1)\y - mPoints(i-1)\y)
mTangents(i)\z = 0.5 * (mPoints(i+1)\z - mPoints(i-1)\z)
EndIf
Next
EndProcedure
;- Ajoute quelques points et ensuite on trace la spline
p.Vector3
pos.Vector3
xd.f = 0
yd.f = 0
pas.f = 1
time.f = 0
Repeat
ClearScreen(0)
ExamineMouse()
If MouseButton(1)
If flag = 0
Flag = 1
p\x = MouseX()
p\z = MouseY()
addPoint(@p)
If xd = 0 And yd = 0
xd = p\x
yd = p\z
EndIf
EndIf
Else
flag = 0
EndIf
StartDrawing(ScreenOutput())
For t=0 To 300
interpolate(@pos, t/300.0)
If t > 0
LineXY(xd, yd, pos\x, pos\z, $AABBCC)
EndIf
xd = pos\x
yd = pos\z
Next t
interpolate(@pos, time)
Circle(pos\x, pos\z, 10, $FFAAAA)
time + pas * 0.02 / ListSize(lPoints())
If time > 1
Time = 1
pas = - pas
ElseIf time < 0
Time = 0
pas = - pas
EndIf
For i=0 To ListSize(lPoints())-1
Circle(mPoints(i)\x, mPoints(i)\z, 2, $FF)
Next
LineXY(0, MouseY(), Scx, MouseY(), $AAAAAA)
LineXY(MouseX(), 0, MouseX(), Scy, $AAAAAA)
StopDrawing()
ExamineKeyboard()
FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)