Simple coordinates equation or impossible coordinates equation?

[SierraKen]

Ever since the 90's I've tried various ways to make this equation which probably seems laughable to you all because the question is so simple.
How can I plot points automatically from any coordinate to any other coordinate in a straight line, without using the LINE command?
I am trying to make a cone making program using the CIRCLE command and I not only need that answer, but also how to make a smooth rendition in radius from one to the other.
Does anyone know or can point me to somewhere that knows? Thanks. All of my games that involve a bad guy chasing you is just the simple (for example) if x < x2 then x=x+1. But it's not that easy when making a straight line when y is different of course. It's just been so many decades and I've looked on Google and I can't really find a way. There must be some kind of equation?

[SMcNeill]

Wouldn’t you just use the slope?

Rise = Y1 - Y2
Run = X1 - X2
Slope = Rise / Run

Then each time you move X steps, you increment Y by the slope * X.

Or move Y steps, you increment X by 1 / slope * Y.

(Or maybe vice versa.  It’s been a while, so I may have X/Y reversed.)

[OldMoses]

I concur with Steve on that one. Even dealing with a three dimensional environment, the principle of the thing should hold true. It only gets a little more difficult if you start converting between cartesian coordinates and polar ones. Then the trig rears its head.

[SierraKen]

LOL! I knew it had to be easy. Thanks guys! I will work on that probably tonight or tomorrow. I just been out of school for a very long time. lol

[SierraKen]

For some reason I can't get it to work. I've tried different variations and still nothing. I don't know if it's a negative and positive thing or what it could be. Here is the code I have so far. The first half is just asking people for the 2 sets of coordinates. I might be missing something huge or small.

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(800, 600, 32)
2. start:
3. _TITLE "Cone Maker - by Ken G."
4. _LIMIT 200
5. CLS
6. x1:
7. INPUT "X1 (0-800) = ", x1
8. IF x1 < 0 OR x1 > 800 THEN PRINT "Out of range, try again.": GOTO x1:
9. y1:
10. INPUT "Y1 (0-600) = ", y1
11. IF y1 < 0 OR y1 > 600 THEN PRINT "Out of range, try again.": GOTO y1:
12. r1:
13. INPUT "Radius (1-400) = ", r1
14. IF r1 < 1 OR r1 > 400 THEN PRINT "Out of range, try again.": GOTO r1:
15. x2:
16. INPUT "X2 (0-800) = ", x2
17. IF x2 < 0 OR x2 > 800 THEN PRINT "Out of range, try again.": GOTO x2:
18. y2:
19. INPUT "Y2 (0-600) = ", y2
20. IF y2 < 0 OR y2 > 600 THEN PRINT "Out of range, try again.": GOTO y2:
21. r2:
22. INPUT "Radius (1-400) = ", r2
23. IF r2 < 1 OR r2 > 400 THEN PRINT "Out of range, try again.": GOTO r2:
24. CLS
25. '-----------------------------------------------------------------------------------------------
26. rn = x1 - x2
27. rs = y1 - y2
28. slope = rs / rn
29. c = 50
30. DO
31.     x1 = slope * y1
32.     y1 = 1 / slope * x1
33.     c = c + 1
34.     CIRCLE (x1, y1), 10, _RGB32(0, c, 0)
35.     IF x1 > x2 - 2 AND x1 < x2 + 2 AND y1 > y2 - 2 AND y1 < y2 + 2 THEN END
36.  
37. LOOP
38.  

[SMcNeill]

Let’s say we want to draw a line from 100,100 to 200,200.

Your slope is going to end up being 1, so all you need is:

FOR I = 0 TO 100
    PSET (X1 + I,  Y1 + I * Slope)
NEXT

^ Each time your X-coordinate increases a step, you increase the Y-coordinate by the slope.

You’d plot at:
100,100
101,101
102,102
...
198,198
199,199
200,200

*Im not at a PC tonight, but I’ll write you an actual demo tomorrow, if no one else gets around to it before then.  ;)

[OldMoses]

If I'm understanding this project correctly, getting slope is only the beginning of the problem. Creating a cone from a circle brings in issues of perspective. What direction is the cone viewed from? Above, sidelong or obliquely? It's hard to represent a solid well without going into 3D (adding a Z axis to the equation), then the shading and/or ray tracing algorithm would have something to be based upon.

[SierraKen]

