REM PROGRAM D3_BOHR ADAPTED FROM EINSTEIN
REM THIS PROGRAM SHOULD SHOW THE EFFECTS OF DIFFERENT WAVELENGTHS
PI = 3.141593: DRC = PI / 180: PI23 = 2 * PI / 3
L = 100: AMP = .5
R1 = 2: YC = 20
RA = .5: RE = .1: RORB = 1
DIM ATM(200), DX(5), DY(5)
DIM R(14), G(14), B(14)
R(1) = 54: G(1) = 0: B(1) = 54
R(2) = 24: G(2) = 0: B(2) = 40
R(3) = 0: G(3) = 0: B(3) = 48
R(4) = 0: G(4) = 0: B(4) = 63
R(5) = 0: G(5) = 36: B(5) = 60
R(6) = 16: G(6) = 48: B(6) = 63
R(7) = 0: G(7) = 56: B(7) = 0
R(8) = 36: G(8) = 63: B(8) = 0
R(9) = 63: G(9) = 63: B(9) = 0
R(10) = 63: G(10) = 48: B(10) = 0
R(11) = 63: G(11) = 36: B(11) = 0
R(12) = 63: G(12) = 24: B(12) = 0
R(13) = 54: G(13) = 0: B(13) = 0
R(14) = 36: G(14) = 0: B(14) = 0

SCREEN 12
FOR I = 1 TO 14
HUE = 65536 * B(I) + 256 * G(I) + R(I)
PALETTE I, HUE
NEXT I
WINDOW (0, 0)-(80, 60)
CIRCLE (10, 10), RA, 6
PAINT (10, 10), 6
GET (10 - RA, 10 - RA)-(10 + RA, 10 + RA), ATM
PUT (10 - RA, 10 + RA), ATM, XOR
CLS : COLOR 15
PRINT "THIS PROGRAM SHOWS HOW DIFFERENT WAVELENGTHS OF LIGHT IMPACT MOLECULES"
PRINT "                    HIT ANY KEY TO BEGIN PROGRAM"
WHILE INKEY$ = "": WEND
CLS
LINE (28, 51)-(13, 56)
LINE (28, 51)-(28, 48)
LINE (52, 56)-(35, 51)
LINE (35, 51)-(35, 48)
FOR I = 2 TO 14
LINE (7 + 3 * I, 56)-(10 + 3 * I, 57), I, BF
NEXT I
LINE (5, 15)-(75, 15)
LOCATE 24, 9: PRINT ".1       .2       .4        1        5       10       20       50"
COLOR 9: LOCATE 25, 2: PRINT "IONIZE    SPLIT     SPLIT       L (æm)             ROTATE       VIBRATE"
LOCATE 26, 2: PRINT " ATOMS     O-O      OZONE  LITTLE IMPACT ON GAS     3+ ATOM MOLECULES"
COLOR 2: LOCATE 7, 8: PRINT "ULTRAVIOLET"
COLOR 15: LOCATE 7, 29: PRINT "VISIBLE"
COLOR 13: LOCATE 7, 54: PRINT "INFRARED": COLOR 15
FOR I = 1 TO 8
X = 9 * I + 1: XC = X - 5
LINE (9 * I + .5, 15)-(9 * I + .5, 16)
SELECT CASE I
CASE 1
PUT (XC - RA, YC - RA), ATM
XE = XC + RORB
YE = YC
CIRCLE (XE, YE), RE
CASE 2
DX = 1.25 * RA: DY = 0
PUT (XC + DX, YC + DY), ATM, XOR
PUT (XC - DX, YC - DY), ATM, XOR
CASE ELSE
FOR NA = 1 TO 3
DX(NA) = 1.25 * RA * COS(NA * PI23)
DY(NA) = 1.25 * RA * SIN(NA * PI23)
PUT (XC + DX(NA), YC + DY(NA)), ATM, XOR
NEXT NA

END SELECT

