bouncing ball

[zylum]

i was bored so i made this... i know it's not impressive but meh

code:

setscreen ("offscreenonly") type coords :     record         x : real         y : real     end record const xdecay := 0.995 const ydecay := 0.99 const gravity := -0.2 const balls := 20 const speed := 3 const ballRadius := balls + 1 var ball : array 1 .. balls of coords for i : 1 .. balls     ball (i).x := maxx div 2     ball (i).y := maxy div 2 end for var dx, dy : real := 0 var oldx, oldy : int var clr : array 1 .. balls of int var mx, my, md : int var holding : boolean := false fcn checkIfHolding (x, y : int) : boolean     if Math.Distance (ball (1).x, ball (1).y, x, y) < ballRadius and md = 1 then         holding := true         result true     else         result false     end if end checkIfHolding proc updateBalls     mousewhere (mx, my, md)     if md = 1 then         if checkIfHolding (mx, my) or holding = true then             dx := 0             dy := 0             ball (1).x := mx             ball (1).y := my         else             holding := false             ball (1).x += dx             ball (1).y += dy             dx *= xdecay             if abs (dy) > 1 or ball (1).y > 1 then                 dy += gravity             else                 ball (1).y := 0             end if             dy *= ydecay         end if     else         if holding = true then             dx := mx - oldx             dy := my - oldy         end if         holding := false         ball (1).x += dx         ball (1).y += dy         dx *= xdecay         if abs (dy) > 1 or ball (1).y > 2 then             dy += gravity         else             ball (1).y := 0         end if         dy *= ydecay     end if     for i : 2 .. balls         ball (i).x -= (ball (i).x - ball (i - 1).x) / speed         ball (i).y -= (ball (i).y - ball (i - 1).y) / speed     end for     if ball (1).x < 0 or ball (1).x > maxx then         dx *= -xdecay         if ball (1).x < 0 then             ball (1).x := 0         else             ball (1).x := maxx         end if     end if     if ball (1).y < 0 then         dy *= -0.8         if ball (1).y < 0 then             ball (1).y := 0         end if     end if     oldx := mx     oldy := my end updateBalls proc drawBalls     for decreasing i : balls .. 1         drawfilloval (round (ball (i).x), round (ball (i).y), ballRadius - i, ballRadius - i, clr (i))     end for end drawBalls proc makeColors (clrs : int)     for i : 1 .. clrs         clr (i) := RGB.AddColor (i / clrs, i / clrs, i / clrs)     end for end makeColors makeColors (balls) loop     updateBalls     drawBalls     View.Update     cls end loop

-zylum

[Paul]

cool, can I make it bounce left or right?

[zylum]

huh? lol, you know you could pic it up right?

[Paul]

wow, heres what I get... your code is pretty complicated for me to understand lol, but not that hard, I shoulda seen the mousewhere... its cool, but the decay or whatever seems a little weird to me, maybe a bit much? its just the ball bouces for like 3 seconds on the ground, until the bounce is so small, it seems to be rolling. but wow....*salivates*

[Delos]

[sigh]

That's all I have to say. Anything more would not do it justice.

[sigh]

[edit: Well, actually, I am going to say some more!]


Here's a bit of an alteration on your code. Looks nice:

code:

setscreen ("offscreenonly") type coords :     record         x : real         y : real     end record const xdecay := 0.99 const ydecay := 0.99 const gravity := -0.1 const balls := 35 const speed := 5 const ballRadius := 15 const elasticity := 1.6 var ball : array 1 .. balls of coords for i : 1 .. balls     ball (i).x := maxx div 2     ball (i).y := maxy div 2 end for var dx, dy : real := 0 var oldx, oldy : int var clr : array 1 .. balls of int var mx, my, md : int var holding : boolean := false fcn checkIfHolding (x, y : int) : boolean     if Math.Distance (ball (1).x, ball (1).y, x, y) < ballRadius and md = 1 then         holding := true         result true     else         result false     end if end checkIfHolding proc updateBalls     mousewhere (mx, my, md)     if md = 1 then         if checkIfHolding (mx, my) or holding = true then             dx := 0             dy := 0             ball (1).x := mx             ball (1).y := my         else             holding := false             ball (1).x += dx             ball (1).y += dy             dx *= xdecay             if abs (dy) > 1 or ball (1).y > 1 then                 dy += gravity             else                 ball (1).y := 0             end if             dy *= ydecay         end if     else         if holding = true then             dx := mx - oldx             dy := my - oldy         end if         holding := false         ball (1).x += dx         ball (1).y += dy         dx *= xdecay         if abs (dy) > 1 or ball (1).y > 1 then             dy += gravity         else             ball (1).y := 0         end if         dy *= ydecay     end if     for i : 2 .. balls         ball (i).x -= (ball (i).x - ball (i - 1).x) / speed         ball (i).y -= (ball (i).y - ball (i - 1).y) / speed     end for     if ball (1).x < 0 or ball (1).x > maxx then         dx *= -xdecay         if ball (1).x < 0 then             ball (1).x := 0         else             ball (1).x := maxx         end if     end if     if ball (1).y < 0 then         dy *= -elasticity         if ball (1).y < 0 then             ball (1).y := 0         end if     end if     oldx := mx     oldy := my end updateBalls proc drawBalls     for decreasing i : balls .. 1         drawfilloval (round (ball (i).x), round (ball (i).y), ballRadius - i, ballRadius - i, clr (i))     end for end drawBalls proc makeColors (clrs : int) var a : real := 0.6     for i : 1 .. clrs         %clr (i) := RGB.AddColor (i / clrs, i / clrs, i / clrs)         clr (i) := RGB.AddColor (a, a,a+ i / clrs)     end for end makeColors makeColors (balls) loop     updateBalls     drawBalls     View.Update     delay (10)     cls end loop

