'
' Primary degrees of freedom:
'
rawresolution = 10 ' Raw curve resolution.
targetpoints = 400 ' Number of points per curve.
smoothiterations = 40 ' Magnitude of `smooth' effect.
' ********** ********** ********** ********** **********
SCREEN 12
screenwidth = 640
screenheight = 480
centerx = screenwidth / 2
centery = screenheight / 2
start:
REDIM pointchainx(999, targetpoints)
REDIM pointchainy(999, targetpoints)
REDIM tempchainx(999, targetpoints)
REDIM tempchainy(999, targetpoints)
curvenum = 0
exitflag = 0
xold = 999999
yold = 999999
GOSUB refresh
DO
curvenum = curvenum + 1
numpoints = 0
'
' Gather raw data for one curve at a time.
' Click+drag mouse button 1 to trace out a curve.
'
DO
DO WHILE _MOUSEINPUT
x = _MOUSEX
y = _MOUSEY
IF (x > 0) AND (x < screenwidth) AND (y > 0) AND (y < screenheight) THEN
IF _MOUSEBUTTON(1) THEN
GOSUB unconvert
delta = SQR((x - xold) ^ 2 + (y - yold) ^ 2)
'
' Collect data only if the new point is sufficiently far away from the previous point.
'
IF (delta > rawresolution) AND (numpoints < targetpoints - 1) THEN
numpoints = numpoints + 1
pointchainx(curvenum, numpoints) = x
pointchainy(curvenum, numpoints) = y
xold = x: yold = y
GOSUB convert
PSET (x, y), 14
END IF
END IF
END IF
LOOP
key$ = INKEY$
SELECT CASE key$
CASE " "
GOTO start
CASE CHR$(27)
exitflag = 1
GOTO quitsequence
END SELECT
LOOP UNTIL NOT _MOUSEBUTTON(1) AND numpoints > 1
'
' If the curve contains less than the minimum numer of points, use interpolation to fill in the gaps.
'
DO
'
' Determine the pair of neighboring points that have the greatest separation of all pairs.
'
rad2max = -1
kmax = -1
FOR k = 1 TO numpoints - 1
xfac = pointchainx(curvenum, k) - pointchainx(curvenum, k + 1)
yfac = pointchainy(curvenum, k) - pointchainy(curvenum, k + 1)
rad2 = xfac ^ 2 + yfac ^ 2
IF rad2 > rad2max THEN
kmax = k
rad2max = rad2
END IF
NEXT
'
' Starting next to kmax, create a `gap' by shifting all other points by one index.
'
FOR j = numpoints TO kmax + 1 STEP -1
pointchainx(curvenum, j + 1) = pointchainx(curvenum, j)
pointchainy(curvenum, j + 1) = pointchainy(curvenum, j)
NEXT
'
' Fill the gap with a new point whose position is determined by the average of its neighbors.
'
pointchainx(curvenum, kmax + 1) = (1 / 2) * (pointchainx(curvenum, kmax) + pointchainx(curvenum, kmax + 2))
pointchainy(curvenum, kmax + 1) = (1 / 2) * (pointchainy(curvenum, kmax) + pointchainy(curvenum, kmax + 2))
numpoints = numpoints + 1
LOOP UNTIL (numpoints = targetpoints)
GOSUB refresh
SLEEP 1
'
' At this stage, the curve still has all of its sharp edges. Use a `relaxation method' to smooth.
' The new position of a point is equal to the average position of its neighboring points.
'
FOR j = 1 TO smoothiterations
FOR k = 2 TO numpoints - 1
tempchainx(curvenum, k) = (1 / 2) * (pointchainx(curvenum, k - 1) + pointchainx(curvenum, k + 1))
tempchainy(curvenum, k) = (1 / 2) * (pointchainy(curvenum, k - 1) + pointchainy(curvenum, k + 1))
NEXT
FOR k = 2 TO numpoints - 1
pointchainx(curvenum, k) = tempchainx(curvenum, k)
pointchainy(curvenum, k) = tempchainy(curvenum, k)
NEXT
NEXT
GOSUB refresh
LOOP UNTIL exitflag = 1
quitsequence:
END
refresh:
CLS
GOSUB printbackground
GOSUB drawcurves
RETURN
printbackground:
PRINT " Drag the left mouse button to draw a curve."
PRINT " Single left-clicking generates straight lines."
PRINT " After drawing a curve, watch it smooth after 1 second."
RETURN
' Draw curves.
drawcurves:
FOR w = 1 TO curvenum
FOR k = 1 TO targetpoints - 1
x = pointchainx(w, k)
y = pointchainy(w, k)
GOSUB convert
xa = x: ya = y
x = pointchainx(w, k + 1)
y = pointchainy(w, k + 1)
GOSUB convert
xb = x: yb = y
LINE (xa, ya)-(xb, yb), 14
NEXT
NEXT
RETURN
' Convert from cartesian coordinates to screen coordinates.
convert:
x0 = x: y0 = y
x = x0 + centerx
y = -y0 + centery
RETURN
' Inverse of the above conversion.
unconvert:
x0 = x: y0 = y
x = x0 - centerx
y = -y0 + centery
RETURN