Convert mouse input to DRAW

[STxAxTIC]

Decided to tackle a problem Fellippe and Dajan were talking about, but not from scratch.

I started with the "curve smoother" code in Samples, and then removed some of the embarrassing stuff. I ignored 90% of what DRAW can do, and only kept TA and U. End result is, you can draw curves with the mouse they are auto-smoothed, and translated to DRAW instead of LINE. Hope someone finds it useful.

Code: QB64: [Select]

1. SCREEN 12
2.  
3. '
4. ' Primary degrees of freedom:
5. '
6. rawresolution = 7.5 ' Raw curve resolution.
7. targetpoints = 500 ' Number of points per curve.
8. smoothiterations = 20 ' Magnitude of `smooth' effect.
9.  
10. ' ********** ********** ********** ********** **********
11.  
12. TYPE Vector
13.     X AS DOUBLE
14.     Y AS DOUBLE
15. END TYPE
16.  
17. DIM SHARED Center AS Vector
18. Center.X = _WIDTH / 2
19. Center.Y = _HEIGHT / 2
20.  
21. REDIM pointchainx(999, targetpoints)
22. REDIM pointchainy(999, targetpoints)
23. REDIM tempchainx(999, targetpoints)
24. REDIM tempchainy(999, targetpoints)
25.  
26. curvenum = 0
27. exitflag = 0
28. xold = 999999
29. yold = 999999
30.  
31. GOSUB refresh
32.  
33. DO
34.     curvenum = curvenum + 1
35.     numpoints = 0
36.  
37.     ' Gather raw data for one curve at a time.
38.     ' Click+drag mouse button 1 to trace out a curve.
39.     DO
40.         DO WHILE _MOUSEINPUT
41.             x = _MOUSEX
42.             y = _MOUSEY
43.             IF (x > 0) AND (x < _WIDTH) AND (y > 0) AND (y < _HEIGHT) THEN
44.                 IF _MOUSEBUTTON(1) THEN
45.                     x = x - Center.X
46.                     y = -y + Center.Y
47.                     delta = SQR((x - xold) ^ 2 + (y - yold) ^ 2)
48.  
49.                     ' Collect data only if the new point is sufficiently far away from the previous point.
50.                     IF (delta > rawresolution) AND (numpoints < targetpoints - 1) THEN
51.                         numpoints = numpoints + 1
52.                         pointchainx(curvenum, numpoints) = x
53.                         pointchainy(curvenum, numpoints) = y
54.                         CALL CPset(x, y, 14)
55.                         xold = x
56.                         yold = y
57.                     END IF
58.                 END IF
59.             END IF
60.         LOOP
61.  
62.     LOOP UNTIL NOT _MOUSEBUTTON(1) AND numpoints > 1
63.  
64.     ' If the curve contains less than the minimum numer of points, use interpolation to fill in the gaps.
65.     DO WHILE (numpoints < targetpoints)
66.  
67.         ' Determine the pair of neighboring points that have the greatest separation of all pairs.
68.         rad2max = -1
69.         kmax = -1
70.         FOR k = 1 TO numpoints - 1
71.             xfac = pointchainx(curvenum, k) - pointchainx(curvenum, k + 1)
72.             yfac = pointchainy(curvenum, k) - pointchainy(curvenum, k + 1)
73.             rad2 = xfac ^ 2 + yfac ^ 2
74.             IF rad2 > rad2max THEN
75.                 kmax = k
76.                 rad2max = rad2
77.             END IF
78.         NEXT
79.  
80.         ' Starting next to kmax, create a `gap' by shifting all other points by one index.
81.         FOR j = numpoints TO kmax + 1 STEP -1
82.             pointchainx(curvenum, j + 1) = pointchainx(curvenum, j)
83.             pointchainy(curvenum, j + 1) = pointchainy(curvenum, j)
84.         NEXT
85.  
86.         ' Fill the gap with a new point whose position is determined by the average of its neighbors.
87.         pointchainx(curvenum, kmax + 1) = (1 / 2) * (pointchainx(curvenum, kmax) + pointchainx(curvenum, kmax + 2))
88.         pointchainy(curvenum, kmax + 1) = (1 / 2) * (pointchainy(curvenum, kmax) + pointchainy(curvenum, kmax + 2))
89.  
90.         numpoints = numpoints + 1
91.     LOOP
92.  
93.     GOSUB refresh
94.     SLEEP 1
95.  
96.     ' At this stage, the curve still has all of its sharp edges. Use a `relaxation method' to smooth.
97.     ' The new position of a point is equal to the average position of its neighboring points.
98.     FOR j = 1 TO smoothiterations
99.         FOR k = 2 TO numpoints - 1
100.             tempchainx(curvenum, k) = (1 / 2) * (pointchainx(curvenum, k - 1) + pointchainx(curvenum, k + 1))
101.             tempchainy(curvenum, k) = (1 / 2) * (pointchainy(curvenum, k - 1) + pointchainy(curvenum, k + 1))
102.         NEXT
103.         FOR k = 2 TO numpoints - 1
104.             pointchainx(curvenum, k) = tempchainx(curvenum, k)
105.             pointchainy(curvenum, k) = tempchainy(curvenum, k)
106.         NEXT
107.     NEXT
108.  
109.     GOSUB refresh
110.  
111. LOOP UNTIL exitflag = 1
112.  
113. quitsequence:
114. END
115.  
116. refresh:
117. CLS
118. PRINT "                  Drag the left mouse button to draw a curve."
119. PRINT "                Single left-clicking generates straight lines."
120. PRINT "             After drawing a curve, watch it smooth after 1 second."
121. FOR w = 1 TO curvenum
122.     z$ = ""
123.     FOR k = 1 TO targetpoints - 1
124.         x1 = pointchainx(w, k)
125.         y1 = pointchainy(w, k)
126.         x2 = pointchainx(w, k + 1)
127.         y2 = pointchainy(w, k + 1)
128.         'CALL CLine(x1, y1, x2, y2, 14)
129.  
130.         '''
131.         ' Fellippe, this was it ...
132.         dr = SQR((x2 - x1) ^ 2 + (y2 - y1) ^ 2)
133.         ang = INT(180 / 3.14 * ATN((y2 - y1) / (x2 - x1)))
134.         IF (x2 < x1) THEN
135.             ang = 180 + ang
136.         END IF
137.         z$ = z$ + " TA" + STR$(ang - 90) + "U" + STR$(dr) + " "
138.         '''
139.  
140.     NEXT
141.     ' Make a point to get DRAW started.
142.     CALL CPset(pointchainx(w, 1), pointchainy(w, 1), 15)
143.     ' Draw replaces CLine.
144.     DRAW z$
145. NEXT
146. RETURN
147.  
148. SUB CPset (x, y, col)
149.     PSET (Center.X + x, -y + Center.Y), col
150. END SUB
151.  
152. SUB CLine (x1, y1, x2, y2, col)
153.     LINE (Center.X + x1, -y1 + Center.Y)-(Center.X + x2, -y2 + Center.Y), col
154. END SUB