I think I might have got it! Or it's as close as I can get it so far. It's probably not perfect, might not even be perfect coordinates. And I know it's not perfect radius, might work with that later tomorrow.

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(800, 600, 32)
2. start:
3. _TITLE "Cone Maker - by Ken G."
4. _LIMIT 200
5. CLS
6. x1:
7. INPUT "X1 (0-800) = ", x1
8. IF x1 < 0 OR x1 > 800 THEN PRINT "Out of range, try again.": GOTO x1:
9. y1:
10. INPUT "Y1 (0-600) = ", y1
11. IF y1 < 0 OR y1 > 600 THEN PRINT "Out of range, try again.": GOTO y1:
12. r1:
13. INPUT "Radius (1-400) = ", r1
14. IF r1 < 1 OR r1 > 400 THEN PRINT "Out of range, try again.": GOTO r1:
15. x2:
16. INPUT "X2 (0-800) = ", x2
17. IF x2 < 0 OR x2 > 800 THEN PRINT "Out of range, try again.": GOTO x2:
18. y2:
19. INPUT "Y2 (0-600) = ", y2
20. IF y2 < 0 OR y2 > 600 THEN PRINT "Out of range, try again.": GOTO y2:
21. r2:
22. INPUT "Radius (1-400) = ", r2
23. IF r2 < 1 OR r2 > 400 THEN PRINT "Out of range, try again.": GOTO r2:
24. gap:
25. INPUT "Gap (.01-1) = ", gap
26. IF gap < .01 OR gap > 40 THEN PRINT "Out of range, try again.": GOTO r2:
27.  
28.  
29. CLS
30. rn = x1 - x2
31. rs = y1 - y2
32. slope = rs / rn
33. c = 50
34. DO
35.     x1 = slope + x1
36.     y1 = slope + y1
37.     r1 = slope + r1
38.     c = c + 1
39.     CIRCLE (x1, y1), r1, _RGB32(0, c, 0)
40.     IF x1 > x2 - 5 AND x1 < x2 + 5 AND y1 > y2 - 5 AND y1 < y2 + 5 THEN END
41.  
42. LOOP
43.  
44.  

[bplus]

This?

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(800, 600, 32)
2. x1 = 200
3. y1 = 50
4. x2 = 300
5. y2 = 300
6. CIRCLE (x1, y1), 1
7. CIRCLE (x2, y2), 1
8. dx = x2 - x1
9. dy = y2 - y1
10.  
11. 'y1 = x1 * dy/dx - yIntersect
12. yIntersect = x1 * dy / dx - y1
13.  
14. FOR x = x1 TO x2
15.     PSET (x, x * dy / dx - yIntersect)
16. NEXT
17.  
18. 'cone  axis ?
19. 'from y = 50 to y = 300 x = 200
20. LINE (200, 50)-(200, 300)
21.  
22. 'circles  of cone will have radius x - 200
23. 'circles of cone will have centers x = 200 y=some where between 50 and 300
24. FOR x = x1 TO x2 STEP 10
25.     CIRCLE (200, x * dy / dx - yIntersect), x - 200, &HFF008800, , , .1
26. NEXT
27.  
28.  

[SierraKen]

LOL bplus, you just got the Christmas Tree Award! Pretty awesome there.
I was more actually looking for 2 circles making a cone with 2 open ends. But I can try to work with yours sometime, thanks!

[bplus]

Pretty interesting Interference patterns:

Code: QB64: [Select]

1. _TITLE "Cone Trees,   press any for new scene..."
2. CONST xmax = 1280, ymax = 720, ymaxd2 = ymax / 2
3. SCREEN _NEWIMAGE(xmax, ymax, 32)
4. _SCREENMOVE 65, 5
5. RANDOMIZE TIMER
6. DO
7.     FOR y = 0 TO ymax / 2
8.         LINE (0, y)-(xmax, y), _RGB32(200, 100, 128 + 127 * y / ymaxd2), BF
9.     NEXT
10.     FOR y = ymax / 2 TO ymax
11.         yy = y - ymaxd2
12.  
13.         LINE (0, y)-(xmax, y), _RGB32(255 - 128 * yy / ymaxd2, 255 - 128 * yy / ymaxd2, 255 - 128 * yy / ymaxd2), BF
14.     NEXT
15.     FOR i = 1 TO 100
16.         x = RND * xmax:
17.         h = randWeight(10, ymax - 20, 8)
18.         y = (ymax - h) / 2: s = 2 * RND + 2
19.         drawCone x, y, h, s
20.     NEXT
21.     SLEEP
22. LOOP UNTIL _KEYDOWN(27)
23. SYSTEM
24.  
25. SUB drawCone (topX, topY, height, slope) 'slope 2 to 4 probably best
26.     x1 = topX
27.     y1 = topY
28.     y2 = y1 + height
29.     yIntersect = x1 * slope - y1
30.     LINE (x1, y1)-(x1, y2), &HFF884422
31.     FOR y = y1 TO y2 STEP 2
32.         x = (y + yIntersect) / slope
33.         CIRCLE (x1, y), x - x1, &H77008800, _PI, 2 * _PI, .1
34.     NEXT
35. END SUB
36.  
37. FUNCTION randWeight (manyValue, fewValue, power)
38.     randWeight = manyValue + RND ^ power * (fewValue - manyValue)
39. END FUNCTION
40.  
41.  

