Curve Smoother by STxAxTIC & FellippeHeitor

[The Librarian]

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