[FellippeHeitor]

It's great how this translated from line to DRAW, man.

[dajan]

There's not much difference between unsmoothed and smoothed curve, when your mouse move scans so many points. If I was allowed only click a few points, then the additional smoothing would stand out much more. Anyway, inspiring, thanks.

[STxAxTIC]

It's all adjustable dajan - play with the top three numbers or draw really long curves for more effect to show. There are a handful of ways to decide how much smoothing to do, even dynamic ways - but I skipped that.

[bplus]

There's not much difference between unsmoothed and smoothed curve, when your mouse move scans so many points. If I was allowed only click a few points, then the additional smoothing would stand out much more. Anyway, inspiring, thanks.

It's all adjustable dajan - play with the top three numbers or draw really long curves for more effect to show. There are a handful of ways to decide how much smoothing to do, even dynamic ways - but I skipped that.

Well guys, it just so happens that I modified STxAxTIC's Curve Smoother code to make a Toolbox SUB out of it. In the process I modified the hell out of the rest of STxAxTIC's demo code, so it was a piece of cake to modify it again to test single clicking which I was curious about too, so here is the test code for Toolbox SUB Smooth testing with single mouse clicks:

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. _TITLE "Smooth SUB test code" ' B+ started 2020-01-24 adapted and modified from
3. ' Curve smoother by STxAxTIC https://www.qb64.org/forum/index.php?topic=184.msg963#msg963
4. ' I want a Toolbox Sub that will take an array of points for a curve and smooth them out.
5. ' 2020-01-25 add getClick, fcirc and modify thic to test single click points data.
6.  
7. CONST maxPoints = 500
8. TYPE XY
9.     x AS SINGLE
10.     y AS SINGLE
11. END TYPE
12.  
13. SCREEN _NEWIMAGE(800, 600, 32)
14.  
15. DIM numPoints, x, y, k
16. DO
17.     'reinitialize everything for next curve test of Smooth
18.     clean
19.     REDIM pts(0) AS XY
20.     numPoints = 0
21.     'get bunch of clicks until enter keypress
22.     DO
23.         x = -1
24.         getClick x, y, k
25.         IF x <> -1 THEN AppendXY pts(), x, y: numPoints = numPoints + 1: CIRCLE (x, y), 1, &HFFFF00FF
26.         IF numPoints >= maxPoints THEN EXIT DO
27.         IF k = 27 THEN END
28.  
29.     LOOP UNTIL k = 13 AND numPoints > 1
30.     Smooth pts(), maxPoints, 5
31.     drawcurve pts(), 10, &HFFFFFF00
32.     SLEEP 5
33. LOOP
34.  
35. '======================= Feature SUB =======================================================================
36. ' This code takes a dynamic points array and adds and modifies points to smooth out the data,
37. ' to be used as Toolbox SUB. b+ 2020-01-24 adapted and modified from:
38. ' Curve smoother by STxAxTIC https://www.qb64.org/forum/index.php?topic=184.msg963#msg963
39. SUB Smooth (arr() AS XY, targetPoints AS INTEGER, smoothIterations AS INTEGER)
40.     'TYPE XY
41.     '    x AS SINGLE
42.     '    y AS SINGLE
43.     'END TYPE
44.     ' targetPoints is the number of points to be in finished smoothed out array
45.     ' smoothIterations is number of times to try and round out corners
46.  
47.     DIM rad2Max, kmax, k, numPoints, xfac, yfac, rad2, j
48.     numPoints = UBOUND(arr)
49.     REDIM _PRESERVE arr(0 TO targetPoints) AS XY
50.     REDIM temp(0 TO targetPoints) AS XY
51.     DO
52.         '
53.         ' Determine the pair of neighboring points that have the greatest separation of all pairs.
54.         '
55.         rad2Max = -1
56.         kmax = -1
57.         FOR k = 1 TO numPoints - 1
58.             xfac = arr(k).x - arr(k + 1).x
59.             yfac = arr(k).y - arr(k + 1).y
60.             rad2 = xfac ^ 2 + yfac ^ 2
61.             IF rad2 > rad2Max THEN
62.                 kmax = k
63.                 rad2Max = rad2
64.             END IF
65.         NEXT
66.         '
67.         ' Starting next to kmax, create a `gap' by shifting all other points by one index.
68.         '
69.         FOR j = numPoints TO kmax + 1 STEP -1
70.             arr(j + 1).x = arr(j).x
71.             arr(j + 1).y = arr(j).y
72.         NEXT
73.  
74.         '
75.         ' Fill the gap with a new point whose position is determined by the average of its neighbors.
76.         '
77.         arr(kmax + 1).x = .5 * (arr(kmax).x + arr(kmax + 2).x)
78.         arr(kmax + 1).y = .5 * (arr(kmax).y + arr(kmax + 2).y)
79.  
80.         numPoints = numPoints + 1
81.     LOOP UNTIL (numPoints = targetPoints)
82.     '
83.     ' At this stage, the curve still has all of its sharp edges. Use a `relaxation method' to smooth.
84.     ' The new position of a point is equal to the average position of its neighboring points.
85.     '
86.     FOR j = 1 TO smoothIterations
87.         FOR k = 2 TO numPoints - 1
88.             temp(k).x = .5 * (arr(k - 1).x + arr(k + 1).x)
89.             temp(k).y = .5 * (arr(k - 1).y + arr(k + 1).y)
90.         NEXT
91.         FOR k = 2 TO numPoints - 1
92.             arr(k).x = temp(k).x
93.             arr(k).y = temp(k).y
94.         NEXT
95.     NEXT
96. END SUB
97.  
98. SUB clean
99.     CLS
100.     yCP 10, "Click mouse to hearts content or 500 times. Escape quits testing."
101.     yCP 30, "Press enter to test curve drawing..."
102.     yCP 50, "b+ Smooth SUB that uses STxAxTIC's Curve Smoother code."
103.     yCP 600 - 30, "Curve will disappear in 5 secs or keypress then Click your way to another curve."
104. END SUB
105.  
106. SUB drawcurve (arr() AS XY, thk, c AS _UNSIGNED LONG)
107.     DIM k
108.     FOR k = 1 TO UBOUND(arr) - 1
109.         thic arr(k).x, arr(k).y, arr(k + 1).x, arr(k + 1).y, thk, c
110.     NEXT
111. END SUB
112.  
113. 'update 2020-01-24 to include PD2 inside the sub
114. SUB thic (x1, y1, x2, y2, thick, K AS _UNSIGNED LONG)
115.     DIM PD2 AS DOUBLE, t2 AS SINGLE, a AS SINGLE, x3 AS SINGLE, y3 AS SINGLE, x4 AS SINGLE, y4 AS SINGLE
116.     DIM x5 AS SINGLE, y5 AS SINGLE, x6 AS SINGLE, y6 AS SINGLE
117.     PD2 = 1.570796326794897
118.     t2 = thick / 2
119.     IF t2 < 1 THEN t2 = 1
120.     a = _ATAN2(y2 - y1, x2 - x1)
121.     x3 = x1 + t2 * COS(a + PD2)
122.     y3 = y1 + t2 * SIN(a + PD2)
123.     x4 = x1 + t2 * COS(a - PD2)
124.     y4 = y1 + t2 * SIN(a - PD2)
125.     x5 = x2 + t2 * COS(a + PD2)
126.     y5 = y2 + t2 * SIN(a + PD2)
127.     x6 = x2 + t2 * COS(a - PD2)
128.     y6 = y2 + t2 * SIN(a - PD2)
129.     ftri x6, y6, x4, y4, x3, y3, K
130.     ftri x3, y3, x5, y5, x6, y6, K
131.     fcirc x1, y1, t2, K 'added on for this app
132.     fcirc x2, y2, t2, K ' ditto
133. END SUB
134.  
135. '2019-12-16 fix by Steve saves some time with STATIC and saves and restores last dest
136. SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
137.     DIM D AS LONG
138.     STATIC a&
139.     D = _DEST
140.     IF a& = 0 THEN a& = _NEWIMAGE(1, 1, 32)
141.     _DEST a&
142.     _DONTBLEND a& '  '<<<< new 2019-12-16 fix
143.     PSET (0, 0), K
144.     _BLEND a& '<<<< new 2019-12-16 fix
145.     _DEST D
146.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
147. END SUB
148.  
149. 'update 2020-01-24 now with _printwidth so can use any FONT
150. SUB yCP (y, s$) 'for xmax pixel wide graphics screen Center Print at pixel y row
151.     _PRINTSTRING ((_WIDTH - _PRINTWIDTH(s$)) / 2, y), s$
152. END SUB
153.  
154. ' modified for XY type
155. SUB AppendXY (arr() AS XY, addx, addy)
156.     REDIM _PRESERVE arr(LBOUND(arr) TO UBOUND(arr) + 1) AS XY
157.     arr(UBOUND(arr)).x = addx
158.     arr(UBOUND(arr)).y = addy
159. END SUB
160.  
161. 'getClick returns the mouse x, y position WHEN THE MOUSE WAS RELEASED! or keypress ASC 27 or 32 to 125
162. '2019-08-06 Test now with new mBox and inputBox procedures
163. 'found  mBox needed a _KEYCLEAR, how about inputBox?  OK had _KEYCLEAR already
164. SUB getClick (mx, my, q)
165.     DIM mb, i
166.     mb = _MOUSEBUTTON(1)
167.     WHILE mb
168.         WHILE _MOUSEINPUT: WEND '<<<<<<<<<<<<<<<<<<<<  clear previous mb
169.         mb = _MOUSEBUTTON(1)
170.     WEND
171.     _KEYCLEAR 'clear previous key presses
172.     mx = -1: my = -1: q = 0
173.     DO WHILE mx = -1 AND my = -1
174.         q = _KEYHIT
175.         IF q = 27 OR q = 13 THEN _KEYCLEAR: EXIT SUB  'edit 2020-01-25 for this app
176.         i = _MOUSEINPUT: mb = _MOUSEBUTTON(1)
177.         'IF mb THEN
178.         DO WHILE mb 'wait for release
179.             q = _KEYHIT
180.             IF q = 27 OR q = 13 THEN EXIT SUB 'edit 2020-01-25 for this app
181.             i = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
182.             _LIMIT 1000
183.         LOOP
184.         _LIMIT 1000
185.     LOOP
186. END SUB
187.  
188. 'from Steve Gold standard
189. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
190.     DIM Radius AS INTEGER, RadiusError AS INTEGER
191.     DIM X AS INTEGER, Y AS INTEGER
192.     Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
193.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
194.     LINE (CX - X, CY)-(CX + X, CY), C, BF
195.     WHILE X > Y
196.         RadiusError = RadiusError + Y * 2 + 1
197.         IF RadiusError >= 0 THEN
198.             IF X <> Y + 1 THEN
199.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
200.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
201.             END IF
202.             X = X - 1
203.             RadiusError = RadiusError - X * 2
204.         END IF
205.         Y = Y + 1
206.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
207.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
208.     WEND
209. END SUB
210.  
211.  

Note: Smooth SUB name is supposed to be that, not SMOOTH in all caps.

And it's true what STxAxTIC says, the Smoothing effect is really noticeable only when you draw really long scribbles (update) when the targetNumber is high like 500 or 1000.

[dajan]

...so here is the test code for Toolbox SUB Smooth testing with single mouse clicks

bplus, that was exactly what i meant, but why doesn't your code smooth the curve? Or it does just very slightly and very close to the points itself? Here's  smoothed 4 point curve that is more like rectange. Also, can I make lines thin in your demo?

STxAxTIC, you are right, when I move the mouse very quickly, the points are further from each other and smoothenes is more obvious then. But I was curious about the same as bplus, how would it curve a few separately clicked points.

[bplus]

Hi dajan, try maxPoints at 20 and interations at 35

[dajan]

bplus, yeah thanks.
the maxpoints=100 and iterations=30 works about how I would expect.