I was more actually looking for 2 circles making a cone with 2 open ends.

Ken can you find a picture of what you are talking about?
A mega horn shape?

[STxAxTIC]

Beautiful as usual bplus. I like when you take someone's code and run with it.

So ken, does the picture below kindof sketch what you want?

What you see are two ellipses (drawn by hand in paint, but we have the real thing in qb64), and then two lines. The lines don't necessarily touch the top of the ellipses, or any particular axis. Rather, they are a pair of tangent lines that just brush the two ellipses. The second screenshot shows a second case to help paint the picture.

To calculate those tangent lines, there are two methods... I bet I can predict the type of answers you'll receive - provided these pictures get close to your question... but think that Lagrange multipliers are the way to go. I'll cook up the latter solution for an exercise perhaps.

[Petr]

Hi SierraKen,

Try GETPOINTS  SUB, which i wrote for you now. Sub return array, which contains all points between two points (so as LINE it use)

Code: QB64: [Select]

1. 'LINE points to array
2.  
3. TYPE LinePoints
4.     X AS INTEGER
5.     Y AS INTEGER
6. END TYPE
7. REDIM SHARED LP(0) AS LinePoints
8.  
9. SCREEN _NEWIMAGE(800, 600, 32)
10.  
11. LINE (540, 99)-(100, 199)
12. GETPOINTS 540, 99, 100, 199, LP()
13. SLEEP
14. 'if all points in array are calctulated correctly, all points in LINE are draw yellow
15.  
16.  
17. FOR D = 0 TO UBOUND(lp)
18.     PSET (LP(D).X, LP(D).Y), &HFFFFFF00
19. NEXT D
20.  
21.  
22. SUB GETPOINTS (x1, y1, x2, y2, A() AS LinePoints)
23.     DIM lenght AS INTEGER
24.     lenght = _HYPOT(x1 - x2, y1 - y2) 'Fellippe Heitor show me using this great function.
25.     REDIM A(lenght) AS LinePoints
26.     FOR fill = 0 TO lenght
27.         IF x1 > x2 THEN A(fill).X = x1 - fill * ((x1 - x2) / lenght)
28.         IF x1 < x2 THEN A(fill).X = x1 + fill * ((x2 - x1) / lenght)
29.         IF x1 = x2 THEN A(fill).X = x1
30.         IF y1 > y2 THEN A(fill).Y = y1 - fill * ((y1 - y2) / lenght)
31.         IF y1 < y2 THEN A(fill).Y = y1 + fill * ((y2 - y1) / lenght)
32.         IF y1 = y2 THEN A(fill).Y = y1
33.     NEXT
34. END SUB
35.  

´

