Handy JB Library Tools - Bounce Light Beam Off Mirror Demo

[plus]

While putting this Demo together I added 2 more routines to my JB Library: P2AngleToP1 and ArrowTo and fixed aline, box and fbox.
Somewhen I got the impression I had to add another pixel to the end of a line or corner of a box.
That extra pixel sure screwed up my beautiful ArrowTo Routine fixed by getting rid of that extra pixel.

Here's how to do Light Beam Reflecting without vectors but you still need to know a Normal is perpendicular to a plane or line ie just add 90 degrees to that line Angle for Normal Angle.

'P2AngleToP1 test function b+ 2023-01-24
'Test this with Mirror Reflection of Light Beam from Mouse Click Position

' Don't know where Output Windows default font is. My default seems to be 7 pix wide.
' Using Consolus Regular 12 in both Editor and Printer

global Xmax, Ymax, Pi, Deg, Rad, CX, CY, MirrorDegrees, MirrorRadius, MX, MY
Xmax = 660
Ymax = 660
Pi = acs(-1)
Deg = 180 / Pi
Rad = Pi / 180
CX = 330
CY = 330
nomainwin

WindowWidth = Xmax + 8
WindowHeight = Ymax + 32
UpperLeftX = (DisplayWidth - Xmax) / 2  'or delete if Xmax is 1200 or above
UpperLeftY = (DisplayHeight - Ymax) / 2   'or delete if Ymax is 700 or above

open "Bounce Light Beam from Mirror Center Screen" for graphics_nsb_nf as #gr  '<======================= title
#gr "setfocus"
#gr "trapclose quit"
#gr "when leftButtonUp lButtonUp"
#gr "when characterInput charIn"
#gr "down"
#gr "fill black"

' check arrow drawing needs to subtract 1 for some crazy reason, FIXED
call ArrowTo CX, CY, 0, 100, "yellow"
' check P2AngleToP1
#gr "backcolor black"
#gr "color white"
call stext 10, 10, str$(P2AngleToP1(CX, CY, 660, 330)) ' 0 degrees
call stext 10, 30, str$(P2AngleToP1(CX, CY, 330, 660)) ' 90 degrees
call stext 10, 50, str$(P2AngleToP1(CX, CY,   0, 330)) ' 180 degrees
call stext 10, 70, str$(P2AngleToP1(CX, CY, 330,   0)) ' 270 degrees

' OK set up Light Beam Bouncing Off Mirror
MirrorDegrees = 0
MirrorRadius = distance(CX, CY, 0, 0) ' from corner to center longest length needed
MX = CX + 100
MY = CY + 100 ' 45 degrees off center length 100*SQR(2)
call Display
wait

' Routines for this app
sub Legend
   #gr "color white"
   call ctext 15, "Mouse Click becomes light beam source pointed to center of screen."
   call ctext 35, "Lightgray = mirror reflecting light beam"
   call ctext 55, "Yellow = the angle of beam to center point of screen"
   call ctext 75, "Blue = the line perpendicular to mirror"
   call ctext 95, "Green = angle of refelection off mirror at the center point"
   call ctext 115, "Rotate mirror with R key clockwise, L key CCW."
   call ctext 135, "Click mouse to change light beam source."
end sub

sub Display
   #gr "fill black"
   call Legend
   mirrorx1 = CX + MirrorRadius * Cos(Rad * MirrorDegrees)
   mirrory1 = CY + MirrorRadius * Sin(Rad * MirrorDegrees)
   mirrorx2 = CX + MirrorRadius * Cos(Rad * MirrorDegrees + Pi)
   mirrory2 = CY + MirrorRadius * Sin(Rad * MirrorDegrees + Pi)
   #gr "color lightgray"
   call aline mirrorx1, mirrory1, mirrorx2, mirrory2

   ' perpendicular to mirror, both sides = blue
   normal = MirrorDegrees + 90
   call ArrowTo CX, CY, normal, 100, "blue"
   call ArrowTo CX, CY, normal + 180, 100, "blue"

   ' light beam from mouse source to cx, cy = yellow
   degreeAngleMouse = P2AngleToP1(MX, MY, CX, CY)
   distMouse = distance(CX, CY, MX, MY)
   call ArrowTo MX, MY, degreeAngleMouse, distMouse, "yellow"

   ' diff = angle of mouse to normal but flipped 180 because reflected back
   diff = normal - P2AngleToP1(CX, CY, MX, MY)
   call ArrowTo CX, CY, normal + diff, distMouse, "darkgreen"
   #gr "flush"
