-----------------------------------

Cezna

Fri Jun 04, 2010 3:29 pm


Gravity Wells (highly customizable)

-----------------------------------

This is my gravity wells program. It's just a gravity simulator, using a warped version of the real formula for the force of gravity (assuming mass of 1 for the balls, which is why only one mass variable appears in the equation).
The controls are:

Left click: create a ball (they get pulled around by gravity)
Right click: create a gravity well (these exert gravity on the balls)
Scroll click on a well: this changes it's colour and it's mass, toggling through:
         red = positive mass (attracts balls)
         green = 0 mass (does nothing to balls)
         blue = negative mass (this repels the balls)
Space bar: toggles background between black and white
1, 2 and 3: toggles the 'zoom' (I put that in quotes because it just changes the radius and mass of everything, as I couldn't figure out a simple way to simulate zooming in and out)
Arrow keys: toggle the respective boundaries between bouncing the balls back when they hit them (represented by a blue line along the boundary) and sending them to the opposite side of the screen if they go out of bounds (represented by a red line along the boundary)

Fell free to play with it, tear it apart, use any of the code in it, and post ideas, suggestions, etc.
There is also some cool music, which is why it is a zip.


-----------------------------------

Insectoid

Fri Jun 04, 2010 4:00 pm


RE:Gravity Wells (highly customizable)

-----------------------------------

Methinks you're missing something.


-----------------------------------

Carey

Fri Jun 04, 2010 5:11 pm


RE:Gravity Wells (highly customizable)

-----------------------------------

I would be happy to take a look at it and give you feedback but for that I would need to see your code :P


-----------------------------------

Cezna

Fri Jun 04, 2010 7:14 pm


RE:Gravity Wells (highly customizable)

-----------------------------------

I can't figure out how to attach a file....
It just waits like 10 minutes while saying 'Sending request to compsci.ca...' at the bottom of my browser, then gives an error, and it's well under the max size for .zip files

So until I figure it out, or someone explains it to me, here is the code (but obviously not the song):


[code]
setscreen ("offscreenonly, nobuttonbar, graphics:max;max")
Mouse.ButtonChoose ("multibutton")
Music.PlayFileLoop ("Osmos.mp3")
var wells, maxballs, balls, maxwells, backclr, mx, my, b, ballradius : int
var angle, wellmass, grav : real
var click1, click100, spacepress, uppress, downpress, leftpress, rightpress, mid, large, pageuppress, pagedownpress
    : boolean := false
var topbound, bottombound, leftbound, rightbound, small : boolean := true
var keys : array char of boolean
maxballs := 200
maxwells := 100
var ballx, bally, ballvx, ballvy : array 1 .. maxballs of real
var ballclr : array 1 .. maxballs of int
var d, wellmassmem : array 1 .. maxballs of real
var click10 : array 1 .. maxwells of boolean
balls := 0
wells := 0
backclr := white
ballradius := 8
grav := 1

/* CONTROLS */
/* LEFT CLICK : spawn a ball at the mouse*/
/* RIGHT CLICK : spawn a gravity well at the mouse*/
/* SCROLL CLICK : change the mass (between positive, zero, and negative) of a gravity well*/
/* red wells : poisitve mass (attract balls)
 green wells : zero mass (don't effect balls)
 blue wells : negative mass (repel balls)*/
/* SPACE BAR : toggle background colour between white and black*/
/* UP ARROW : toggle top boundary*/
/* DOWN ARROW : toggle bottom boundary*/
/* LEFT ARROW : toggle left boundary*/
/* RIGHT ARROW : toggle right boundary*/
/* CTRL (CONTROL) : change between large, medium and small wells and balls
 this will effect only wells and balls drawn after the change is made*/
/* PAGE UP : increase strength of gravity (multiply by 10)*/
/* PAGE DOWN : decrease strength of gravity (divide by 10)*/

type gravwell :
    record
	x : real
	y : real
	mass : real
	radius : int
	clr : int
    end record

var well : array 1 .. 100 of gravwell

function getAngle (x, y : real) : real
    if x = 0 and y = 0 then
	result 0
    elsif x = 0 and y > 0 then
	result 90
    elsif x < 0 and y = 0 then
	result 180
    elsif x = 0 and y < 0 then
	result 270
    elsif x > 0 and y > 0 then
	result arctand (y / x)
    elsif x < 0 and y > 0 then
	result 180 + arctand (y / x)
    elsif x < 0 and y < 0 then
	result 180 + arctand (y / x)
    elsif x > 0 and y < 0 then
	result 360 + arctand (y / x)
    else
	result 0
    end if
end getAngle

function getDistance (x1, y1, x2, y2 : real) : real
    if sqrt ((x2 - x1) ** 2 + (y2 - y1) ** 2) = 0 then
	result .001
    else
	result sqrt ((x2 - x1) ** 2 + (y2 - y1) ** 2)
    end if
end getDistance

proc Boundaries
    for count : 1 .. balls
	% left bound
	if leftbound = true then
	    if ballx (count) + ballvx (count) - 8 = maxx then
		ballvx (count) *= -.5
	    end if
	    if ballx (count) > maxx then
		ballx (count) := maxx - 1
	    end if
	elsif rightbound = false then
	    if ballx (count) > maxx then
		ballx (count) := 0
	    end if
	end if
	% bottom bound
	if bottombound = true then
	    if bally (count) + ballvy (count) - 8 = maxy then
		ballvy (count) *= -.5
	    end if
	    if bally (count) > maxy then
		bally (count) := maxy - 1
	    end if
	elsif topbound = false then
	    if bally (count) > maxy then
		bally (count) := 0
	    end if
	end if
    end for
end Boundaries

proc Moving
    for count : 1 .. balls
	for count2 : 1 .. wells
	    angle := getAngle (well (count2).x - ballx (count), well (count2).y - bally (count))
	    d (count2) := getDistance (well (count2).x, well (count2).y, ballx (count), bally (count))
	    ballvx (count) += (cosd (angle) * well (count2).mass) / (d (count2) ** 2) * grav
	    ballvy (count) += (sind (angle) * well (count2).mass) / (d (count2) ** 2) * grav
	end for
	ballx (count) += ballvx (count)
	bally (count) += ballvy (count)
    end for
    % spawning balls
    if b = 1 and balls < maxballs and mx >= 0 and mx = 0 and my  0 then
		    wellmassmem (count) := well (count).mass
		    well (count).mass := 0
		    well (count).clr := green
		elsif wellmass = 0 then
		    well (count).mass := wellmassmem (count)
		    well (count).mass *= -1
		    well (count).clr := blue
		elsif wellmass < 0 then
		    well (count).mass *= -1
		    well (count).clr := red
		end if
	    end if
	    click10 (count) := true
	else
	    click10 (count) := false
	end if
    end for
    % spawning wells
    if b = 100 and wells < maxwells and mx >= 0 and mx = 0 and my  0 then
		well (count).mass := 5000
	    end if
	end for
    end if
    if keys ('2') then
	small := false
	mid := true
	large := false
	ballradius := 3
	for count : 1 .. wells
	    well (count).radius := 20
	    if well (count).mass < 0 then
		well (count).mass := -2000
	    elsif well (count).mass = 0 then
		wellmassmem (count) := 2000
	    elsif well (count).mass > 0 then
		well (count).mass := 2000
	    end if
	end for
    end if
    if keys ('3') then
	small := false
	mid := false
	large := true
	ballradius := 1
	for count : 1 .. wells
	    well (count).radius := 10
	    if well (count).mass < 0 then
		well (count).mass := -1000
	    elsif well (count).mass = 0 then
		wellmassmem (count) := 1000
	    elsif well (count).mass > 0 then
		well (count).mass := 1000
	    end if
	end for
    end if
    if keys ('r') then
	small := true
	mid := false
	large := false
	ballradius := 8
	balls := 0
	wells := 0
	grav := 1
	cls
    end if
    if keys (chr (201)) /* PAGE UP */ and grav = .001 then
	if pagedownpress = false then
	    grav /= 10
	end if
	pagedownpress := true
    else
	pagedownpress := false
    end if
end Moving

loop
    colourback (backclr)
    cls
    Mouse.Where (mx, my, b)
    Boundaries
    Moving
    for count : 1 .. wells
	drawfilloval (round (well (count).x), round (well (count).y), well (count).radius, well (count).radius, well (count).clr)
    end for
    for count : 1 .. balls
	drawfilloval (round (ballx (count)), round (bally (count)), ballradius, ballradius, ballclr (count))
    end for
    % border indicators
    if topbound then
	drawline (0, maxy, maxx, maxy, blue)
    elsif not topbound then
	drawline (0, maxy, maxx, maxy, red)
    end if
    if leftbound then
	drawline (0, 0, 0, maxy, blue)
    elsif not leftbound then
	drawline (0, 0, 0, maxy, red)
    end if
    if bottombound then
	drawline (0, 0, maxx, 0, blue)
    elsif not bottombound then
	drawline (0, 0, maxx, 0, red)
    end if
    if rightbound then
	drawline (maxx, 0, maxx, maxy, blue)
    elsif not rightbound then
	drawline (maxx, 0, maxx, maxy, red)
    end if
    Time.DelaySinceLast (30)
    View.Update
end loop
[/code]


-----------------------------------

Cezna

Sat Jun 05, 2010 2:35 pm


RE:Gravity Wells (highly customizable)

-----------------------------------

What does it mean if I try to attach a file, and after like 10 minutes of loading, it goes to an error page saying "No post mode specified"?


-----------------------------------

Zren

Sat Jun 05, 2010 3:33 pm


RE:Gravity Wells (highly customizable)

-----------------------------------

After I saw what this could do, I could hardly stop myself from making this. Add it before the main loop:

for i : 0 .. 359 by 4
    wells += 1
    well (wells).x := round (maxx div 2 + i  * cosd (i * 3))
    well (wells).y := round (maxy div 2 + i  * sind (i * 3))
    well (wells).radius := 10
    wellmassmem (wells) := 500
    well (wells).mass := -10-i*1.5
    well (wells).clr := blue
end for


-----------------------------------

Cezna

Sun Jun 06, 2010 10:08 am


RE:Gravity Wells (highly customizable)

-----------------------------------

I had never even thought of that, but it looks amazing.
If anyone else has any cool ideas, post 'em here.

If I get enough responses in the same format as Zren's, I'll make them into modules that can be called from the main program, so you can run any of them from the same program.


-----------------------------------

Cezna

Sun Jun 06, 2010 10:44 am


Re: Gravity Wells (highly customizable)

-----------------------------------

Here's another version, this one traces the orbits of the balls
I recommend using size 2 or 3 (press 2 or 3 when you start), with gravity 10 times normal (press page up when you start).
You have to allow the balls to settle into orbit so that they aren't going to hit the centre and go flying off the screen, but once they have settled down, you can turn the boundaries off by pressing the arrow keys, and allow them to go off the screen during their orbit.

You can get some really cool designs with this one. (Finally got it to attach files, sort of, I just stopped trying to post the .zip)

I also attached the original program, the one posted above. (I can't get the song to upload, however)