' nm5lib.bas - jackord@kw.igs.net - revised 15 Feb 08 - Liberty Basic v4.02
' pulse on n-segment string clamped at both ends for n=48, 96, 192, and 384
' time dependence from Newton's Law or FFSS (lowest 64 modes) and dispersion relation
' symmetry used to speed FFSS calculation

' Initialize Window
  nomainwin
  button#1, "Pulse A", [p1], UL, 10, 5, 60, 20
  button#1, "Pulse B", [p2], UL, 80, 5, 60, 20
  button#1, "Motion", [p3], UL, 150, 5, 60, 20
  dim a$(5)
  a$(0)="n=48": a$(1)="n=96": a$(2)="n=192": a$(3)="n=384"
  combobox#1.c1, a$(, [waitHere], 220, 5, 70, 120
  checkbox#1.c2, "FFSS", [waitHere], [waitHere], 300, 5, 80, 20
  WindowWidth=410     ' Pixel Scale 0-392
  WindowHeight=298    ' Pixel Scale 0-260
  UpperLeftX=10: UpperLeftY=10
  open "Pulse Motion: FFSS" for graphics_nsb as #1
  #1 "trapclose [quit]"
  #1.c1 "selectindex 1"
  kk=0: plt=0: nf=768
  dim y(385): dim z(385): dim v(385): dim xx(385): dim yy(385)
  dim b(65): dim d(65): dim w(65)

[waitHere]
  wait

[p1]
  kk=1: jt=0: goto [motion]
[p2]
  kk=2: jt=0: goto [motion]
[p3]
  if kk>0 then plt=1: goto [motion]
goto [waitHere]

[motion]
  if jt=0 then
    #1.c1 "selectionindex?": input#1.c1, ind
    n=48*int(2^(ind-1))
    if n<64 then nm=n else nm=64
    redim y(n+1): redim v(n+1): redim z(n+1): redim xx(n+1): redim yy(n+1)
    redim b(nm+1): redim d(nm+1): redim w(nm+1)
    #1 "cls ; rule over ; down ; backcolor blue"
    #1 "color black ; line 3 124 3 164 ; line 388 124 388 164"
    for i=0 to n: xx(i)=4+384/n*i: next i
    dt=n/384: pi=4*atn(1)
    #1.c2 "value?": input#1.c2, z$                       ' FFSS
    for i=3*n/8 to 5*n/8                                 ' Init Pulse A
      y(i)=40*(1-cos((i-3*n/8)*pi/n*8))
      v(i)=0-40*pi/n*8*sin((i-3*n/8)*pi/n*8)
      if kk=2 then                                       ' Init Pulse B
        v(i)=v(i)*cos(4*(i-3*n/8)*pi/n*8)+y(i)*4*pi/n*8*sin(4*(i-3*n/8)*pi/n*8)
        y(i)=y(i)*cos(4*(i-3*n/8)*pi/n*8)
      end if
    next i
    if z$="set" then
      for i=1 to nm-1
        w(i)=2*sin(pi*i/2/n)
        for j=1 to n-1
          b(i)=b(i)+2*y(j)*sin(pi*i*j/n)/n
          d(i)=d(i)+2*v(j)/w(i)*sin(pi*i*j/n)/n
        next j
      next i
    else
      dt=dt/4
      for i=1 to n-1                                     ' Feynman half-step
        v(i)=v(i)+(y(i-1)+y(i+1)-2*y(i))*dt/2
      next i
    end if
    #1 "rule xor ; color blue"
    yy(0)=144: z(0)=144: z(n)=144
    if n<96 then #1 "place 4 144 ; circlefilled 4 ; circle 4 ; place 388 144 ; circlefilled 4 ; circle 4"
  end if
  tt=time$("ms")
  while jt=0 or plt=1                                    ' Main loop
    for i=1 to n                                         ' Plot y(i)
      yy(i)=144-int(y(i)+.5)
      if jt>0 then
        #1 "line "; xx(i-1); " "; z(i-1); " "; xx(i); " "; z(i)
        if n<96 and i<n then #1 "circlefilled 4 ; circle 4"
      end if
      #1 "line "; xx(i-1); " "; yy(i-1); " "; xx(i); " "; yy(i)
      if n<96 and i<n then #1 "circlefilled 4 ; circle 4"
      z(i-1)=yy(i-1)
    next i
    jt=jt+1
    if z$="set" then                                     ' FFSS
      for i=1 to n-1
        y(i)=0
        for k=1 to nm-1 step 2
          y(i)=y(i)+b(k)*sin(pi*i*k/n)*cos(w(k)*jt*dt)
        next k
        for k=2 to nm-2 step 2
          y(i)=y(i)+d(k)*sin(pi*i*k/n)*sin(w(k)*jt*dt)
        next k
      next i
    else                                                 ' Feynman algorithm
      for j=1 to 4
        for i=1 to n-1                                   ' Step y(i)
          y(i)=y(i)+v(i)*dt
        next i
        for i=1 to n-1                                   ' Step v(i) (F=ma)
          v(i)=v(i)+(y(i-1)+y(i+1)-2*y(i))*dt
        next i
      next j
    end if
    scan: #1 "discard"
    if jt=nf+1 then
      plt=0: kk=0: tt=time$("ms")-tt
      #1 "place 5 255 ; color black ; backcolor white"
      #1 "\Run time(ms)="; tt
    end if
  wend
goto [waitHere]

[quit]
  close #1
end