And for drawing circles and elipses...  here is one small part from my one program for QB64 draw... i am too lazy to degrade it for easiest use... For CIRCLE use, set CIRCLES size to 1.

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(800, 600, 32)
2.  
3. DO UNTIL _KEYHIT = 27
4.     Circles &HFFFF0000, 10
5. LOOP
6.  
7. SUB Circles (FColor~&, size)
8.     InitMouse mx, my, mb1, mb2
9.     omx = mx: omy = my
10.     PCOPY _DISPLAY, 1
11.  
12.     DO UNTIL mb1 = 0
13.         InitMouse mx, my, mb1, mb2
14.         PCOPY 1, _DISPLAY
15.         k& = _KEYHIT
16.  
17.         CX = (omx + mx) / 2
18.         CY = (omy + my) / 2
19.  
20.         r1 = ABS((omx - mx) / 2)
21.         r2 = ABS((omy - my) / 2)
22.  
23.         ratio = ABS((omy - my) / (omx - mx))
24.         IF k& = 32 THEN
25.             ratio = 1
26.             IF r1 >= r2 THEN r = r1 ELSE r = r2
27.             IF omx < mx THEN CX = omx + r ELSE CX = omx - r
28.             IF omy < my THEN CY = omy + r ELSE CY = omy - r
29.  
30.             IF mx <= omx THEN omx = CX - r: mx = CX + r
31.             IF mx > omx THEN omx = CX + r: mx = CX - r
32.  
33.             IF my <= omy THEN omy = CY - r: my = CY + r
34.             IF my > omy THEN omy = CY + r: my = CY - r
35.         END IF
36.         IF r1 >= r2 THEN r = r1 ELSE r = r2
37.         IF omx < mx THEN LineX1 = omx - size / 2: LineX2 = mx + size / 2 ELSE LineX1 = omx + size / 2: LineX2 = mx - size / 2
38.         IF omy < my THEN LineY1 = omy - size / 2: LineY2 = my + size / 2 ELSE LineY1 = omy + size / 2: LineY2 = my - size / 2
39.         LINE (LineX1, LineY1)-(LineX2, LineY2), &HFF888888, B , 127
40.  
41.  
42.  
43.  
44.         IF size = 1 THEN
45.             CIRCLE (CX, CY), r, FColor~&, , , ratio
46.         ELSE
47.             FOR k = 0 TO _PI(2) STEP .01
48.                 x1 = CX + COS(k) * r1
49.                 y1 = CY + SIN(k) * r2
50.                 IF k& = 32 THEN
51.                     rr1 = r
52.                     rr2 = r
53.                 ELSE
54.                     rr1 = r1
55.                     rr2 = r2
56.                 END IF
57.  
58.                 x2 = CX + COS(k + .035) * rr1
59.                 y2 = CY + SIN(k + .035) * rr2
60.  
61.                 TLine x1, y1, x2, y2, FColor~&, size
62.  
63.             NEXT k
64.         END IF
65.  
66.         _DISPLAY
67.         _LIMIT 20
68.     LOOP
69.     _AUTODISPLAY
70. END SUB
71.  
72. SUB TLine (x1, y1, x2, y2, kolor~&, size)
73.     lenght = SQR((x2 - x1) ^ 2 + (y2 - y1) ^ 2)
74.     '    angle = JK!(x1, y1, x2, y2, lenght)
75.     angle = JK2!(x1, y1, x2, y2)
76.  
77.     x5 = x1 + COS(angle - _PI(.5)) * size / 2
78.     y5 = y1 + SIN(angle - _PI(.5)) * size / 2
79.     x6 = x2 + COS(angle - _PI(.5)) * size / 2
80.     y6 = y2 + SIN(angle - _PI(.5)) * size / 2
81.  
82.     x3 = x1 + COS(angle + _PI(.5)) * size / 2 'Calculation of perpendicular vector. The default vector is X1, Y1 to X2, Y2. The JK function returns the angle of rotation of the vector, the perpendicular vector is shift by 90 degrees, (or PI /2) in radians.
83.     y3 = y1 + SIN(angle + _PI(.5)) * size / 2
84.     x4 = x2 + COS(angle + _PI(.5)) * size / 2
85.     y4 = y2 + SIN(angle + _PI(.5)) * size / 2
86.  
87.     v = _NEWIMAGE(100, 100, 32)
88.     d = _DEST
89.     _DEST v
90.     CLS , kolor~&
91.     _DEST d
92.  
93.     IF lenght THEN
94.         _MAPTRIANGLE (1, 1)-(99, 1)-(1, 99), v TO(x5, y5)-(x6, y6)-(x3, y3), _DEST, _SMOOTH
95.         _MAPTRIANGLE (99, 1)-(1, 99)-(99, 99), v TO(x6, y6)-(x3, y3)-(x4, y4), _DEST, _SMOOTH
96.     END IF
97.     _FREEIMAGE v
98. END SUB
99.  
100.  
101. SUB InitMouse (mx, my, mb1, mb2)
102.     WHILE _MOUSEINPUT: WEND
103.     mx = _MOUSEX
104.     my = _MOUSEY
105.     mb1 = _MOUSEBUTTON(1)
106.     mb2 = _MOUSEBUTTON(2)
107. END SUB
108.  
109. FUNCTION JK2! (x1, y1, x2, y2) 'X = cos, Y = sin
110.     JK2! = _ATAN2(y1 - y2, x1 - x2)
111.     IF JK2! < 0 THEN JK2! = _PI(2) + JK2!
112. END FUNCTION
113.  

I add here simple example how use CIRCLE collision detection and GETPOINTS.  The output is not 100% accurate.

Code: QB64: [Select]

