' ' 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