Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: SierraKen on December 14, 2019, 07:42:40 pm

Title: Simple coordinates equation or impossible coordinates equation?
Post by: SierraKen on December 14, 2019, 07:42:40 pm
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?
Title: Re: Simple coordinates equation or impossible coordinates equation?
Post by: SMcNeill on December 14, 2019, 07:51:39 pm
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.)
Title: Re: Simple coordinates equation or impossible coordinates equation?
Post by: OldMoses on December 14, 2019, 08:05:31 pm
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.
Title: Re: Simple coordinates equation or impossible coordinates equation?
Post by: SierraKen on December 14, 2019, 08:16:07 pm
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
Title: Re: Simple coordinates equation or impossible coordinates equation?
Post by: SierraKen on December 14, 2019, 09:15:07 pm
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
  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:
  25. '-----------------------------------------------------------------------------------------------
  26. rn = x1 - x2
  27. rs = y1 - y2
  28. slope = rs / rn
  29. c = 50
  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.  
  38.  
Title: Re: Simple coordinates equation or impossible coordinates equation?
Post by: SMcNeill on December 14, 2019, 09:31:48 pm
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.  ;)
Title: Re: Simple coordinates equation or impossible coordinates equation?
Post by: OldMoses on December 14, 2019, 09:47:24 pm
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.
Title: Re: Simple coordinates equation or impossible coordinates equation?
Post by: SierraKen on December 14, 2019, 10:02:44 pm
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
  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.  
  30. rn = x1 - x2
  31. rs = y1 - y2
  32. slope = rs / rn
  33. c = 50
  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.  
  43.  
  44.  




Title: Re: Simple coordinates equation or impossible coordinates equation?
Post by: bplus on December 14, 2019, 11:05:01 pm
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)
  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
  27.  
  28.  
Title: Re: Simple coordinates equation or impossible coordinates equation?
Post by: SierraKen on December 14, 2019, 11:35:45 pm
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!
Title: Re: Simple coordinates equation or impossible coordinates equation?
Post by: bplus on December 15, 2019, 12:45:01 am
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)
  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
  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
  36.  
  37. FUNCTION randWeight (manyValue, fewValue, power)
  38.     randWeight = manyValue + RND ^ power * (fewValue - manyValue)
  40.  
  41.  


Quote
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?
Title: Re: Simple coordinates equation or impossible coordinates equation?
Post by: STxAxTIC on December 15, 2019, 04:02:55 am
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.
Title: Re: Simple coordinates equation or impossible coordinates equation?
Post by: Petr on December 15, 2019, 08:10:59 am
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
  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()
  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
  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
  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.  
  4.     Circles &HFFFF0000, 10
  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
  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
  99.  
  100.  
  101. SUB InitMouse (mx, my, mb1, mb2)
  103.     mx = _MOUSEX
  104.     my = _MOUSEY
  105.     mb1 = _MOUSEBUTTON(1)
  106.     mb2 = _MOUSEBUTTON(2)
  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!
  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
  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
  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
  29.  
  30.  
  31. TYPE ball
  32.     X AS INTEGER
  33.     Y AS INTEGER
  34.     Xs AS INTEGER
  35.     Ys AS INTEGER
  37. DIM Ball AS ball
  38.  
  39. Ball.X = 400
  40. Ball.Y = 300
  41. Ball.Xs = 1
  42. Ball.Ys = 1
  43.  
  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
  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
  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
  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
  110.  

 


Title: Re: Simple coordinates equation or impossible coordinates equation?
Post by: SierraKen on December 15, 2019, 12:31:48 pm
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
  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.  
  30. rn = x1 - x2
  31. rs = y1 - y2
  32. slope = rs / rn
  33. c = 50
  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.  
  43.  
Title: Re: Simple coordinates equation or impossible coordinates equation?
Post by: bplus on December 15, 2019, 12:46:54 pm
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&


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.  
  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
  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
  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&
  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)
  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
  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.


Title: Re: Simple coordinates equation or impossible coordinates equation?
Post by: STxAxTIC on December 15, 2019, 01:59:37 pm
Hey bplus,