1. TYPE LinePoints
2.     X AS INTEGER
3.     Y AS INTEGER
4. END TYPE
5. REDIM SHARED a(0) AS LinePoints 'contains X, Y for 1 LINE (40 points)
6. REDIM SHARED B(0) AS LinePoints 'contains X, Y for bottom and ceilings lines (40 points * 20 * 2)
7. REDIM SHARED c(0) AS LinePoints 'It contains points X, Y in a square cutout around the balloon
8.  
9. SCREEN _NEWIMAGE(800, 600, 32)
10.  
11.  
12. oldy = 40 + RND * 80
13. FOR u = 0 TO 760 STEP 40
14.     oldy = y
15.     y = 40 + RND * 150
16.     LINE (u, oldy)-(u + 40, y)
17.     GETPOINTS u, oldy, u + 40, y, a() 'save all LINE points to array A (ceiling)
18.     ADDPOINTS a(), B() '                         add this points to array B
19. NEXT
20.  
21. y = 560 - RND * 80
22. FOR u = 0 TO 760 STEP 40
23.     oldy = y
24.     y = 560 - RND * 130
25.     LINE (u, oldy)-(u + 40, y)
26.     GETPOINTS u, oldy, u + 40, y, a() 'save all LINE points to array A (bottom)
27.     ADDPOINTS a(), B() '                         add this points to array B
28. NEXT
29.  
30.  
31. TYPE ball
32.     X AS INTEGER
33.     Y AS INTEGER
34.     Xs AS INTEGER
35.     Ys AS INTEGER
36. END TYPE
37. DIM Ball AS ball
38.  
39. Ball.X = 400
40. Ball.Y = 300
41. Ball.Xs = 1
42. Ball.Ys = 1
43.  
44. PCOPY _DISPLAY, 1
45. DO
46.     PCOPY 1, _DISPLAY
47.     SORT Ball.X, Ball.Y, c() '           write VALIDS points for compars from array B to array C
48.     FOR test = 0 TO UBOUND(c)
49.         x = c(test).X
50.         y = c(test).Y
51.         xy& = _HYPOT(x - Ball.X, y - Ball.Y)
52.         IF 50 ^ 2 >= xy& THEN
53.             IF Ball.Y < 300 THEN Ball.Ys = 1 + ABS(_ATAN2(Ball.Ys - y, Ball.Xs - x)) ELSE Ball.Ys = -1 - ABS(_ATAN2(Ball.Ys - y, Ball.Xs - x))
54.         END IF
55.     NEXT
56.  
57.     IF Ball.X - 50 < 1 THEN Ball.Xs = 1
58.     IF Ball.X + 50 > 800 THEN Ball.Xs = -1
59.     IF Ball.Y - 50 < 1 THEN Ball.Ys = 1
60.     IF Ball.Y + 50 > 600 THEN Ball.Ys = -1
61.  
62.  
63.  
64.     CIRCLE (Ball.X, Ball.Y), 50
65.     Ball.X = Ball.X + Ball.Xs
66.     Ball.Y = Ball.Y + Ball.Ys
67.  
68.     _DISPLAY
69.     _LIMIT 30
70. LOOP
71.  
72. SUB SORT (x, y, c() AS LinePoints)
73.     REDIM c(0) AS LinePoints
74.     FOR t = 0 TO UBOUND(b)
75.         IF B(t).X > x - 50 AND B(t).X < x + 50 THEN
76.             IF B(t).Y > y - 50 AND B(t).Y < y + 50 THEN
77.                 c(i).X = B(t).X
78.                 c(i).Y = B(t).Y
79.                 i = i + 1
80.                 REDIM _PRESERVE c(i) AS LinePoints
81.             END IF
82.         END IF
83.     NEXT
84.     REDIM _PRESERVE c(i - 1) AS LinePoints
85. END SUB
86.  
87. SUB GETPOINTS (x1, y1, x2, y2, A() AS LinePoints)
88.     DIM lenght AS INTEGER
89.     lenght = _HYPOT(x1 - x2, y1 - y2) 'Fellippe Heitor show me using this great function.
90.     REDIM A(lenght) AS LinePoints
91.     FOR fill = 0 TO lenght
92.         IF x1 > x2 THEN A(fill).X = x1 - fill * ((x1 - x2) / lenght)
93.         IF x1 < x2 THEN A(fill).X = x1 + fill * ((x2 - x1) / lenght)
94.         IF x1 = x2 THEN A(fill).X = x1
95.         IF y1 > y2 THEN A(fill).Y = y1 - fill * ((y1 - y2) / lenght)
96.         IF y1 < y2 THEN A(fill).Y = y1 + fill * ((y2 - y1) / lenght)
97.         IF y1 = y2 THEN A(fill).Y = y1
98.     NEXT
99. END SUB
100.  
101. SUB ADDPOINTS (a() AS LinePoints, B() AS LinePoints)
102.     u = UBOUND(b)
103.     u2 = UBOUND(a)
104.     REDIM _PRESERVE B(u + u2) AS LinePoints
105.     FOR add = u TO u + u2
106.         B(add) = a(i)
107.         i = i + 1
108.     NEXT
109. END SUB
110.  

 