end sub

' modified Library routines: ==========================================================
sub lButtonUp H$, mx, my  'must have handle and mouse x,y
   MX = mx : MY = my
   call Display
   'call quit H$          '<=== H$ global window handle
end sub

sub charIn H$, c$ ' handle, character modified to change Mirror Angle
   if ((c$ = "R") or (c$ = "r")) and (MirrorDegrees < 90) then MirrorDegrees = MirrorDegrees + 1 : call Display
   if ((c$ = "L") or (c$ = "l")) and (MirrorDegrees > 0) then MirrorDegrees = MirrorDegrees - 1 : call Display
end sub

' Library Routines used: ==============================================================

sub aline x0, y0, x1, y1
   #gr "line ";x0;" ";y0;" ";x1;" ";y1  'add 1 to end point, no! makes crooked lines!
end sub

' use angles in degrees units instead of radians (converted inside sub)
Sub ArrowTo BaseX, BaseY, dAngle, lngth, colr$
   rAngle = Rad * dAngle
   x1 = BaseX + lngth * Cos(rAngle)  ' why are these arrows crooked!?!? stupid +1 in aline sub
   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)
   #gr "color ";colr$
   call aline BaseX, BaseY, x1, y1
   call aline x1, y1, x2, y2
   call aline x1, y1, x3, y3
End Sub

Function Atan2(y, x)
   'Atan2 is a function which determines the angle between points
   'x1, y1 and x2, y2. The angle returned is in radians
   'The angle returned is always in the range of
   '-PI to PI radians (-180 to 180 degrees)
   '==============================================================
   'NOTE the position of Y and X arguments
   'This keeps Atan2 function same as other language versions
   '==============================================================
  If x = 0 Then
      If y < 0 Then
           Atan2 = -1.5707963267948967
       Else
           Atan2 = 1.5707963267948967
       End If
  Else
      chk = atn(y/x)
      If x < 0 Then
          If y < 0 Then
               chk = chk - 3.1415926535897932
           Else
               chk = chk + 3.1415926535897932
           End If
      End If
       Atan2 = chk
  End If
  'thanks Andy Amaya
End Function

sub ctext y, message$  'uses const Xmax and sub stext
   call stext (Xmax - len(message$) * 7) /2, y, message$
end sub

function distance(x1, y1, x2, y2) ' between 2 points good for Hypotenuse too!
   distance = ( (x1 - x2) ^ 2 + (y1 - y2) ^ 2) ^ .5
end function

'  To find the angle point(x2, y2) makes to (x1, y1) in Degrees
Function P2AngleToP1 (x1, y1, x2, y2)
   ' The angle in degrees a 2nd point (x2, y2)  makes to a first point (x1, y1)

   ' Delta means change between 1 measure and another for example x2 - x1
   deltaX = x2 - x1
   deltaY = y2 - y1

   ' Take DegreeAngle = DAtan2(y2 - y1, x2 - x1)
   rtn = Deg * (Atan2(deltaY, deltaX))
   If rtn < 0 Then P2AngleToP1 = rtn + 360 Else P2AngleToP1 = rtn
End Function

'Need line: #gr "trapclose quit"
sub quit H$
   close #gr '<=== this needs Global H$ = "gr"
   end       'Thanks Facundo, close graphic wo error
end sub

'JB Library of procedures NOT USED but handy for newbies ===================================

