'ComptREF.BAS - a simple animation of the Compton scattering data.
'-------------------------- RUN
INSTRUCTIONS ---------------------------
'RUN the app by opening it in QBasic, and hitting F5.
'To terminate the iteration, press the <Esc> key [once]. The app will
'complete the current iteration.
'When the yellow "e" appears, press the <e> key to terminate the app.
'Hitting any other key will continue to the NEXT STEP in the
program.1.
'----------------------There are currently FIVE MAIN PROGRAM STEPS.
When I posted this version of
'----------------------the app, all five were active.
'[Execution can also be terminated by holding down the <Ctrl> key and
'pressing the <Break> key. It's best to use <Shift> + <F5> to start
the
'app after using <Ctrl> + <Break> [because QBasic tends to 'jumble'
graphical
'output following <Ctrl> + <Break>.
'If you want to single-step the program, uncomment the "u.PauseQ"
statements.
'[remove the "'" in the leftmost column] or add more of your own.
'The various steps in the app can be deselected by placing a ['] in
the
'left-most column of the code below [after the "Begin" label].
'In QBasic, the subroutines can be accessed by hitting F2.
'(c) by K. p. Collins, Sunday, 2002-12-15.
'------------------------ END of RUN
INSTRUCTIONS ---------------------
'This app depicts the Compton Scattering apparatus schematically, and
plots
'electron recoil' via two different methods [refs in the code].
'The 'wiggles' in the 'apparatus' view are the 'electron recoil'
variations.
'Tapered Harmony explains the 'catenaries' in the 'scattering' traces
via
'continuous index of refraction variation. This will be demonstrated
in the
'next version of the "Compton" app that I post.
'ken
'---------------------- START OF PROGRAM
CODE -------------------------
DECLARE SUB m.Apparatus ()
DECLARE SUB m.SSW (deOnly%)
DECLARE SUB n.Compton ()
DECLARE SUB n.Trig ()
DECLARE SUB p.Apparatus (FullScreen%)
DECLARE SUB v.LeftBot ()
DECLARE SUB v.MidBot ()
DECLARE SUB v.RgtBot ()
DECLARE SUB p.SSW (deOnly%)
DECLARE SUB p.Common ()
DECLARE SUB v.MidTop.0 ()
DECLARE SUB u.PrnHdr.SSW ()
DECLARE SUB u.DrawXRay.Source (CX, CY, r1, r2, FullScreen%)
DECLARE SUB u.PrnHDRDetail ()
DECLARE SUB u.Init ()
DECLARE SUB u.prn (value, L%, r%, lead%, dec%)
DECLARE SUB u.SetColors (colorOutLim%)
DECLARE SUB u.PauseQ ()
DECLARE SUB u.SlowDown ()
DECLARE SUB v.RgtTop (FullScreen%)
DECLARE SUB v.LeftTop ()
DECLARE SUB p.trig ()
DECLARE SUB u.PrnHdr.Trig ()
DECLARE SUB u.PrnHdr.Aparatus ()
DECLARE SUB u.InitPhase ()
DECLARE SUB p.Vol.Nuc ()
DECLARE SUB p.Vol.Shell ()
DECLARE SUB p.Smiley ()
DECLARE SUB p.dDE ()
DECLARE SUB p.DE ()
DECLARE FUNCTION u.GetStep (direction%)
DECLARE SUB SetBotRightView ()
DECLARE SUB u.SetColor.BB (BBmethod%, BBcolor1%)
DECLARE SUB v.MidTop.1 ()
DECLARE SUB n.trig.TAN ()
DECLARE SUB v.MidBot.TANX ()
DECLARE SUB v.LeftBot.BB (left, top, hgt, wid)
DECLARE SUB L (X1, Y1, X2, Y2, ColorL%)
DECLARE SUB v.RgtBot.NUC ()
DECLARE SUB v.RgtBot.Shell ()
DECLARE SUB n.InitTheta ()
DECLARE SUB n.TrigMAX ()
COMMON SHARED compression%, color1%, color2% 'app state variables
COMMON SHARED theta0%, theta1% 'starting theta
COMMON SHARED Comptn% 'switch views
COMMON SHARED gridNUC%, gridSHELL% 'draw\not grids
COMMON SHARED r, de, dWL, theta 'SSW vars @ theta
COMMON SHARED deMax, deMin, WL0 'global limits
COMMON SHARED lastVolNuc, lastVolSHELL 'doubling save
COMMON SHARED lastDE, lastWRK 'doubling save
COMMON SHARED pi '3.141592653589793
COMMON SHARED border% 'Show/not Borders
COMMON SHARED dDEview% 'full-screen m.dDE
COMMON SHARED rad, tRAD 'covert-to-radians
factors
DIM tr(1 TO 40) AS SINGLE
COMMON SHARED tr() AS SINGLE 'Trig Fx sine, cosine
values
DIM tt(1 TO 20) AS SINGLE
COMMON SHARED tt() AS SINGLE 'Trig Fx tangent
values
COMMON SHARED delay 'Slow Processing on
fast PCs
'set, below, to a %
of one second
'set, below, to 0 for
no delay
'===================== USER-MODIFIABLE PARAMETERS
========================
'CONST slow% = 1 'uncomment if you want the thing to
single-step
'at 1-second intervals [~3 minutes per
phase].
'When running "slowly", holding down the
<Ctrl>
'key overrides. Hit the <Pause> key if you
want
'to look at interesting theta correlations
'CONST fast% = 1 'uncomment for a quick look
border% = 7 'uncomment to turn on view borders
'[Turning off borders gives a better view
'into the left and right viewports'
mapping
'of the spherical Geometry's rigorous
'correlation to the continuous refraction
'dynamics.]
delay = 0 'set slowdown factor for your PC [% of one
second]
'One 1/100 of a second, delay = 1
'one second: delay = 100
'or any single-precision number between 0
and 100.
IF delay > 100 THEN delay = 100 'don't delay more than
one sec
'==================== END USER-MODIFIABLE PARAMETERS
=====================
CONST h = 6.626076E-34 'Js - Planck's 'constant'
CONST me = 9.10939E-31 'kg - 'mass' of 'electron'
CONST C = 2.997924E+08 'm/s - speed of light
CONST e.NL = 2.718281828459045# ' Natural Log base
CONST BoltzK = 1.380658E-23 ' Boltzmann's constant (J/K)
CONST ESC = 27
begin:
'm.Apparatus 'full-screen Compton Scattering apparatus
[schematic]
m.SSW 0 'SSW<->UES harmonics - continuously-varying index
of refraction
'm.SSW 1 'SSW<->UES harmonics - dE only
GOTO begin
SUB L (X1, Y1, X2, Y2, ColorL%)
LINE (X1, Y1)-(X2, Y2), ColorL%
END SUB
SUB m.Apparatus
u.Init
u.InitPhase
u.PrnHdr.Aparatus
IF delay = 0 THEN
delaying% = 1
delay = 10
END IF
compression% = 1
ex% = 0
WHILE ex% = 0
compression% = compression% * -1
'flip-flop phase
StepSize = u.GetStep(compression%)
FOR theta = theta0% TO theta1% STEP StepSize
k$ = INKEY$
IF k$ = CHR$(ESC) THEN
u.PauseQ
ELSEIF k$ = "e" OR k$ = "E" THEN
ex% = 1
EXIT FOR
ELSE
p.Apparatus 1
IF delay > 0 THEN u.SlowDown
END IF
NEXT
WEND
IF delaying% = 1 THEN
delay = 0
END IF
u.PauseQ
END SUB
SUB m.dDE
u.Init
u.InitPhase
dDEview% = 1
u.PrnHdr.SSW
compression% = 1
ex% = 0
WHILE ex% = 0
compression% = compression% * -1
'flip-flop phase
StepSize = u.GetStep(compression%)
FOR theta = theta0% TO theta1% STEP StepSize
k$ = INKEY$
IF k$ = CHR$(ESC) THEN
u.PauseQ
ELSEIF k$ = "e" OR k$ = "E" THEN
ex% = 1
EXIT FOR
ELSE
n.InitTheta
p.dDE
IF delay > 0 THEN u.SlowDown
END IF
NEXT
WEND
dDEview% = 0
u.PauseQ
END SUB
SUB m.SSW (deOnly%)
u.Init
u.InitPhase
u.PrnHdr.SSW
compression% = 1
ex% = 0
WHILE ex% = 0
compression% = compression% * -1
'flip-flop phase
StepSize = u.GetStep(compression%)
FOR theta = theta0% TO theta1% STEP StepSize
k$ = INKEY$
IF k$ = CHR$(ESC) THEN
u.PauseQ
ELSEIF k$ = "e" OR k$ = "E" THEN
ex% = 1
EXIT FOR
ELSE
n.InitTheta
p.SSW deOnly%
IF delay > 0 THEN u.SlowDown
END IF
NEXT
IF compression% = -1 THEN
gridSHELL% = 1 'don't
draw grids
ELSE
gridNUC% = 1
END IF
WEND
u.PauseQ
END SUB
SUB n.Compton
dWL = (h / (me * C)) 'calc delta WL using Compton
equation
dWL = dWL * (1 - COS(theta * rad)) * 10 ^ 9
de = dWL / WL0 'calc delta energy
diff = deMax - de
r = diff
IF Comptn% <> 1 THEN
'@@@n.Vol.Nuc 'plot compression volume ratio
'@@@n.Vol.Shell 'plot expansion volume ratio
END IF
END SUB
SUB n.InitTheta
tRAD = theta * rad
n.Compton
n.Trig
n.trig.TAN
END SUB
SUB n.Trig
ERASE tr
tr(1) = r * COS(tRAD)
tr(2) = r * SIN(tRAD)
tr(3) = r * COS(tRAD / 2)
tr(4) = r * SIN(tRAD / 2)
tr(5) = r * COS(tRAD / 4)
tr(6) = r * SIN(tRAD / 4)
tr(7) = r * COS(tRAD / 8)
tr(8) = r * SIN(tRAD / 8)
tr(9) = r * COS(tRAD / 16)
tr(10) = r * SIN(tRAD / 16)
tr(11) = r * COS(tRAD / 32)
tr(12) = r * SIN(tRAD / 32)
tr(21) = deMax * COS(tRAD)
tr(22) = deMax * SIN(tRAD)
tr(23) = deMax * COS(tRAD / 2)
tr(24) = deMax * SIN(tRAD / 2)
tr(25) = deMax * COS(tRAD / 4)
tr(26) = deMax * SIN(tRAD / 4)
tr(27) = deMax * COS(tRAD / 8)
tr(28) = deMax * SIN(tRAD / 8)
tr(29) = deMax * COS(tRAD / 16)
tr(30) = deMax * SIN(tRAD / 16)
tr(31) = deMax * COS(tRAD / 32)
tr(32) = deMax * SIN(tRAD / 32)
END SUB
SUB n.Trig.Notes
'tr(1) = r * COS(t)
'tr(2) = r * SIN(t)
'
'tr(3) = r * COS(t / 2)
'tr(4) = r * SIN(t / 2)
'
'tr(5) = r * COS(t / 4)
'tr(6) = r * SIN(t / 4)
'
'tr(7) = r * COS(t / 8)
'tr(8) = r * SIN(t / 8)
'
'tr(9) = r * COS(t / 16)
'tr(10) = r * SIN(t / 16)
'
'tr(11) = r * COS(t / 32)
'tr(12) = r * SIN(t / 32)
'
'tr(21) = deMax * COS(t)
'tr(22) = deMax * SIN(t)
'
'tr(23) = deMax * COS(t / 2)
'tr(24) = deMax * SIN(t / 2)
'
'tr(25) = deMax * COS(t / 4)
'tr(26) = deMax * SIN(t / 4)
'
'tr(27) = deMax * COS(t / 8)
'tr(28) = deMax * SIN(t / 8)
'
'tr(29) = deMax * COS(t / 16)
'tr(30) = deMax * SIN(t / 16)
'
'tr(31) = deMax * COS(t / 32)
'tr(32) = deMax * SIN(t / 32)
END SUB
SUB n.trig.TAN
ERASE tt
tt(1) = r * TAN(tRAD)
tt(2) = r * TAN(tRAD / 2)
tt(3) = r * TAN(tRAD / 4)
tt(4) = r * TAN(tRAD / 8)
tt(5) = r * TAN(tRAD / 16)
tt(6) = r * TAN(tRAD / 32)
tt(13) = deMax * TAN(tRAD)
tt(14) = deMax * TAN(tRAD / 2)
tt(15) = deMax * TAN(tRAD / 4)
tt(16) = deMax * TAN(tRAD / 8)
tt(17) = deMax * TAN(tRAD / 16)
tt(18) = deMax * TAN(tRAD / 32)
END SUB
SUB p.Apparatus (FullScreen%)
v.RgtTop FullScreen%
CLS
r1 = 25 'inner radius
r2 = 35 'outer radius
CX = 62 'center of
circle X
IF FullScreen% = 1 THEN CY = 35.25 ELSE CY = 50 'center of circle
Y
tRAD = theta * rad
r2CosT2 = r2 * COS(tRAD / 2)
r2SinT2 = r2 * SIN(tRAD / 2)
r2CosT = r2 * COS(tRAD)
r2SinT = r2 * SIN(tRAD)
u.DrawXRay.Source CX, CY, r1, r2, FullScreen%
LINE (CX - (.3 * r2CosT2), CY - (.3 * r2SinT2))-(CX + (.3 * r2CosT2),
CY + (.3 * r2SinT2)), 7 'cystal spectrometer
IF theta > 0 THEN
IF theta > 175 THEN
LINE (19, CY + 5)-(21, CY - 5), 8, BF 'shutter
ELSE
CIRCLE (CX, CY), r2 / 3, 3, tRAD, pi 'theta arc
LINE (19, CY - 2)-(21, CY - 12), 8, BF 'shutter
LINE (19, CY)-(CX, CY), 15 'incident x-ray
LINE (CX, CY)-(CX + r2, CY), 8 'incident x-ray.S
'refraction
LINE (CX, CY)-(CX + r2CosT, CY + r2SinT), 5
END IF
ELSE
LINE (19, CY - 2)-(21, CY - 12), 8, BF 'shutter
LINE (19, CY)-(CX + r2, CY), 15 'incident x-ray
END IF
'u.PauseQ
END SUB
SUB p.Common
v.LeftTop
u.prn theta, 1, 4, 3, 0 'print Theta
u.prn de, 1, 14, 0, 0 'print delta energy
u.prn dWL, 1, 31, 0, 0 'print delta wavelength
PSET (theta, de), color1% 'plot delta energy @ Theta
IF theta = 90 THEN
LINE (0, de)-(180, de), 2 'plot inflection
END IF
IF compression% = 1 THEN
LINE (0, -.0003)-(theta, -.0003), 3 'plot Theta
LINE (-3, 0)-(-3, de), 12 'plot delta energy
ELSE
LINE (0, -.0003)-(180, -.0003), 0
LINE (0, -.0003)-(theta, -.0003), 3 'plot Theta
LINE (-3, 0)-(-3, deMax), 0
LINE (-3, 0)-(-3, de), 12 'plot delta energy
END IF
IF Comptn% <> 1 THEN
p.dDE
END IF
IF slow% THEN
SLEEP 1 'steps at 1 second
intervals
END IF
END SUB
SUB p.dDE
STATIC lastTheta
u.SetColors colorOutLim%
v.MidBot
COLOR 7: LOCATE 20, 38: PRINT "~d("; : COLOR 4: PRINT "dE"; : COLOR
7: PRINT ")"
IF (precision% = 0 AND (theta = 0 OR theta = 180)) OR (precision% = 1
AND (theta <= .1 OR theta >= 179.8)) THEN
lastDE = deMin
lastWRK = -deMin
END IF
IF compression% = 1 THEN
WRK = lastDE - de
u.prn WRK, 22, 35, 0, 0
IF precision% = 1 THEN
PSET (theta - 1.05, (WRK)), color1%
ELSE
IF fast% = 1 THEN
PSET (theta - 2.5, (WRK)), color1%
ELSE
PSET (theta, (WRK)), color1%
END IF
END IF
ELSE
WRK = de - lastDE
IF theta < 179 THEN
u.prn WRK, 22, 35, 0, 0
ELSE
LOCATE 22, 33: PRINT " -"; : PRINT CHR$(236); : PRINT "
"
END IF
IF precision% THEN
PSET (theta - .95, (WRK)), color1%
ELSE
IF fast% = 1 THEN
PSET (theta + 2.5, (WRK)), color1%
ELSE
PSET (theta + 1, (WRK)), color1%
END IF
END IF
END IF
IF compression% = 1 AND theta <> 180 AND WRK < 2 * lastWRK THEN
LINE (theta - 1, .000005)-(theta - 1, .000025), color1%
LINE (theta - 5, WRK)-(theta + 5, WRK), color1%
lastWRK = WRK
ELSEIF compression% = -1 AND WRK < (2 * lastWRK) THEN
LINE (theta - 1, .000005)-(theta - 1, .000025), color1%
LINE (theta - 5, WRK)-(theta + 5, WRK), color1%
lastWRK = WRK
END IF
lastDE = de
lastTheta = theta
'u.PauseQ
END SUB
SUB p.Smiley
VIEW (5, 5)-(635, 475)
WINDOW
CIRCLE (250, 100), 50, 7, , , 3 / 4
CIRCLE (350, 100), 50, 7, , , 3 / 4
LINE (300, 150)-(250, 250), 7
LINE (250, 250)-(300, 275), 7
END SUB
SUB p.SSW (deOnly%)
CX = .03
CY = .03
p.Apparatus 0
u.SetColors colorOutLim%
v.MidTop.0
CIRCLE (CX, CY), deMax, colorOutLim% 'outer limit
IF deOnly% = 0 THEN 'whole SSW<->UES
IF theta = 0 THEN
LINE (-CX, CY)-(2 * CX, CY), 8 'horizontal axis
LINE (-CX, CY)-(2 * CX, CY), 15 'incoming energy
pass-through
ELSE
LINE (CX, -CY)-(CX, 2 * CY), 8 'vertical axis
LINE (-CX, CY)-(2 * CX, CY), 8 'horizontal axis
CIRCLE (CX, CY), deMax / 3, 3, tRAD, pi 'theta arc
LINE (0, CY)-(CX - r, CY), 15 'incoming energy
'SWS refraction
LINE (CX, CY)-(CX + tr(1), CY + tr(2)), 5
LINE (CX + tr(1), CY + tr(2))-(CX + tr(21), CY + tr(22)), 14
LINE (CX - r, CY)-(CX, CY), 5 'incoming refraction
LINE (CX - r, CY)-(CX + tr(1), CY + tr(2)), 7 'chord
END IF
IF theta < 180 THEN
CIRCLE (CX, CY), r, color1% 'inner edge compress
& expand
END IF
LINE (CX - (.5 * tr(23)), CY - (.5 * tr(24)))-(CX + (.5 * tr(23)),
CY + (.5 * tr(24))), 7 'cystal spectrometer
ELSE 'only delta energy
IF theta <> 0 THEN
'SWS refraction
LINE (CX + tr(1), CY + tr(2))-(CX + tr(21), CY + tr(22)), 14
END IF
END IF
'IF theta = 90 THEN
' CIRCLE (CX - tr(2), CY + tr(2)), tr(2), 14, 3 * pi / 2, 1.9999 *
pi
' u.PauseQ
'END IF
p.Vol.Nuc 'plot compression
volume ratio
p.Vol.Shell 'plot expansion
volume ratio
p.Common
v.LeftBot
v.MidBot
v.RgtBot
'''u.MEM 'check memory status
'u.PauseQ
END SUB
SUB p.trig
CX = .03
CY = .03
n.Compton
u.SetColors colorOutLim%
v.MidTop.0
CIRCLE (CX, CY), deMax, 8 'outer limit
CIRCLE (CX, CY), r, 8 'SSW
LINE (-CX, CY)-(2 * CX, CY), 8 'horizontal axis
LINE (-CX, CY)-(2 * CX, CY), 8 'horizontal axis
'SWS refraction
'LINE (cx, CY)-(cx + tr(1), CY + tr(2)), 5
'LINE (cx + tr(1), CY + tr(2))-(cx + tr(7), CY + tr(8)), 14
FOR J% = 1 TO 12
FOR I% = 1 TO 12
u.prn theta, 12, 2, 3, 0
LOCATE 14, 2: PRINT J%, I%
LINE (CX, CY)-(CX + tr(J%), CY + tr(I%)), 14
LINE (CX + tr(J%), CY + tr(I%))-(CX + tr(J%), CY + tr(I%)), 9
LINE (CX - tr(J%), CY - tr(I%))-(CX - tr(J%), CY - tr(I%)), 10
LINE (CX + tr(J%), CY - tr(I%))-(CX + tr(J%), CY - tr(I%)), 11
LINE (CX - tr(J%), CY + tr(I%))-(CX - tr(J%), CY + tr(I%)), 12
LINE (CX + tr(J%), CY + tr(I%))-(CX + tr(J%), CY + tr(I%)), 13
LINE (CX + tr(J%), CY - tr(I%))-(CX - tr(J%), CY - tr(I%)), 14
LINE (CX - tr(J%), CY + tr(I%))-(CX - tr(J%), CY - tr(I%)), 15
LINE (CX - tr(J%), CY - tr(I%))-(CX + tr(J%), CY - tr(I%)), 7
LINE (CX - tr(J%), CY - tr(I%))-(CX - tr(J%), CY + tr(I%)), 4
IF delay > 0 THEN u.SlowDown
'u.PauseQ
NEXT
NEXT
'u.PauseQ
END SUB
SUB p.trig.0
'vertex right horizontal triangle top side
LINE (CX + r2SinT2, CY + r2Cos2)-(CX - r2SinT2, CY + r2CosT2), 2
'vertex right horizontal triangle left bas
LINE (CX - r2SinT2, CY + r2CosT2)-(CX - r2SinT2, CY - r1CosT), 7
'LINE (cx - r2SinT2, CY - r2CosT2)-(cx - r2SinT2, CY - r2CosT2), 2
'horizontal triangle bot side
'LINE (cx + r2SinT2, CY + r2Cos2)-(cx - r2SinT2, CY - r2CosT2), 2
'horizontal triangle top side
'LINE (cx - r2SinT2, CY + r2Cos2)-(cx + r2SinT2, CY + r2CosT2), 4
'horizontal triangle right bas
'LINE (cx + r2SinT2, CY - r2CosT2)-(cx + r2SinT2, CY + r2CosT2), 4
'LINE (cx + r2SinT2, CY - r2CosT2)-(cx + r2SinT2, CY + r2CosT2), 4
'horizontal triangle bot side
'LINE (cx - r2SinT2, CY + r2Cos2)-(cx + r2SinT2, CY - r2CosT2), 4
'vertical left
'vertical chord right
LINE (CX + r2CosT2, CY - r2SinT2)-(CX + r2CosT2, CY + r2SinT2), 1
'vertical chord left
'LINE (cx - r2CosT2, CY - r2SinT2)-(cx - r2CosT2, CY + r2SinT2), 5
'vertical chord right
'LINE (cx + r2CosT2, CY - r2SinT2)-(cx + r2CosT2, CY + r2SinT2), 7
'horizontal chord top
'LINE (cx - r2CosT2, CY + r2SinT2)-(cx + r2CosT2, CY + r2SinT2), 3
'horizontal chord bot
'LINE (cx + r2CosT2, CY - r2SinT2)-(cx - r2CosT2, CY - r2SinT2), 6
END SUB
SUB p.Vol.Nuc
IF compression% = 1 THEN 'compression
SignOP% = 1
ELSE
SignOP% = -1
END IF
IF theta < 179.7 THEN
volSphereOUT = 4 / 3 * pi * deMax ^ 3
volSphereIN = 4 / 3 * pi * r ^ 3
volRatioNUC = volSphereOUT / (SignOP% * volSphereIN)
END IF
IF compression% = 1 AND gridNUC% = 0 THEN
v.RgtBot.NUC
minY = -10 * deMin: maxY = deMax + 10 * deMin
IF theta >= 54 AND theta < 178 AND (volRatioNUC > (2 *
lastVolNuc)) THEN
LINE (theta + 2.5, .95 * 10000000)-(theta + 2.5, -10000000), 8
'vertical
lastVolNuc = volRatioNUC
v.LeftTop
LINE (theta, 0)-(theta, deMax), 8
LINE (0, de)-(177, de), 8 'grid delta
energy
END IF
END IF
IF theta >= 54 THEN 'AND theta < 170 THEN
v.RgtBot.NUC
PSET (theta, (-1 * SignOP% * volRatioNUC)), color1% 'plot
VolRatioNUC
END IF
'u.PauseQ
COLOR 7
END SUB
SUB p.Vol.Shell
IF compression% = 1 THEN 'compression
SignOP% = -1
ELSE
SignOP% = 1
END IF
IF theta <> 0 THEN
volSphereOUT = 4 / 3 * pi * deMax ^ 3
volSphereIN = 4 / 3 * pi * r ^ 3
volRatioSHELL = volSphereOUT / (volSphereOUT - volSphereIN)
END IF
IF compression% = -1 THEN
IF gridSHELL% = 0 THEN 'draw
gridlines once
v.RgtBot
IF theta > .9 THEN
IF theta < 55 AND volRatioSHELL > (2 * lastVolSHELL) THEN
LINE (theta, 0)-(theta, 98), 8 'vertical grid
line
lastVolSHELL = volRatioSHELL
v.LeftTop
IF theta < 180 THEN
LINE (theta, 0)-(theta, deMax), 8
END IF
LINE (0, de)-(177, de), 8 'hor grid delta
energy
END IF
END IF
END IF
END IF
IF theta > .9 AND theta < 55 THEN
v.RgtBot.Shell
PSET (theta, volRatioSHELL), color1% 'plot volume
ratio
END IF
COLOR 7
'u.PauseQ
END SUB
SUB SetBotRightView
X1 = 640 - 185: X2 = X1 + 182
VIEW (X1, 234)-(X2, 463), , border% 'set viewport for compression
volume plot
WINDOW (-5, 100)-(184, -10000)
END SUB
SUB u.DrawXRay.Source (CX, CY, r1, r2, FullScreen%)
LINE (10, CY + 2)-(14, CY - 2), 1, BF 'scattering'
material
IF FullScreen% = 1 THEN
VIEW (56, 203)-(114, 292)
ELSE
VIEW (447, 111)-(462, 137)
END IF
WINDOW (-10, -10)-(10, 10)
FOR I% = 1 TO 5 'I was 'bored'
:-]
colorX% = INT(16 * RND)
offSET = INT((21) * RND - 10)
LINE (0, 0)-(10 * COS(offSET), 10 * SIN(offSET)), colorX%
NEXT
v.RgtTop FullScreen%
CIRCLE (12, CY + 20), 5, 15, .15 * pi, .85 * pi 'x-ray source0
CIRCLE (8, CY + 20), 3, 15, .5 * pi, 1.5 * pi 'x-ray source1
CIRCLE (16, CY + 20), 3, 15, 1.5 * pi, 0 'x-ray source2
CIRCLE (16, CY + 20), 3, 15, 0, .5 * pi 'x-ray source3
CIRCLE (12, CY + 20), 5, 15, 1.14 * pi, 1.85 * pi 'x-ray source4
LINE (8, CY + 20)-(16, CY + 20), colorX% 'x-ray element
LINE (12, CY + 18)-(12, CY), 15 'incident x-ray0
LINE (12, CY)-(19, CY), 15 'incident x-ray1
LINE (5, CY + 10)-(11, CY + 8), 8, BF 'shield top left
LINE (13.5, CY + 10)-(19, CY + 8), 8, BF 'shield top right
LINE (17, CY + 10)-(19, CY + 2), 8, BF 'shield left-top
LINE (17, CY - 2)-(19, CY - 9), 8, BF 'shield left-bot
LINE (5, CY + 10)-(7, CY - 9), 8, BF 'shield right
LINE (5, CY - 7)-(19, CY - 9), 8, BF 'shield bottom
CIRCLE (CX, CY), r1, 8 'detector orbit
END SUB
FUNCTION u.GetStep (phase%)
IF precision% = 1 THEN
IF phase% = 1 THEN
theta0% = 0
theta1% = 179.9
ELSE
theta0% = 179.9
theta1% = 0
END IF
u.GetStep = .1 * phase%
ELSEIF fast% = 1 THEN
IF phase% = 1 THEN
theta0% = 0
theta1% = 180
ELSE
theta0% = 180
theta1% = 0
END IF
u.GetStep = 5 * phase%
ELSE
IF phase% = 1 THEN
theta0% = 1
theta1% = 180
ELSE
theta0% = 180
theta1% = 0
END IF
u.GetStep = 1 * phase%
END IF
END FUNCTION
SUB u.Init
SCREEN 12
VIEW: WINDOW: CLS
RANDOMIZE TIMER
dDEview% = 0
Comptn% = 0
gridNUC% = 0
gridSHELL% = 0
pi = 4 * ATN(1)
rad = pi / 180
WL0 = .2 'Wavelength(0) - calculate the Compton equation for 0.20
nm xrays
deMax = ((h / (me * C)) * (1 - COS(180 * (pi / 180))) / WL0) * 10 ^ 9
deMin = ((h / (me * C)) * (1 - COS(1 * (pi / 180))) / WL0) * 10 ^ 9
END SUB
SUB u.InitPhase
lastVolNuc = 0
lastVolSHELL = 0
lastDE = deMin
lastWRK = deMax
END SUB
SUB u.Mem
VIEW: WINDOW: CLS
LOCATE 10, 17: PRINT "Num-ARRAY"
LOCATE 10, 29: PRINT "STACK"
LOCATE 10, 37: PRINT "STRING"
PRINT "Memory status: "
LOCATE 11, 16: PRINT FRE(-1)
LOCATE 11, 28: PRINT FRE(-2)
LOCATE 11, 36: PRINT FRE("")
u.PauseQ
END SUB
SUB u.PauseQ
COLOR 14: LOCATE 1, 79: PRINT "e"
114 a$ = INKEY$: IF a$ = "" THEN GOTO 114
IF a$ = "c" OR a$ = "c" THEN CLS
IF a$ = "E" OR a$ = "e" THEN COLOR 7: END
COLOR 0: LOCATE 1, 79: PRINT "e": COLOR 7
END SUB
SUB u.prn (value, r%, C%, lead%, dec%)
LOCATE r%, C%: PRINT SPC(lead% + dec%); 'erase prior value
COLOR color1%
LOCATE r%, C%
IF dec% = 8 THEN
PRINT USING "#.########"; value
ELSEIF dec% = 4 THEN
PRINT USING "##.####"; value
ELSEIF lead% = 0 THEN
PRINT USING "#.##########"; value
ELSEIF lead% = 3 THEN
COLOR 3
PRINT USING "###.#"; value
ELSEIF lead% = 10 THEN
PRINT USING "##########.######"; value
ELSEIF lead% = 17 THEN
PRINT USING "#################.######"; value
END IF
COLOR 7
END SUB
SUB u.PrnHdr.Aparatus
COLOR 15
LOCATE 1, 25: PRINT "Compton Scattering Apparatus"
COLOR 7
END SUB
SUB u.PrnHDR.Detail
IF dDEview% = 1 THEN
IF compression% = 1 THEN
'compression phase
IF color1% = 12 THEN
'nucleating
LOCATE 21, 35: PRINT " Nucleating "
ELSE 'just
compressing
LOCATE 21, 35: PRINT " Un-shelling "
END IF
ELSE
'expansion phase
IF color1% = 9 THEN 'shelling
LOCATE 21, 35: PRINT " Shelling "
ELSE 'just
expanding
LOCATE 21, 35: PRINT "Un-nucleating"
END IF
END IF
ELSEIF smile% <> 1 THEN
IF compression% = 1 THEN
'compression phase
IF color1% = 12 THEN
'nucleating
COLOR 7: LOCATE 21, 35: PRINT " Nucleating "
LOCATE 27, 60: PRINT "Compression": COLOR color1%
LOCATE 28, 60: PRINT "Nucleating "
COLOR 7: LOCATE 8, 66: PRINT "Compression ": COLOR color1%
LOCATE 9, 66: PRINT "Nucleating "
ELSE 'just
compressing
COLOR 7: LOCATE 21, 35: PRINT " Un-shelling "
LOCATE 27, 60: PRINT "Compression": COLOR color1%
LOCATE 28, 60: PRINT "Un-shelling"
COLOR 7: LOCATE 8, 66: PRINT "Compression": COLOR color1%
LOCATE 9, 66: PRINT "Un-shelling"
END IF
ELSE 'expansion
phase
IF color1% = 9 THEN 'shelling
COLOR 7: LOCATE 21, 35: PRINT " Shelling "
LOCATE 8, 66: PRINT "EXPANSION ": COLOR color1%
LOCATE 9, 66: PRINT "Shelling "
COLOR 7: LOCATE 27, 60: PRINT "Expansion ": COLOR color1%
LOCATE 28, 60: PRINT "Shelling "
ELSE 'just
expanding
COLOR 7: LOCATE 21, 35: PRINT "Un-nucleating"
LOCATE 8, 66: PRINT "Expansion ": COLOR color1%
LOCATE 9, 66: PRINT "Un-nucleating"
COLOR 7: LOCATE 27, 60: PRINT "Expansion ": COLOR color1%
LOCATE 28, 60: PRINT "Un-nucleating "
END IF
END IF
END IF
COLOR 7
END SUB
SUB u.PrnHdr.SSW
COLOR 15
LOCATE 1, 2: PRINT CHR$(233) 'theta
COLOR 14
LOCATE 1, 11: PRINT "dE" 'delta energy
COLOR 15
LOCATE 1, 27: PRINT "dWL" 'delta wavelength
LOCATE 1, 58: PRINT "SSW<->UES Harmonics"
COLOR 7
END SUB
SUB u.PrnHdr.Trig
COLOR 15
LOCATE 17, 2: PRINT "X1:" 'LINE x1
LOCATE 18, 2: PRINT "Y1:" 'LINE y1
LOCATE 19, 2: PRINT "X2:" 'LINE x2
LOCATE 20, 2: PRINT "Y2:" 'LINE y2
COLOR 7
END SUB
SUB u.SetColor.BB (BBmethod%, BBcolor1%)
IF compression% = 1 THEN 'set Black Body
display colors
IF theta >= 55 THEN
color1% = 12 'high-red
IF BBmethod% = 1 THEN
BBcolor1% = 9 'high-blue
ELSEIF BBmethod% = 2 THEN
BBcolor1% = 11 'high-cyan
ELSEIF BBmethod% = 3 THEN
BBcolor1% = 12 'high-red
ELSE
BBcolor1% = 7 'low-white
END IF
ELSE
color1% = 4 'low-red
IF BBmethod% = 1 THEN
BBcolor1% = 1 'low-blue
ELSEIF BBmethod% = 2 THEN
BBcolor1% = 3 'low-cyan
ELSEIF BBmethod% = 3 THEN
BBcolor1% = 4 'low-red
ELSE
BBcolor1% = 8 'grey
END IF
END IF
ELSE
IF theta > 54 THEN
color1% = 1
IF BBmethod% = 1 THEN
BBcolor1% = 1 'low-blue
ELSEIF BBmethod% = 2 THEN
BBcolor1% = 3 'low-cyan
ELSEIF BBmethod% = 3 THEN
BBcolor1% = 4 'low-red
ELSE
BBcolor1% = 8 'grey
END IF
ELSE
color1% = 9
IF BBmethod% = 1 THEN
BBcolor1% = 9 'high-blue
ELSEIF BBmethod% = 2 THEN
BBcolor1% = 11 'high-cyan
ELSEIF BBmethod% = 3 THEN
BBcolor1% = 12 'high-red
ELSE
BBcolor1% = 7 'low-white
END IF
END IF
END IF
END SUB
SUB u.SetColors (colorOutLim%)
IF compression% = 1 THEN 'set display colors
colorOutLim% = 8
IF theta >= 55 THEN
color1% = 12
color2% = 9
ELSE
color1% = 4
color2% = 1
END IF
ELSE
IF theta > 54 THEN
color1% = 2
color2% = 1
colorOutLim% = 8
ELSE
color1% = 10
color2% = 9
colorOutLim% = 10
END IF
END IF
END SUB
SUB u.SlowDown
TIMER ON
start = TIMER
DO UNTIL elapsed > start + (delay / 100)
elapsed = TIMER
LOOP
TIMER OFF
'COLOR 8
'LOCATE 1, 2
'PRINT USING "."; elapsed - start 'elapsed-time in upper-left
corner
'COLOR 7
END SUB
SUB v.LeftBot
VIEW (4, 234)-(206, 477), , border%
WINDOW (-5, -(400 * deMin))-(185, deMax + (100 * deMin))
END SUB
SUB v.LeftBot.BB (left, top, hgt, wid)
VIEW (4, 234)-(206, 477), , border%
WINDOW (left, -top)-(wid, hgt)
END SUB
SUB v.LeftTop
VIEW (4, 20)-(206, 230), , border%
WINDOW (-5, -(400 * deMin))-(185, deMax + (100 * deMin))
END SUB
SUB v.MidBot
IF dDEview% = 1 THEN 'set viewport for Middle-Middle
~m.dDE View
VIEW (50, 479)-(600, 1)
ELSE
VIEW (210, 234)-(424, 477), , border%
END IF
IF precision% = 1 THEN 'very-sensitive `window'
diagonal
WINDOW (-20, .000005)-(200, -.000022)
ELSE
IF fast% = 1 THEN
WINDOW (-5, 7.499999999999999D-05)-(187.5, -.00114)
ELSE
WINDOW (-5, .00004)-(187.5, -.00023)
END IF
END IF
END SUB
SUB v.MidBot.TANX
VIEW (210, 234)-(424, 477), , border%
'WINDOW (-1, 0)-(181, .0055)
WINDOW (-1, 0)-(181, .02)
END SUB
SUB v.MidTop.0
VIEW (210, 20)-(424, 230), , border%
WINDOW (0, 0)-(.061, .06)
CLS
END SUB
SUB v.MidTop.1
VIEW (210, 20)-(424, 230), , border%
WINDOW (0, 0)-(.061, .06)
END SUB
SUB v.RgtBot
VIEW (428, 234)-(638, 477), , border%
IF compression% = 1 THEN
WINDOW (-5, 100)-(184, -10000)
ELSE
WINDOW (-5, 100)-(184, 0)
END IF
END SUB
SUB v.RgtBot.NUC
VIEW (428, 234)-(638, 477), , border%
'WINDOW (-5, 100)-(184, -10000) 'standard
WINDOW (0, 10000000)-(180, -10000000)
END SUB
SUB v.RgtBot.Shell
VIEW (428, 234)-(638, 477), , border%
WINDOW (0, 100)-(180, -95)
'WINDOW (-5, 100)-(184, 0) 'standard
'WINDOW (-5, 100)-(184, -10000) 'nuc
END SUB
SUB v.RgtTop (FullScreen%)
IF FullScreen% = 1 THEN
VIEW (4, 20)-(638, 477), , border%
WINDOW (-1, -1)-(101, 71)
ELSE
VIEW (428, 20)-(638, 230), , border%
WINDOW (-1, -1)-(101, 101)
END IF
END SUB