You're welcome to try to tweak that busted function if you find the time. I remember that whole development arc well - and judging the lion by his claw, whoever put the finishing touches on ellipsetiltfill was definitely not me. On the other hand, ellipsetilt and ellipsefill still look like my handywork. In other words, that error started with someone else. I'll try to find it if you don't get there first.
Title: Re: Simple coordinates equation or impossible coordinates equation?
Post by: Petr on December 15, 2019, 04:40:04 pm
I didn't really understand too much, about what you and STxAxTIC are talking about here. Is it about drawing a cone? Or to fill in an ellipse? I tried a simple program to fill the cone. I had to use the trick to get the right bottom diameter. When I wanted to calculate it (we will not lie, mathematics is my death), so it just did not work. The angle to be entered is the angle at the top of the cone. I tried to count it all through the sinus theorem. Unfortunately, probably because of the sum of the angles in the triangle, where their sum is 180 degrees, the angle at the vertex cannot be greater than 90 degrees. (Or, again, bug is here between keyboard and chair)  :)

Code: QB64: [Select]
  1. SCREEN _NEWIMAGE(800, 600, 256)
  2.  
  3. tm = 1
  5.     t = t + tm
  6.     CLS
  7.     R 400, 50, 300, t
  8.     LOCATE 1: PRINT t
  9.     SLEEP
  10.     IF t > 90 OR t < 1 THEN tm = tm * -1
  12.  
  13.  
  14. SUB R (hx, hy, v, u)
  15.     uu = _D2R(u) '                       angle on top vertex
  16.     y = hy + v '                         lower y = upper y + v (v = height)
  17.     polomer = SIN(uu) * v '              radius on bottom
  18.  
  19.  
  20.     nx1 = hx - (polomer * SIN(uu)) '     left X point on radius
  21.     nx2 = hx + (polomer * SIN(uu)) '     right X point on radius
  22.  
  23.     de = (nx2 - nx1) / 2 '              radius for ellipse
  24.     CIRCLE (hx, y), de, 14, _PI, _PI(2), .1
  25.     LINE (nx1, y)-(hx, hy), 14
  26.     LINE (nx2, y)-(hx, hy), 14
  27.     PAINT (hx, hy + v / 2), 14, 14
  29.  
Title: Re: Simple coordinates equation or impossible coordinates equation?
Post by: SierraKen on December 15, 2019, 04:51:19 pm
That's neat Petr, that draws cones similar to what bplus made. But what I am going for is probably even harder. I want 2 open ended circles, one on each end. Like the second one bplus made which is really good and he calls them megaphones.  A circle on each end, like a tube. But one circle is a different size than the other. And not just filled in like with PAINT or something, but with a 3D effect using low to high shades of color. Like a megaphone. I apologize for saying 2D earlier, I was wrong. Here is the first way I made it earlier using my circle code and LINE commands for each point. But using the full circles draws just too much I think, or the shade is off. I added the Save feature when I was wanting to save these to .bmp.

