1. orbit
Hello, someone was asking about an orbit program... Well, I recently
made this. I know the physics aren't quite right and it all goes
haywire after about 4 perfect orbits but it has some nifty effects:
1. every thing's speed and direction is effected by everything elses
mass and relative position
2. the screen is always centered on the first object in the "universe"
sequence; it's the sun but it doesn't have to be.
3. the "universe" is set up for a cool orbit thing happenin'
4. Umm, I can't think of any more right now
Note that some commented lines got wrapped in my mailer so you might
want to fix them (only if you want it to run).
include graphics.e
constant pos = 1, dir = 2, mass = 3, kuler = 4,
scale = 15, X = 1, Y = 2, center = {320, 240}
object universe, junk
junk = graphics_mode (18)
universe = {{{2500, 3000}, {0, 0}, 1000, YELLOW},
{{ 500, 3000}, {0, 20}, 100, CYAN},
{{1000, 3000}, {0, 30}, 100, GREEN},
{{1500, 3000}, {0, 40}, 100, GRAY},
{{3500, 3000}, {0, -40}, 100, BLUE},
{{4000, 3000}, {0, -30}, 100, BROWN},
{{4500, 3000}, {0, -20}, 100, MAGENTA}}
function convert (sequence c)
object s
while 1 do
s = sqrt (c [X] * c [X] + c [Y] * c [Y])
if s > 1 then
c = c/s
--position (1,1) print (1, c)
else return c
end if
end while
end function
function dist2d (sequence p1, sequence p2)
return sqrt (((p1 [1] - p2 [1]) * (p1 [1] - p2 [1])) +
((p1 [2] - p2 [2]) * (p1 [2] - p2 [2])))
end function
procedure delay ()
object t
t = time ()
while time () - t < .010 do end while
end procedure
function recalc (sequence U)
object this, that, other
for i = 1 to length (U) do
this = U [i]
other = U [1..i-1] & U [i+1..length(U)]
for j = 1 to length (other) do
that = other [j]
--if dist2d (this [pos], that [pos]) <= this [mass]/2 + that
[mass]/2 then
--this [dir] = this [dir] * (this [dir] - that [dir]) / (this
[mass]/2)
--else
this [dir] = this [dir] - convert(this [pos] - that [pos])
*( that [mass] - this [mass])
/(dist2d (this [pos], that [pos]) +.0001)
--end if
end for
this [pos] = (this [pos] + this [dir])
U [i] = this
end for
return U
end function
procedure drawstuff (sequence U, atom c)
for i = 1 to length (U) do
ellipse (c * U [i] [kuler], 1,
((U [i] [pos] - U [i] [mass]/2) /scale) + (-U [1] [pos] /scale
+center),
((U [i] [pos] + U [i] [mass]/2) /scale) + (-U [1] [pos] /scale
+center))
end for
end procedure
while get_key () != 27 do
universe = recalc (universe)
drawstuff (universe ,1)
delay ()
drawstuff (universe ,0)
-- position (1,1) print (1, floor ((universe +.5)))
end while
junk = graphics_mode (-1)
--------------end code----------------------
todays asci code: alt + 253 = 2
sincerely,
Lewis Townsend
______________________________________________________
Get Your Private, Free Email at http://www.hotmail.com
2. Re: orbit
also, how 'bout instead of clearing the screen every time a planet moves,
just erase the spot where the planets were previously. It reduces
flicker.
___________________________
When it comes to programming languages, Euphoria is a cut above -
matt1278 at juno.com and matt1421 at juno.com(and soon to be
irisnmatt at prodigy.net. Then again, maybe not) Euphoria programmer
Web users: <A HREF=mailto:"matt1421 at juno.com">matt1421 at juno.com</A> or <A
___________________________________________________________________
You don't need to buy Internet access to use free Internet e-mail.
Get completely free e-mail from Juno at http://www.juno.com
Or call Juno at (800) 654-JUNO [654-5866]
3. Re: orbit
Tip: Use an if/then/end if statement if you don't want it's value. e.g.
if graphics_mode(-1) then
end if
My user.e file has a discard procedure that does that. Eu complained
about junk not being used when your program ended
___________________________
When it comes to programming languages, Euphoria is a cut above -
matt1278 at juno.com and matt1421 at juno.com(and soon to be
irisnmatt at prodigy.net. Then again, maybe not) Euphoria programmer
Web users: <A HREF=mailto:"matt1421 at juno.com">matt1421 at juno.com</A> or <A
___________________________________________________________________
You don't need to buy Internet access to use free Internet e-mail.
Get completely free e-mail from Juno at http://www.juno.com
Or call Juno at (800) 654-JUNO [654-5866]
4. Re: orbit
- Posted by Matt Z Nunyabidness <matt1421 at JUNO.COM>
Sep 29, 1998
-
Last edited Sep 30, 1998
What's this
<<< No Message Collected >>>
thingy?
___________________________
When it comes to programming languages, Euphoria is a cut above -
matt1278 at juno.com and matt1421 at juno.com(and soon to be
irisnmatt at prodigy.net. Then again, maybe not) Euphoria programmer
Web users: <A HREF=mailto:"matt1421 at juno.com">matt1421 at juno.com</A> or <A
___________________________________________________________________
You don't need to buy Internet access to use free Internet e-mail.
Get completely free e-mail from Juno at http://www.juno.com
Or call Juno at (800) 654-JUNO [654-5866]
