Attribute VB_Name = "Module2"
'**********************************************************
'* Program to demonstrate Apollonius circles and clipping *
'* capability of Module Gr2D.bas                          *
'*                                                        *
'*         Visual Basic 4.0 Release By J-P Moreau, Paris  *
'*                      (www.jpmoreau.fr)                 *
'* ------------------------------------------------------ *
'* DESCRIPTION:  At each step, the program:               *
'*   1. randomly defines 3 circles so that they are at    *
'*      least partially visible and each one is tangent   *
'*      to the other two.                                 *
'*   2. recursively draws all the internal (apollonius)   *
'*      circles until radius is to small, using a fast    *
'*      procedure to draw circles.                        *
'* ------------------------------------------------------ *
'*                                                        *
'* NOTE:    The print option is not implemented here.     *
'**********************************************************
DefDbl A-H, O-Z
DefInt I-N

'A circle is defined by a table C(3), where C(1),C(2)
'are the center coordinates, and C(3) = 1 / Radius.

Public Error2D As Boolean


Function Dist2D(A(), B()) As Double
'Calculate the distance between two points A(2),B(2)
  Dim V(2) As Double
  Call GetVector2D(A, B, V)
  Dist2D = XNorm2D(V)
End Function

Sub GetVector2D(A(), B(), V())
'Get 2D vector from point A to point B
  V(1) = B(1) - A(1)
  V(2) = B(2) - A(2)
End Sub


Function horsLimites(C()) As Boolean
'returns True if circle is not entirely visible
  r = 1 / C(3)
  horsLimites = True
  If (x < X_min) And (r < X_min - x) Then Exit Function
  If (y < Y_min) And (r < Y_min - y) Then Exit Function
  If (x > X_max) And (r < x - X_max) Then Exit Function
  If (y > Y_max) And (r < y - Y_max) Then Exit Function
  horsLimites = False
End Function


'returns the internal circle to 3 given tangent circles
Sub CercleInterne(c1(), c2(), c3(), Co())
  Dim V2(2) As Double
  Dim V3(2) As Double
  Dim eps As Double, u As Double, vv As Double
  Dim d As Double
  eps = 0.0000000001
  If c1(3) > c2(3) Then
    For i = 1 To 3
      Co(i) = c1(i): c1(i) = c2(i): c2(i) = Co(i)
    Next i
  End If
  If c2(3) > c3(3) Then
    For i = 1 To 3
      Co(i) = c2(i): c2(i) = c3(i): c3(i) = Co(i)
    Next i
  End If
  Call GetVector2D(c1, c2, V2)
  Call GetVector2D(c1, c3, V3)
  d = V2(1) * V3(2) - V2(2) * V3(1)
  If Abs(d) < eps Then
    erreur2D = True
  Else
    erreur2D = False
  End If
  If erreur2D = True Then Exit Sub
  u = Sqr(c3(3)) * Sqr(c1(3) + c2(3) + c1(3) * (c2(3) / c3(3)))
  Co(3) = c1(3) + c2(3) + c3(3) + 2# * u
  u = (1 + c2(3) / c1(3) + (c2(3) - c1(3)) / Co(3)) / c1(3) / c2(3)
  vv = (1 + c3(3) / c1(3) + (c3(3) - c1(3)) / Co(3)) / c1(3) / c3(3)
  'centre.x:=c1.centre.x+(u*V3.y-V2.y*v)/d;
  Co(1) = c1(1) + (u * V3(2) - V2(2) * vv) / d
  'centre.y:=c1.centre.y+(v*V2.x-V3.x*u)/d
  Co(2) = c1(2) + (vv * V2(1) - V3(1) * u) / d

End Sub

'draw a given circle using the fast subroutine Circle1
'defined in module Gr2D
Sub traceCercle(C())
  cx = C(1): cy = C(2): r = 1# / C(3)
  Circle1 cx, cy, r, True
End Sub