Code: QB64: [Select]
  1. SCREEN _NEWIMAGE(800, 600, 32)
  2. start:
  3. _TITLE "Cone Maker - by Ken G."
  4. _LIMIT 1000
  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. gaps:
  25. INPUT "Gap Space (.01-5) = ", gap
  26. IF gap < .01 THEN PRINT "Gap is too small, try again.": GOTO gaps:
  28. one:
  29. _LIMIT 1000
  30. seconds = seconds + gap
  31. s = (60 - seconds) * 6 + 180
  32. xx1 = INT(SIN(s / 180 * 3.141592) * r1) + x1
  33. xx2 = INT(SIN(s / 180 * 3.141592) * r2) + x2
  34. yy1 = INT(COS(s / 180 * 3.141592) * r1) + y1
  35. yy2 = INT(COS(s / 180 * 3.141592) * r2) + y2
  36.  
  37. CIRCLE (xx1, yy1), 2, _RGB32(127, 216, 127)
  38. CIRCLE (xx2, yy2), 2, _RGB32(127, 216, 127)
  39. LINE (xx1, yy1)-(xx2, yy2), _RGB32(0, seconds * 4, 0)
  40. IF seconds > 60 THEN
  41.     seconds = 0
  42.     _TITLE "Press S to Save to .bmp file, or do again press Y or N."
  43.     GOTO again:
  45. GOTO one:
  46. again:
  47. ag$ = INKEY$
  48. IF ag$ = "y" OR ag$ = "Y" THEN GOTO start:
  49. IF ag$ = "n" OR ag$ = "N" THEN END
  50. IF ag$ = "s" OR ag$ = "S" THEN GOTO saving:
  51. GOTO again:
  52.  
  53. 'This section saves the calendar to a BMP file along with the SUB at the end of this program.
  54. saving:
  55. 'Saving
  56. 'This section first saves your picture as temp.bmp and then
  57. 'asks you a name for your picture and then renames temp.bmp to your name.
  58. _TITLE "Saving"
  59. 'Now we call up the SUB to save the image to BMP.
  60. SaveImage 0, "temp.bmp"
  61. _DELAY .25
  65. PRINT "                       Saving"
  67. PRINT "         Your bmp file will be saved in the"
  68. PRINT "         same directory as this program is."
  69. PRINT "         It can be used with almost any"
  70. PRINT "         other graphics program or website."
  71. PRINT "         It is saved using:"
  72. PRINT "         width: 800  height: 600 pixels."
  74. PRINT "         Type a name to save your picture"
  75. PRINT "         and press the Enter key. Do not"
  76. PRINT "         add .bmp at the end, the program"
  77. PRINT "         will do it automatically."
  79. PRINT "         Also do not use the name temp"
  80. PRINT "         because the program uses that name"
  81. PRINT "         and it would be erased the next time"
  82. PRINT "         you save a picture."
  83. PRINT "         Example: MyPic"
  84. PRINT "         Quit and Enter key ends program."
  86. INPUT "         ->"; nm$
  87. IF nm$ = "Quit" OR nm$ = "quit" OR nm$ = "QUIT" THEN END
  88. nm$ = nm$ + ".bmp"
  89. 'Checking to see if the file already exists on your computer.
  90. theFileExists = _FILEEXISTS(nm$)
  91. IF theFileExists = -1 THEN
  92.     PRINT
  93.     PRINT "       File Already Exists"
  94.     PRINT "       Saving will delete your old"
  95.     PRINT "       bmp picture."
  96.     PRINT "       Would you like to still do it?"
  97.     PRINT "       (Y/N)."
  98.     PRINT "       Esc goes to start screen."
  99.     llloop:
  100.     _LIMIT 100
  101.     ag2$ = INKEY$
  102.     IF ag2$ = CHR$(27) THEN GOTO start:
  103.     IF ag2$ = "" THEN GOTO llloop:
  104.     IF ag2$ = "y" OR ag$ = "Y" THEN
  105.         SHELL _HIDE "DEL " + nm$
  106.         GOTO saving2:
  107.     END IF
  108.     GOTO llloop:
  110. saving2:
  111. SHELL _HIDE "REN " + "temp.bmp" + " " + nm$
  112. nm$ = ""
  113. FOR snd = 100 TO 700 STEP 100
  114.     SOUND snd, 2
  115. NEXT snd
  116. m = 0
  117. _TITLE "Cone Maker - by Ken G."
  119. GOTO start:
  120.  
  121.  
  122. 'This section saves the .bmp picture file.
  123. SUB SaveImage (image AS LONG, filename AS STRING)
  124.     bytesperpixel& = _PIXELSIZE(image&)
  125.     IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
  126.     IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
  127.     x& = _WIDTH(image&)
  128.     y& = _HEIGHT(image&)
  129.     b$ = "BM????QB64????" + MKL$(40) + MKL$(x&) + MKL$(y&) + MKI$(1) + MKI$(bpp&) + MKL$(0) + "????" + STRING$(16, 0) 'partial BMP header info(???? to be filled later)
  130.     IF bytesperpixel& = 1 THEN
  131.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
  132.             cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
  133.             b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
  134.         NEXT
  135.     END IF
  136.     MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
  137.     lastsource& = _SOURCE
  138.     _SOURCE image&
  139.     IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
  140.     FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
  141.         r$ = ""
  142.         FOR px& = 0 TO x& - 1
  143.             c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
  144.             IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
  145.         NEXT px&
  146.         d$ = d$ + r$ + padder$
  147.     NEXT py&
  148.     _SOURCE lastsource&
  149.     MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
  150.     b$ = b$ + d$ ' total file data bytes to create file
  151.     MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
  152.     IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
  153.     f& = FREEFILE
  154.     OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
  155.     OPEN filename$ + ext$ FOR BINARY AS #f&
  156.     PUT #f&, , b$
  157.     CLOSE #f&
  159.  
  160.  

