REM df5bbc.bas - jackord@kw.igs.net - 20 Dec 2010 - BBC Basic 5.50b
      REM X-ray diffraction patterns for cubic crystals genertated by superimposing
      REM   Huygens' wavelets from an nxnxn array of single atoms (SC) or a basis of
      REM   two (BCC) or four (FCC) atoms, where n is either scanned from 2 to 1024
      REM   or set to 256.
      REM The wavelength can be chosen to enhance diffraction from
      REM   (111), (201), or (211) planes.
      
      *FLOAT 64
      
      REM Install libraries
      INSTALL @lib$+"WINLIB5"
      
      REM Controls
      b1% = FN_button("PLOT", 20, 5, 50, 20, FN_setproc(PROCq1), 0)
      c0% = FN_combobox("", 15, 30, 60, 20, 0, 3)
      c1% = FN_combobox("", 2, 80, 86, 60, 0, 3)
      c2% = FN_combobox("", 2, 105, 86, 60, 0, 3)
      c3% = FN_combobox("", 2, 130, 86, 60, 0, 3)
      
      REM Initialize window
      WindowWidth=330                                             : REM Pixel Scale 0-330
      WindowHeight=240                                            : REM Pixel Scale 0-240
      VDU 23,22,WindowWidth;WindowHeight;8,12,16,128
      SYS "SetWindowText", @hwnd%, "X-ray diffraction from Cubic Crystals"
      SYS "SendMessage", c0%, &143, 0, "SC"
      SYS "SendMessage", c0%, &143, 0, "BCC"
      SYS "SendMessage", c0%, &143, 0, "FCC"
      SYS "SendMessage", c1%, &143, 0, "Transmit"
      SYS "SendMessage", c1%, &143, 0, "Reflect"
      SYS "SendMessage", c2%, &143, 0, "Scan n"
      SYS "SendMessage", c2%, &143, 0, "n=256"
      SYS "SendMessage", c3%, &143, 0, "la=2a/3"
      SYS "SendMessage", c3%, &143, 0, "la=2a/5"
      SYS "SendMessage", c3%, &143, 0, "la=2a/6"
      SYS "SendMessage", c0%, &14E, 0, 0
      SYS "SendMessage", c1%, &14E, 0, 0
      SYS "SendMessage", c2%, &14E, 0, 0
      SYS "SendMessage", c3%, &14E, 0, 0
      *FONT Arial,10
      OFF: ON CLOSE QUIT
      ORIGIN 420, 240
      DIM la(4)
      a=3.615E-7: z=30: zz=z*z
      la(0)=2*a/3: la(1)=2*a/5: la(2)=2*a/6
      
      REPEAT
        WAIT 1
      UNTIL FALSE
      
      DEF PROCq1
      CLS : VDU 5
      SYS "SendMessage", c0%, &147, 0, 0 TO ch0%
      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
        di=1                                                      :REM Transmit
      ELSE
        di=-1                                                     :REM Reflect
      ENDIF
      IF ch2%=0 THEN
        n1=1: n2=10                                               :REM Scan
      ELSE
        n1=8: n2=n1                                               :REM n=256
      ENDIF
      * REFRESH OFF
      FOR n=n1 TO n2                                              :REM Scan loop
        FOR ny=-120 TO 120                                        :REM Screen Y loop
          FOR nx=-120 TO 120                                      :REM Screen X loop
            r0=SQR(zz+nx*nx+ny*ny)
            b=2*PI*a/r0/la(ch3%)
            sr=1: si=0: ni=1: sn=1
            kk=1: s$="SC"                                         :REM Simple Cubic
            IF ch0%=1 THEN
              t=b/2*(nx+ny+di*z-r0): rr=COS(t): ri=SIN(t)
              qr=sr+rr*sr-ri*si: si=si+rr*si+ri*sr: sr=qr
              kk=2: s$="BCC"                                      :REM Body-Centred Cubic
            ENDIF
            IF ch0%=2 THEN
              t=b/2*(nx+ny): rr=COS(t): ri=SIN(t)
              qr=sr+rr*sr-ri*si: qi=si+rr*si+ri*sr
              t=b/2*(nx+di*z-r0): rr=COS(t): ri=SIN(t)
              qr=qr+rr*sr-ri*si: qi=qi+rr*si+ri*sr
              t=b/2*(ny+di*z-r0): rr=COS(t): ri=SIN(t)
              qr=qr+rr*sr-ri*si: qi=qi+rr*si+ri*sr: sr=qr: si=qi
              kk=4: s$="FCC"                                      :REM Face-Centred Cubic
            ENDIF
            FOR i=1 TO n                                          :REM Array 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 n                                          :REM Array 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
            ni=1
            FOR i=1 TO n                                          :REM Array Z loop
              t=b*ni*(di*z-r0): 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=2550*(sr*sr+si*si)/sn/sn/kk/kk: IF c>255 THEN c=255
            GCOL 1: COLOUR 1, 0, c, 0: PLOT 2*nx, 2*ny            :REM Plot Intensity
          NEXT nx
        NEXT ny
        GCOL 15: MOVE -230, -210: PRINT s$; "    n="; 2^n
        * REFRESH
      NEXT n
      * REFRESH ON
      ENDPROC