REM df2bbc.bas - jackord@kw.igs.net - revised 12 Feb 10 - BBC Basic 5.50b
      REM The diffraction pattern produced when light from a helium-neon laser
      REM   strikes a circular (d=.05 mm) aperture and falls on a screen 1000 mm
      REM   away (125 mm if "z/8" is chosen). One pixel represents 1 mm on the screen.
      REM The plot is "overexposed" to make lower intensity variations visible.
      REM The numerical calculation uses either a square grid with 41 points along d
      REM   (21 if "n/2" is chosen), or a random array with the same number of points.
      
      *FLOAT 64
      
      REM Install libraries
      INSTALL @lib$+"WINLIB5"
      
      REM Controls
      b1% = FN_button("Run", 5, 5, 50, 20, FN_setproc(PROCq1), 0)
      c1% = FN_combobox("", 5, 30, 50, 60, 0, 3)
      c2% = FN_combobox("", 5, 55, 50, 60, 0, 3)
      c3% = FN_combobox("", 5, 80, 50, 60, 0, 3)
      
      REM Initialize window
      WindowWidth=300                                   : REM Pixel Scale 0-300
      WindowHeight=240                                  : REM Pixel Scale 0-240
      VDU 23,22,WindowWidth;WindowHeight;8,12,16,128
      SYS "SetWindowText", @hwnd%, "Circular Aperture"
      SYS "SendMessage", c1%, &143, 0, "n"
      SYS "SendMessage", c1%, &143, 0, "n/2"
      SYS "SendMessage", c2%, &143, 0, "z"
      SYS "SendMessage", c2%, &143, 0, "z/8"
      SYS "SendMessage", c3%, &143, 0, "Grd"
      SYS "SendMessage", c3%, &143, 0, "Rnd"
      SYS "SendMessage", c1%, &14E, 0, 0
      SYS "SendMessage", c2%, &14E, 0, 0
      SYS "SendMessage", c3%, &14E, 0, 0
      *FONT Arial,10
      DIM x(1400), y(1400)
      OFF: ON CLOSE QUIT
      REPEAT
        WAIT 1
      UNTIL FALSE
      
      DEF PROCq1
      CLS : VDU 5
      ORIGIN 360, 240
      SYS "SendMessage", c1%, &147, 0, 0 TO ch1%
      SYS "SendMessage", c2%, &147, 0, 0 TO ch2%
      SYS "SendMessage", c3%, &147, 0, 0 TO ch3%
      IF ch1%=0 THEN n=20 ELSE n=10
      IF ch2%=0 THEN z=1000 ELSE z=125
      la=.633/1000: zz=z*z                              : REM Helium-neon red
      d=.05: dd=d/(2*n+1): nn=n*(n+1): nm=INT(PI*nn): r2=d*d/4
      sc=255000./nm/nm
      tt=TIME
      IF ch3%=0 THEN
        FOR ny=0 TO 120                                 : REM Screen loops
          FOR nx=0 TO 120
            r0=SQR(zz+nx*nx+ny*ny): sr=0: si=0
            a=.5*(1+z/r0)*z/r0: b=2*PI/r0/la
            FOR j=-n TO n                               : REM Aperture Y loop
              yg=j*dd: m=INT(SQR(nn-j*j))
              FOR i=-m TO m                             : REM Aperture X loop
                xg=i*dd
                t=b*(nx*xg+ny*yg)
                sr=sr+a*COS(t): si=si+a*SIN(t)
              NEXT i
            NEXT j
            c=INT((sr*sr+si*si)*sc): IF c>255 THEN c=255
            GCOL 1
            COLOUR 1,c,0,0
            PLOT 2*nx, 2*ny                             : REM Plot Intensity
            PLOT -2*nx, 2*ny                            : REM assuming symmetry
            PLOT 2*nx, -2*ny
            PLOT -2*nx, -2*ny
          NEXT nx
        NEXT ny
      ELSE
        ns=0: sc=sc/2
        WHILE ns<nm
          xg=d*(RND(1)-.5): yg=d*(RND(1)-.5)
          IF xg*xg+yg*yg<=r2 THEN ns=ns+1: x(ns)=xg: y(ns)=yg
        ENDWHILE
        FOR ny=-120 TO 120                              : REM Screen loops
          FOR nx=-120 TO 120
            r0=SQR(zz+nx*nx+ny*ny): sr=0: si=0
            a=.5*(1+z/r0)*z/r0: b=2*PI/r0/la
            FOR i=1 TO nm                               : REM Array loop
              t=b*(nx*x(i)+ny*y(i))
              sr=sr+a*COS(t): si=si+a*SIN(t)
            NEXT i
            c=INT((sr*sr+si*si)*sc): IF c>255 THEN c=255
            GCOL 1
            COLOUR 1,c,0,0
            PLOT 2*nx, 2*ny                             : REM Plot Intensity
          NEXT nx
        NEXT ny
      ENDIF
      GCOL 0: MOVE -350, -204: PRINT "T="; INT((TIME-tt)/100); " s";
      ENDPROC