Program: moon.bas
Program description Select: Programma MOON nl
DECLARE SUB STORE (r23#)
DECLARE SUB GETANGLE (x#, y#, angle#)
DEFDBL A-Z
' VVS.BAS
'
CONST pi = 3.141592653589#
CONST rad = 180 / pi
CONST esc = 27, ENTER = 13
DIM SHARED idim, rr23(30), imax, max, imin, min
SCREEN 12
' x corner y corner = 640,480
xctr = 640 / 2: yctr = 480 / 2
idim = 2
SL1:
CLS
PRINT "0 End "
PRINT "1 Asteroide outside <> Earth inside"
PRINT "2 Asteroide inside <> Earth outside"
PRINT "3 Asteroide = Earth"
PRINT "4 Earth Straight line "
PRINT "5 Earth free fall v = 0"
PRINT "6 Earth ellipse"
PRINT "7 Earth circle "
PRINT "8 Moon ellipse"
INPUT "Test "; test
IF test < 1 OR test > 8 THEN END
h = .004 ' delta time
rev = 1 ' rev = 0 short distance
mulc = 1.6
mulc1 = 5
dispcond = 100 ' inner loop count
slow = 0 ' slow. Enter s or S
m1 = 100000: m2 = 100: m3 = 0
x1 = 0: y1 = 0: x2 = 0: y2 = 0: x3 = 0: y3 = 0
vsign = 1
corr = 1 ' correctie
corry3 = 0: corrx3 = 0 ' test 7 corr x3 or y3
tmovemax = 1: tmove = 0 ' Except for test 4
dashcnt = 50 ' dash count cnt13 and cnt23
r13tot = 0
SELECT CASE test
CASE IS = 1
' outside
COLOR 14
PRINT " Asteroide outside in yellow "
COLOR 15
PRINT "1 = From outside to inside (in front)"
PRINT "2 = Collision Earth"
PRINT "3 = From outside to inside (in front)"
PRINT "4 = outside"
INPUT type1
rev = 3
h = .002 ' delta time
r2 = 100
alp2 = 90 ' angle earth
alp3 = 30 ' angle moon
SELECT CASE type1
CASE IS = 1
r3 = 110 ' astroide boven langs inside
CASE IS = 2
rev = 0
r3 = 114.1: alp3 = 30 ' collision .0789
' r3 = 114: alp3 = 30 ' collision .1341
' r3 = 113.9: alp3 = 30 ' collision .2068
CASE IS = 3
r3 = 117.5
CASE IS = 4
r3 = 120 ' speed increase 15.980
r3 = 118
r3 = 117.8
CASE ELSE
type1 = 1
r3 = 110 ' astroide boven langs inside
END SELECT
CLS
PSET (xctr, yctr), 12
CASE IS = 2
' inside
COLOR 14
PRINT " Asteroide inside in yellow "
COLOR 15
PRINT "1 = From inside to outside (behind)"
PRINT "2 = Collision with Earth"
PRINT "3 = inside"
INPUT type1
rev = 3
h = .002
r2 = 100:
alp2 = 90
alp3 = 140
SELECT CASE type1
CASE IS = 1
' r3 = 92 ' from behind
r3 = 90: ' from behind passes
CASE IS = 2
rev = 0
'r3 = 87.5: alp3 = 140 ' collision .0392
'r3 = 87.45: alp3 = 140 ' collision .0231
'r3 = 87.4: alp3 = 140 ' collision .0115
'r3 = 87.35: alp3 = 140 ' collision .00585
'r3 = 87.3: alp3 = 140 ' collision .0254
'r3 = 87.5: alp3 = 145 ' collision .086724
'r3 = 87.4: alp3 = 145 ' collision .0398
'r3 = 87.3: alp3 = 145 ' collision .01198
'r3 = 87.25: alp3 = 145 ' collision .00587
'r3 = 87.23: alp3 = 145 ' collision .00407
'r3 = 87.22: alp3 = 145 ' collision .00487
'r3 = 87.2: alp3 = 145 ' collision .0097
'r3 = 87.4: alp3 = 150 ' collision .0653
'r3 = 87.35: alp3 = 150 ' collision .0436
'r3 = 87.25: alp3 = 150 ' collision .01408
r3 = 87.2: alp3 = 150 ' collision .00685
CASE IS = 3
r3 = 83 ' stays inside ellipse inside
CASE ELSE
type1 = 1
r3 = 90: ' from behind passes
END SELECT
CLS
PSET (xctr, yctr), 12
CASE IS = 3
mulc1 = 1
rev = 6
r2 = 100:
alp2 = 90
alp3 = 90 + 90
alp3 = 0
r3 = 100:
slow = 1
INPUT "init angle 110, 95, 94, 70, 85, 86, 270 "; a$
IF a$ = "" THEN alp3 = 110 ELSE alp3 = VAL(a$)
' around 270
IF alp3 > 230 AND alp3 < 310 THEN
rev = 100: slow = 0: dispcond = 20: corr = 0
IF alp3 > 265 AND alp3 < 275 THEN
multest3 = 40
ELSE
IF alp3 >= 260 AND alp3 <= 280 THEN multest3 = 10 ELSE multest3 = 1
END IF
END IF
CASE IS = 4
' m3 around m2
idim = 30
rev = 0
h = .0004
dispcond = 200 ' inner loop count
mulc1 = 50
r2 = 100:
alp2 = 90
r3 = 1
m1old = m1 ' save m1
m1 = 0
INPUT "init angle 0, 90, 180, 270 "; alp3
INPUT "Initial correction ? Y or N ", a$
IF UCASE$(a$) = "N" THEN corr = 0 ELSE corr = 1
tmovemax = 5000
CASE IS = 7, 8
' m3 around m2
rev = 3
dispcond = 500 ' extra test accuracy
dispcond = 100
h = .0004
mulc1 = 50
r2 = 100:
alp2 = 90
r3 = 1 ' 31.6
' r3 = 1.4 ' 19
' r3 = 1.5 ' 17.2
' r3 = 1.58 ' 15.9
' r3 = 1.6 ' 15.6
' r3 = 2 ' 11.1
IF test = 7 THEN PRINT "Special tests -1, -2, -3, -4"
INPUT "init angle 0, 90, 180, 270 "; alp3
CASE IS = 5
rev = 1 ' short distance
mulc1 = 50
h = .0004
r2 = 150:
alp2 = 90
alp3 = 90
r3 = 1
CASE IS = 6
rev = 2
mulc1 = 50
h = .0003
r2 = 100:
alp2 = 90
alp3 = 90
r3 = .8
CASE ELSE
END
END SELECT
r2save = r2
CLS
PSET (xctr, yctr), 12
jdim = idim / 2
h = h / dispcond ' update delta time
mulc2 = mulc1 * 1.2
' special corrections for test 7 to improve stability
IF test = 7 THEN
IF alp3 = -1 THEN alp3 = 0: corrx3 = -.002
IF alp3 = -2 THEN alp3 = 90: corry3 = .001
IF alp3 = -3 THEN alp3 = 180: corrx3 = .002
IF alp3 = -4 THEN alp3 = 270: corry3 = -.001
END IF
IF alp2 = 0 THEN alp2 = .002 ' to detect revolutions
IF alp3 = 0 THEN alp3 = .002 ' to detect revolutions
IF test <= 3 THEN
v2 = -SQR(m1 / r2): v2str = ABS(v2) ' circle speed earth
x2 = x1 + r2 * COS(alp2 * pi / 180): y2 = y1 + r2 * SIN(alp2 * pi / 180)
v2x = v2 * COS((alp2 + 90) * pi / 180): v2y = v2 * SIN((alp2 + 90) * pi / 180)
v3 = -SQR(m1 / r3): v3str = ABS(v3) ' circle speed moon
x3 = x1 + r3 * COS(alp3 * pi / 180): y3 = y1 + r3 * SIN(alp3 * pi / 180)
v3x = vsign * v3 * COS((alp3 + 90) * pi / 180): v3y = vsign * v3 * SIN((alp3 + 90) * pi / 180)
IF corr = 1 THEN
x2 = x2 + v2x * h / 2: y2 = y2 + v2y * h / 2 ' add offset
x3 = x3 + v3x * h / 2: y3 = y3 + v3y * h / 2 ' add offset
END IF
END IF
IF test >= 4 THEN
IF m1 > 0 THEN v2 = -SQR(m1 / r2): ' circle speed
IF test = 4 THEN v2 = -SQR(m1old / r2): ' circle speed
IF test = 5 THEN v2 = 0
IF test = 6 THEN v2 = v2 * .8
v2str = ABS(v2)
x2 = x1 + r2 * COS(alp2 * pi / 180): y2 = y1 + r2 * SIN(alp2 * pi / 180)
v2x = v2 * COS((alp2 + 90) * pi / 180):
v2y = v2 * SIN((alp2 + 90) * pi / 180)
IF corr = 1 THEN
x2 = x2 + v2x * h / 2: y2 = y2 + v2y * h / 2 ' add offset
END IF
v3 = -SQR(m2 / r3): ' circle speed
IF test = 8 THEN v3 = v3 * 1.005 ' Moon ellipse
v3str = ABS(v3)
x3 = x2 + r3 * COS(alp3 * pi / 180): ' Moon + Earth
y3 = y2 + r3 * SIN(alp3 * pi / 180)
v3x = vsign * v3 * COS((alp3 + 90) * pi / 180)
v3y = vsign * v3 * SIN((alp3 + 90) * pi / 180)
' PRINT USING "####.#########"; x3; y3; v3x; v3y; v3
' correction
IF corr = 1 THEN
x3 = x3 + v3x * h / 2: y3 = y3 + v3y * h / 2 ' add offset
END IF
y3 = y3 + corry3 ' correctie y3 test 7
x3 = x3 + corrx3 ' correctie x3 test 7
v3x = v3x + v2x
v3y = v3y + v2y
' PRINT USING "####.#########"; v2x; v2y; v3x; v3y; v3: GOTO END1
END IF
IF v2str > 0 THEN t2 = 2 * pi * r2 / v2str ELSE t2 = 10 ' Earth
maxj = rev * t2 / (h * dispcond)
maxj = INT(maxj) + 1
IF rev = 0 THEN maxj = 50000
t3 = 2 * pi * r3 / v3str ' Moon
' PRINT test; t2; "t3 "; t3; t2 / t3
PRINT "test"; test;
COLOR 6
PRINT "init"; INT(alp3);
COLOR 15
PRINT USING "t2###.#"; t2;
PRINT USING " t3###.##"; t3;
COLOR 7
PRINT USING " t2/t3###.#"; t2 / t3
COLOR 15
LOCATE 1, 45: PRINT "rev2"; rev;
LOCATE 1, 56 - 3: PRINT USING "max#######"; maxj;
COLOR 7: LOCATE 1, 65: PRINT "Hit Esc to stop"
LOCATE 5, 75: IF slow = 1 THEN PRINT "Slow"; ELSE PRINT " ";
color1 = 7 ' Grijs
color2 = 14 ' Geel
color3 = 6
color4 = 14 ' Asteroide Geel
time1 = TIMER
c1 = 0: c2 = 0: c3 = 0: c4 = 0
time2 = 0: time2old = 0: time2ct = 0
time3 = 0: time3old = 0: time3ct = 0
alpr2 = 0: alpr2old = 0
alpr3 = 0: alpr3old = 0
r13t2 = 0: r13t1 = 0: r13t0 = 0:
r23t3 = 0: r23t2 = 0: r23t1 = 0: r23t0 = 0
r13tot = 0
r23mintot1 = 0: r23mintot2 = 0
r13mintot = 0: r13maxtot = 0
v3t2 = 0: v3t1 = 0: v3t0 = 0
v3max = 0: v3min = 0
r23c3 = 0: r23c4 = 0
v2x0 = v2x: v2y0 = v2y
v3x0 = v3x: v3y0 = v3y
x20 = x2: y20 = y2
x30 = x3: y30 = y3
x3max = x3: x3min = x3: y3max = y3: y3min = y3
x3maxtime = 0: x3mintime = 0: y3maxtime = 0: y3mintime = 0
' Start simulation
FOR j = 1 TO maxj
IF j MOD 100 < 0 THEN
LOCATE 10, 1
PRINT j
PRINT "x3"; x3; "y3"; y3: PRINT "v3x"; v3x; "v3y"; v3y
PRINT "x2"; x2; "y2"; y2; "v2x"; v2x; "v2y"; v2y
INPUT a$: IF UCASE$(a$) = "E" THEN END
END IF
FOR i = 1 TO dispcond
n = (j - 1) * dispcond + i ' total # of cycles
dx = x1 - x2: dy = y1 - y2
'IF test <> 0 THEN
alpr2old = alpr2
GETANGLE -dx, -dy, alpr2
time2 = time2 + 1
IF alpr2old <> 0 THEN
' test revolution earth
IF (alpr2 <= alp2 AND alpr2old >= alp2) THEN
' PRINT alpr2old; alp2; alpr2: END
time2ct = time2ct + 1
LOCATE 3, 60:
PRINT USING "t2###.####"; (time2 - time2old) * h;
LOCATE 3, 72
PRINT USING "rev2###"; time2ct
time2old = time2
IF test = 3 AND (alp3 > 230 AND alp3 < 310) THEN
COLOR 7
LOCATE 26, 1: PRINT USING "x2####.####"; x2; :
LOCATE 26, 67: PRINT USING "y2 ####.####"; y2;
LOCATE 27, 1: PRINT USING "x3####.####"; x3; :
LOCATE 27, 67: PRINT USING "y3 ####.####"; y3;
IF x3 > x3max THEN x3max = x3: x3maxtime = time2ct
IF x3 < x3min THEN x3min = x3: x3mintime = time2ct
IF y3 > y3max THEN y3max = y3: y3maxtime = time2ct
IF y3 < y3min THEN y3min = y3: y3mintime = time2ct
IF x3maxtime = time2ct - 20 THEN x3min = x3 ' reset
IF x3mintime = time2ct - 20 THEN x3max = x3 ' reset
IF y3maxtime = time2ct - 5 THEN y3min = y3 ' reset
IF y3mintime = time2ct - 5 THEN y3max = y3 ' reset
PSET (xctr + (x3 - 0) * multest3, yctr - (y3 + 100) * multest3 * 10), 14
PSET (xctr + (x30 - 0) * multest3, yctr - (y30 + 100) * multest3 * 10), 12
LOCATE 28, 1:
IF x3mintime = time2ct THEN COLOR 7 ELSE COLOR 15
PRINT USING "x3min#####"; x3mintime; : PRINT USING "#####.#####"; x3min;
LOCATE 29, 1
IF x3maxtime = time2ct THEN COLOR 7 ELSE COLOR 15
PRINT USING "x3max#####"; x3maxtime; : PRINT USING "#####.#####"; x3max;
LOCATE 28, 58
IF y3mintime = time2ct THEN COLOR 7 ELSE COLOR 15
PRINT USING "y3min#####"; y3mintime; : PRINT USING "#####.#####"; y3min;
LOCATE 29, 58:
IF y3maxtime = time2ct THEN COLOR 7 ELSE COLOR 15
PRINT USING "y3max#####"; y3maxtime; : PRINT USING "#####.#####"; y3max;
END IF
END IF
END IF
' END IF
r2 = dx * dx + dy * dy: r = SQR(r2): r12 = r
a12x = dx / (r * r2): a12y = dy / (r * r2)
dx = x1 - x3: dy = y1 - y3
r2 = dx * dx + dy * dy: r = SQR(r2): r13 = r:
IF test <= 3 THEN
alpr3old = alpr3
GETANGLE -dx, -dy, alpr3
time3 = time3 + 1
' test revolution asteroide
IF (alpr3 <= alp3 AND alpr3old >= alp3) THEN
time3ct = time3ct + 1
LOCATE 4, 60:
PRINT USING "t3###.####"; (time3 - time3old) * h;
LOCATE 4, 72:
PRINT USING "rev3###"; time3ct
time3old = time3
END IF
END IF
r13t2 = r13t1: r13t1 = r13t0
r13t0 = r13
a13x = dx / (r * r2): a13y = dy / (r * r2)
dx = x2 - x3: dy = y2 - y3
r2 = dx * dx + dy * dy: r = SQR(r2): r23 = r:
IF test >= 4 THEN
alpr3old = alpr3
GETANGLE -dx, -dy, alpr3
time3 = time3 + 1
' test revolution moon
IF (alpr3 <= alp3 AND alpr3old >= alp3) THEN
time3ct = time3ct + 1
LOCATE 4, 60
PRINT USING "t3###.####"; (time3 - time3old) * h;
LOCATE 4, 72
PRINT USING "rev3###"; time3ct
time3old = time3
END IF
END IF
IF (rev = 0 AND test <= 3 AND (r23t0 > r23t1)) OR r12 < 2 THEN
' Get final closest distance
IF r23 < r3 THEN COLOR 4 ELSE COLOR 3
LOCATE 2, 1:
PRINT USING "r23####.########"; r23
IF r13 < r2save THEN COLOR 14 ELSE COLOR 13
LOCATE 2, 20: PRINT USING "r13####.######"; r13;
COLOR 15
LOCATE 2, 56: PRINT USING "#######"; j
GOTO END1
END IF
a23x = dx / (r * r2): a23y = dy / (r * r2)
v2x = v2x + a12x * m1 * h: v2y = v2y + a12y * m1 * h
v2x = v2x - a23x * m3 * h: v2y = v2y - a23y * m3 * h
v3x = v3x + a13x * m1 * h: v3y = v3y + a13y * m1 * h
v3x = v3x + a23x * m2 * h: v3y = v3y + a23y * m2 * h
v3t2 = v3t1: v3t1 = v3t0:
v3 = SQR(v3x * v3x + v3y * v3y)
v3t0 = v3
IF v3t1 < v3t0 AND v3t1 < v3t2 THEN v3min = v3t1
IF v3t1 > v3t0 AND v3t1 > v3t2 THEN v3max = v3t1
x2old = x2
x2 = x2 + v2x * h: y2 = y2 + v2y * h
x3 = x3 + v3x * h: y3 = y3 + v3y * h
IF x2old = 0 THEN x2old = x2
IF test >= 4 THEN
' Calculate average distance near minimum and maximum distance
' Sun Moon
IF r13t1 < r13t0 AND r13t1 < r13t2 THEN
r13min = r13t1
c1 = c1 + 1
color2 = 14 ' Yellow
COLOR 14
LOCATE 26, 1: PRINT "min13"; c1; j; : PRINT USING "####.##############"; r13t2; r13t1; r13t0;
' Collision Eart/Moon at Sun
r23mintot1 = r23mintot1 + r23
r13mintot = r13mintot + r13t1 - 100
LOCATE 4, 1: PRINT c1; : PRINT USING "r23 min###.#######"; r23mintot1 / c1
LOCATE 8, 1: PRINT USING "r13 Avg####.#######"; 100 + r13mintot / c1
' Collision Eart/Moon at Sun
' GOTO end1
IF test = 5 AND r13min < 1 THEN GOTO END1
cnt13 = -dashcnt
END IF
IF r13t1 > r13t0 AND r13t1 > r13t2 THEN
IF r13t2 <> 0 THEN
c2 = c2 + 1
color2 = 13 ' Magenta
COLOR 13
LOCATE 27, 1: PRINT "max13"; c2; j; : PRINT USING "####.##############"; r13t2; r13t1; r13t0;
r23mintot2 = r23mintot2 + r23
r13maxtot = r13maxtot + r13t1 - 100
LOCATE 5, 1: PRINT c2; : PRINT USING "r23 max###.#######"; r23mintot2 / c2
cnt13 = -dashcnt
LOCATE 9, 1: PRINT USING "r13 Avg####.#######"; 100 + r13maxtot / c2
END IF
END IF
ELSE
END IF
' Change color Earth between white and brown after each revolution
IF x2 > 0 AND x2old < 0 THEN
IF color1 = 7 THEN color1 = 6 ELSE color1 = 7
END IF
' END IF
' Minimum and maximum distance Earth Moon.
IF test >= 4 THEN
tmove = tmove + 1 ' filter for test 4
IF (tmove MOD tmovemax) = 0 THEN
tmove = 0
' END
r23t3 = r23t2: r23t2 = r23t1: r23t1 = r23t0
r23t0 = r23
IF j = 1 AND i = -1 THEN
LOCATE 10, 1: PRINT r23t3; r23t2; r23t1; r23t0
LOCATE 12, 1: PRINT r13t3; r13t2; r13t1; r13t0
LOCATE 14, 1: PRINT x1, x2, x3
LOCATE 16, 1: PRINT y1, y2, y3
GOTO END1
END IF
' INPUT a$: IF UCASE$(a$) = "E" THEN END
IF r23t2 = 0 THEN r23t3 = r23: r23t2 = r23: r23t1 = r23
IF r23t2 < r23t1 AND r23t1 < r23t0 THEN r23up = 1
IF r23t0 < r23t1 AND r23t1 < r23t2 THEN r23up = -1
IF r23t1 < r23t0 AND r23t1 < r23t2 AND r23up = -1 THEN
c3 = c3 + 1
color3 = 4 ' red
COLOR 4
LOCATE 28, 1: PRINT "min23"; c3; j; : PRINT USING "####.##############"; r23t2; r23t1; r23t0;
r23min = r23t1
IF UCASE$(pr$) = "P" THEN
LOCATE 10, 1
PRINT "x3"; x3; "y3"; y3; "v3x"; v3x; "v3y"; v3y
PRINT "x2"; x2; "y2"; y2; "v2x"; v2x; "v2y"; v2y
END
END IF
cnt23 = -dashcnt
END IF
IF r23t1 > r23t0 AND r23t1 > r23t2 AND r23up = 1 THEN
c4 = c4 + 1
color3 = 3 ' Cyan
COLOR 3
LOCATE 29, 1: PRINT "max23"; c4; j; : PRINT USING "####.##############"; r23t2; r23t1; r23t0;
r23max = r23t1
IF test = 7 THEN
IF c4 MOD 2 = 0 OR (corrx3 = 0 AND corry3 = 0) THEN
r23c3 = r23c3 + 1
r23max1 = ((r23c3 - 1) * r23max1 + r23max) / r23c3
LOCATE 6, 1: PRINT r23c3; : PRINT USING "r23 max1##.#######"; r23max1
'INPUT a$: IF UCASE$(a$) = "E" THEN END
ELSE
r23c4 = r23c4 + 1
r23max2 = ((r23c4 - 1) * r23max2 + r23max) / r23c4
LOCATE 7, 1: PRINT r23c4; : PRINT USING "r23 max2##.#######"; r23max2
END IF
END IF
cnt23 = -dashcnt
END IF
END IF
ELSE
' r23t3 = r23t2: r23t2 = r23t1: r23t1 = r23t0
' r23t0 = r23
' IF r23t2 = 0 THEN r23t3 = r23: r23t2 = r23: r23t1 = r23
' END
END IF
NEXT i
' Outer loop
COLOR 15
cnt = j
cnt23 = cnt23 + 1
cnt13 = cnt13 + 1
IF cnt23 = 0 THEN
color3 = 0
ELSE
IF cnt23 > 0 THEN
IF (cnt23 + 15) MOD 20 = 0 THEN
color3 = 0
ELSE
IF cnt23 MOD 20 = 0 THEN color3 = 7
END IF
END IF
END IF
IF cnt13 = 0 THEN
color2 = 7
ELSE
IF cnt13 > 0 THEN
IF (cnt13 + 20) MOD 30 = 0 THEN
color2 = 0
ELSE
IF cnt13 MOD 30 = 0 THEN color2 = 7
END IF
END IF
END IF
IF color2 = 7 AND test < 4 THEN color2 = 14 ' Asteroide
r13tot = r13tot + r13 - 100
COLOR 15
IF cnt MOD 50 = 0 OR cnt = maxj THEN
IF r23 < r3 THEN COLOR 4 ELSE COLOR 3
LOCATE 2, 1:
PRINT USING "r23####.########"; r23
IF r13 < r2save THEN COLOR 14 ELSE COLOR 13
LOCATE 2, 20:
PRINT USING "r13####.######"; r13;
COLOR 15
LOCATE 2, 56: PRINT USING "#######"; cnt; :
LOCATE 2, 65
PRINT USING "Hoek#####.##"; alpr3
LOCATE 3, 1: PRINT USING " v3###.####"; v3; :
PRINT USING " min###.####"; v3min; : PRINT USING " max###.####"; v3max
IF test <> 5 THEN
LOCATE 2, 38:
r13avr = 100 + r13tot / j
PRINT USING "Avg####.######"; r13avr
END IF
IF slow = 1 THEN
timeold = TIMER
DO
' wait
LOOP UNTIL TIMER > timeold + 1
END IF
END IF
' Outer circle: Earth
PSET (xctr + (x2 - x1) * mulc, yctr - (y2 - y1) * mulc), color1
IF test >= 4 THEN
IF r13 > r12 THEN color4 = 13 ELSE color4 = 14
END IF
' Asteroide or Moon
PSET (xctr + (x3 - x1) * mulc, yctr - (y3 - y1) * mulc), color4
PSET (xctr + (x3 - x2) * mulc1, yctr - (y3 - y2) * mulc1), color2
IF test > 3 THEN
PSET (xctr + (x3 - x2) * mulc2, yctr - (y3 - y2) * mulc2), color3
END IF
DO
a$ = INKEY$
IF a$ = CHR$(esc) THEN GOTO END1
IF UCASE$(a$) = "P" THEN pr$ = "P"
IF UCASE$(a$) = "S" THEN
IF slow = 0 THEN slow = 1 ELSE slow = 0
COLOR 7
LOCATE 5, 75: IF slow = 1 THEN PRINT "Slow"; ELSE PRINT " ";
END IF
LOOP UNTIL UCASE$(a$) = ""
NEXT j
END1:
COLOR 15
LOCATE 30, 1: PRINT "Hit any key to continue";
DO:
a$ = INKEY$
LOOP UNTIL a$ <> ""
GOTO SL1
SUB GETANGLE (x, y, angle)
IF x <> 0 THEN
angle = ATN(y / x) * rad
IF x < 0 THEN
angle = angle + 180
ELSE
IF y < 0 THEN
angle = angle + 360
END IF
END IF
IF angle = 90 AND x > 0 THEN angle = angle - .000000001#
ELSE
IF y > 0 THEN
angle = 90
ELSE
angle = 270
END IF
END IF
END SUB
SUB STORE (r23)
FOR i = idim TO 1 STEP -1
rr23(i) = rr23(i - 1)
NEXT i
rr23(0) = r23
max = rr23(0): imax = 0
min = rr23(0): imin = 0
' not all values stored
IF rr23(idim) = 0 THEN EXIT SUB
FOR i = 1 TO idim
IF rr23(i) > max THEN max = rr23(i): imax = i
IF rr23(i) < min THEN min = rr23(i): imin = i
NEXT i
EXIT SUB
LOCATE 5, 1
IF imax = idim / 2 THEN
COLOR 3
FOR i = idim TO 0 STEP -1: PRINT rr23(i); : NEXT i: PRINT
PRINT "max"; imax; max;
' INPUT a$: IF UCASE$(a$) = "E" THEN END
END IF
IF imin = idim / 2 THEN
COLOR 4
FOR i = idim TO 0 STEP -1: PRINT rr23(i); : NEXT i: PRINT
PRINT "min"; imin; min;
' INPUT a$: IF UCASE$(a$) = "E" THEN END
END IF
END SUB
Back to my home page Contents of This Document