Attribute VB_Name = "Module2" '*********************************************************************** '* SIMULATION OF AN ELLIPTICAL BILLARD * '* ------------------------------------------------------------------- * '* In one of his books (*), the polish mathematician Hugo Steinhaus * '* outlines the idea of an elliptical billard table! He distinguishes * '* three cases of trajectory, depending on throwing the ball: * '* 1) between the two focuses of the ellipse 2) between one focus and * '* the edge of the billard 3) passing through a focus. This program * '* allows to visualize the envelope of trajectories in the three cases * '* with a limitation of 100 rebounds. * '* ------------------------------------------------------------------- * '* From "Graphisme dans le plan et dans l'espace avec Turbo Pascal 4.0 * '* by R. Dony - MASSON 1990, page 113" [BIBLI 12]. * '* * '* Microsoft Visual Basic release by J-P Moreau * '* (Program to use with Billard.frm and Gr2D.bas) * '* (www.jpmoreau.fr) * '* ------------------------------------------------------------------- * '* (*) Mathématiques en instantanés by Hugo Steinhaus, Flammarion 1964 * '*********************************************************************** 'global variables of billard Public bord, limite As Integer Public a, b, increment As Double Dim f1, f2, f3, f4, m, m0, n, n0, xx1, yy1, xx2, yy2 As Double Dim nbrerebonds, intersection As Integer 'extern MaxX, MaxY (see Gr2D.bas) 'test if line y=mx+n meets the ellipse Sub Test() Dim delta As Double delta = a * a * b * b * (a * a * m * m + b * b - n * n) If (delta > 0#) Then intersection = 1 Else intersection = 0 End If End Sub 'draw elliptical border of billard Sub DrawEllipse() Dim angle, pi, x1, y1 As Double pi = 3.1415926535 cloture bord, MaxX - bord, 2 * bord, MaxY - 25 Bordure angle = 0#: x1 = a: y1 = 0# MoveXY x1, y1 While (angle < 2# * pi) angle = angle + increment x2 = a * Cos(angle) y2 = b * Sin(angle) LineXY x2, y2 Wend End Sub 'draw a cross at point (x,y) Sub croixaufoyer(x As Double, y As Double) Dim l As Double l = 0.03 * a MoveXY x - l, y LineXY x + l, y MoveXY x, y - l LineXY x, y + l End Sub 'draw focuses of ellipse Sub TraceFoyers() Dim xf As Double xf = Sqr(a * a - b * b) croixaufoyer -xf, 0 croixaufoyer xf, 0 End Sub 'swap coordinates Sub permute() Dim aux As Double aux = xx1: xx1 = xx2: xx2 = aux aux = yy1: yy1 = yy2: yy2 = aux End Sub 'find intersection between line and ellipse Sub SeekIntersection() Dim delta, denom As Double delta = a * a * b * b * (a * a * m * m + b * b - n * n) denom = a * a * m * m + b * b If (delta > 0) Then xx1 = (-a * a * m * n + Sqr(delta)) / denom End If yy1 = m * xx1 + n If (delta > 0) Then xx2 = (-a * a * m * n - Sqr(delta)) / denom End If yy2 = m * xx2 + n If (m > 0) Then If (yy1 > yy2) Then permute End If ElseIf (m < 0) Then If (yy1 < yy2) Then permute End If ElseIf (xx1 > xx2) Then permute End If End Sub 'draw trajectories with a maximum of 100 rebounds Sub Trajectory() Dim nbrerebonds As Integer nbrerebonds = 0 MoveXY f1, m * f1 + n LineXY xx2, yy2 nbrerebonds = nbrerebonds + 1 While (nbrerebonds <= limite) If (xx2 <> 0#) Then tgphi = a * a * yy2 / (b * b * xx2) Else tgphi = 1E+15 End If tgteta = m angleinc = Atn((tgphi - tgteta) / (1 + tgphi * tgteta)) anglephi = Atn(tgphi) m = Sin(angleinc + anglephi) / Cos(angleinc + anglephi) If (Abs(n) < 0.001) Then m = 0: n = 0 Else n = yy2 - m * xx2 End If xprec = xx2: yprec = yy2 SeekIntersection If (Abs(xprec - xx1) > 0.000001) Then permute End If MoveXY xprec, yprec LineXY xx2, yy2 nbrerebonds = nbrerebonds + 1 Wend End Sub 'The initial line has for equation y = mx + n, with m=1.5 and n=3.5 'These values may be changed by the program user Sub Draw_Billard() Dim i As Integer MaxX = 9200: MaxY = 6800 'set initial values s0\$ = "1.5 3.5" S\$ = InputBox("Input m n (ex.:1.5 3.5):", "BILLARD", s0\$) i = 1: s1\$ = "" While Mid\$(S\$, i, 1) <> " " s1\$ = s1\$ & Mid\$(S\$, i, 1) i = i + 1 Wend s2\$ = Right\$(S\$, Len(S\$) - i) m0 = Val(s1\$): n0 = Val(s2\$) m = m0: n = n0 bord = 10: limite = 100: a = 5#: b = 3#: increment = 0.1 f1 = -1.1 * a: f2 = -f1: f3 = -1.1 * b: f4 = -f3 Fenetre f1, f2, f3, f4 Test If (intersection) Then Form1.Cls Display 250, 250, "ELLIPTICAL BILLARD" DrawEllipse TraceFoyers SeekIntersection Trajectory S\$ = "M= " & Str(m0) Display MaxX - 1300, 250, S\$ S\$ = "N= " & Str(n0) Display MaxX - 1300, 500, S\$ Else Beep MsgBox "The line does not meet the ellipse!", 0, "WARNING" End If Beep Form1.Command2.Caption = "Continue" End Sub 'end of file billard.bas