[zylum]

with that code the ball never stops bouncing in fact it bounces higher and higher

[Paul]

it does look pretty cool, reverse boucing!! but its kinda laggy
can I ask you how you made it so that if you draged the mouse faster, and let go the ball went faster? is there a way to test the velocity of the mouse?

[Catalyst]

whee

code:

setscreen ("offscreenonly") type coords :     record         x : real         y : real     end record const xdecay := 0.995 const ydecay := 0.99 const gravity := -0.2 const balls := 20 const speed := 3 const ballRadius := balls + 1 var ball : array 1 .. balls of coords for i : 1 .. balls     ball (i).x := maxx div 2 + 10     ball (i).y := maxy div 2 + 10 end for var dx, dy : real := 0 var oldx, oldy : int var clr : array 1 .. balls of int var mx, my, md : int var holding : boolean := false fcn checkIfHolding (x, y : int) : boolean     if Math.Distance (ball (1).x, ball (1).y, x, y) < ballRadius and md = 1 then         holding := true         result true     else         result false     end if end checkIfHolding proc updateBalls     var gravityX, gravityY, dist : real := 0     var cX : int := maxx div 2     var cY : int := maxy div 2     mousewhere (mx, my, md)     if md = 1 then         if checkIfHolding (mx, my) or holding = true then             dx := 0             dy := 0             ball (1).x := mx             ball (1).y := my         else             dist := sqrt ((ball (1).x - cX) * (ball (1).x - cX) + (ball (1).y - cY) * (ball (1).y - cY))             gravityX := - (ball (1).x - cX) / dist             gravityY := - (ball (1).y - cY) / dist             drawline (round (ball (1).x), round (ball (1).y), round (ball (1).x + gravityX), round (ball (1).y + gravityY), 42)             holding := false             ball (1).x += dx             ball (1).y += dy             dx *= xdecay             if abs (dy) > 1 or ball (1).y > 1 then                 dx += gravityX                 dy += gravityY             else                 ball (1).y := 0             end if             dy *= ydecay         end if     else         if holding = true then             dx := mx - oldx             dy := my - oldy         end if         dist := sqrt ((ball (1).x - cX) * (ball (1).x - cX) + (ball (1).y - cY) * (ball (1).y - cY))         gravityX := - (ball (1).x - cX) / dist         gravityY := - (ball (1).y - cY) / dist         drawline (round (ball (1).x), round (ball (1).y), round (ball (1).x + gravityX), round (ball (1).y + gravityY), 42)         holding := false         ball (1).x += dx         ball (1).y += dy         dx *= xdecay         if abs (dy) > 1 or ball (1).y > 1 then             dx += gravityX             dy += gravityY         else             ball (1).y := 0         end if         dy *= ydecay     end if     for i : 2 .. balls         ball (i).x -= (ball (i).x - ball (i - 1).x) / speed         ball (i).y -= (ball (i).y - ball (i - 1).y) / speed     end for     if ball (1).x < 0 or ball (1).x > maxx then         dx *= -xdecay         if ball (1).x < 0 then             ball (1).x := 0         else             ball (1).x := maxx         end if     end if     if ball (1).y < 0 then         dy *= -0.8         if ball (1).y < 0 then             ball (1).y := 0         end if     end if     oldx := mx     oldy := my end updateBalls proc drawBalls     for decreasing i : balls .. 1         drawfilloval (round (ball (i).x), round (ball (i).y), ballRadius - i, ballRadius - i, clr (i))     end for end drawBalls proc makeColors (clrs : int)     for i : 1 .. clrs         clr (i) := RGB.AddColor (i / clrs, i / clrs, i / clrs)     end for end makeColors makeColors (balls) loop     updateBalls     drawBalls     View.Update     cls end loop

[Paul]

your crazy, have you any idea how frustrating it is to try and catch it??? its cool though

[white_dragon]

haha! tats so true! got me sooooooooo pissed off

[apomb]

All you gotta do is hold the button down near the path and it will stop ... and btw that is the wildest effect ive ever saw in turing!

[AiR]

Hmm damnit Math.Distance has a problem on my turing 4.0.

[gamer]

then just dl the update of 4.0.5

[zeldamaster1230]

