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