IUBio Biosequences .. Software .. Molbio soft .. Network News .. FTP

The Black-Body Power Spectrum [was: Re: 'gravity' [___]]

KP_PC k.p.collins at worldnet.att.net
Thu Oct 9 13:13:28 EST 2003


'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







More information about the Neur-sci mailing list

Send comments to us at biosci-help [At] net.bio.net