[SierraKen]

LOL Bplus, really cool forest!

Peter, those are some really great examples of finding coordinates, thanks! I might use your line and circle detection on some games if I get around to it. Thanks again. :)

Static, yes that's what I'm making. A person types in 2 X and Y coordinates and it makes 2 circles which are both ends of the cone. Then it draws more circles to go from one end to the other to form the cone. I tried also doing it with my circle code and using the LINE command at each point, going from 1 circle to the other. And it SORTA works. Except that most cones don't come out very good when the LINES go all the way around. So I changed it to the CIRCLE command, and that is how I needed the SLOPE equation and am still working with that. I am almost there though, will have to work with it later this afternoon. This is what I have so far..

By the way, just so you all know, I'm not in the process of making any huge program or game with this, am just making a Cone making program is all. And I thought that this would be good learning experience for myself and maybe others.

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(800, 600, 32)
2. start:
3. _TITLE "Cone Maker - by Ken G."
4. _LIMIT 200
5. CLS
6. x1:
7. INPUT "X1 (0-800) = ", x1
8. IF x1 < 0 OR x1 > 800 THEN PRINT "Out of range, try again.": GOTO x1:
9. y1:
10. INPUT "Y1 (0-600) = ", y1
11. IF y1 < 0 OR y1 > 600 THEN PRINT "Out of range, try again.": GOTO y1:
12. r1:
13. INPUT "Radius (1-400) = ", r1
14. IF r1 < 1 OR r1 > 400 THEN PRINT "Out of range, try again.": GOTO r1:
15. x2:
16. INPUT "X2 (0-800) = ", x2
17. IF x2 < 0 OR x2 > 800 THEN PRINT "Out of range, try again.": GOTO x2:
18. y2:
19. INPUT "Y2 (0-600) = ", y2
20. IF y2 < 0 OR y2 > 600 THEN PRINT "Out of range, try again.": GOTO y2:
21. r2:
22. INPUT "Radius (1-400) = ", r2
23. IF r2 < 1 OR r2 > 400 THEN PRINT "Out of range, try again.": GOTO r2:
24. gap:
25. INPUT "Gap (.01-1) = ", gap
26. IF gap < .01 OR gap > 40 THEN PRINT "Out of range, try again.": GOTO r2:
27.  
28.  
29. CLS
30. rn = x1 - x2
31. rs = y1 - y2
32. slope = rs / rn
33. c = 50
34. DO
35.     x1 = slope + x1
36.     y1 = slope + y1
37.     r1 = slope + r1
38.     c = c + 1
39.     CIRCLE (x1, y1), r1, _RGB32(0, c, 0)
40.     IF x1 > x2 - 5 AND x1 < x2 + 5 AND y1 > y2 - 5 AND y1 < y2 + 5 THEN END
41.  
42. LOOP
43.  

[bplus]

Hi STxAxTIC,

I discovered that this works only part of the time, from ToolBox:

Code: QB64: [Select]

