Author Topic: Curve Smoother by STxAxTIC  (Read 167 times)

Offline The Librarian

  • Moderator
Curve Smoother by STxAxTIC
« on: March 17, 2018, 02:08:19 AM »
Curve Smoother

Author: STxAxTIC
Source: Submission
Version: 2014
Tags: [drawing]

Description:
This program demonstrates (i) linear interpolation, and (ii) a relaxation technique to "smooth out" a hand-drawn curve. Several controls over the resolution and "smooth factor" can be tweaked at the top of the code.

Source code:
Code: [Select]
'
' 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