'notes: arrays are global limited in dimensions, no constants, no imports, no declares...
'must "call" subs no ()! not even in definitions and must use () for parameterless functions

sub midpoint x1, y1, x2, y2, fraction, byref midx, byref midy
 midx = (x2 - x1) * fraction + x1
 midy = (y2 - y1) * fraction + y1
end sub

function rand(lo, hi)
   rand = int((hi - lo + 1) * rnd(0)) + lo
end function

sub hue r, g, b 'fore and back
   #gr "color ";r;" ";g;" ";b
   #gr "backcolor ";r;" ";g;" ";b
end sub

sub fore r, g, b
   #gr "color ";r;" ";g;" ";b
end sub

sub back r, g, b  'backcolor is used for fills
   #gr "backcolor ";r;" ";g;" ";b
end sub

sub QBcolr colrNum
   select case colrNum
   case 0   : #gr "color black"
   case 1   : #gr "color darkblue"
   case 2   : #gr "color brown"
   case 3   : #gr "color darkcyan"
   case 4   : #gr "color darkred"
   case 5   : #gr "color darkpink"
   case 6   : #gr "color darkgreen"
   case 7   : #gr "color lightgray"
   case 8   : #gr "color darkgray"
   case 9   : #gr "color blue"
   case 10  : #gr "color green"
   case 11  : #gr "color cyan"
   case 12  : #gr "color red"
   case 13  : #gr "color pink"
   case 14  : #gr "color yellow"
   case 15  : #gr "color white"
   end select
end sub

sub pset x, y
   #gr "set ";x;" ";y
end sub

sub box x0, y0, x1, y1
   #gr "place ";x0;" ";y0
   #gr "box ";x1;" ";y1 'add pixel at end
end sub

sub fbox x0, y0, x1, y1
   #gr "place ";x0;" ";y0
   #gr "boxfilled ";x1;" ";y1
end sub

sub circ x, y, radius
   #gr "place ";x;" ";y;"; circle ";radius
end sub

sub fcirc x, y, radius
   #gr "place ";x;" ";y;"; circlefilled ";radius
end sub

sub ellips x, y, w, h  '< no e on end!
   #gr "place ";x;" ";y;"; ellipse ";w;" ";h
end sub

sub fellipse x, y, w, h
   #gr "place ";x;" ";y;"; ellipsefilled ";w;" ";h
end sub

'ink the color that is percent between the first color and 2nd color
sub midInk r1, g1, b1, r2, g2, b2, frac
   dr = (r2 - r1) * frac : dg = (g2 - g1) * frac : db = (b2 - b1) * frac
   #H$ "color ";r1 + dr;" ";g1 + dg;" ";b1 + db
   #H$ "backcolor ";r1 + dr;" ";g1 + dg;" ";b1 + db
end sub

'Fast Filled Triangle Sub by AndyAmaya
Sub ftriangle x1, y1, x2, y2, x3, y3
   'triangle coordinates must be ordered: where x1 < x2 < x3
   If x2 < x1 Then x = x2 : y = y2 : x2 = x1 : y2 = y1 : x1 = x : y1 = y
   'swap x1, y1, with x3, y3
   If x3 < x1 Then x = x3 : y = y3 : x3 = x1 : y3 = y1 : x1 = x : y1 = y
   'swap x2, y2 with x3, y3
   If x3 < x2 Then x = x3 : y = y3 : x3 = x2 : y3 = y2 : x2 = x : y2 = y
   If x1 <> x3 Then slope1 = (y3 - y1) /(x3 - x1)
   'draw the first half of the triangle
   length = x2 - x1
   If length <> 0 Then
       slope2 = (y2 - y1)/(x2 - x1)
       For x = 0 To length
           #gr "Line ";int(x + x1);" ";int(x * slope1 + y1);" ";int(x + x1);" ";int(x * slope2 + y1)
       Next
   End If
   'draw the second half of the triangle
   y = length * slope1 + y1 : length = x3 - x2
   If length <> 0 Then
       slope3 = (y3 - y2) /(x3 - x2)
       For x = 0 To length
           #gr "Line ";int(x + x2);" ";int(x * slope1 + y);" ";int(x + x2);" ";int(x * slope3 + y2)
       Next
   End If
   call aline x1, y1, x2, y2
   call aline x2, y2, x1, y1
   call aline x2, y2, x3, y3
   call aline x3, y3, x2, y2
   call aline x1, y1, x3, y3
   call aline x3, y3, x1, y1
