Posts: 3,980
Threads: 177
Joined: Apr 2022
Reputation:
220
10-14-2022, 06:36 PM
(This post was last modified: 10-14-2022, 06:40 PM by bplus.)
Sorry should have quoted:
Quote:Wait a minute.... how are you getting zero degrees to point to the right along the x axis? When I pop 0 degrees into sin and cos I end up with it going along the Y axis.
OH CRUD. Have I been failing to account for the top left corner being 0,0 on the standard screen?
I've been doing:
newX= oldx+range*sin(angle)
newY= oldy+range*cos(angle)
which of couse works but 0 degress points straight "down" the screen along the Y axis.
Now there's a good question!
I would say you have Sin() associated with X coordinate and Cos() with Y coordinate. Not saying it's wrong but not the convention I use or come from, just reverse newX uses the Cos() and newY uses the Sin().
We all would agree Sin(0) = 0 and Cos(0) = 1 if you make x the vertical axis your coordinate system could work but all of Basic graphics assumes x is the horizontal axis and y the vertical, it's usually f(x) or y as a function of x, x is horizontal and increasing going right is convention.
We are arguing conventions, you say tamoto I say tomato.
WINDOW does allow any way you want it! So if you want it like you learn in math and physics use WINDOW but then you need conversion functions to go from standard Basic screen with "upside down" y axis to y axis going up as Y values increase.
b = b + ...
Posts: 660
Threads: 142
Joined: Apr 2022
Reputation:
58
oh darn..... I have been doing it "wrongish" . I've been trying to do relative bearing for my zoom_trek program and getting it wrong again and again, usually only worked in 2 quadrants. I just reassigned the sin and cos and it seem to be working now.
Posts: 3,980
Threads: 177
Joined: Apr 2022
Reputation:
220
(10-14-2022, 07:26 PM)James D Jarvis Wrote: oh darn..... I have been doing it "wrongish" . I've been trying to do relative bearing for my zoom_trek program and getting it wrong again and again, usually only worked in 2 quadrants. I just reassigned the sin and cos and it seem to be working now.
For "relative bearing" do you mean the angle of one point to another point, say the base point. That would employ the _Atan2 Function and that returns pos and neg radian angles. If you expect only positive angles you would miss out on half the things around base point.
Do you get the difference of radians versus degrees? I ask because if you prefer degrees I have nice conversion (I think) for finding that "relative bearing" that might be easier to use. Straight _ATan2() is tricky even knowing radians.
b = b + ...
Posts: 660
Threads: 142
Joined: Apr 2022
Reputation:
58
Thanks, I've got it working. I maxed out at Calculus-IV in college and was a technical illustrator for decades so I'm pretty comfortable with angles, I just have to avoid silly mistakes while programming. I've forgotten more math than the average person has ever learned. I might have time to really update the zoom_trek program this weekend so what I mentioned here will make more sense to other folks.
Posts: 3,980
Threads: 177
Joined: Apr 2022
Reputation:
220
10-16-2022, 12:48 PM
(This post was last modified: 10-16-2022, 01:34 PM by bplus.
Edit Reason: Code was missing Poly Fill sub routine, want to keep all Degrees subs together
)
Hey let's bounce a ball inside some regular polygons!
Code: (Select All) Option _Explicit
_Title "Bounce Ball Inside Polygon" 'b+ 2022-10-16
Screen _NewImage(800, 600, 32) ' standard screen size 800 wide, 600 height for quick QB64 Demos with full color potential (the 32)
_ScreenMove 250, 50
Randomize Timer
_PrintMode _KeepBackground
Type lineSegment
As Single x1, y1, x2, y2, dN ' 2 end points
End Type
' mod RegularPoly to save lines created by
Dim cx, cy, polyRadius, Dstart, SecDegrees, x1, y1, x2, y2 ' building container
Dim As _Unsigned Long PK
Dim As Long NLines, L, Container
cx = _Width / 2: cy = _Height / 2 + 40: polyRadius = 250: Dstart = 270
PK = _RGB32(0, 150, 85) ' minty green background out of bounds
startNewPoly:
NLines = Int(Rnd * 10) + 3
SecDegrees = 360 / NLines
ReDim Boundaries(1 To NLines) As lineSegment
Cls
x1 = cx + polyRadius * CosD(Dstart)
y1 = cy + polyRadius * SinD(Dstart)
For L = 1 To NLines
x2 = cx + polyRadius * CosD(Dstart + L * SecDegrees)
y2 = cy + polyRadius * SinD(Dstart + L * SecDegrees)
Line (x1, y1)-(x2, y2), PK ' back to first point
Boundaries(L).x1 = x1 ' save these line segment end points for containing the ball
Boundaries(L).y1 = y1
Boundaries(L).x2 = x2
Boundaries(L).y2 = y2
'if we take the midpoint of the two endpoints and draw a line to the center we have the normal angle of the line
' on the same side we want to keep the ball!
' midx = (x1+ x2)/2
' midy = (y1 + y2)/2
' the angle of the normal is! Aha!
Boundaries(L).dN = DAtan2((x1 + x2) / 2, (y1 + y2) / 2, cx, cy) ' angle from midpoint to center
' check angles midpoint is 22.5 degress less (for 8 sides) and going in opp direction
' Print Dstart + L * SecDegrees - 22.5 - 180, Boundaries(L).dN
x1 = x2: y1 = y2
Next
Paint (1, 1), PK, PK
Print " Yellow = the vector of ball heading towards line."
Print " Blue = vector perpendicular (normal) to boundary line."
Print " White = angle of refelection off line."
Print " esc starts a different poly."
Container = _NewImage(_Width, _Height, 32)
_PutImage , 0, Container
Dim bx, by, ba, br, bspeed, hit, hitx1, hity1, hitx2, hity2, diff
bx = cx: by = cy: bspeed = 5
br = 20 ' make ball radius (br) at least 2* speed
ba = Rnd * 360 ' setup up ball in middle of screen/container random heading = ba (ball angle)
' ok just bounce ball around the polygon container
Do
_PutImage , Container, 0
Circle (bx, by), br ' draw ball then calc next loaction
bx = bx + bspeed * CosD(ba) ' test x, y is new ball position if dont run into wall
by = by + bspeed * SinD(ba)
For L = 1 To NLines ' did we hit any?
hit = lineIntersectCircle%(Boundaries(L).x1, Boundaries(L).y1, Boundaries(L).x2, Boundaries(L).y2, bx, by, br, hitx1, hity1, hitx2, hity2)
' probably should back it up before processing bounce
If hit Then ' rebound ball
Circle (bx, by), br
_Display
While hit ' back up circle
bx = bx + CosD(ba - 180)
by = by + SinD(ba - 180)
hit = lineIntersectCircle%(Boundaries(L).x1, Boundaries(L).y1, Boundaries(L).x2, Boundaries(L).y2, bx, by, br, hitx1, hity1, hitx2, hity2)
'Circle (bx, by), br
'_Display
Wend
_PutImage , Container, 0
Circle (bx, by), br
' Yellow arrow for incoming towards boundary (I reversed the head of arrow to compare to reflection angle)
ArrowTo bx + 3 * br * CosD(ba + 180), by + 3 * br * SinD(ba + 180), ba, 3 * br, &HFFFFFF00
' Blue Vector Perpendicular to plane
ArrowTo bx, by, Boundaries(L).dN, 5 * br, &HFF0000FF
' Reflected ball off line
diff = Boundaries(L).dN - ba + 180
ba = Boundaries(L).dN + diff ' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> new direction
ArrowTo bx, by, ba, 3 * br, &HFFFFFFFF
_Display
_Delay 1
End If
Next
_Display
_Limit 30
Loop Until _KeyDown(27)
GoTo startNewPoly
' return 0 no Intersect, 1 = tangent 1 point touch, 2 = 2 point intersect
' if intersect returns point or points of intersect ix1, iy1, ix2, iy2
' intersect points are -999 if non existent ie no intersect or 2nd point when circle is tangent
Function lineIntersectCircle% (lx1, ly1, lx2, ly2, cx, cy, r, ix1, iy1, ix2, iy2)
Dim m, y0, A, B, C, D, x1, y1, x2, y2, ydist
'needs SUB slopeYintersect (X1, Y1, X2, Y2, slope, Yintercept)
If lx1 <> lx2 Then
slopeYintersect lx1, ly1, lx2, ly2, m, y0 ' Y0 otherwise know as y Intersect
' https://math.stackexchange.com/questions/228841/how-do-i-calculate-the-intersections-of-a-straight-line-and-a-circle
A = m ^ 2 + 1
B = 2 * (m * y0 - m * cy - cx)
C = cy ^ 2 - r ^ 2 + cx ^ 2 - 2 * y0 * cy + y0 ^ 2
D = B ^ 2 - 4 * A * C 'telling part of Quadratic formula = 0 then circle is tangent or > 0 then 2 intersect points
If D < 0 Then ' no intersection
ix1 = -999: iy1 = -999: ix2 = -999: iy2 = -999: lineIntersectCircle% = 0
ElseIf D = 0 Then ' one point tangent
x1 = (-B + Sqr(D)) / (2 * A)
y1 = m * x1 + y0
ix1 = x1: iy1 = y1: ix2 = -999: iy2 = -999: lineIntersectCircle% = 1
Else '2 points
x1 = (-B + Sqr(D)) / (2 * A): y1 = m * x1 + y0
x2 = (-B - Sqr(D)) / (2 * A): y2 = m * x2 + y0
ix1 = x1: iy1 = y1: ix2 = x2: iy2 = y2: lineIntersectCircle% = 2
End If
Else 'vertical line
If r = Abs(lx1 - cx) Then ' tangent
ix1 = lx1: iy1 = cy: ix2 = -999: iy2 = -999: lineIntersectCircle% = 1
ElseIf r < Abs(lx1 - cx) Then 'no intersect
ix1 = -999: iy1 = -999: ix2 = -999: iy2 = -999: lineIntersectCircle% = 0
Else '2 point intersect
ydist = Sqr(r ^ 2 - (lx1 - cx) ^ 2)
ix1 = lx1: iy1 = cy + ydist: ix2 = lx1: iy2 = cy - ydist: lineIntersectCircle% = 2
End If
End If
End Function
Sub slopeYintersect (X1, Y1, X2, Y2, slope, Yintercept) ' fix for when x1 = x2
slope = (Y2 - Y1) / (X2 - X1)
Yintercept = slope * (0 - X1) + Y1
End Sub
Sub RegularPolyFill (cx, cy, radius, nPoints, dStart, K As _Unsigned Long)
Dim secDegrees, p, x, y, lastX, lastY, startX, startY
secDegrees = 360 / nPoints
For p = 1 To nPoints
x = cx + radius * CosD(dStart + p * secDegrees)
y = cy + radius * SinD(dStart + p * secDegrees)
If p > 1 Then
TriFill cx, cy, lastX, lastY, x, y, K
Else
startX = x: startY = y
End If
lastX = x: lastY = y
Next
TriFill cx, cy, lastX, lastY, startX, startY, K ' back to first point
End Sub
Sub RegularPoly (cx, cy, radius, nPoints, dStart, K As _Unsigned Long)
Dim secDegrees, p, x, y, saveX, saveY
secDegrees = 360 / nPoints
For p = 1 To nPoints
x = cx + radius * CosD(dStart + p * secDegrees)
y = cy + radius * SinD(dStart + p * secDegrees)
If p = 1 Then PSet (x, y), K: saveX = x: saveY = y Else Line -(x, y), K
Next
Line -(saveX, saveY), K ' back to first point
End Sub
' use angles in degrees units instead of radians (converted inside sub)
Function CosD (degrees)
' Note this function uses whatever the default type is, better not be some Integer Type.
CosD = Cos(_D2R(degrees))
End Function
' use angles in degrees units instead of radians (converted inside sub)
Function SinD (degrees)
' Note this function uses whatever the default type is, better not be some Integer Type.
SinD = Sin(_D2R(degrees))
End Function
' use angles in degrees units instead of radians (converted inside sub)
Function DAtan2 (x1, y1, x2, y2) ' The angle in degrees a 2nd point (x2, y2) makes to a first point (x1, y1)
' Note this function uses whatever the default type is, better not be some Integer Type.
' Delta means change between 1 measure and another for example x2 - x1
Dim deltaX, deltaY, rtn
deltaX = x2 - x1
deltaY = y2 - y1
' To find the angle point(x2, y2) makes to (x1, y1) in Degrees
' Take DegreeAngle = DAtan2(y2 - y1, x2 - x1)
rtn = _R2D(_Atan2(deltaY, deltaX))
If rtn < 0 Then DAtan2 = rtn + 360 Else DAtan2 = rtn
End Function
' use angles in degrees units instead of radians (converted inside sub)
Sub ArrowTo (BaseX As Long, BaseY As Long, dAngle As Double, lngth As Long, colr As _Unsigned Long)
Dim As Long x1, y1, x2, y2, x3, y3
Dim As Double rAngle
rAngle = _D2R(dAngle)
x1 = BaseX + lngth * Cos(rAngle)
y1 = BaseY + lngth * Sin(rAngle)
x2 = BaseX + .8 * lngth * Cos(rAngle - _Pi(.05))
y2 = BaseY + .8 * lngth * Sin(rAngle - _Pi(.05))
x3 = BaseX + .8 * lngth * Cos(rAngle + _Pi(.05))
y3 = BaseY + .8 * lngth * Sin(rAngle + _Pi(.05))
Line (BaseX, BaseY)-(x1, y1), colr
Line (x1, y1)-(x2, y2), colr
Line (x1, y1)-(x3, y3), colr
End Sub
' use angles in degrees units instead of radians (converted inside sub)
Sub drawArc (xc, yc, radius, dStart, dMeasure, colr As _Unsigned Long)
' xc, yc Center for arc circle
' rStart is the Radian Start Angle, use _D2R for conversion from Degrees to Radians
' rMeasure is the measure of Arc in Radain units, use _D2R for conversion from Degrees to Radians
' Arc will start at rStart and go clockwise around for rMeasure Radians
Dim rStart, rMeasure, rEnd, stepper, a, x, y
rStart = _D2R(dStart)
rMeasure = _D2R(dMeasure)
rEnd = rStart + rMeasure
stepper = 1 / radius ' the bigger the radius the smaller the steps
For a = rStart To rEnd Step stepper
x = xc + radius * Cos(a)
y = yc + radius * Sin(a)
If a > rStart Then Line -(x, y), colr Else PSet (x, y), colr
Next
End Sub
'' BEST saves dest and optimized with Static a& and alpha colors work better
'2019-12-16 fix by Steve saves some time with STATIC and saves and restores last dest
Sub TriFill (x1, y1, x2, y2, x3, y3, K As _Unsigned Long) ' 2022-10-13 changed name
Dim D As Long
Static a&
D = _Dest
If a& = 0 Then a& = _NewImage(1, 1, 32)
_Dest a&
_DontBlend a& ' '<<<< new 2019-12-16 fix
PSet (0, 0), K
_Blend a& '<<<< new 2019-12-16 fix
_Dest D
_MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
End Sub
b = b + ...
Posts: 1,586
Threads: 59
Joined: Jul 2022
Reputation:
52
^
|
Nice program. But the elitist that I am decided to change things, setting [ESC] to quit the program and spacebar to restart maybe with a different polygon. But I ran into an issue with "_KEYDOWN()" in which doesn't trap and hold properly a key that produces a glyph. Therefore I was forced to set right [SHIFT] key instead of spacebar to rerun, since a "shift" key could be trapped and held properly.
The idea was to prevent somebody from leaning on a key so the screen goes crazy being forced to go into an ornerous loop. I need more sleep lately, I know...
Posts: 3,980
Threads: 177
Joined: Apr 2022
Reputation:
220
10-16-2022, 01:59 PM
(This post was last modified: 10-16-2022, 01:59 PM by bplus.)
(10-16-2022, 01:50 PM)mnrvovrfc Wrote: ^
|
Nice program. But the elitist that I am decided to change things, setting [ESC] to quit the program and spacebar to restart maybe with a different polygon. But I ran into an issue with "_KEYDOWN()" in which doesn't trap and hold properly a key that produces a glyph. Therefore I was forced to set right [SHIFT] key instead of spacebar to rerun, since a "shift" key could be trapped and held properly.
The idea was to prevent somebody from leaning on a key so the screen goes crazy being forced to go into an ornerous loop. I need more sleep lately, I know...
It's true that _keydown(27) part could have been handled better. It was a last minute bonus to add the ability to run different Polygons and just catching a keypress and handling it when done calculating would have been better. Kind of like a slot machine with all the different Polygons flashing up on screen until it settles on the next one to do :-))
Say did Cleveland win something last night? I heard all this cheering from TV last night around time of news hour.
b = b + ...
Posts: 1,586
Threads: 59
Joined: Jul 2022
Reputation:
52
(10-16-2022, 01:59 PM)bplus Wrote: Say did Cleveland win something last night? I heard all this cheering from TV last night around time of news hour. Yes the Guardians win one more time tonight and they knock the Yankees out of the baseball playoffs. If they win they play Houston for the American League championship, otherwise one more game back at the Stadium in the Bronx.
Posts: 3,980
Threads: 177
Joined: Apr 2022
Reputation:
220
Excellent! Can't believe they are still playing baseball this time of year.
b = b + ...
Posts: 3,980
Threads: 177
Joined: Apr 2022
Reputation:
220
10-18-2022, 03:25 PM
(This post was last modified: 10-18-2022, 03:25 PM by bplus.)
Bouncing Light Beam Off Mirror
Code: (Select All) Option _Explicit
_Title "Bounce Light Beam" ' b+ 2022-10-18
Screen _NewImage(800, 600, 32) ' standard screen size 800 wide, 600 height for quick QB64 Demos with full color potential (the 32)
_ScreenMove 250, 50
Randomize Timer
Dim As Long cx, cy, mirrorRadius, Legend, mirrorDegrees, mx, my, degreeAngleMouse, diff
Dim mirrorx1, mirrory1, mirrorx2, mirrory2, distMouse, normal
cx = 400: cy = 300: mirrorRadius = _Hypot(400, 300) ' <<< long enough to span screen at any angle
Cls ' <<<<<<< this gives us a solid black background in our image of legend we are going to make
Print " Mouse is source of beam pointed to center of screen, rotate mirror with mouse wheel."
Print " Silver = mirror reflecting light beam"
Print " Yellow = the angle of beam to center point of screen"
Print " Blue = the line perpendicular to mirror"
Print " Green = angle of refelection off mirror at the center point"
Legend = _NewImage(_Width, _Height, 32) ' make copy of screen note
_PutImage , 0, Legend
Do
_PutImage , Legend, 0 ' because of black background this effectively erases image from loop before no CLS needed
While _MouseInput ' get mouse wheel changes and update status of mouse
If mirrorDegrees + _MouseWheel * 5 <= 90 And mirrorDegrees + _MouseWheel * 5 >= 0 Then mirrorDegrees = mirrorDegrees + _MouseWheel * 5
Wend
mx = _MouseX: my = _MouseY
' draw the mirror = silver
mirrorx1 = cx + mirrorRadius * CosD(mirrorDegrees)
mirrory1 = cy + mirrorRadius * SinD(mirrorDegrees)
mirrorx2 = cx + mirrorRadius * CosD(mirrorDegrees + 180)
mirrory2 = cy + mirrorRadius * SinD(mirrorDegrees + 180)
Line (mirrorx1, mirrory1)-(mirrorx2, mirrory2), _RGB32(200)
' perpendicular to mirror, both sides = blue
normal = mirrorDegrees + 90
ArrowTo cx, cy, normal, 100, _RGB32(0, 0, 255)
ArrowTo cx, cy, normal + 180, 100, _RGB32(0, 0, 255)
' light beam from mouse source to cx, cy = yellow
degreeAngleMouse = DAtan2(mx, my, cx, cy)
distMouse = _Hypot(cx - mx, cy - my)
ArrowTo mx, my, degreeAngleMouse, distMouse, _RGB32(255, 255, 0)
' diff = angle of mouse to normal but flipped 180 because reflected back
diff = normal - DAtan2(cx, cy, mx, my)
ArrowTo cx, cy, normal + diff, distMouse, _RGB32(0, 200, 0)
_Display
_Limit 60
Loop Until _KeyDown(27) ' we are done when escape is pressed
' use angles in degrees units instead of radians (converted inside sub)
Function CosD (degrees)
' Note this function uses whatever the default type is, better not be some Integer Type.
CosD = Cos(_D2R(degrees))
End Function
' use angles in degrees units instead of radians (converted inside sub)
Function SinD (degrees)
' Note this function uses whatever the default type is, better not be some Integer Type.
SinD = Sin(_D2R(degrees))
End Function
' use angles in degrees units instead of radians (converted inside sub)
Function DAtan2 (x1, y1, x2, y2) ' The angle in degrees a 2nd point (x2, y2) makes to a first point (x1, y1)
' Note this function uses whatever the default type is, better not be some Integer Type.
' Delta means change between 1 measure and another for example x2 - x1
Dim deltaX, deltaY, rtn
deltaX = x2 - x1
deltaY = y2 - y1
' To find the angle point(x2, y2) makes to (x1, y1) in Degrees
' Take DegreeAngle = DAtan2(y2 - y1, x2 - x1)
rtn = _R2D(_Atan2(deltaY, deltaX))
If rtn < 0 Then DAtan2 = rtn + 360 Else DAtan2 = rtn
End Function
' use angles in degrees units instead of radians (converted inside sub)
Sub ArrowTo (BaseX As Long, BaseY As Long, dAngle As Double, lngth As Long, colr As _Unsigned Long)
Dim As Long x1, y1, x2, y2, x3, y3
Dim As Double rAngle
rAngle = _D2R(dAngle)
x1 = BaseX + lngth * Cos(rAngle)
y1 = BaseY + lngth * Sin(rAngle)
x2 = BaseX + .8 * lngth * Cos(rAngle - _Pi(.05))
y2 = BaseY + .8 * lngth * Sin(rAngle - _Pi(.05))
x3 = BaseX + .8 * lngth * Cos(rAngle + _Pi(.05))
y3 = BaseY + .8 * lngth * Sin(rAngle + _Pi(.05))
Line (BaseX, BaseY)-(x1, y1), colr
Line (x1, y1)-(x2, y2), colr
Line (x1, y1)-(x3, y3), colr
End Sub
b = b + ...
|