IF I < 3 THEN HUE = 2
IF I = 4 THEN HUE = 15
IF I > 4 THEN HUE = 14
IF I = 4 OR I = 5 THEN J2 = 120 ELSE J2 = 0
FOR J = 0 TO 800 + J2
YWV = 26 + YC - .032 * J
XWV = X + AMP * SIN(J / (2 * 1.5 ^ I))
THTA = PI * J / 100
SELECT CASE I
CASE 1
CIRCLE (XE, YE), RE, 0
XE = XC + RORB * COS(THTA)
YE = YC + RORB * SIN(THTA)
CIRCLE (XE, YE), RE
CASE 2
PUT (XC + DX, YC + DY), ATM, XOR
PUT (XC - DX, YC - DY), ATM, XOR
DX = 1.25 * RA * COS(THTA)
DY = 1.25 * RA * SIN(THTA)
PUT (XC + DX, YC + DY), ATM, XOR
PUT (XC - DX, YC - DY), ATM, XOR
CASE ELSE
FOR NA = 1 TO 3
PUT (XC + DX(NA), YC + DY(NA)), ATM, XOR
DX(NA) = 1.25 * RA * COS(THTA + NA * PI23)
DY(NA) = 1.25 * RA * SIN(THTA + NA * PI23)
PUT (XC + DX(NA), YC + DY(NA)), ATM, XOR
NEXT NA

END SELECT

FOR KK = 1 TO 1000
NEXT KK
PSET (XWV - 5, YWV), HUE
NEXT J

SELECT CASE I
CASE 1
FOR KK = 1 TO 1000
CIRCLE (XE, YE), RE, 0
XE = XE - .005: YE = YE + .01
CIRCLE (XE, YE), RE
NEXT KK
PUT (XC - RA, YC - RA), ATM
CASE 2
FOR KK = 1 TO 1000
PUT (XC + DX, YC + DY), ATM, XOR
PUT (XC - DX, YC - DY), ATM, XOR
DX = DX + .01
DY = DY + .02
PUT (XC + DX, YC + DY), ATM, XOR
PUT (XC - DX, YC - DY), ATM, XOR
NEXT KK
PUT (XC + DX, YC + DY), ATM, XOR
PUT (XC - DX, YC - DY), ATM, XOR
CASE 3
FOR KK = 1 TO 1000
FOR NA = 1 TO 3
PUT (XC + DX(NA), YC + DY(NA)), ATM, XOR
DX(NA) = DX(NA) + .015 * (-.5 + NA MOD 2)
DY(NA) = DY(NA) - .03 * (.5 - NA MOD 2)
PUT (XC + DX(NA), YC + DY(NA)), ATM, XOR
NEXT NA
NEXT KK
FOR NA = 1 TO 3
PUT (XC + DX(NA), YC + DY(NA)), ATM, XOR
NEXT NA
CASE 4 TO 7
IF I < 6 THEN
DDTH = 1
ELSEIF I = 6 THEN
DDTH = 3
ELSE
DDTH = 2
END IF
FOR KK = 1 TO 2500
THTA = THTA + DDTH * PI / 300
FOR NA = 1 TO 3
PUT (XC + DX(NA), YC + DY(NA)), ATM, XOR
DX(NA) = 1.25 * RA * COS(THTA + NA * PI23)
DY(NA) = 1.25 * RA * SIN(THTA + NA * PI23)
PUT (XC + DX(NA), YC + DY(NA)), ATM, XOR
NEXT NA
NEXT KK
FOR NA = 1 TO 3
PUT (XC + DX(NA), YC + DY(NA)), ATM, XOR
NEXT NA
CASE 8
FOR KK = 1 TO 2500
THTA = THTA + DDTH * PI / 300
THT2 = KK * PI / 160
DRMOL = 2 - .75 * COS(THT2)
FOR NA = 1 TO 3
PUT (XC + DX(NA), YC + DY(NA)), ATM, XOR
DX(NA) = DRMOL * RA * COS(THTA + NA * PI23)
DY(NA) = DRMOL * RA * SIN(THTA + NA * PI23)
PUT (XC + DX(NA), YC + DY(NA)), ATM, XOR
NEXT NA
NEXT KK
FOR NA = 1 TO 3
PUT (XC + DX(NA), YC + DY(NA)), ATM, XOR
NEXT NA
END SELECT
NEXT I