My God ... that is the most amazing (save for Catalyst's stuff) program I have ever seen! Here's my mod on it:

code:

var win : int := Window.Open ("graphics:1000;600") setscreen ("offscreenonly") type coords :     record         x : real         y : real     end record const xdecay := 0.995 const ydecay := 0.99 const gravity := -0.2 const balls := 100 const speed := 3 const ballRadius := balls + 1 var ball : array 1 .. balls of coords for i : 1 .. balls     ball (i).x := maxx div 2     ball (i).y := maxy div 2 end for var dx, dy : real := 0 var oldx, oldy : int var clr : array 1 .. balls of int var mx, my, md : int var holding : boolean := false fcn checkIfHolding (x, y : int) : boolean     if round (sqrt ((ball (1).x - x) ** 2 + (ball (1).y - y) ** 2)) < ballRadius and md = 1 then         %if Math.Distance (ball (1).x, ball (1).y, x, y) < ballRadius and md = 1 then         holding := true         result true     else         result false     end if end checkIfHolding proc updateBalls     mousewhere (mx, my, md)     if md = 1 then         if checkIfHolding (mx, my) or holding = true then             dx := 0             dy := 0             ball (1).x := mx             ball (1).y := my         else             holding := false             ball (1).x += dx             ball (1).y += dy             dx *= xdecay             if abs (dy) > 1 or ball (1).y > 1 then                 dy += gravity             else                 ball (1).y := 0             end if             dy *= ydecay         end if     else         if holding = true then             dx := mx - oldx             dy := my - oldy         end if         holding := false         ball (1).x += dx         ball (1).y += dy         dx *= xdecay         if abs (dy) > 1 or ball (1).y > 2 then             dy += gravity         else             ball (1).y := 0         end if         dy *= ydecay     end if     for i : 2 .. balls         ball (i).x -= (ball (i).x - ball (i - 1).x) / speed         ball (i).y -= (ball (i).y - ball (i - 1).y) / speed     end for     if ball (1).x < 0 or ball (1).x > maxx then         dx *= -xdecay         if ball (1).x < 0 then             ball (1).x := 0         else             ball (1).x := maxx         end if     end if     if ball (1).y < 0 then         dy *= -0.8         if ball (1).y < 0 then             ball (1).y := 0         end if     end if     oldx := mx     oldy := my     delay (5) end updateBalls proc drawBalls     for decreasing i : balls .. 1         drawfilloval (round (ball (i).x), round (ball (i).y), ballRadius - i, ballRadius - i, clr (i))     end for end drawBalls proc makeColors (clrs : int)     for i : 1 .. clrs         clr (i) := RGB.AddColor (i / clrs, i / clrs, i / clrs)     end for end makeColors makeColors (balls) loop     updateBalls     drawBalls     View.Update     cls end loop

If you hold it, and move it around in an infinity sign, it's sort of reminiscent of a dragon. Good job!

[Delta]

Check this out... its a snake...

code:

var win : int := Window.Open ("graphics:1000;600") setscreen ("offscreenonly") type coords :     record         x : real         y : real     end record const xdecay := 0.995 const ydecay := 0.99 const gravity := -0.2 const balls := 100 const speed := 3 const ballRadius := balls + 1 var ball : array 1 .. balls of coords for i : 1 .. balls     ball (i).x := maxx div 2     ball (i).y := maxy div 2 end for var oldx, oldy : int var clr : array 1 .. balls of int var mx, my, md : int var holding : boolean := false fcn checkIfHolding (x, y : int) : boolean     if round (sqrt ((ball (1).x - x) ** 2 + (ball (1).y - y) ** 2)) < ballRadius and md = 1 then         %if Math.Distance (ball (1).x, ball (1).y, x, y) < ballRadius and md = 1 then         holding := true         result true     else         result false     end if end checkIfHolding var dx, dy : int := 5 dy := 2 proc updateBalls         if ball (1).x > maxx then         dx := -5     elsif ball (1).x < 0 then         dx := 5     end if     if ball (1).y > 100 then         dy := -2     elsif ball (1).y < 0 then         dy := 2     end if     ball (1).x += dx     ball (1).y += dy     for i : 2 .. balls         ball (i).x -= (ball (i).x - ball (i - 1).x) / speed         ball (i).y -= (ball (i).y - ball (i - 1).y) / speed     end for     delay (5) end updateBalls proc drawBalls     for decreasing i : balls .. 1         drawfilloval (round (ball (i).x), round (ball (i).y), ballRadius - i, ballRadius - i, clr (i))     end for     drawfilloval (round (ball (1).x)-20, round (ball (1).y), 20,5, 12)     drawfilloval (round (ball (1).x)+20, round (ball (1).y), 20,5, 12) end drawBalls proc makeColors (clrs : int)     for i : 1 .. clrs         clr (i) := RGB.AddColor (i / clrs, i / clrs, i / clrs)     end for end makeColors makeColors (balls) loop     updateBalls     drawBalls     View.Update     cls end loop