Author Topic: Curve Smoother  (Read 3281 times)

0 Members and 1 Guest are viewing this topic.

Offline The Librarian

  • Moderator
  • Newbie
  • Posts: 42
Curve Smoother
« on: March 17, 2018, 01:08:19 AM »
Curve Smoother

Author: @STxAxTIC @FellippeHeitor
Source: Submission
Version: 2014
Tags: [graphics], [relaxation algorithm], [anti-aliasing]

Description:
This program demonstrates (i) linear interpolation to create a curve between points, (ii) a relaxation algorithm to "smooth over" a curve to remove sharp edges, and (iii) plotting with anti-aliasing.

Source code:
Code: QB64: [Select]
  1. ' Display
  2. SCREEN _NEWIMAGE(800, 600, 32)
  3. _SCREENMOVE (_DESKTOPWIDTH \ 2 - _WIDTH \ 2) - 3, (_DESKTOPHEIGHT \ 2 - _HEIGHT \ 2) - 29
  4. _TITLE "If these curves were smoother they'd steal your wife."
  5.  
  6. ' Meta
  7. start:
  8.  
  9. ' Data structures
  10. TYPE Vector
  11.     x AS DOUBLE
  12.     y AS DOUBLE
  13.  
  14. ' Object type
  15. TYPE Object
  16.     Elements AS INTEGER
  17.     Shade AS _UNSIGNED LONG
  18.  
  19. ' Object storage
  20. DIM SHARED Shape(300) AS Object
  21. DIM SHARED PointChain(300, 500) AS Vector
  22. DIM SHARED TempChain(300, 500) AS Vector
  23. DIM SHARED ShapeCount AS INTEGER
  24. DIM SHARED SelectedShape AS INTEGER
  25.  
  26. ' Initialize
  27. ShapeCount = 0
  28.  
  29. ' Main loop
  30.     IF (UserInput = -1) THEN GOTO start
  31.     CALL Graphics
  32.     _LIMIT 120
  33.  
  34.  
  35. FUNCTION UserInput
  36.     TheReturn = 0
  37.     ' Keyboard input
  38.     kk = _KEYHIT
  39.     SELECT CASE kk
  40.         CASE 32
  41.             DO: LOOP UNTIL _KEYHIT
  42.             WHILE _MOUSEINPUT: WEND
  43.             _KEYCLEAR
  44.             CALL NewMouseShape(7.5, 150, 15)
  45.             CLS
  46.     END SELECT
  47.     IF (kk) THEN
  48.         _KEYCLEAR
  49.     END IF
  50.     UserInput = TheReturn
  51.  
  52. SUB Graphics
  53.     LINE (0, 0)-(_WIDTH, _HEIGHT), _RGBA(0, 0, 0, 200), BF
  54.     CALL cprintstring(16 * 17, "PRESS SPACE and then drag MOUSE 1 to draw a new shape.")
  55.     FOR ShapeIndex = 1 TO ShapeCount
  56.         FOR i = 1 TO Shape(ShapeIndex).Elements - 1
  57.             CALL lineSmooth(PointChain(ShapeIndex, i).x, PointChain(ShapeIndex, i).y, PointChain(ShapeIndex, i + 1).x, PointChain(ShapeIndex, i + 1).y, Shape(ShapeIndex).Shade)
  58.         NEXT
  59.     NEXT
  60.     _DISPLAY
  61.  
  62. SUB NewMouseShape (rawresolution AS DOUBLE, targetpoints AS INTEGER, smoothiterations AS INTEGER)
  63.     ShapeCount = ShapeCount + 1
  64.     numpoints = 0
  65.     xold = 999 ^ 999
  66.     yold = 999 ^ 999
  67.     DO
  68.         DO WHILE _MOUSEINPUT
  69.             x = _MOUSEX
  70.             y = _MOUSEY
  71.             IF (x > 0) AND (x < _WIDTH) AND (y > 0) AND (y < _HEIGHT) THEN
  72.                 IF _MOUSEBUTTON(1) THEN
  73.                     x = x - (_WIDTH / 2)
  74.                     y = -y + (_HEIGHT / 2)
  75.                     delta = SQR((x - xold) ^ 2 + (y - yold) ^ 2)
  76.                     IF (delta > rawresolution) AND (numpoints < targetpoints - 1) THEN
  77.                         numpoints = numpoints + 1
  78.                         PointChain(ShapeCount, numpoints).x = x
  79.                         PointChain(ShapeCount, numpoints).y = y
  80.                         CALL cpset(x, y, _RGB(0, 255, 255))
  81.                         xold = x
  82.                         yold = y
  83.                     END IF
  84.                 END IF
  85.             END IF
  86.         LOOP
  87.         _DISPLAY
  88.     LOOP UNTIL NOT _MOUSEBUTTON(1) AND (numpoints > 1)
  89.  
  90.     DO WHILE (numpoints < targetpoints)
  91.         rad2max = -1
  92.         kmax = -1
  93.         FOR k = 1 TO numpoints - 1
  94.             xfac = PointChain(ShapeCount, k).x - PointChain(ShapeCount, k + 1).x
  95.             yfac = PointChain(ShapeCount, k).y - PointChain(ShapeCount, k + 1).y
  96.             rad2 = xfac ^ 2 + yfac ^ 2
  97.             IF rad2 > rad2max THEN
  98.                 kmax = k
  99.                 rad2max = rad2
  100.             END IF
  101.         NEXT
  102.         FOR j = numpoints TO kmax + 1 STEP -1
  103.             PointChain(ShapeCount, j + 1).x = PointChain(ShapeCount, j).x
  104.             PointChain(ShapeCount, j + 1).y = PointChain(ShapeCount, j).y
  105.         NEXT
  106.         PointChain(ShapeCount, kmax + 1).x = (1 / 2) * (PointChain(ShapeCount, kmax).x + PointChain(ShapeCount, kmax + 2).x)
  107.         PointChain(ShapeCount, kmax + 1).y = (1 / 2) * (PointChain(ShapeCount, kmax).y + PointChain(ShapeCount, kmax + 2).y)
  108.         numpoints = numpoints + 1
  109.     LOOP
  110.  
  111.     FOR j = 1 TO smoothiterations
  112.         FOR k = 2 TO numpoints - 1
  113.             TempChain(ShapeCount, k).x = (1 / 2) * (PointChain(ShapeCount, k - 1).x + PointChain(ShapeCount, k + 1).x)
  114.             TempChain(ShapeCount, k).y = (1 / 2) * (PointChain(ShapeCount, k - 1).y + PointChain(ShapeCount, k + 1).y)
  115.         NEXT
  116.         FOR k = 2 TO numpoints - 1
  117.             PointChain(ShapeCount, k).x = TempChain(ShapeCount, k).x
  118.             PointChain(ShapeCount, k).y = TempChain(ShapeCount, k).y
  119.         NEXT
  120.     NEXT
  121.  
  122.     Shape(ShapeCount).Elements = numpoints
  123.     Shape(ShapeCount).Shade = _RGB(100 + INT(RND * 155), 100 + INT(RND * 155), 100 + INT(RND * 155))
  124.     SelectedShape = ShapeCount
  125.  
  126. SUB cpset (x1, y1, col AS _UNSIGNED LONG)
  127.     PSET (_WIDTH / 2 + x1, -y1 + _HEIGHT / 2), col
  128.  
  129. SUB cprintstring (y, a AS STRING)
  130.     _PRINTSTRING (_WIDTH / 2 - (LEN(a) * 8) / 2, -y + _HEIGHT / 2), a
  131.  
  132. SUB lineSmooth (x0, y0, x1, y1, c AS _UNSIGNED LONG)
  133.     'translated from
  134.     'https://en.wikipedia.org/w/index.php?title=Xiaolin_Wu%27s_line_algorithm&oldid=852445548
  135.  
  136.     DIM plX AS INTEGER, plY AS INTEGER, plI
  137.  
  138.     DIM steep AS _BYTE
  139.     steep = ABS(y1 - y0) > ABS(x1 - x0)
  140.  
  141.     IF steep THEN
  142.         SWAP x0, y0
  143.         SWAP x1, y1
  144.     END IF
  145.  
  146.     IF x0 > x1 THEN
  147.         SWAP x0, x1
  148.         SWAP y0, y1
  149.     END IF
  150.  
  151.     DIM dx, dy, gradient
  152.     dx = x1 - x0
  153.     dy = y1 - y0
  154.     gradient = dy / dx
  155.  
  156.     IF dx = 0 THEN
  157.         gradient = 1
  158.     END IF
  159.  
  160.     'handle first endpoint
  161.     DIM xend, yend, xgap, xpxl1, ypxl1
  162.     xend = _ROUND(x0)
  163.     yend = y0 + gradient * (xend - x0)
  164.     xgap = (1 - ((x0 + .5) - INT(x0 + .5)))
  165.     xpxl1 = xend 'this will be used in the main loop
  166.     ypxl1 = INT(yend)
  167.     IF steep THEN
  168.         plX = ypxl1
  169.         plY = xpxl1
  170.         plI = (1 - (yend - INT(yend))) * xgap
  171.         GOSUB plot
  172.  
  173.         plX = ypxl1 + 1
  174.         plY = xpxl1
  175.         plI = (yend - INT(yend)) * xgap
  176.         GOSUB plot
  177.     ELSE
  178.         plX = xpxl1
  179.         plY = ypxl1
  180.         plI = (1 - (yend - INT(yend))) * xgap
  181.         GOSUB plot
  182.  
  183.         plX = xpxl1
  184.         plY = ypxl1 + 1
  185.         plI = (yend - INT(yend)) * xgap
  186.         GOSUB plot
  187.     END IF
  188.  
  189.     DIM intery
  190.     intery = yend + gradient 'first y-intersection for the main loop
  191.  
  192.     'handle second endpoint
  193.     DIM xpxl2, ypxl2
  194.     xend = _ROUND(x1)
  195.     yend = y1 + gradient * (xend - x1)
  196.     xgap = ((x1 + .5) - INT(x1 + .5))
  197.     xpxl2 = xend 'this will be used in the main loop
  198.     ypxl2 = INT(yend)
  199.     IF steep THEN
  200.         plX = ypxl2
  201.         plY = xpxl2
  202.         plI = (1 - (yend - INT(yend))) * xgap
  203.         GOSUB plot
  204.  
  205.         plX = ypxl2 + 1
  206.         plY = xpxl2
  207.         plI = (yend - INT(yend)) * xgap
  208.         GOSUB plot
  209.     ELSE
  210.         plX = xpxl2
  211.         plY = ypxl2
  212.         plI = (1 - (yend - INT(yend))) * xgap
  213.         GOSUB plot
  214.  
  215.         plX = xpxl2
  216.         plY = ypxl2 + 1
  217.         plI = (yend - INT(yend)) * xgap
  218.         GOSUB plot
  219.     END IF
  220.  
  221.     'main loop
  222.     DIM x
  223.     IF steep THEN
  224.         FOR x = xpxl1 + 1 TO xpxl2 - 1
  225.             plX = INT(intery)
  226.             plY = x
  227.             plI = (1 - (intery - INT(intery)))
  228.             GOSUB plot
  229.  
  230.             plX = INT(intery) + 1
  231.             plY = x
  232.             plI = (intery - INT(intery))
  233.             GOSUB plot
  234.  
  235.             intery = intery + gradient
  236.         NEXT
  237.     ELSE
  238.         FOR x = xpxl1 + 1 TO xpxl2 - 1
  239.             plX = x
  240.             plY = INT(intery)
  241.             plI = (1 - (intery - INT(intery)))
  242.             GOSUB plot
  243.  
  244.             plX = x
  245.             plY = INT(intery) + 1
  246.             plI = (intery - INT(intery))
  247.             GOSUB plot
  248.  
  249.             intery = intery + gradient
  250.         NEXT
  251.     END IF
  252.  
  253.     EXIT SUB
  254.  
  255.     plot:
  256.     ' Change to regular PSET for standard coordinate orientation.
  257.     CALL cpset(plX, plY, _RGB32(_RED32(c), _GREEN32(c), _BLUE32(c), plI * 255))
  258.     RETURN
  259.  

« Last Edit: March 21, 2020, 11:35:01 PM by The Librarian »