'position
'velocity
'mass
'colour
DIM particles
(0 TO 3) AS particle_t
initial(0).px = 320
initial(0).py = 320
initial(0).m = 100000
initial
(0).c
= _RGB32(255, 255, 255)
initial(1).px = 320
initial(1).py = 130
initial(1).m = 10
initial(1).vx = 2.0
initial
(1).c
= _RGB32(255, 0, 0)
initial(2).px = 320
initial(2).py = 480
initial(2).m = 20
initial(2).vx = -2
initial
(2).c
= _RGB32(0, 255, 0)
initial(3).px = 10
initial(3).py = 0
initial(3).m = 2
initial(3).vx = 1.5
initial
(3).c
= _RGB32(0, 0, 255)G = 0.01
start:
PRINT "Four bodies exist in 2D space. Your challenge is to define parameters for them" PRINT "(mass, initial position and initial velocity) so that they can orbit for as long" PRINT "as possible before they collide. You can also specify a value for G, the" PRINT "gravitational constant." PRINT "Use the arrow keys to move between the boxes, and numeric keys and the enter key" PRINT "Press C to copy setup to clipboard, and P to paste setup from clipboard." PRINT "Press F5 to run the simulation, and Escape to exit simulation. Good luck!"
selx = 17
sely = 13
k$ = ""
IF seld
> 0 THEN seld
= seld
- 1 IF selp
> 0 THEN selp
= selp
- 1 IF seld
< 5 THEN seld
= seld
+ 1 IF selp
< 3 THEN selp
= selp
+ 1 summary$
= summary$
+ MKS$(initial
(p
).px
) + MKS$(initial
(p
).py
) + MKS$(initial
(p
).vx
) + MKS$(initial
(p
).vy
) + MKS$(initial
(p
).m
) summary$
= summary$
+ MKS$(G
) initial
(p
).px
= CVS(MID$(summary$
, p
* 20 + 1, 4)) initial
(p
).py
= CVS(MID$(summary$
, p
* 20 + 5, 4)) initial
(p
).vx
= CVS(MID$(summary$
, p
* 20 + 9, 4)) initial
(p
).vy
= CVS(MID$(summary$
, p
* 20 + 13, 4)) initial
(p
).m
= CVS(MID$(summary$
, p
* 20 + 17, 4))
G = newval
CASE 0: initial
(selp
).px
= newval
CASE 1: initial
(selp
).py
= newval
CASE 2: initial
(selp
).vx
= newval
CASE 3: initial
(selp
).vy
= newval
CASE 4: initial
(selp
).m
= newval
selx = 24
sely = 19
selx = 16 * selp + 17
sely = 13 + seld
sim:
particles(p) = initial(p)
'sanity check
PRINT "Simulation error: particle"; p;
"has non-positive mass."
PRINT "Press any key to return to simulation"
ax = 0
ay = 0
IF p2
<> p
THEN 'avoid calculating when both particles are the same one 'magnitude of force
f = G * particles(p2).m * particles(p).m / ((particles(p2).px - particles(p).px) ^ 2 + (particles(p2).py - particles(p).py) ^ 2)
'direction, taking p as reference particle
ang
= _ATAN2(-(particles
(p2
).py
- particles
(p
).py
), (particles
(p2
).px
- particles
(p
).px
)) ax
= ax
+ f
* COS(ang
) / particles
(p
).m
ay
= ay
- f
* SIN(ang
) / particles
(p
).m
'we now have net accelerations
particles(p).vx = particles(p).vx + ax
particles(p).vy = particles(p).vy + ay
particles(p).px = particles(p).px + particles(p).vx
particles(p).py = particles(p).py + particles(p).vy
IF particles
(p
).px
< xmin
THEN xmin
= particles
(p
).px
IF particles
(p
).px
> xmax
THEN xmax
= particles
(p
).px
IF particles
(p
).py
< ymin
THEN ymin
= particles
(p
).py
IF particles
(p
).py
> ymax
THEN ymax
= particles
(p
).py
CIRCLE (particles
(p
).px
, particles
(p
).py
), 10, particles
(p
).c
'check for collisions
p2 = 0
IF _HYPOT(particles
(p2
).px
- particles
(p
).px
, particles
(p2
).py
- particles
(p
).py
) < 20 THEN collision& = -1
collisionx = particles(p).px + (particles(p2).px - particles(p).px) / 2
collisiony = particles(p).py + (particles(p2).py - particles(p).py) / 2
t&& = t&& + 1
reset_sim:
t&& = 0
collision& = 0
xmin = 0
ymin = 0
xmax = 0
ymax = 0
active_obj = 0
print_table:
PRINT "+--------------+---------------+---------------+---------------+---------------+" PRINT "| Body colour: | White | Red | Blue | Green |" PRINT "+--------------+---------------+---------------+---------------+---------------+" PRINT "| Position X | | | | |" PRINT "| Position Y | | | | |" PRINT "| Velocity X | | | | |" PRINT "| Velocity Y | | | | |" PRINT "+--------------+---------------+---------------+---------------+---------------+" PRINT "Gravitational Constant: "
'-------------------------------------------------------------------------
' BASE64 Encoding / Decoding
' Original VBDOS Version by G. Balla, 1996 (Public Domain)
' QB 4.5 Conversion by Marc van den Dikkenberg, 1999
' From [http://www.qb45.com/download.php?id=1198], trimmed & optimized(no longer runs in QBASIC!) & updated (INTEGER->LONG for larger strings) & disabled input stream concatenation option --Galleon 2013
'--------------------------------------------------------------------------
DIM SHARED icChopMask
AS LONG ' Constant 8-bit mask (Faster than using string constants) DIM SHARED icBitShift
AS LONG ' Constant shift mask (Faster than using string constants) DIM SHARED icStartMask
AS LONG ' Initial mask value (Faster than using string constants)
'iEndOfText AS LONG ''''removed from params
' Initialize 2nd encoding pass lookup dictionary
szAlphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
' Initialize Constants
icChopMask = 255
icBitShift = 4
icStartMask = &H10
' Initialize Masks
iShift = icBitShift
iLowShift = 0
iRollOver = 0
iHighMask = -1
iEndOfText = -1 ''''new
' Create variables
' Check if empty decoded string.
decodeBASE64$ = ""
' Initialize working string
szTemp
= SPACE$(LEN(szEncoded
) + 10) ''''changed szTempLen = 0 ''''new
' Begin Decoding
' Get next alphabet
iChar
= ASC(szEncoded
, iCounter
) ''''changed ' Get Decoded value
' Check if character is valid
' Char is valid, process it
' 1st char in block of 4, keep high part of character
iRollOver
= (iPtr
* iShift
) AND icChopMask
' Reset masks for next character
iHighMask = &H30
iLowShift = icStartMask
iShift = icStartMask
' Start saving decoded character
szTempLen
= szTempLen
+ 1:
ASC(szTemp
, szTempLen
) = iRollOver
OR ((iPtr
AND iHighMask
) / iLowShift
) ''''changed ' Calculate next mask and shift values
iRollOver
= (iPtr
* iShift
) AND icChopMask
iShift = iShift * icBitShift
iHighMask
= (iHighMask \ icBitShift
) OR &H30 iLowShift = iLowShift / icBitShift
iShift = icBitShift
iLowShift = 0
' Concat last character if required
IF (iShift
> icBitShift
AND iShift
< 256) THEN ' Character remaining in iRollOver
' Last string to decode in file
szTempLen
= szTempLen
+ 1:
ASC(szTemp
, szTempLen
) = iRollOver
''''changed ' Exit wth decoded string
decodeBASE64$
= LEFT$(szTemp
, szTempLen
) ''''changed
' Create variables
' Check if empty decoded string.
encodeBASE64$ = ""
' Initialize lookup dictionary and constants
szAlphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
icBitShift = 4
icChopMask = 255
icLowFill = 3
' Initialize Masks
szTemp
= SPACE$(LEN(szUnEncoded
) * 2 + 10) ''''changed szTempLen = 0 ''''new
iHighMask = &HFC
iLowMask = &H3
iShift = &H10
iRollOver = 0
' Begin Encoding process
' Fetch ascii character in decoded string
iChar
= ASC(szUnEncoded
, iCounter
) ''''changed ' Calculate Alphabet lookup pointer
iPtr
= ((iChar
AND iHighMask
) \
(iLowMask
+ 1)) OR iRollOver
' Roll bit patterns
iRollOver
= (iChar
AND iLowMask
) * iShift
' Concatenate encoded character to working encoded string
szTempLen
= szTempLen
+ 1:
ASC(szTemp
, szTempLen
) = ASC(szAlphabet
, iPtr
+ 1) ''''changed ' Adjust masks
iHighMask
= (iHighMask
* icBitShift
) AND icChopMask
iLowMask = iLowMask * icBitShift + icLowFill
iShift = iShift \ icBitShift
' If last character in block, concat last RollOver and
' reset masks
szTempLen
= szTempLen
+ 1:
ASC(szTemp
, szTempLen
) = ASC(szAlphabet
, iRollOver
+ 1) ''''changed iRollOver = 0
iHighMask = &HFC
iLowMask = &H3
iShift = &H10
' If RollOver remains, concat it to the working string
szTempLen
= szTempLen
+ 1:
ASC(szTemp
, szTempLen
) = ASC(szAlphabet
, iRollOver
+ 1) ''''changed szTemp
= LEFT$(szTemp
, szTempLen
) ''''new ' Pad encoded string with required '=' pad characters
' Return encoded string
encodeBASE64$ = szTemp
