REM df3bbc.bas - jackord@kw.igs.net - revised 13 Feb 10 - BBC Basic 5.50b
      REM The diffraction pattern produced when light from a helium-neon laser
      REM   strikes either
      REM   (1) an equilateral triangular aperture (side d=.05 mm),
      REM   (2) a rectangular aperture (.05x.025 mm), or
      REM   (3) a square aperture (side .05 mm)
      REM   and falls on a screen 1000 mm away (125 mm if "z/8" is chosen for the triangle).
      REM One pixel represents 1 mm on the screen.
      REM The numerical calculation uses
      REM   (1) a close-packed array for the triangle with 50 points along d
      REM       (25 if "n/2" is chosen)
      REM   (2) a square 1024x512 grid for the rectangle
      REM   (3) a square 1024x1024 grid for the square.
      REM The rectangle and square use the fast algorithm.
      REM The plot is "overexposed" to make lower intensity variations visible.
      
      *FLOAT 64
      
      REM Install libraries
      INSTALL @lib$+"WINLIB5"
      
      REM Controls
      b1% = FN_button("Tri", 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)
      b2% = FN_button("Rec", 5, 80, 50, 20, FN_setproc(PROCq2), 0)
      b3% = FN_button("Sqr", 5, 105, 50, 20, FN_setproc(PROCq3), 0)
      
      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%, "Triangle, Rectangle, and Square"
      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", c1%, &14E, 0, 0
      SYS "SendMessage", c2%, &14E, 0, 0
      *FONT Arial,10
      OFF: ON CLOSE QUIT
      REPEAT
        WAIT 1
      UNTIL FALSE
      
      DEF PROCq1                                        : REM Triangle
      CLS : VDU 5
      ORIGIN 360, 240
      SYS "SendMessage", c1%, &147, 0, 0 TO ch1%
      SYS "SendMessage", c2%, &147, 0, 0 TO ch2%
      IF ch1%=0 THEN n=50 ELSE n=25
      IF ch2%=0 THEN z=1000 ELSE z=125
      la=.633/1000: zz=z*z                              : REM Helium-neon red
      d=.05: dd=d/n: nm=n*(n+1)/2: sc=255000./nm/nm
      tt=TIME
      FOR ny=-120 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*dd/r0/la: by=b*SQR(3)/2
          FOR j=0 TO n-1                                : REM Aperture Y loop
            FOR i=1 TO n-j                              : REM Aperture X loop
              t=b*nx*(i+.5*j)+by*ny*j
              sr=sr+COS(t): si=si+SIN(t)
            NEXT i
          NEXT j
          c=INT((sr*sr+si*si)*a*a*sc): IF c>255 THEN c=255
          GCOL 1
          COLOUR 1,c,0,0
          PLOT 2*nx, 2*ny: PLOT -2*nx, 2*ny             : REM Plot Intensity
        NEXT nx
      NEXT ny
      GCOL 15: MOVE -40, -24: DRAW 40, -24: DRAW 0, 48: DRAW -40, -24
      GCOL 0: MOVE -350, -204: PRINT "T="; INT((TIME-tt)/100); " s";
      ENDPROC
      
      DEF PROCq2: nc=9                                  : REM Rectangle
      
      DEF PROCq3: nc=10                                 : REM Square
      SYS "SendMessage", c1%, &14E, 0, 0
      SYS "SendMessage", c2%, &14E, 0, 0
      CLS : VDU 5
      ORIGIN 360,240
      la=.633/1000                                      : REM Helium-neon red
      nb=10: n=1024: d=.05: dd=d/n: z=1000: zz=z*z
      sc=255000
      tt=TIME
      FOR ny=0 TO 120                                   : REM Screen loops
        FOR nx=0 TO 120
          r0=SQR(zz+nx*nx+ny*ny)
          a=.5*(1+z/r0)*z/r0: b=2*PI*dd/r0/la
          sr=1: si=0: ni=1: sn=1.0
          FOR i=1 TO nb                                 : REM Aperture X loop
            t=b*ni*nx
            rr=COS(t): ri=SIN(t)
            qr=sr+rr*sr-ri*si: si=si+rr*si+ri*sr
            sr=qr: ni=2*ni: sn=2*sn
          NEXT i
          ni=1
          FOR i=1 TO nc                                 : REM Aperture Y loop
            t=b*ni*ny
            rr=COS(t): ri=SIN(t)
            qr=sr+rr*sr-ri*si: si=si+rr*si+ri*sr
            sr=qr: ni=2*ni: sn=2*sn
          NEXT i
          c=(sr*sr+si*si)*a*a*sc/sn/sn: IF c>255 THEN c=255
          GCOL 1
          COLOUR 1, c, 0, 0
          PLOT 2*nx, 2*ny: PLOT -2*nx, 2*ny             : REM Plot Intensity
          IF ny>0 THEN PLOT 2*nx, -2*ny: PLOT -2*nx, -2*ny
        NEXT nx
      NEXT ny
      GCOL 15:
      IF nc=9 THEN RECTANGLE -40, -20, 80, 40 ELSE RECTANGLE -40, -40, 80, 80
      GCOL 0: MOVE -350, -204: PRINT "T="; (TIME-tt)/100; " s";
      ENDPROC