DECLARE SUB curva (r!, l!, n!, h1!, h2!, col!)
n = 1: h1 = 1: h2 = 2: R1 = .86: R2 = .042: l1 = .46: l2 = .7
SCREEN 12
LOCATE 10, 1
PRINT " PROGRAM 'FAIRY'"
PRINT
PRINT
PRINT "Plots the transmissivity of a plane paralell plate of
refractive"
PRINT "index n and variable thickness h between limits h1 and h2,
illuminated"
PRINT "at normal incidence with two wavelengths l1 and l2, with two
different"
PRINT "values R1 and R2 of the reflectivity of both faces. This
reflectivity"
PRINT "is supposed given by an aggregated surface layer and not by
a Fresnel"
PRINT "reflection. Is for study of the profile of multiple beam
fringes."; ""
PRINT "The default values are those of Fig. 2.3"
PRINT "Lengths in microns."
PRINT "To finish put n = 0."
DO: LOOP WHILE INKEY$ = ""
DO
CLS
PRINT "n ="; n; : INPUT a$: IF a$ <> "" THEN n
= VAL(a$)
IF n = 0 THEN END
PRINT "h1 ="; h1; : INPUT a$: IF a$ <> "" THEN
h1 = VAL(a$)
PRINT "h2 ="; h2; : INPUT a$: IF a$ <> "" THEN
h2 = VAL(a$)
PRINT "R1 ="; R1; : INPUT a$: IF a$ <> "" THEN
R1 = VAL(a$)
PRINT "R2 ="; R2; : INPUT a$: IF a$ <> "" THEN
R2 = VAL(a$)
PRINT "l1 ="; l1; : INPUT a$: IF a$ <> "" THEN
l1 = VAL(a$)
PRINT "l2 ="; l2; : INPUT a$: IF a$ <> "" THEN
l2 = VAL(a$)
CLS
LOCATE 30, 1: PRINT h1; : LOCATE 30, 76: PRINT h2;
FOR x = 0 TO 640 STEP 64
IF x = 640 THEN x = 639
LINE (x, 0)-(x, 480), 8
NEXT x
FOR x = 0 TO 640 STEP 6.4
LINE (x, 0)-(x, 5), 8
LINE (x, 474)-(x, 479), 8
NEXT x
FOR y = 0 TO 480 STEP 48
IF y = 480 THEN y = 479
LINE (0, y)-(640, y), 8
NEXT y
FOR y = 0 TO 480 STEP 4.8
LINE (0, y)-(5, y), 8
LINE (634, y)-(639, y),
8
NEXT y
CALL curva(R1, l1, n, h1, h2, 4)
CALL curva(R2, l1, n, h1, h2, 4)
CALL curva(R1, l2, n, h1, h2, 9)
CALL curva(R2, l2, n, h1, h2, 9)
DO: LOOP WHILE INKEY$ = ""
LOOP
SUB curva (r, l, n, h1, h2, col)
pi = 4 * ATN(1)
f = 4 * r / ((1 - r) ^ 2)
FOR h = h1 TO h2 STEP (h2 - h1) / 640
it = 1 / (1 + f * (SIN(2 * pi * n * h / l)) ^ 2)
xp = 640 * (h - h1) / (h2 - h1)
yp = 480 * (1 - it)
IF h = h1 THEN PSET (xp, yp)
LINE -(xp, yp), col
NEXT h
END SUB