1. 'STxAxTIC this is not filling correctly all the time, only sometimes works
2. SUB EllipseTiltFill (destHandle&, CX, CY, a, b, ang, C AS _UNSIGNED LONG)
3.     '  destHandle& = destination handle
4.     '  CX = center x coordinate
5.     '  CY = center y coordinate
6.     '   a = semimajor axis
7.     '   b = semiminor axis
8.     ' ang = clockwise orientation of semimajor axis in radians (0 default)
9.     '   C = fill color
10.     DIM max AS INTEGER, mx2 AS INTEGER, i AS INTEGER, j AS INTEGER
11.     DIM prc AS _UNSIGNED LONG
12.     DIM D AS INTEGER, S AS INTEGER
13.     D = _DEST: S = _SOURCE
14.     prc = _RGB32(255, 255, 255, 255)
15.     IF a > b THEN max = a + 1 ELSE max = b + 1
16.     mx2 = max + max
17.     tef& = _NEWIMAGE(mx2, mx2)
18.     _DEST tef&
19.     _SOURCE tef&
20.     FOR k = 0 TO 6.283185307179586 + .025 STEP .025
21.         i = max + a * COS(k) * COS(ang) + b * SIN(k) * SIN(ang)
22.         j = max + a * COS(k) * SIN(ang) - b * SIN(k) * COS(ang)
23.         IF k <> 0 THEN
24.             LINE (lasti, lastj)-(i, j), prc
25.         ELSE
26.             PSET (i, j), prc
27.         END IF
28.         lasti = i: lastj = j
29.     NEXT
30.     DIM xleft(mx2) AS INTEGER, xright(mx2) AS INTEGER, x AS INTEGER, y AS INTEGER
31.     FOR y = 0 TO mx2
32.         x = 0
33.         WHILE POINT(x, y) <> prc AND x < mx2
34.             x = x + 1
35.         WEND
36.         xleft(y) = x
37.         WHILE POINT(x, y) = prc AND x < mx2
38.             x = x + 1
39.         WEND
40.         WHILE POINT(x, y) <> prc AND x < mx2
41.             x = x + 1
42.         WEND
43.         IF x = mx2 THEN xright(y) = xleft(y) ELSE xright(y) = x
44.     NEXT
45.     _DEST destHandle&
46.     FOR y = 0 TO mx2
47.         IF xleft(y) <> mx2 THEN LINE (xleft(y) + CX - max, y + CY - max)-(xright(y) + CX - max, y + CY - max), C, BF
48.     NEXT
49.     _DEST D: _DEST S
50.     _FREEIMAGE tef&
51. END SUB

Here is my test code for drawing Megaphones:

Code: QB64: [Select]

