REM nm4bbc.bas - jackord@kw.igs.net - revised 19 Mar 07 - BBC Basic v5.50b
      REM n-segment string with fixed ends for n=8, 48, 96, 192, and 384
      REM time dependence from F=ma or FFSS (lowest 64 modes) and the dispersion reln
      REM Pluck and Pulse initial displacements
      REM y(n/4) plotted versus time
      
      *FLOAT64
      INSTALL @lib$+"WINLIB5"
      
      REM Initialize Window
      b1% = FN_button("Pluck", 80, 5, 60, 20, FN_setproc(PROCp1), 0)
      b2% = FN_button("Pulse", 150, 5, 60, 20, FN_setproc(PROCp2), 0)
      b3% = FN_button("Motion", 220, 5, 60, 20, FN_setproc(PROCp3), 0)
      c1% = FN_combobox("", 290, 5, 70, 120, 0, 3)
      c2% = FN_combobox("", 360, 5, 70, 40, 0, 3)
      WindowWidth=525
      WindowHeight=260
      VDU 23,22,WindowWidth;WindowHeight;8,15,16,128
      SYS "SetWindowText", @hwnd%, "Pulse on an N-Segment String"
      SYS "SendMessage", c1%, &143, 0, "n=8"
      SYS "SendMessage", c1%, &143, 0, "n=48"
      SYS "SendMessage", c1%, &143, 1, "n=96"
      SYS "SendMessage", c1%, &143, 1, "n=192"
      SYS "SendMessage", c1%, &143, 1, "n=384"
      SYS "SendMessage", c1%, &14E, 0, 0
      SYS "SendMessage", c2%, &143, 0, "F=ma"
      SYS "SendMessage", c2%, &143, 1, "FFSS"
      SYS "SendMessage", c2%, &14E, 0, 0
      DIM y(384): DIM v(384): DIM y2%(128)
      DIM b(64): DIM w(64)
      kk=0: plt=0: jt=0: nf=768
      OFF: VDU 5
      
      REPEAT
        WAIT 1
      UNTIL FALSE
      QUIT
      
      DEF PROCp1: kk=1: jt=0                         : REM Pulse A
      
      DEF PROCp2: kk=2: jt=0                         : REM Pulse B
      
      DEF PROCp3: IF kk>0 THEN plt=1 ELSE ENDPROC    : REM Motion
      
      IF jt=0 THEN
        SYS "SendMessage", c1%, &147, 0, 0 TO ch1%
        SYS "SendMessage", c2%, &147, 0, 0 TO ch2%
        IF ch1%=0 THEN n=8 ELSE n=48*2^(ch1%-1)
        IF n<64 THEN nm=n ELSE nm=64
        dt=n/384
        FOR i=0 TO n: y(i)=0: v(i)=0: NEXT i
        IF kk=1 THEN
          FOR i=0 TO n/2
            y(i)=448*i/n: y(n-i)=y(i)
          NEXT i
        ELSE
          FOR i=3*n/8 TO n/2
            y(i)=1792/n*(i-3*n/8): y(n-i)=y(i)
          NEXT i
        ENDIF
        IF ch2%=1 THEN
          FOR i=1 TO nm-1                            : REM FFSS
            b(i)=0: 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
            NEXT j
          NEXT i
        ELSE
          dt=dt/4                                    : REM F=ma Feynman half-step
          FOR i=1 TO n-1
            v(i)=v(i)+(y(i-1)+y(i+1)-2*y(i))*dt/2
          NEXT i
        ENDIF
        y2%(0)=232+INT(y(n/4)+1)
      ENDIF
      IF plt=1 THEN * REFRESH OFF
      tt=TIME
      WHILE jt=0 OR plt=1
        CLS: GCOL 0: MOVE 8, 190: DRAW 8, 270: MOVE 776, 190: DRAW 776, 270
        MOVE 784, 232: DRAW 1040, 232
        GCOL 12: MOVE 8, 260
        FOR i=0 TO n: DRAW 8+768/n*i, 232+INT(y(i)+1): NEXT i    : REM Draw string
        IF n<96 THEN
          FOR i=0 TO n                               : REM Point masses if n<96
            IF i=n/4 THEN GCOL 9 ELSE GCOL 12
            CIRCLE FILL 10+768/n*i, 230+INT(y(i)+1), 8
          NEXT i
        ENDIF
        GCOL 9: MOVE 784, y2%(0)                     : REM Plot y(n/4) versus time
        n2%=INT(jt/6): IF n2%=jt/6 THEN y2%(n2%)=232+INT(y(n/4)+1)
        FOR i=0 TO n2%
          DRAW 784+2*i, y2%(i)
        NEXT i
        IF plt=1 THEN * REFRESH
        jt=jt+1
        IF ch2%=1 THEN
          FOR i=1 TO n/2                             : REM FFSS
            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
            y(n-i)=y(i)
          NEXT i
        ELSE
          FOR j=1 TO 4                               : REM F=ma
            FOR i=1 TO n-1
              y(i)=y(i)+v(i)*dt
            NEXT i
            FOR i=1 TO n-1
              v(i)=v(i)+(y(i-1)+y(i+1)-2*y(i))*dt
            NEXT i
          NEXT j
        ENDIF
        WHILE (TIME-tt)<2*jt: WAIT 1: ENDWHILE
        IF jt=nf+1 THEN plt=0: kk=0: * REFRESH ON
      ENDWHILE
      ENDPROC