[futurebasic] Re: [XFB] Recursive FN Questions

Message: < previous - next > : Reply : Subscribe : Cleanse
Home   : April 2003 : Group Archive : Group : All Groups

From: Ken Shmidheiser <kshmidheiser@...>
Date: Thu, 24 Apr 2003 06:39:56 -0400
Robert,

I thought I found a simple solution to your problem at (take a look
at the graphic there):


<http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=11488&lngWId=1>


I spent a little time converting the Planet Source VB code to FB^3,
but in the end came up short. I think it's because VB has the Pset
function which allows the programmer to set any screen pixel, and the
closest equivalent I could find is the Toolbox SetCPixel which
apparently plots points differently. At any rate, I ended up with
plotted lines instead of the bezier curve. I'm posting my code
because someone may see the error of my way and offer a suggestion to
get it working properly in FB^3.

Ken

/*
    Here is an absolute minimum Cubic Spline routine
    based on code by Jason Bullen found at:

<http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=11488&lngWId=1>


    It's a VB rewrite from a Java applet I found by by Anthony Alto 4/25/99

    Computes coefficients based on equations mathematically derived
    from the curve constraints, i.e.:

      Curves meet at knots (predefined points); these must be sorted by X
      First derivatives must be equal at knots
      Second derivatives must be equal at knots

*/

begin globals

_nPoints = 7

dim as single x(_nPoints), y(_nPoints)
dim as single p(_nPoints), u(_nPoints)

end globals


begin enum 1
_plotBtn
_drawBtn
end enum


local fn BuildWindow
dim as rect     r
dim as rgbcolor backRGB

backRGB.red   = 0
backRGB.green = 0
backRGB.blue  = 0

setrect( r, 0, 0, 350, 350 )
appearance Window -1, "", @r, _kDocumentWindowClass,
_kWindowStandardFloatingAttributes

setrect( r, 20, 310, 165, 330 )
button _plotBtn, 1, "Plot control points", @r,_push

setrect( r, 175, 310, 330, 330 )
button _drawBtn, 1, "Draw cubic spline", @r,_push

DEF SETWINDOWBACKGROUND( backRGB, _true )

window 1

end fn

/*

   FN SetPandU:

    Function to compute the parameters of our cubic spline.
    Based on equations derived from some basic facts...

    Each segment must be a cubic polynomial.
    Curve segments must have equal first and second derivatives
    at knots they share.
    General algorithm taken from a book which has long since been lost.

    The math that derived this stuff is pretty messy...
    expressions are isolated and put into arrays.

    We're essentially trying to find the values of the second derivative
    of each polynomial at each knot within the curve. That's why
    there's only N-2 p's (where N is # points). Later, we use
    the p's and u's to calculate curve points...

*/
local fn SetPandU
dim as integer i
dim as single  d(_nPoints), w(_nPoints)


for i = 2 to _nPoints - 1
d(i) = 2 * (x(i + 1) - x(i - 1))
next i

for i = 1 to _nPoints - 1
u(i) = x(i + 1) - x(i)
next i

for i = 2 to _nPoints - 1
w(i) = 6# * ((y(i + 1) - y(i)) / u(i) - (y(i) - y(i - 1)) / u(i - 1))
next i

for i = 2 to _nPoints - 2
w(i + 1) = w(i + 1) - w(i) * u(i) / d(i)
d(i + 1) = d(i + 1) - u(i) * u(i) / d(i)
next i

p(1) = 0#
for i = _nPoints - 1 to 2 step -1
p(i) = (w(i) - u(i) * p(i + 1)) / d(i)
next i

p(_nPoints) = 0#

end fn

local fn F( x as single )
dim as single F

F = x * x * x - x

end fn = F

local fn GetCurvePoint( i as integer, v as single )
dim as single t, curvePt

// Derived curve equation (which uses p's and u's for coefficients)

t = (v - x(i)) / u(i)

curvePt = t * y(i + 1) + (1 - t) * y(i) + u(i)¬
* u(i) * (fn F(t) * p(i + 1) + fn F(1 - t) * p(i)) / 6#

end fn = curvePt


local fn DoCurve
dim as integer  piece
dim as single   xPos, yPos
dim as rgbcolor foreRGB

foreRGB.red   = 62535
foreRGB.green = 62535
foreRGB.blue  = 0

rgbForeColor( foreRGB )

fn SetPandU

for piece = 1 to _nPoints - 1
for xPos = x( piece ) to x( piece + 1 )
yPos = fn GetCurvePoint( piece, xPos )
//Picture1.PSet (xPos, yPos), &H0
SetCPixel( xPos, yPos, foreRGB )
next xPos
next piece

end fn

// Function to plot a few points for testing
local fn LoadPoints
dim as integer i
dim as rgbcolor foreRGB

foreRGB.red   = 62535
foreRGB.green = 62535
foreRGB.blue  = 62535

rgbForeColor( foreRGB )

x(1) =  20:     y(1) =  20
x(2) =  50:     y(2) = 100
x(3) = 100:     y(3) =  30
x(4) = 150:     y(4) =  70
x(5) = 200:     y(5) = 170
x(6) = 250:     y(6) =  20

for i = 1 to _nPoints-1
circle x(i), y(i), 5
next i

end fn

local fn DoDialog
dim as long evnt, id

evnt = dialog(0)
id = dialog(evnt)

select case( evnt )
case _wndClose
select( id )
case 1 :  gFBQuit = _zTrue
end select
case _btnClick
select( id )
case _plotBtn : fn LoadPoints
case _drawBtn : fn DoCurve
end select
end select

end fn

on dialog fn DoDialog

fn BuildWindow

do
handleevents
until gFBQuit
end