Program: Two_body.bas

DEFDBL A-Z
'                              TWO_BODY.BAS
'              Revision 1.0    Original                 16 Dec 1995
'              Revision 1.1    Cosmetic Changes         20 Dec 1995
DECLARE SUB GETSCREEN ()
DECLARE SUB SETSTANDARD1 ()
DECLARE SUB INITIALISE1 ()

DIM SHARED x0(10), x1(10), y0(10), y1(10)
DIM SHARED l1, steps, isteps, iclsel, dxy, t, waittim, g
DIM SHARED xmax, ymax, xchrmax, ychrmax, fract, scren%

DIM x0h(2), x1h(2), y0h(2), y1h(2), m(2)      ' historic values

CONST ESC = 27, ENTER = 13, TAB0 = 9
CONST UP = 72, DOWN = 80, LEFT = 75, RIGHT = 77

title$ = "2 Objects m0 and m1 Demonstration"
Null$ = CHR$(0)               'See page 191

SETSTANDARD1
INITIALISE1
scren% = 12: GETSCREEN: SCREEN 12

mstr:

INITIALISE1

IF newtab = 0 THEN CLS
COLOR 7
LOCATE ychrmax - 2, 1: PRINT " Use TAB to select a point";
LOCATE ychrmax - 1, 1: PRINT " Use arrow keys to modify coordinates of the point";
LOCATE ychrmax, 1: PRINT " Use Esc to end";
COLOR 15
LOCATE 1, 25: PRINT title$
ax01 = -2 * x0(1) + x0(0) + x0(2)
ay01 = -2 * y0(1) + y0(0) + y0(2)
a0 = SQR(ax01 * ax01 + ay01 * ay01)
dx1 = x0(1) - x1(1): dy1 = y0(1) - y1(1)
r1 = SQR(dx1 * dx1 + dy1 * dy1)
m(1) = a0 * r1 * r1 / g
PRINT USING "m1 left  ########.#"; m(1)
ax11 = -2 * x1(1) + x1(0) + x1(2)
ay11 = -2 * y1(1) + y1(0) + y1(2)
a1 = SQR(ax11 * ax11 + ay11 * ay11)
m(0) = a1 * r1 * r1 / g
LOCATE 2, 60: PRINT USING "m0 right ########.#"; m(0)
dx0 = x0(0) - x1(0): dy0 = y0(0) - y1(0)
r0 = SQR(dx0 * dx0 + dy0 * dy0): rrr0 = r0 * r0 * r0
ax00 = g * m(1) * -dx0 / rrr0: vx00 = x0(1) - x0(0) - ax00 / 2
ay00 = g * m(1) * -dy0 / rrr0: vy00 = y0(1) - y0(0) - ay00 / 2
ax10 = g * m(0) * dx0 / rrr0: vx10 = x1(1) - x1(0) - ax10 / 2
ay10 = g * m(0) * dy0 / rrr0: vy10 = y1(1) - y1(0) - ay10 / 2

LOCATE 4, 1:
PRINT "G = "; g;
LOCATE 4, 64:
PRINT "hor"; TAB(74); "ver"
LOCATE 5, 60:
IF iclsel = 3 THEN COLOR 12 ELSE COLOR 7
PRINT "3"; : PRINT USING "####.##"; TAB(63); x0(2); TAB(73); 400 - y0(2)
LOCATE 6, 60:
IF iclsel = 2 THEN COLOR 12 ELSE COLOR 7
PRINT "2"; : PRINT USING "####.##"; TAB(63); x0(1); TAB(73); 400 - y0(1)
LOCATE 7, 60:
IF iclsel = 1 THEN COLOR 12 ELSE COLOR 7
PRINT "1"; : PRINT USING "####.##"; TAB(63); x0(0); TAB(73); 400 - y0(0)
x0(4) = x0(0): y0(4) = y0(0): x1(4) = x1(0): y1(4) = y1(0)
vx02 = vx00: vy02 = vy00: vx12 = vx10: vy12 = vy10

COLOR 7
FOR i = 0 TO 2
  IF i = iclsel - 1 THEN COLOR 12 ELSE COLOR 7
  PSET (x0(i), y0(i))
  PSET (x1(i), y1(i))
  ' save old values for display purposes.
  x0h(i) = x0(i): y0h(i) = y0(i): x1h(i) = x1(i): y1h(i) = y1(i)
NEXT i

icl = 0

COLOR 15
IF icl = iclsel - 1 THEN COLOR 12 ELSE COLOR 15
  PSET (x0(4), y0(4))
  PSET (x1(4), y1(4))
COLOR 15

FOR i = 0 TO steps
  dx2 = x1(4) - x1(1): dy2 = y1(4) - y1(1)
  r2 = SQR(dx2 * dx2 + dy2 * dy2)               ' distance from origin of left
  IF (i > 10 * isteps AND r2 < 10) OR r2 > 400 THEN GOTO mass2  ' terminate
  x0(3) = x0(4): x1(3) = x1(4): y0(3) = y0(4): y1(3) = y1(4)
  vx01 = vx02: vy01 = vy02: vx11 = vx12: vy11 = vy12
  dx2 = x0(3) - x1(3): dy2 = y0(3) - y1(3)
  r2 = SQR(dx2 * dx2 + dy2 * dy2): rrr2 = r2 * r2 * r2
  ax02 = g * m(1) * -dx2 / rrr2: vx02 = vx01 + ax02 * t: x0(4) = x0(3) + vx02 * t
  ay02 = g * m(1) * -dy2 / rrr2: vy02 = vy01 + ay02 * t: y0(4) = y0(3) + vy02 * t
  ax12 = g * m(0) * dx2 / rrr2: vx12 = vx11 + ax12 * t: x1(4) = x1(3) + vx12 * t
  ay12 = g * m(0) * dy2 / rrr2: vy12 = vy11 + ay12 * t: y1(4) = y1(3) + vy12 * t
  IF i MOD isteps = isteps - 1 THEN
    icl = icl + 1
    IF icl = iclsel - 1 THEN COLOR 12 ELSE COLOR 7
    IF icl = 4 AND newtab = 1 THEN newtab = 0: GOTO mass2   ' terminate
    IF icl < 3 THEN
      x0(icl) = x0(4): y0(icl) = y0(4): x1(icl) = x1(4): y1(icl) = y1(4)
    END IF
    PSET (x0(4), y0(4))
    PSET (x1(4), y1(4))
  END IF
NEXT i

mass2:

FOR i = 0 TO 2
  LOCATE 5, 60:
  IF iclsel = 3 THEN COLOR 12 ELSE COLOR 7
  PRINT "3 "; : PRINT USING "####.##"; TAB(63); x0h(2); TAB(73); 400 - y0h(2)
  IF iclsel = 2 THEN COLOR 12 ELSE COLOR 7
  LOCATE 6, 60
  PRINT "2 "; : PRINT USING "####.##"; TAB(63); x0h(1); TAB(73); 400 - y0h(1)
  IF iclsel = 1 THEN COLOR 12 ELSE COLOR 7
  LOCATE 7, 60
  PRINT "1 "; : PRINT USING "####.##"; TAB(63); x0h(0); TAB(73); 400 - y0h(0)
  IF i = iclsel - 1 THEN COLOR 12 ELSE COLOR 7
  PSET (x0(i), y0(i)): PSET (x0h(i), y0h(i))
  PSET (x1(i), y1(i)): PSET (x1h(i), y1h(i))
NEXT i

COLOR 15
LOCATE ychrmax - 2, 1: PRINT " Use TAB to select a point";
LOCATE ychrmax - 1, 1: PRINT " Use arrow keys to modify coordinates of the point";
LOCATE ychrmax, 1: PRINT " Use Esc to end";
a$ = INKEY$
DO: a$ = INKEY$: LOOP UNTIL a$ <> ""
IF a$ = CHR$(ESC) THEN END
a = ASC(a$)
' IF a = ENTER THEN GOTO mstr
IF time1 = 0 THEN
  IF UCASE$(a$) = "G" THEN
    LOCATE 6, 1: INPUT "G "; g1
    IF g1 > 0 THEN g = g1
  END IF
  FOR i = 0 TO 2
    x0(i) = x0h(i): y0(i) = y0h(i): x1(i) = x1h(i): y1(i) = y1h(i)
  NEXT i
  IF a = TAB0 THEN
    iclsel = iclsel + 1
    IF iclsel = 4 THEN iclsel = 1
    newtab = 1                          ' set new tab condition
  END IF
  IF a$ = Null$ + CHR$(RIGHT) THEN
    x0(iclsel - 1) = x0(iclsel - 1) + dxy
    ' x0(0) is the highest
    IF iclsel > 1 THEN
      IF x0(iclsel - 1) = x0(iclsel - 2) THEN x0(iclsel - 1) = x0(iclsel - 2) - dxy
    END IF
  END IF
  IF a$ = Null$ + CHR$(LEFT) THEN
    x0(iclsel - 1) = x0(iclsel - 1) - dxy
    ' x0(2) is the smallest
    IF iclsel < 3 THEN
      IF x0(iclsel - 1) = x0(iclsel) THEN x0(iclsel - 1) = x0(iclsel) + dxy
    END IF
  END IF
  IF a$ = Null$ + CHR$(UP) THEN
    y0(iclsel - 1) = y0(iclsel - 1) - dxy
    IF iclsel < 3 THEN
      IF y0(iclsel - 1) < y0(iclsel) + 1 THEN y0(iclsel - 1) = y0(iclsel) + 1
    END IF
  END IF
  IF a$ = Null$ + CHR$(DOWN) THEN
    y0(iclsel - 1) = y0(iclsel - 1) + dxy
    IF iclsel > 1 THEN
      IF y0(iclsel - 1) > y0(iclsel - 2) - 1 THEN y0(iclsel - 1) = y0(iclsel - 2) - 1
    END IF
  END IF
ELSE
  IF TIMER > time1 + waittim THEN time1 = 0   ' clear lock
END IF
GOTO mstr

SUB GETSCREEN
'                                                                  GETSCREEN
SELECT CASE scren%
CASE 7
   xmax = 320: ymax = 200: fract = 1.2
   xchrmax = 40: ychrmax = 25
CASE 8
   xmax = 640: ymax = 200: fract = 2.4
   xchrmax = 80: ychrmax = 25
CASE 9
   xmax = 640: ymax = 350: fract = 1.368
   xchrmax = 80: ychrmax = 25
CASE 12
   xmax = 640: ymax = 480: fract = 1
   xchrmax = 80: ychrmax = 30
CASE ELSE
   PRINT "SCREEN ERROR, not 7, 8, 9 or 12"
END SELECT
END SUB

SUB INITIALISE1
'                                                        INITIALISE1
dx0 = x0(0) - x0(1): dy0 = y0(0) - y0(1)
r1 = SQR(dx0 * dx0 + dy0 * dy0)            'r1 = length between pos 1,2 of m0
x1(1) = x1(0) - l1 / r1 * (x0(1) - x0(0))
y1(1) = y1(0) - l1 / r1 * (y0(1) - y0(0))
dx0 = x0(1) - x0(2): dy0 = y0(1) - y0(2)
r2 = SQR(dx0 * dx0 + dy0 * dy0)            'r2 = length between pos 1,2 of m0
l2 = l1 * r2 / r1                          'l2 = length between pos 1,2 of m1
x1(2) = x1(1) - l1 / r1 * (x0(2) - x0(1))
y1(2) = y1(1) - l1 / r1 * (y0(2) - y0(1))
END SUB

SUB SETSTANDARD1
'                                                              SETSTANDARD1
dx = 100
x0(0) = 350 + dx: y0(0) = 200      ' pos 1 m0
x0(1) = 349.75 + dx: y0(1) = 180   ' pos 2 m0
x0(2) = 346 + dx: y0(2) = 160.5    ' pos 3 m0
x1(0) = 150 + dx: y1(0) = 200      ' pos 1 m1
l1 = 4                             ' l1 = length between pos 1,2 of m1
vsteps = 1000                      ' visible number of steps
isteps = 50                        ' invisible number of steps
iclsel = 1
dxy = .25                          ' increase of arrow keys
waittim = .5                       ' wait time in seconds
g = 1                              ' G  
t = 1 / isteps: steps = vsteps * isteps
END SUB