'Recursive subroutine to draw all the visible internal
'circles until size is too small}
Sub TraceInterne(c1(), c2(), c3())
Dim h11 As Boolean
Dim h12 As Boolean
Dim h13 As Boolean
Dim Co(3) 'circle
  h11 = horsLimites(c1): h12 = horsLimites(c2)
  If h11 And h12 Then Exit Sub
  h13 = horsLimites(c3)
  If h13 And (h11 Or h12) Then Exit Sub
  If c1(3) + c2(3) + c3(3) < 500 Then
    Call CercleInterne(c1, c2, c3, Co)
    Call traceCercle(Co)
    Call TraceInterne(c1, c2, Co)
    Call TraceInterne(c1, c3, Co)
    Call TraceInterne(c2, c3, Co)
  End If
End Sub

'***********************************************************
'* INPUTS:                                                 *
'*            Circle c1 defined by center and 1/radius     *
'*            Circle c2 defined by center, radius t.b.d.   *
'*            Circle c3 defined by 1/radius, center t.b.d. *
'* OUTPUTS:                                                *
'*            Circle c2 with 1/radius defined              *
'*            Circle c3 with center defined                *
'*            so that each circle is tangent to the other  *
'*            two.                                         *
'* ------------------------------------------------------- *
'* NOTE: t.b.d. means To be defined.                       *
'***********************************************************
Sub troisiemeCercle(c1(), c2(), c3())
Dim V(2) As Double         '2D vector
  C = 1# / Dist2D(c1, c2)
  If C >= c1(3) Then
    Error2D = True
  Else
    Error2D = False
  End If
  x = 1#
  For i = 1 To 12000
    x = x + Sin(x)
  Next i
  If Error2D Then Exit Sub
  A = C / c1(3): B = 1 - A: c2(3) = C / B
  Call GetVector2D(c1, c2, V)
  C = C / c3(3): A = A + C: B = B + C
  C = (A * A - B * B + 1#) / 2#
  A = Sqr(A * A - C * C)
  c3(1) = c1(1): c3(2) = c1(2)
  x = c3(1): y = c3(2)
  c3(1) = x + V(1) * C + A * V(2)
  c3(2) = y + V(2) * C - A * V(1)
End Sub


'main subroutine (called by button <Go> of main form
'uses Module Gr2D.bas
Sub Exec_Apollo()
  Dim c1(3), c2(3), c3(3) 'three circles
  Form1.Cls
  Randomize Timer
  'define physical window
  X_min = -0.6: Y_min = -0.45: X_max = 0.6: Y_max = 0.45
  Call Fenetre(X_min, X_max, Y_min, Y_max)
  'define window in pixels
  Call Cloture(500, MaxX - 25, 100, MaxY - 250)
  'additional caption
  Display 700, 400, "APOLLONIUS CIRCLES"
  'draw axes Ox, Oy
  Call Axes
  'draw grid with steps 0.1 and 0.05
  Call Grid(0.1, 0.05)
  'graduate axes with steps 0.2 and 0.1
  Call Graduate(0.2, 0.1)
  'draw a border around graph
  Call Bordure
  'main random loop
  Do
    'define first random circle
    c1(1) = Rnd(1) - 1#: c1(2) = 0.5 * Rnd(1) - 1.25
    c1(3) = Rnd(1) + 0.3
    'define center of 2nd circle
    c2(1) = Rnd(1) - 1#: c2(2) = 0.5 * Rnd(1) + 0.5
    'define curbature of 3rd circle
    c3(3) = Rnd(1) + 0.3
    'seek center of third circle
    Call troisiemeCercle(c1, c2, c3)
  Loop Until Error2D = False
  'draw the three tangent circles
  traceCercle c1
  traceCercle c2
  traceCercle c3
  'recursively draw all internal circles
  TraceInterne c1, c2, c3

End Sub

Function XNorm2D(V()) As Double
'returns the length of a 2D vector
  x = Abs(V(1))
  y = Abs(V(2))
  If x < y Then
    temp = y
    y = x
    x = temp
  End If
  If x > 0.0000000001 Then
    XNorm2D = x * Sqr(1# + (y / x) ^ 2)
  Else
    XNorm2D = 0#
  End If
End Function