Title: Re: Simple coordinates equation or impossible coordinates equation?
Post by: bplus on December 15, 2019, 05:05:24 pm
Wow has this test code revealed allot of messed up things:
First tiltedEllipseFill then
fTri: Steves recent mods adding STATIC and removing _FREEIMAGE, do not work with transparencies specially in my quad function which merely calls fTri twice.
RotoZoom2, tried and true was leaving seams in the rotozoomed rotated filled ellipsii

So all those fixed now, I left transparencies in to show the nice seamless tilted ellipsii fills, Ken just replace with solid colors for 3D faking, just replace 2x's in the &Hxx.... with &HFF:
Code: QB64: [Select]
  1. _TITLE "fTiltEllipse tests" 'b+ 2019-12-15
  2. 'test code from "Draw megaphone Test, click 4 points in clockwise direction first pair is one opening and 2nd is 2nd." 'B+ 2019-12-15
  3.  
  4. CONST xmax = 800, ymax = 600
  5. SCREEN _NEWIMAGE(xmax, ymax, 32)
  6. _SCREENMOVE 300, 40
  7.  
  9.     CLS
  10.     WHILE pi < 4 'get 4 mouse clicks
  11.         _PRINTSTRING (5, 5), SPACE$(20)
  12.         _PRINTSTRING (5, 5), "Need 4 clicks, have" + STR$(pi)
  13.         WHILE _MOUSEINPUT: WEND
  14.         IF _MOUSEBUTTON(1) AND oldMouse = 0 THEN 'new mouse down
  15.             pi = pi + 1
  16.             mx(pi) = _MOUSEX: my(pi) = _MOUSEY
  17.             CIRCLE (mx(pi), my(pi)), 2
  18.         END IF
  19.         oldMouse = _MOUSEBUTTON(1)
  20.         _DISPLAY
  21.         _LIMIT 60
  22.     WEND
  23.     LINE (mx(2), my(2))-(mx(3), my(3))
  24.     LINE (mx(4), my(4))-(mx(1), my(1))
  25.     ang1 = _ATAN2(my(2) - my(1), mx(2) - mx(1))
  26.     maj1 = (_HYPOT(mx(1) - mx(2), my(1) - my(2))) / 2
  27.     min1 = .1 * maj1
  28.     cx1 = (mx(1) + mx(2)) / 2
  29.     cy1 = (my(1) + my(2)) / 2
  30.     EllipseTilt cx1, cy1, maj1, min1, ang1, &HFFFFFFFF
  31.     ang2 = _ATAN2(my(3) - my(4), mx(3) - mx(4))
  32.     maj2 = (_HYPOT(mx(3) - mx(4), my(3) - my(4))) / 2
  33.     min2 = .1 * maj2
  34.     cx2 = (mx(3) + mx(4)) / 2
  35.     cy2 = (my(3) + my(4)) / 2
  36.     EllipseTilt cx2, cy2, maj2, min2, ang2, &HFFFFFFFF
  37.     _DISPLAY
  38.     _DELAY 3
  39.     CLS
  40.     _PRINTSTRING (5, 5), "Sleeping, wake with click or keypress..."
  41.     fTiltEllipse 0, cx2, cy2, maj2, min2, ang2, &H880000FF 'check trnasparency
  42.     fquad mx(1), my(1), mx(2), my(2), mx(3), my(3), mx(4), my(4), &H880000FF
  43.     fTiltEllipse 0, cx1, cy1, maj1, min1, ang1, &H88FFFF00
  44.     _DISPLAY
  45.     cSleep 45
  46.  
  47.     pi = 0 'point index
  49.  
  50.  
  51.  
  52. 'thanks STxAxTIC from Toolbox
  53. SUB EllipseTilt (CX, CY, a, b, ang, C AS _UNSIGNED LONG)
  54.     DIM k, i, j
  55.     '  CX = center x coordinate
  56.     '  CY = center y coordinate
  57.     '   a = semimajor axis  major radius
  58.     '   b = semiminor axis  minor radius
  59.     ' ang = clockwise orientation of semimajor axis in radians (0 default)
  60.     '   C = fill color
  61.     FOR k = 0 TO 6.283185307179586 + .025 STEP .025
  62.         i = a * COS(k) * COS(ang) + b * SIN(k) * SIN(ang)
  63.         j = -a * COS(k) * SIN(ang) + b * SIN(k) * COS(ang)
  64.         i = i + CX
  65.         j = -j + CY
  66.         IF k <> 0 THEN
  67.             LINE -(i, j), C
  68.         ELSE
  69.             PSET (i, j), C
  70.         END IF
  71.     NEXT
  73.  
  74. 'relace broken toolbax code
  75. 'this needs RotoZoom3 to rotate image BUT it can now scale it also!
  76. SUB fTiltEllipse (destH AS LONG, ox AS INTEGER, oy AS INTEGER, majorRadius AS INTEGER, minorRadius AS INTEGER, radianAngle AS SINGLE, c AS _UNSIGNED LONG)
  77.     'setup isolated area, draw fFlatEllipse and then RotoZoom the image into destination
  78.     'ox, oy is center of ellipse
  79.     'majorRadius is 1/2 the lonest axis
  80.     'minorRadius is 1/2 the short axis
  81.     'radianAngle is the Radian Angle of Tilt
  82.     'c is of course color
  83.     sd& = _DEST
  84.     temp& = _NEWIMAGE(2 * majorRadius, 2 * minorRadius, 32)
  85.     _DEST temp&
  86.     fEllipse majorRadius, minorRadius, majorRadius, minorRadius, c
  87.     _DEST destH
  88.     RotoZoom3 ox, oy, temp&, 1, 1, radianAngle
  89.     _FREEIMAGE temp&
  90.     _DEST sd&
  92.  
  93. 'modified 2019-12-15 _seamless added, rotation convert to radians
  94. SUB RotoZoom3 (X AS LONG, Y AS LONG, Image AS LONG, xScale AS SINGLE, yScale AS SINGLE, radianRotation AS SINGLE) ' 0 at end means no scaling of x or y
  95.     DIM px(3) AS SINGLE: DIM py(3) AS SINGLE
  96.     W& = _WIDTH(Image&): H& = _HEIGHT(Image&)
  97.     px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
  98.     px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
  99.     sinr! = SIN(-radianRotation): cosr! = COS(-radianRotation)
  100.     FOR i& = 0 TO 3
  101.         x2& = (px(i&) * cosr! + sinr! * py(i&)) + X * xScale: y2& = (py(i&) * cosr! - px(i&) * sinr!) + Y * yScale
  102.         px(i&) = x2&: py(i&) = y2&
  103.     NEXT
  104.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
  105.     _MAPTRIANGLE _SEAMLESS(0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
  107.  
  108. 'this seems to work as well as any
  109. SUB fEllipse (CX AS LONG, CY AS LONG, xRadius AS LONG, yRadius AS LONG, c AS _UNSIGNED LONG)
  110.     DIM scale AS SINGLE, x AS LONG, y AS LONG
  111.     scale = yRadius / xRadius
  112.     LINE (CX, CY - yRadius)-(CX, CY + yRadius), c, BF
  113.     FOR x = 1 TO xRadius
  114.         y = scale * SQR(xRadius * xRadius - x * x)
  115.         LINE (CX + x, CY - y)-(CX + x, CY + y), c, BF
  116.         LINE (CX - x, CY - y)-(CX - x, CY + y), c, BF
  117.     NEXT
  119.  
  120. ' found at [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]:    http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=14425.0
  121. SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
  122.     DIM D AS LONG
  123.     D = _DEST
  124.     a& = _NEWIMAGE(1, 1, 32)
  125.     _DEST a&
  126.     PSET (0, 0), K
  127.     _DEST D
  128.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
  129.     _FREEIMAGE a& '<<< this is important!
  131.  
  132. '2019-11-20 Steve saves some time with STATIC and saves and restores last dest
  133. SUB ftri1 (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
  134.     DIM D AS LONG
  135.     STATIC a&
  136.     D = _DEST
  137.     IF a& = 0 THEN a& = _NEWIMAGE(1, 1, 32)
  138.     _DEST a&
  139.     PSET (0, 0), K
  140.     _DEST D
  141.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
  143.  
  144. 'need 4 non linear points (not all on 1 line) list them clockwise so x2, y2 is opposite of x4, y4
  145. SUB fquad (x1, y1, x2, y2, x3, y3, x4, y4, K AS _UNSIGNED LONG)
  146.     ftri x1, y1, x2, y2, x4, y4, K
  147.     ftri x3, y3, x2, y2, x4, y4, K
  149.  
  150. SUB cSleep (secsWait AS DOUBLE) 'wait for keypress or mouseclick, solves midnight problem nicely I think
  151.     DIM wayt AS INTEGER, oldMouse AS INTEGER, k AS LONG, startTime AS DOUBLE
  152.  
  153.     startTime = TIMER
  154.     wayt = 1
  155.     _KEYCLEAR
  156.     WHILE wayt
  157.         WHILE _MOUSEINPUT: WEND
  158.         IF _MOUSEBUTTON(1) AND oldMouse = 0 THEN wayt = 0
  159.         oldMouse = _MOUSEBUTTON(1) ' <<< this is Steve's cool way to get clear of mouse click
  160.         k = _KEYHIT: IF k > 0 THEN _KEYCLEAR: wayt = 0
  161.         IF TIMER - startTime < 0 THEN 'past midnight
  162.             IF TIMER + 24 * 60 * 60 - startTime > secsWait THEN wayt = 0
  163.         ELSE
  164.             IF TIMER - startTime >= secsWait THEN wayt = 0
  165.         END IF
  166.         _LIMIT 30
  167.     WEND
  169.  
  170.  

Title: Re: Simple coordinates equation or impossible coordinates equation?
Post by: SierraKen on December 15, 2019, 05:42:09 pm
Bplus, that works great!
Title: Re: Simple coordinates equation or impossible coordinates equation?
Post by: SMcNeill on December 16, 2019, 12:55:09 am
Isn't this simple little demo what you were trying to accomplish?

Code: QB64: [Select]
  1. SCREEN _NEWIMAGE(800, 600, 32)
  2.  
  3. LINE (100, 100)-(200, 300)
  4. Cone 100, 100, 10, 200, 300, 30, &H77FFFFFF
  5. LINE (100, 300)-(300, 100)
  6. Cone 100, 300, 30, 300, 100, 120, &H337700FF
  7.  
  8.  
  9.  
  10.  
  11. SUB Cone (x1, y1, r1, x2, y2, r2, kolor AS _UNSIGNED LONG)
  12.     rise = y2 - y1
  13.     runn = x2 - x1
  14.     slope = rise / runn
  15.     rchange = r2 - r1
  16.     RateOfRadiusChange = rchange / runn
  17.     FOR i = 0 TO runn
  18.         CircleFill x1 + i, y1 + i * slope, r1 + RateOfRadiusChange * i, kolor
  19.         SLEEP
  20.     NEXT
  22.  
  23. SUB CircleFill (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
  24.     ' CX = center x coordinate
  25.     ' CY = center y coordinate
  26.     '  R = radius
  27.     '  C = fill color
  28.     DIM Radius AS INTEGER, RadiusError AS INTEGER
  29.     DIM X AS INTEGER, Y AS INTEGER
  30.     Radius = ABS(R)
  31.     RadiusError = -Radius
  32.     X = Radius
  33.     Y = 0
  34.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
  35.     LINE (CX - X, CY)-(CX + X, CY), C, BF
  36.     WHILE X > Y
  37.         RadiusError = RadiusError + Y * 2 + 1
  38.         IF RadiusError >= 0 THEN
  39.             IF X <> Y + 1 THEN
  40.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  41.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  42.             END IF
  43.             X = X - 1
  44.             RadiusError = RadiusError - X * 2
  45.         END IF
  46.         Y = Y + 1
  47.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  48.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  49.     WEND
  51.  

There's one stray SLEEP statement in there, so you can watch as it works, so feel free to take it out if it's not something you're interested in having in your own code.  ;)
Title: Re: Simple coordinates equation or impossible coordinates equation?
Post by: bplus on December 16, 2019, 09:53:38 am
Nice one Steve, that is simpler. ;)
Title: Re: Simple coordinates equation or impossible coordinates equation?
Post by: SierraKen on December 16, 2019, 12:33:18 pm
Yes Steve, thank you. But every single time I try to make subs they don't work unless I copy other people's code. I am brand new at SUB's, so please tell me why this has a Syntax Error. I'm trying to let the user define the variables instead. Thanks.

Cone x1, y1, r1, x2, y2, r2

Title: Re: Simple coordinates equation or impossible coordinates equation?
Post by: SMcNeill on December 16, 2019, 12:46:33 pm
Quote from: SierraKen on December 16, 2019, 12:33:18 pm
Yes Steve, thank you. But every single time I try to make subs they don't work unless I copy other people's code. I am brand new at SUB's, so please tell me why this has a Syntax Error. I'm trying to let the user define the variables instead. Thanks.

Cone x1, y1, r1, x2, y2, r2

Can you share the rest of the code and the error message?  By itself, I can’t see any reason why it’d fail.
Title: Re: Simple coordinates equation or impossible coordinates equation?
Post by: SierraKen on December 16, 2019, 01:14:15 pm
Code: QB64: [Select]
  1. SCREEN _NEWIMAGE(800, 600, 32)
  2.  
  3. INPUT "X1 = ", x1
  4. INPUT "Y1 = ", y1
  5. INPUT "Radius = ", r1
  6. INPUT "X2 = ", x2
  7. INPUT "Y2 = ", y2
  8. INPUT "Radius = ", r2
  9.  
  10. Cone x1, y1, r1, x2, y2, r2
  11.  
  12.  
  13. 'LINE (100, 100)-(200, 300)
  14. 'Cone 100, 100, 10, 200, 300, 30, &H77FFFFFF
  15. 'LINE (100, 300)-(300, 100)
  16. 'Cone 100, 300, 30, 300, 100, 120, &H337700FF
  17.  
  18.  
  19.  
  20.  
  21. SUB Cone (x1, y1, r1, x2, y2, r2, kolor AS _UNSIGNED LONG)
  22.     kcolor = kcolor + 1
  23.     rise = y2 - y1
  24.     runn = x2 - x1
  25.     slope = rise / runn
  26.     rchange = r2 - r1
  27.     RateOfRadiusChange = rchange / runn
  28.     FOR i = 0 TO runn
  29.         CircleFill x1 + i, y1 + i * slope, r1 + RateOfRadiusChange * i, kolor
  30.         SLEEP
  31.     NEXT
  33.  
  34. SUB CircleFill (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
  35.     ' CX = center x coordinate
  36.     ' CY = center y coordinate
  37.     '  R = radius
  38.     '  C = fill color
  39.     DIM Radius AS INTEGER, RadiusError AS INTEGER
  40.     DIM X AS INTEGER, Y AS INTEGER
  41.     Radius = ABS(R)
  42.     RadiusError = -Radius
  43.     X = Radius
  44.     Y = 0
  45.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
  46.     LINE (CX - X, CY)-(CX + X, CY), C, BF
  47.     WHILE X > Y
  48.         RadiusError = RadiusError + Y * 2 + 1
  49.         IF RadiusError >= 0 THEN
  50.             IF X <> Y + 1 THEN
  51.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  52.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  53.             END IF
  54.             X = X - 1
  55.             RadiusError = RadiusError - X * 2
  56.         END IF
  57.         Y = Y + 1
  58.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  59.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  60.     WEND
  62.  
  63.  
Title: Re: Simple coordinates equation or impossible coordinates equation?
Post by: SierraKen on December 16, 2019, 01:17:15 pm
Here is a picture of the screen with the error message.

Title: Re: Simple coordinates equation or impossible coordinates equation?
Post by: SMcNeill on December 16, 2019, 01:27:38 pm
You’re missing a parameter; you aren’t sending the sub a color value. 

Cone x1, Y1, r1, X2, Y2, R2, kolor <— the last parameter is missing.
Title: Re: Simple coordinates equation or impossible coordinates equation?
Post by: SierraKen on December 16, 2019, 02:43:59 pm
Thanks Steve. It works now.
Text Only | Text with Attachments