Computer Science Canada

bouncing ball

Author:

zylum [ Tue Apr 06, 2004 8:25 pm ]

Post subject:

bouncing ball

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

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

Author:	Paul [ Tue Apr 06, 2004 8:37 pm ]
Post subject:
cool, can I make it bounce left or right?

Author:	zylum [ Tue Apr 06, 2004 8:39 pm ]
Post subject:
huh? lol, you know you could pic it up right?

Author:	Paul [ Tue Apr 06, 2004 8:41 pm ]
Post subject:
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

Author:

Delos [ Tue Apr 06, 2004 8:42 pm ]

Post subject:

[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

Author:	zylum [ Tue Apr 06, 2004 9:26 pm ]
Post subject:
with that code the ball never stops bouncing in fact it bounces higher and higher

Author:	Paul [ Tue Apr 06, 2004 9:29 pm ]
Post subject:
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?

Author:

Catalyst [ Tue Apr 06, 2004 10:51 pm ]

Post subject:

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

Author:	Paul [ Wed Apr 07, 2004 3:05 pm ]
Post subject:
your crazy, have you any idea how frustrating it is to try and catch it??? its cool though

Author:	white_dragon [ Wed Apr 07, 2004 3:50 pm ]
Post subject:
haha! tats so true! got me sooooooooo pissed off

Author:	apomb [ Sat Apr 10, 2004 2:31 pm ]
Post subject:
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!

Author:	AiR [ Wed Apr 28, 2004 10:26 pm ]
Post subject:
Hmm damnit Math.Distance has a problem on my turing 4.0.

Author:	gamer [ Wed Apr 28, 2004 10:36 pm ]
Post subject:
then just dl the update of 4.0.5

Author:

zeldamaster1230 [ Thu Apr 29, 2004 7:55 am ]

Post subject:

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!

Author:

Delta [ Thu Apr 29, 2004 1:23 pm ]

Post subject:

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

Author:	Paul [ Thu Apr 29, 2004 2:03 pm ]
Post subject:
haha, very nice. I can't throw the snake

Author:	netninja [ Wed May 19, 2004 6:32 pm ]
Post subject:
noOOooooOOoooo By the way, set elasticity for 0.9 in the second one, delay to 8, and , and it will be like a normal ball. To make one ball, set balls to 3, and for good speed, put speed to about 3. Ooh, and put xdecay to 98, looks better, to me at least. Zylum, this is meant for you heh.

Author:	Canadian Rob [ Wed May 19, 2004 8:48 pm ]
Post subject:
WOW! Thouse are soooo COOL! Lol I like the won were u gota catch it IT SO HARD! Lol I got it the first time and im like What.. this is easy. I havent caught it since lol

Author:	netninja [ Wed May 19, 2004 9:45 pm ]
Post subject:
Lol my god, just put it onto the line where the ball spins and just click a couple times, so ez, got it immediately

You can syndicate this boards posts using the file backend.php or view the topic map using sitemap.php.

Terms of Use | Privacy Policy