1. _TITLE "Draw megaphone Test, click 4 points in clockwise direction first pair is one opening and 2nd is 2nd." 'B+ 2019-12-15
2. CONST xmax = 800, ymax = 600
3. SCREEN _NEWIMAGE(xmax, ymax, 32)
4. _SCREENMOVE 300, 40
5.  
6. DO
7.     CLS
8.     WHILE pi < 4 'get 4 mouse clicks >>>>>>>>>>>>>>>>>>>> HERE pi means Point Index not _PI
9.         _PRINTSTRING (5, 5), SPACE$(20)
10.         _PRINTSTRING (5, 5), "Need 4 clicks, have" + STR$(pi)
11.         WHILE _MOUSEINPUT: WEND
12.         IF _MOUSEBUTTON(1) AND oldMouse = 0 THEN 'new mouse down
13.             pi = pi + 1
14.             mx(pi) = _MOUSEX: my(pi) = _MOUSEY
15.             CIRCLE (mx(pi), my(pi)), 2
16.         END IF
17.         oldMouse = _MOUSEBUTTON(1)
18.         _DISPLAY
19.         _LIMIT 60
20.     WEND
21.     LINE (mx(2), my(2))-(mx(3), my(3))
22.     LINE (mx(4), my(4))-(mx(1), my(1))
23.     ang1 = _ATAN2(my(2) - my(1), mx(2) - mx(1))
24.     maj1 = (_HYPOT(mx(1) - mx(2), my(1) - my(2))) / 2
25.     min1 = .1 * maj1
26.     cx1 = (mx(1) + mx(2)) / 2
27.     cy1 = (my(1) + my(2)) / 2
28.     EllipseTilt cx1, cy1, maj1, min1, ang1, &HFF0000FF
29.     ang2 = _ATAN2(my(3) - my(4), mx(3) - mx(4))
30.     maj2 = (_HYPOT(mx(3) - mx(4), my(3) - my(4))) / 2
31.     min2 = .1 * maj2
32.     cx2 = (mx(3) + mx(4)) / 2
33.     cy2 = (my(3) + my(4)) / 2
34.     EllipseTilt cx2, cy2, maj2, min2, ang2, &HFF0000FF
35.     _DISPLAY
36.     _DELAY 3
37.     CLS
38.     EllipseTiltFill 0, cx2, cy2, maj2, min2, ang2, &HFF0000FF
39.     fquad mx(1), my(1), mx(2), my(2), mx(3), my(3), mx(4), my(4), &HFF0000FF
40.     EllipseTiltFill 0, cx1, cy1, maj1, min1, ang1, &HFFFF0000
41.     _DISPLAY
42.     _DELAY 3
43.  
44.     pi = 0 'point index
45. LOOP UNTIL _KEYDOWN(27)
46.  
47.  
48.  
49. 'thanks STxAxTIC from Toolbox
50. SUB EllipseTilt (CX, CY, a, b, ang, C AS _UNSIGNED LONG)
51.     DIM k, i, j
52.     '  CX = center x coordinate
53.     '  CY = center y coordinate
54.     '   a = semimajor axis  major radius
55.     '   b = semiminor axis  minor radius
56.     ' ang = clockwise orientation of semimajor axis in radians (0 default)
57.     '   C = fill color
58.     FOR k = 0 TO 6.283185307179586 + .025 STEP .025
59.         i = a * COS(k) * COS(ang) + b * SIN(k) * SIN(ang)
60.         j = -a * COS(k) * SIN(ang) + b * SIN(k) * COS(ang)
61.         i = i + CX
62.         j = -j + CY
63.         IF k <> 0 THEN
64.             LINE -(i, j), C, BF
65.         ELSE
66.             PSET (i, j), C
67.         END IF
68.     NEXT
69. END SUB
70.  
71. 'STxAxTIC this is not filling correctly all the time, only sometimes works
72. SUB EllipseTiltFill (destHandle&, CX, CY, a, b, ang, C AS _UNSIGNED LONG)
73.     '  destHandle& = destination handle
74.     '  CX = center x coordinate
75.     '  CY = center y coordinate
76.     '   a = semimajor axis
77.     '   b = semiminor axis
78.     ' ang = clockwise orientation of semimajor axis in radians (0 default)
79.     '   C = fill color
80.     DIM max AS INTEGER, mx2 AS INTEGER, i AS INTEGER, j AS INTEGER
81.     DIM prc AS _UNSIGNED LONG
82.     DIM D AS INTEGER, S AS INTEGER
83.     D = _DEST: S = _SOURCE
84.     prc = _RGB32(255, 255, 255, 255)
85.     IF a > b THEN max = a + 1 ELSE max = b + 1
86.     mx2 = max + max
87.     tef& = _NEWIMAGE(mx2, mx2)
88.     _DEST tef&
89.     _SOURCE tef&
90.     FOR k = 0 TO 6.283185307179586 + .025 STEP .025
91.         i = max + a * COS(k) * COS(ang) + b * SIN(k) * SIN(ang)
92.         j = max + a * COS(k) * SIN(ang) - b * SIN(k) * COS(ang)
93.         IF k <> 0 THEN
94.             LINE (lasti, lastj)-(i, j), prc
95.         ELSE
96.             PSET (i, j), prc
97.         END IF
98.         lasti = i: lastj = j
99.     NEXT
100.     DIM xleft(mx2) AS INTEGER, xright(mx2) AS INTEGER, x AS INTEGER, y AS INTEGER
101.     FOR y = 0 TO mx2
102.         x = 0
103.         WHILE POINT(x, y) <> prc AND x < mx2
104.             x = x + 1
105.         WEND
106.         xleft(y) = x
107.         WHILE POINT(x, y) = prc AND x < mx2
108.             x = x + 1
109.         WEND
110.         WHILE POINT(x, y) <> prc AND x < mx2
111.             x = x + 1
112.         WEND
113.         IF x = mx2 THEN xright(y) = xleft(y) ELSE xright(y) = x
114.     NEXT
115.     _DEST destHandle&
116.     FOR y = 0 TO mx2
117.         IF xleft(y) <> mx2 THEN LINE (xleft(y) + CX - max, y + CY - max)-(xright(y) + CX - max, y + CY - max), C, BF
118.     NEXT
119.     _DEST D: _DEST S
120.     _FREEIMAGE tef&
121. END SUB
122.  
123. '2019-11-20 Steve saves some time with STATIC and saves and restores last dest
124. SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
125.     DIM D AS LONG
126.     STATIC a&
127.     D = _DEST
128.     IF a& = 0 THEN a& = _NEWIMAGE(1, 1, 32)
129.     _DEST a&
130.     PSET (0, 0), K
131.     _DEST D
132.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
133. END SUB
134.  
135. 'need 4 non linear points (not all on 1 line) list them clockwise so x2, y2 is opposite of x4, y4
136. SUB fquad (x1, y1, x2, y2, x3, y3, x4, y4, K AS _UNSIGNED LONG)
137.     ftri x1, y1, x2, y2, x4, y4, K
138.     ftri x3, y3, x2, y2, x4, y4, K
139. END SUB
140.  
141.  

BTW, the new trick for getting clear of mousebutton click with oldMouse variable, Steve's trick, is working great and Thanks to Petr and Fellippe for reporting _HYPOT() that's got to be faster than soft-coded distance calculations.