Spline program 2/2

 BBS: Inland Empire Archive
Date: 02-16-93 (02:16)             Number: 277
From: DIK COATES                   Refer#: NONE
  To: AL SCHOEPP                    Recvd: NO  
Subj: Spline program 2/2             Conf: (2) Quik_Bas

>>>> QUOTING Al Schoepp to Dik Coates <<<<
Start of Part 2 of 2

'*************************** SUBPROGRAM Spline ******************************
'
'   Draws a smooth curve through points (x(i%),y(i%)).  The screen call must
'   be Mode 10 with a monochrome monitor and EGA board or Mode 9 with a
'   colour monitor and EGA board.  Option Base 1 Command must be used.
'   The coordinate is based on the screen location with the maximum value of
'   "x" less than or equal to 639 and the maximum value of "y" less than or
'   equal to 349.
'
'   ARGUMENTS:  f%()=array for x-coordinates or y-coordinates
'               t()=array for t-coordinates
'               s%=number of points
'               sz%=number of divisions from first point to last
'               ft()=x or y-coordinate values for spline
'
'   RETURNS:    ft()=x or y-coordinate values for spline
'
'   SUBPROGRAMS CALLED: nul
'
SUB Spline (f%(), t(), s%, sz%, ft()) STATIC
 DIM a(50), b(50), c(50)

 FOR i% = 2 TO s%
  b(i%) = t(i%) - t(i% - 1)
  c(i%) = (f%(i%) - f%(i% - 1)) / b(i%)
 NEXT i%

 b(1) = b(2) + b(3)
 c(1) = b(3)
 a(1) = ((b(2) + 2 * b(1)) * c(2) * b(3) + b(2) * b(2) * c(3)) / b(1)

 FOR i% = 2 TO s% - 1
  g = -b(i% + 1) / c(i% - 1)
  a(i%) = g * a(i% - 1) + 3 * (b(i%) * c(i% + 1) + b(i% + 1) * c(i%))
  c(i%) = g * b(i% - 1) + 2 * (b(i%) + b(i% + 1))
 NEXT i%

 g = b(s% - 1) + b(s%)
 a(s%) = ((b(s%) + g + g) * c(s%) * b(s% - 1) + b(s%) *
b(s%) * (f%(s% - 1) - f%(s% - 2)) / b(s% - 1)) / g
 g = -g / c(s% - 1)
 c(s%) = b(s% - 1)
 c(s%) = g * b(s% - 1) + c(s%)
 a(s%) = (g * a(s% - 1) + a(s%)) / c(s%)

 FOR i% = s% - 1 TO 1 STEP -1
  a(i%) = (a(i%) - b(i%) * a(i% + 1)) / c(i%)
 NEXT i%

 FOR i% = 2 TO s%
  d = (f%(i%) - f%(i% - 1)) / b(i%)
  e = a(i% - 1) + a(i%) - 2 * d
  b(i% - 1) = 2 * (d - a(i% - 1) - e) / b(i%)
  c(i% - 1) = (e / b(i%)) * (6 / b(i%))
 NEXT i%

 wt = 0
 i% = 0
 j% = 1
 dt = t(s%) / (sz% - 1)

 WHILE i% < sz%
  IF wt > t(j% + 1) THEN
   j% = j% + 1
  END IF

  i% = i% + 1
  h = wt - t(j%)
  ft(i%) = f%(j%) + h * (a(j%) + h * (b(j%) + h * c(j%) / 3) / 2)
  wt = wt + dt
 WEND
END SUB

'************************* SUBPROGRAM Splinecurve ***************************
'
'   Draws a smooth curve through points (x(i%),y(i%)).  The screen call must
'   be Mode 10 with a monochrome monitor and EGA board or Mode 9 with a
'   colour monitor and EGA board.  Option Base 1 Command must be used.  The
'   Subprogram divides the total chord length of the curve into 600 equal
'   spaces.  This value can be modified by revising "nd%" to a greater or
'   lesser value.  The coordinate is based on the screen location with the
'   maximum value of "x" less than or equal to 639 and the maximum value of
'   "y" less than or equal to 349.
'
'   ARGUMENTS:  n%=number of points
'               xx%()=x-coordinate values for spline
'               yy%()=y-coordinate values for spline
'
'   RETURNS:    nul (draws curve on screen)
'
'   SUBPROGRAMS CALLED: Graphpoints(xx%(),yy%(),(n%))
'                       Spline(xx%(),tt(),(n%),(nd%),spx())
'                       Drawcurve((nd%),spx(),spy())
'
SUB Splinecurve (n%, xx%(), yy%()) STATIC
 DIM spx(600), spy(600)
 REDIM tt(n%)
 nd% = 600

 IF UBOUND(xx%) <> n% OR UBOUND(yy%) <> n% THEN
  PRINT "ERROR: Array size must equal number of points"
  EXIT SUB
 END IF

 tt(1) = 0

 FOR i% = 2 TO n%
  tt(i%) = tt(i% - 1) + FNDist(xx%(i% - 1), yy%(i% - 1), xx%(i%), yy%(i%))
 NEXT i%

 CALL Graphpoints(xx%(), yy%(), (n%))
 CALL Spline(xx%(), tt(), (n%), (nd%), spx())
 CALL Spline(yy%(), tt(), (n%), (nd%), spy())
 CALL Drawcurve((nd%), spx(), spy())
END SUB

End of Part 2
... "I drank WHAT!?" - Socrates

--- Maximus 2.00
 * Origin: Durham Systems (ONLINE!) (1:229/110)