End Sub

sub star x, y, rInner, rOuter, nPoints, angleOffset, TFfill
 ' x, y are same as for circle,
 ' rInner is center circle radius
 ' rOuter is the outer most point of star
 ' nPoints is the number of points,
 ' angleOffset = angle offset IN DEGREES, it will be converted to radians in sub
 ' this is to allow us to spin the polygon of n sides
 ' TFfill filled True or False (1 or 0)

 pAngle = Rad * (360 / nPoints)  :  radAngleOffset = Rad * angleOffset
 x1 = x + rInner * cos(radAngleOffset)
 y1 = y + rInner * sin(radAngleOffset)
 for i = 0 to nPoints - 1
   x2 = x + rOuter * cos(i * pAngle + radAngleOffset + .5 * pAngle)
   y2 = y + rOuter * sin(i * pAngle + radAngleOffset + .5 * pAngle)
   x3 = x + rInner * cos((i + 1) * pAngle + radAngleOffset)
   y3 = y + rInner * sin((i + 1) * pAngle + radAngleOffset)
   if TFfill then
     call ftriangle x1, y1, x2, y2, x3, y3
   else
     call aline x1, y1, x2, y2
     call aline x2, y2, x3, y3
   end if
   x1 = x3 : y1 = y3
 next
 if TFfill then call fcirc x, y, rInner
end sub

sub stext x, y, message$ 'note: have to reset fore or back color after ink
   #gr "place ";x;" ";y;";|";message$
end sub

sub pause mil   'tsh version has scan built-in
   t0 = time$("ms")
   while time$("ms") < t0 + mil : scan : wend
end sub

'draws an arc with center at xCenter, yCenter, radius from center is arcRadius
sub arc xCenter, yCenter, arcRadius, dAStart, dAMeasure
   'notes:
   'you may want to adjust size and color for line drawing
   'using angle measures in degrees to match Just Basic ways with pie and piefilled
   'this sub assumes drawing in a CW direction if dAMeasure positive

   'for Just Basic angle 0 degrees is due East and angle increases clockwise towards South

   'dAStart is degrees to start Angle, due East is 0 degrees

   'dAMeasure is degrees added (Clockwise) to dAstart for end of arc

   rAngleStart = Rad * dAStart
   rAngleEnd = Rad * dAMeasure + rAngleStart
   Stepper = Rad / (.1 * arcRadius) 'fixed
   lastX = xCenter + arcRadius * cos(rAngleStart)
   lastY = yCenter + arcRadius * sin(rAngleStart)
   #gr "set ";int(lastX);" ";int(lastY)
   for rAngle = rAngleStart+Stepper to rAngleEnd step Stepper
       nextX = xCenter + arcRadius * cos(rAngle)
       nextY = yCenter + arcRadius * sin(rAngle)
       #gr "goto ";int(nextX);" ";int(nextY)    'int speeds things up
   next
end sub



[plus]

What happened to the post I saw here last night from newest member (tebys)?

ie, check out all of tebys posts

[Rod]

We get bots and other dubious memberships, since members get access to other members posted emails we try and keep it to real members. There is a new trend where bland messages are posted to make a human moderator believe we have a genuine member but soon after we get spam and members can get email spam. so it was moderated. I don't think they were actually interested in reflection and refraction else they might have said something more intelligent.

[plus]

Yeah it did have a peculiar wording like I made the code just for them.

But who doesn't need a light bouncing off a mirror sim?