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

zylum

Tue Apr 06, 2004 8:25 pm


bouncing ball

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

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

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

Tue Apr 06, 2004 8:37 pm



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

cool, can I make it bounce left or right? :D


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

zylum

Tue Apr 06, 2004 8:39 pm



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

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


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

Paul

Tue Apr 06, 2004 8:41 pm



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

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

Tue Apr 06, 2004 8:42 pm



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




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

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

Tue Apr 06, 2004 9:26 pm



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

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


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

Paul

Tue Apr 06, 2004 9:29 pm



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

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

Tue Apr 06, 2004 10:51 pm



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

whee


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

Wed Apr 07, 2004 3:05 pm



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

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


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

white_dragon

Wed Apr 07, 2004 3:50 pm



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

haha! tats so true! got me sooooooooo pissed  off


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

apomb

Sat Apr 10, 2004 2:31 pm



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

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

Wed Apr 28, 2004 10:26 pm



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

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


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

gamer

Wed Apr 28, 2004 10:36 pm



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

then just dl the update of 4.0.5


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

zeldamaster1230

Thu Apr 29, 2004 7:55 am



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

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


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

Thu Apr 29, 2004 1:23 pm



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

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

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


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

Paul

Thu Apr 29, 2004 2:03 pm



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

haha, very nice. I can't throw the snake  :lol:  :cry:


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

netninja

Wed May 19, 2004 6:32 pm



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

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.


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

Canadian Rob

Wed May 19, 2004 8:48 pm



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

WOW! Thouse are soooo COOL! Lol I like the won were u gota catch it :D IT SO HARD! Lol I got it the first time and im like What.. this is easy. I havent caught it since :( lol


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

netninja

Wed May 19, 2004 9:45 pm



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

Lol
my god, just put it onto the line where the ball spins and just click a couple times, so ez, got it immediately  :lol:   :roll: