' fplwlib.bas - jackord@kw.igs.net - Revised 27 Apr 07 - Liberty Basic v4.02

' Initialize Window
  nomainwin
  button#1, "-2", [Gravity], UL, 6, 4, 26, 18
  button#1, "-1", [InverseR], UL, 42, 4, 26, 18
  button#1, "+1", [Spring], UL, 78, 4, 26, 18
  WindowWidth=410     ' pixel scale 0-400
  WindowHeight=429    ' pixel scale 0-400
  UpperLeftX=100: UpperLeftY=100
  open "Central-Force Motion" for graphics_nsb as #1   ' no slide bars
  #1 "trapclose [quit]"
  gosub [init]

[waitHere]
  wait

[Gravity]
  gosub [init]
  dt=.001: test=1: lp=1
  t=0: x=1: y=0: vx=0: vy=.488: #1 "place 380 200": tt=time$("ms")
  rm=(x*x+y*y)^1.5: vx=vx-x/rm*dt/2: vy=vy-y/rm*dt/2
  while lp=1                                 ' Feynman loop
    xo=x: yo=y: t=t+dt: x=x+vx*dt: y=y+vy*dt
    if test=1 and y<=0 and yo>0 then rmin=0-x: test=0
    #1 "goto "; 200+int(180*x+.5); " "; 200-int(180*y+.5)
    rm=(x*x+y*y)^1.5: vx=vx-x/rm*dt: vy=vy-y/rm*dt
    if y>=0 and yo<0 then lp=0
    while time$("ms")-tt<3000*t: wend
  wend
  t=t-y/vy
  #1 "color black ; place 0 316"
  #1 "\Gravity: n=-2"
  #1 "\Closure Test: Rmax = "; x
  #1 "\Closest Approach: Rmin = "; rmin
  #1 "\Apsidal Angle = 180 degrees"
  #1 "\Torbit/Tcircle = "; t/8/atn(1)
  #1 "\Kepler's Law a^1.5 = "; ((x+rmin)/2)^1.5; " where a = (Rmin+Rmax)/2"
goto [waitHere]

[InverseR]
  gosub [init]
  dt=.001: test=1
  t=0: x=1: y=0: vx=0: vy=.488: #1 "place 380 200": tt=time$("ms")
  rm=x*x+y*y: vx=vx-x/rm*dt/2: vy=vy-y/rm*dt/2
  while t<47.5                                 ' Feynman loop
    if test =1 then xo=x: yo=y: rmin=rm
    t=t+dt: x=x+vx*dt: y=y+vy*dt
    #1 "goto "; 200+int(180*x+.5); " "; 200-int(180*y+.5)
    rm=x*x+y*y: vx=vx-x/rm*dt: vy=vy-y/rm*dt
    if rm>rmin then test=0
    while time$("ms")-tt<500*t: wend
  wend
  #1 "color black ; place 0 364"
  #1 "\Inverse R: n=-1"
  #1 "\Rmin = "; (rmin)^.5
  #1 "\Apsidal Angle = "; 180*(1+atn(yo/xo)/atn(1)/4); " = 360*11/32 degrees"
goto [waitHere]

[Spring]
  gosub [init]
  dt=.001: test=1: lp=1
  t=0: x=1: y=0: vx=0: vy=.488: #1 "place 380 200"
  vx=vx-x*dt/2: vy=vy-y*dt/2
  while lp=1                                 ' Feynman loop
    xo=x: yo=y: t=t+dt: x=x+vx*dt: y=y+vy*dt
    if test=1 and x<=0 and xo>0 then rmin=y: test=0
    #1 "goto "; 200+int(180*x+.5); " "; 200-int(180*y+.5)
    vx=vx-x*dt: vy=vy-y*dt
    if y>=0 and yo<0 then lp=0
    while time$("ms")-tt<1300*t: wend
  wend
  t=t-y/vy
  #1 "color black ; place 0 332"
  #1 "\Spring: n=+1"
  #1 "\Closure Test: Rmax = "; x
  #1 "\Closest Approach: Rmin = "; rmin
  #1 "\Apsidal Angle = 90 degrees"
  #1 "\Torbit/Tcircle = "; t/8/atn(1)

goto [waitHere]

[init]
  #1 "cls ; down ; color black"
  #1 "place 12 36": #1 "\Select Power"
  #1 "backcolor green ; place 200 200 ; circlefilled 19"
  #1 "backcolor red ; place 380 200 ; circlefilled 6"
  #1 "line 377 176 380 170 ; line 383 176 380 170 ; goto 380 200"
  #1 "color blue ; backcolor white"
return

[quit]
  close #1
end