Programming C, C++, Java, PHP, Ruby, Turing, VB
Computer Science Canada 
Programming C, C++, Java, PHP, Ruby, Turing, VB  

Username:   Password: 
 RegisterRegister   
 bouncing ball
Index -> Programming, Turing -> Turing Submissions
Goto page 1, 2  Next
View previous topic Printable versionDownload TopicRate TopicSubscribe to this topicPrivate MessagesRefresh page View next topic
Author Message
zylum




PostPosted: 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
Sponsor
Sponsor
Sponsor
sponsor
Paul




PostPosted: Tue Apr 06, 2004 8:37 pm   Post subject: (No subject)

cool, can I make it bounce left or right? Very Happy
zylum




PostPosted: Tue Apr 06, 2004 8:39 pm   Post subject: (No subject)

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




PostPosted: Tue Apr 06, 2004 8:41 pm   Post subject: (No 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*
Delos




PostPosted: Tue Apr 06, 2004 8:42 pm   Post subject: (No 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
zylum




PostPosted: Tue Apr 06, 2004 9:26 pm   Post subject: (No subject)

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




PostPosted: Tue Apr 06, 2004 9:29 pm   Post subject: (No 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?
Catalyst




PostPosted: Tue Apr 06, 2004 10:51 pm   Post subject: (No 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
Paul




PostPosted: Wed Apr 07, 2004 3:05 pm   Post subject: (No subject)

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




PostPosted: Wed Apr 07, 2004 3:50 pm   Post subject: (No subject)

haha! tats so true! got me sooooooooo pissed off
apomb




PostPosted: Sat Apr 10, 2004 2:31 pm   Post subject: (No 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!
AiR




PostPosted: Wed Apr 28, 2004 10:26 pm   Post subject: (No subject)

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




PostPosted: Wed Apr 28, 2004 10:36 pm   Post subject: (No subject)

then just dl the update of 4.0.5
zeldamaster1230




PostPosted: Thu Apr 29, 2004 7:55 am   Post subject: (No 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!
Delta




PostPosted: Thu Apr 29, 2004 1:23 pm   Post subject: (No 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
Display posts from previous:   
   Index -> Programming, Turing -> Turing Submissions
View previous topic Tell A FriendPrintable versionDownload TopicRate TopicSubscribe to this topicPrivate MessagesRefresh page View next topic

Page 1 of 2  [ 19 Posts ]
Goto page 1, 2  Next
Jump to:   


Style:  
Search: