Program: kuiper.bas
Implementation Select: Implementation
Operation Select: Program: KUIPER.BAS
DECLARE SUB GETANGLE (x#, y#, angle#)
DEFDBL A-Z
' KUIPER.BAS
' Revision 1.0 21 Feb 2004
CONST pi = 3.141592653589#
CONST rad = 180 / pi
CONST esc = 27, ENTER = 13
SCREEN 12
SL1:
CLS
COLOR 15: LOCATE 1, 1
PRINT "1 = 3 object simulation "
PRINT "2 = 4 object simulation, collision"
PRINT "3 = 4 object simulation, capture"
PRINT "4 = 4 object simulation, ejection"
PRINT "5 = 4 object simulation, capture and ejection"
COLOR 7
PRINT "6 = 3 object simulation, circle "
PRINT "7 = 3 object simulation, chaotic "
PRINT "8 = 2 object simulation "
PRINT "9 = 3 object simulation, chaotic "
h = .002
m1 = 100000:
m2 = 30: m3 = m2: m4 = m2 / 10: ' m4 = -1
x1 = 200: y1 = 100:
dr2 = 800
r2 = 100
r2 = r2 + dr2:
v2 = -SQR(m1 / r2): v2str = ABS(v2) ' circle speed
INPUT cond
jmax = 200000
alp2 = 95
mulc = 3.8
mulc1 = 1
mulc2 = 10
v3mul = 1.05
SELECT CASE cond
CASE 1, 6, 7, 8, 9
mesg1$ = "1 = 3 object simulation "
m2 = 30: m3 = m2: m4 = -1
offx = 600
mulc = 3.8 / 2.5: mulc1 = 1 / 2.5: mulc2 = 10
dalp2 = 1.7: v3mul = 1.006: h = .004 'Nee kleiner en groter
dalp2 = 0: v3mul = .9: ' prachtig
dalp2 = -.5: v3mul = .85: ' prachtig
dalp2 = 0: v3mul = .85: ' prachtig
IF cond = 6 THEN dalp2 = 0: v3mul = .73: offx = 700' big circle
IF cond = 7 THEN alp2 = 90: dalp2 = .715: v3mul = .8: offx = 700'unstable chaotic
IF cond = 8 THEN alp2 = 90: dalp2 = .715: v3mul = .8: offx = 700'unstable chaotic
IF cond = 9 THEN alp2 = 90: dalp2 = .715: v3mul = 1.2: offx = 700'unstable chaotic
' alp2 = 90: dalp2 = 1.715: v3mul = 1.09: offx = 700 'unstable chaotic
CASE 2
mesg1$ = "2 = 4 object simulation, collision"
' collision
m2 = 30: m3 = m2: m4 = m2 / 10: ' m4 = -1
dalp2 = 2: dalp4 = -1: v3mul = 1.006: v4mul = 1: h = .004'Nee kleiner en groter
dalp2 = 2: dalp4 = -.61: v3mul = 1.006: v4mul = .99: h = .004 'Nee kleiner en groter
offx = 400
CASE 3
mesg1$ = "3 = 4 object simulation, capture"
' capture
m2 = 30: m3 = m2: m4 = m2 / 10: ' m4 = -1
dalp2 = 1.6: dalp4 = -1: v3mul = 1: v4mul = 1.05: h = .004
offx = 1000
CASE 4
mesg1$ = "4 = 4 object simulation, ejection"
' brilliant case
m2 = 30: m3 = m2: m4 = m2 / 10: ' m4 = -1
dalp2 = 1.7: v3mul = 1.006: v4mul = 1: h = .004'Nee kleiner en groter
offx = 600
CASE 5
mesg1$ = "5 = 4 object simulation, capture and ejection"
' invangen + brilliant
m2 = 30: m3 = m2: m4 = m2 / 10: ' m4 = -1
dalp2 = 1.7: dalp4 = -1: v3mul = 1.003: v4mul = 1.05: h = .004
'dalp2 = 1.61: dalp4 = -1: v3mul = 1.003: v4mul = 1.037: h = .004
offx = 900
CASE ELSE
END
END SELECT
COLOR 7
PRINT "Select ESC to terminate simulation"
PRINT "Select any key to start simulation"
DO:
a$ = INKEY$
IF a$ = CHR$(esc) THEN END
LOOP UNTIL a$ <> ""
dispcond = 20 ' inner loop count
h = h / dispcond ' update time inner loop
CLS
LOCATE 1, 1: PRINT "Sling shot application";
COLOR 14:
PRINT SPACE$(4); mesg1$
COLOR 15:
PRINT "m2 mass = 1"; SPACE$(3);
COLOR 14:
PRINT "m3 mass = 1"; SPACE$(3);
COLOR 11:
IF m4 > 0 THEN PRINT "m4 mass = .1"; SPACE$(3)
COLOR 7
LOCATE 2, 60: PRINT "ESC to terminate"
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)
r3 = r2 + 7
v3 = -SQR(m1 / r3) * v3mul: v3str = ABS(v3) ' escape speed
alp3 = alp2 + dalp2
x3 = x1 + r3 * COS(alp3 * pi / 180): y3 = y1 + r3 * SIN(alp3 * pi / 180)
v3x = v3 * COS((alp3 + 90) * pi / 180): v3y = v3 * SIN((alp3 + 90) * pi / 180)
IF cond = 4 THEN
r4 = 1
x4 = x3: y4 = y3 - r4
v4x = v3x: v4y = v3y
IF m4 >= 0 THEN v4x = v4x + SQR(m3 / r4)
ELSE
r4 = (r3 + r2) / 2
v4 = v3 * v4mul
alp4 = alp2 + dalp4
x4 = x1 + r4 * COS(alp4 * pi / 180): y4 = y1 + r4 * SIN(alp4 * pi / 180)
v4x = v4 * COS((alp4 + 90) * pi / 180): v4y = v4 * SIN((alp4 + 90) * pi / 180)
END IF
v1x = 0: v1y = 0:
r24min = 100000000
r23min = 100000000
r43min = 100000000
IF cond = 8 THEN m1 = 1
FOR j = 1 TO jmax
FOR i = 1 TO dispcond
dx = x1 - x2: dy = y1 - y2
r2 = dx * dx + dy * dy: r = SQR(r2)
a12x = dx / (r * r2): a12y = dy / (r * r2)
v2x = v2x + a12x * m1 * h: v2y = v2y + a12y * m1 * h
dx = x1 - x3: dy = y1 - y3
' GETANGLE -dx, -dy, alpr
r2 = dx * dx + dy * dy: r = SQR(r2)
a13x = dx / (r * r2): a13y = dy / (r * r2)
v3x = v3x + a13x * m1 * h: v3y = v3y + a13y * m1 * h
IF m4 >= 0 THEN
dx = x1 - x4: dy = y1 - y4
r2 = dx * dx + dy * dy: r = SQR(r2)
a14x = dx / (r * r2): a14y = dy / (r * r2)
v4x = v4x + a14x * m1 * h: v4y = v4y + a14y * m1 * h
END IF
dx = x2 - x3: dy = y2 - y3: dx23 = dx: dy23 = dy
r2 = dx * dx + dy * dy: r = SQR(r2): r23 = r
IF r23 < r23min THEN r23min = r23
a23x = dx / (r * r2): a23y = dy / (r * r2)
v2x = v2x - a23x * m3 * h: v2y = v2y - a23y * m3 * h
v3x = v3x + a23x * m2 * h: v3y = v3y + a23y * m2 * h
IF r < 200 * h THEN
LOCATE 3, 50: COLOR 15: PRINT USING "dr23 ########"; r23min / h
vx2 = (vx2 * m2 + vx3 * m3) / (m2 + m3)
vy2 = (vy2 * m2 + vy3 * m3) / (m2 + m3)
m2 = m2 + m4
m4 = -1
END IF
IF m4 >= 0 THEN
dx = x2 - x4: dy = y2 - y4
r2 = dx * dx + dy * dy: r = SQR(r2): r24 = r
IF r24 < r24min THEN r24min = r24
a24x = dx / (r * r2): a24y = dy / (r * r2)
v2x = v2x - a24x * m4 * h: v2y = v2y - a24y * m4 * h
v4x = v4x + a24x * m2 * h: v4y = v4y + a24y * m2 * h
IF r < 200 * h THEN
LOCATE 3, 50: COLOR 15: PRINT USING "dr24 ########"; r24min / h
vx2 = (vx2 * m2 + vx4 * m4) / (m2 + m4)
vy2 = (vy2 * m2 + vy4 * m4) / (m2 + m4)
m2 = m2 + m4
m4 = -1
END IF
END IF
IF m4 >= 0 THEN
dx = x3 - x4: dy = y3 - y4: dx43 = -dx: dy43 = -dy
r2 = dx * dx + dy * dy: r = SQR(r2): r43 = r
IF r43 < r43min THEN r43min = r43
a34x = dx / (r * r2): a34y = dy / (r * r2)
v3x = v3x - a34x * m4 * h: v3y = v3y - a34y * m4 * h
v4x = v4x + a34x * m3 * h: v4y = v4y + a34y * m3 * h
IF r < 200 * h THEN
LOCATE 3, 65: COLOR 11: PRINT USING "dr34 ########"; r43min / h
vx3 = (vx3 * m3 + vx4 * m4) / (m3 + m4)
vy3 = (vy3 * m3 + vy4 * m4) / (m3 + m4)
m3 = m3 + m4
m4 = -1
END IF
END IF
x2 = x2 + v2x * h: y2 = y2 + v2y * h
x3 = x3 + v3x * h: y3 = y3 + v3y * h
x4 = x4 + v4x * h: y4 = y4 + v4y * h
NEXT i
cnt = j
COLOR 15
LOCATE 1, 72: PRINT cnt
PSET ((x2 - offx / 3.8) * mulc, (980 / 3.8 - y2 + dr2) * mulc), 15
PSET ((x3 - offx / 3.8) * mulc, (980 / 3.8 - y3 + dr2) * mulc), 14
IF m4 > 0 THEN PSET (x4 * mulc - offx, 980 - (y4 - dr2) * mulc), 11
PSET (mulc1 * (x2 - 90), (306 - y2 + dr2) * mulc1), 15
PSET (mulc1 * (x3 - 90), (306 - y3 + dr2) * mulc1), 14
IF m4 > 0 THEN PSET (mulc1 * (x4 - 90), (306 - y4 + dr2) * mulc1), 11
PSET (250, 340), 14
CIRCLE (250, 340), 2, 14 'm1
PSET (250 + dx23 * mulc2, 340 - dy23 * mulc2), 15
' COLOR 15: LOCATE 3, 50: PRINT USING "dr23 ########"; r23min / h
time1 = TIMER:
IF time1 > time2 + .3 THEN
time2 = time1
COLOR 15: LOCATE 3, 50: PRINT USING "dr23 ########"; r23 / h
IF m4 > 0 THEN COLOR 11: LOCATE 3, 65: PRINT USING "dr34 ########"; r43 / h
END IF
IF m4 > 0 THEN PSET (250 + dx43 * mulc2, 340 - dy43 * mulc2), 11
DO
a$ = INKEY$
IF a$ = CHR$(esc) THEN GOTO end2
LOOP UNTIL UCASE$(a$) = ""
NEXT j
COLOR 7
end1:
DO:
a$ = INKEY$
IF a$ = CHR$(esc) THEN END
LOOP UNTIL a$ <> ""
end2:
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
ELSE
IF y > 0 THEN
angle = 90
ELSE
angle = 270
END IF
END IF
END SUB
Back to my home page Contents of This Document