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

Offline The Librarian

  • Moderator
Curve Smoother by STxAxTIC
« on: March 17, 2018, 01: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: QB64 [Select]
  1. '
  2. ' Primary degrees of freedom:
  3. '
  4. rawresolution = 10 ' Raw curve resolution.
  5. targetpoints = 400 ' Number of points per curve.
  6. smoothiterations = 40 ' Magnitude of `smooth' effect.
  7.  
  8. ' ********** ********** ********** ********** **********
  9.  
  10. screenwidth = 640
  11. screenheight = 480
  12. centerx = screenwidth / 2
  13. centery = screenheight / 2
  14.  
  15. start:
  16.  
  17. REDIM pointchainx(999, targetpoints)
  18. REDIM pointchainy(999, targetpoints)
  19. REDIM tempchainx(999, targetpoints)
  20. REDIM tempchainy(999, targetpoints)
  21.  
  22. curvenum = 0
  23. exitflag = 0
  24. xold = 999999
  25. yold = 999999
  26.  
  27. GOSUB refresh
  28.  
  29.     curvenum = curvenum + 1
  30.     numpoints = 0
  31.  
  32.     '
  33.     ' Gather raw data for one curve at a time.
  34.     ' Click+drag mouse button 1 to trace out a curve.
  35.     '
  36.     DO
  37.         DO WHILE _MOUSEINPUT
  38.             x = _MOUSEX
  39.             y = _MOUSEY
  40.             IF (x > 0) AND (x < screenwidth) AND (y > 0) AND (y < screenheight) THEN
  41.                 IF _MOUSEBUTTON(1) THEN
  42.                     GOSUB unconvert
  43.                     delta = SQR((x - xold) ^ 2 + (y - yold) ^ 2)
  44.                     '
  45.                     ' Collect data only if the new point is sufficiently far away from the previous point.
  46.                     '
  47.                     IF (delta > rawresolution) AND (numpoints < targetpoints - 1) THEN
  48.                         numpoints = numpoints + 1
  49.                         pointchainx(curvenum, numpoints) = x
  50.                         pointchainy(curvenum, numpoints) = y
  51.                         xold = x: yold = y
  52.                         GOSUB convert
  53.                         PSET (x, y), 14
  54.                     END IF
  55.                 END IF
  56.             END IF
  57.         LOOP
  58.  
  59.         KEY$ = INKEY$
  60.         SELECT CASE KEY$
  61.             CASE " "
  62.                 GOTO start
  63.             CASE CHR$(27)
  64.                 exitflag = 1
  65.                 GOTO quitsequence
  66.         END SELECT
  67.  
  68.     LOOP UNTIL NOT _MOUSEBUTTON(1) AND numpoints > 1
  69.  
  70.     '
  71.     ' If the curve contains less than the minimum numer of points, use interpolation to fill in the gaps.
  72.     '
  73.     DO
  74.         '
  75.         ' Determine the pair of neighboring points that have the greatest separation of all pairs.
  76.         '
  77.         rad2max = -1
  78.         kmax = -1
  79.         FOR k = 1 TO numpoints - 1
  80.             xfac = pointchainx(curvenum, k) - pointchainx(curvenum, k + 1)
  81.             yfac = pointchainy(curvenum, k) - pointchainy(curvenum, k + 1)
  82.             rad2 = xfac ^ 2 + yfac ^ 2
  83.             IF rad2 > rad2max THEN
  84.                 kmax = k
  85.                 rad2max = rad2
  86.             END IF
  87.         NEXT
  88.  
  89.         '
  90.         ' Starting next to kmax, create a `gap' by shifting all other points by one index.
  91.         '
  92.         FOR j = numpoints TO kmax + 1 STEP -1
  93.             pointchainx(curvenum, j + 1) = pointchainx(curvenum, j)
  94.             pointchainy(curvenum, j + 1) = pointchainy(curvenum, j)
  95.         NEXT
  96.  
  97.         '
  98.         ' Fill the gap with a new point whose position is determined by the average of its neighbors.
  99.         '
  100.         pointchainx(curvenum, kmax + 1) = (1 / 2) * (pointchainx(curvenum, kmax) + pointchainx(curvenum, kmax + 2))
  101.         pointchainy(curvenum, kmax + 1) = (1 / 2) * (pointchainy(curvenum, kmax) + pointchainy(curvenum, kmax + 2))
  102.  
  103.         numpoints = numpoints + 1
  104.     LOOP UNTIL (numpoints = targetpoints)
  105.  
  106.     GOSUB refresh
  107.     SLEEP 1
  108.  
  109.     '
  110.     ' At this stage, the curve still has all of its sharp edges. Use a `relaxation method' to smooth.
  111.     ' The new position of a point is equal to the average position of its neighboring points.
  112.     '
  113.     FOR j = 1 TO smoothiterations
  114.         FOR k = 2 TO numpoints - 1
  115.             tempchainx(curvenum, k) = (1 / 2) * (pointchainx(curvenum, k - 1) + pointchainx(curvenum, k + 1))
  116.             tempchainy(curvenum, k) = (1 / 2) * (pointchainy(curvenum, k - 1) + pointchainy(curvenum, k + 1))
  117.         NEXT
  118.         FOR k = 2 TO numpoints - 1
  119.             pointchainx(curvenum, k) = tempchainx(curvenum, k)
  120.             pointchainy(curvenum, k) = tempchainy(curvenum, k)
  121.         NEXT
  122.     NEXT
  123.  
  124.     GOSUB refresh
  125.  
  126. LOOP UNTIL exitflag = 1
  127.  
  128. quitsequence:
  129.  
  130. refresh:
  131. GOSUB printbackground
  132. GOSUB drawcurves
  133.  
  134. printbackground:
  135. PRINT "                  Drag the left mouse button to draw a curve."
  136. PRINT "                Single left-clicking generates straight lines."
  137. PRINT "             After drawing a curve, watch it smooth after 1 second."
  138.  
  139. ' Draw curves.
  140. drawcurves:
  141. FOR w = 1 TO curvenum
  142.     FOR k = 1 TO targetpoints - 1
  143.         x = pointchainx(w, k)
  144.         y = pointchainy(w, k)
  145.         GOSUB convert
  146.         xa = x: ya = y
  147.         x = pointchainx(w, k + 1)
  148.         y = pointchainy(w, k + 1)
  149.         GOSUB convert
  150.         xb = x: yb = y
  151.         LINE (xa, ya)-(xb, yb), 14
  152.     NEXT
  153.  
  154. ' Convert from cartesian coordinates to screen coordinates.
  155. convert:
  156. x0 = x: y0 = y
  157. x = x0 + centerx
  158. y = -y0 + centery
  159.  
  160. ' Inverse of the above conversion.
  161. unconvert:
  162. x0 = x: y0 = y
  163. x = x0 - centerx
  164. y = -y0 + centery
  165.  

« Last Edit: August 08, 2018, 11:17:39 PM by odin »