Ball Drop
| Author |
Message |
Jorbalax
|
 Posted: Thu Mar 06, 2008 8:12 pm Post subject: Ball Drop |
|
|
Man, turing is WAY too easy to procrastinate with...
Anyways...I can't quite figure out why it's so amusing to me...probably because the color scheme reminds me of those ball play pens.
| code: |
View.Set ("graphics:800;600, offscreenonly, nobuttonbar, title:Ball Drop, position:centre;centre")
%editable constants
const COLORARRAY : array 0 .. 4 of int := init (brightred, yellow, brightgreen, brightblue, brightpurple)
const BALLDELAY := 0
const BALLSIZE := 6
const BALLSPEED := 0
const DROPBALLS := KEY_ENTER
const FRAMEDELAY := 15
fcn BALLVEL : real
result (Rand.Int (5, 10) / 100)
end BALLVEL
%-----%
var colnum : int := 0
var balls : flexible array 1 .. 0 of
record
x, y, speed, vel : real
col : int
end record
var removearray : flexible array 1 .. 0 of int
var inputarray : array char of boolean
var mx, my, mb : int
var DROP : boolean := false
var keydown : boolean := false
var lastballsince : int := 0
proc drawdropbox
var c : int := brightred
if DROP then
c := brightgreen
end if
Draw.FillBox (2, maxy - 22, 22, maxy - 2, c)
Draw.Box (2, maxy - 22, 22, maxy - 2, black)
end drawdropbox
proc drawball (x, y, size, col : int)
Draw.FillOval (x, y, size, size, col)
Draw.Oval (x, y, size, size, black)
end drawball
loop
Mouse.Where (mx, my, mb)
Input.KeyDown (inputarray)
if inputarray (DROPBALLS) and not keydown then
DROP := not DROP
keydown := true
end if
if not inputarray (DROPBALLS) then
keydown := false
end if
if mb = 1 and Time.Elapsed - lastballsince > BALLDELAY then
new balls, upper (balls) + 1
balls (upper (balls)).x := mx
balls (upper (balls)).y := my
balls (upper (balls)).col := COLORARRAY (colnum)
balls (upper (balls)).speed := BALLSPEED
balls (upper (balls)).vel := BALLVEL
colnum := (colnum + 1) mod (upper (COLORARRAY) + 1)
lastballsince := Time.Elapsed
end if
new removearray, 0
for i : 1 .. upper (balls)
drawball (round (balls (i).x), round (balls (i).y), BALLSIZE, balls (i).col)
if DROP then
balls (i).y += balls (i).speed
balls (i).speed -= balls (i).vel
end if
if balls (i).y < -15 then
new removearray, upper (removearray) + 1
removearray (upper (removearray)) := i
end if
end for
drawdropbox
View.Update
for i : 1 .. upper (removearray)
for j : removearray (i) .. upper (balls) - 1
balls (j) := balls (j + 1)
end for
new balls, upper (balls) - 1
for l : 1 .. upper (removearray)
removearray (l) -= 1
end for
end for
cls
Time.DelaySinceLast (FRAMEDELAY)
end loop
|
|
|
|
|
|
 |
Sponsor
Sponsor
|
|
|
nastynika
|
| Posted: Fri Mar 07, 2008 9:08 am Post subject: Re: Ball Drop |
|
|
| nice |
|
|
|
|
|
petree08
|
| Posted: Fri Mar 07, 2008 9:51 am Post subject: RE:Ball Drop |
|
|
that's pretty neat, i like the "red light/green light" thing, it would be cool if the balls bounced off the floor
i just went into your code and added a bounce ferature (hope you don't mind)
%THE FOLOWING CODE WAS WRITTEN BY JORBALAX with the exception of the the bounce i added
| code: |
View.Set ("graphics:800;600, offscreenonly, nobuttonbar, title:Ball Drop, position:centre;centre")
%editable constants
const COLORARRAY : array 0 .. 4 of int := init (brightred, yellow, brightgreen, brightblue, brightpurple)
const BALLDELAY := 0
const BALLSIZE := 6
const BALLSPEED := 0
const DROPBALLS := KEY_ENTER
const FRAMEDELAY := 15
fcn BALLVEL : real
result (Rand.Int (5, 10) / 100)
end BALLVEL
%-----%
var colnum : int := 0
var balls : flexible array 1 .. 0 of
record
x, y, speed, vel : real
col : int
end record
var removearray : flexible array 1 .. 0 of int
var inputarray : array char of boolean
var mx, my, mb : int
var DROP : boolean := false
var keydown : boolean := false
var lastballsince : int := 0
proc drawdropbox
var c : int := brightred
if DROP then
c := brightgreen
end if
Draw.FillBox (2, maxy - 22, 22, maxy - 2, c)
Draw.Box (2, maxy - 22, 22, maxy - 2, black)
end drawdropbox
proc drawball (x, y, size, col : int)
Draw.FillOval (x, y, size, size, col)
Draw.Oval (x, y, size, size, black)
end drawball
loop
Mouse.Where (mx, my, mb)
Input.KeyDown (inputarray)
if inputarray (DROPBALLS) and not keydown then
DROP := not DROP
keydown := true
end if
if not inputarray (DROPBALLS) then
keydown := false
end if
if mb = 1 and Time.Elapsed - lastballsince > BALLDELAY then
new balls, upper (balls) + 1
balls (upper (balls)).x := mx
balls (upper (balls)).y := my
balls (upper (balls)).col := COLORARRAY (colnum)
balls (upper (balls)).speed := BALLSPEED
balls (upper (balls)).vel := BALLVEL
colnum := (colnum + 1) mod (upper (COLORARRAY) + 1)
lastballsince := Time.Elapsed
end if
new removearray, 0
for i : 1 .. upper (balls)
drawball (round (balls (i).x), round (balls (i).y), BALLSIZE, balls (i).col)
if DROP then
balls (i).y += balls (i).speed
balls (i).speed -= balls (i).vel
%%%% PARRT PETREE ADDED
if balls (i).y < 1 then
balls (i).speed := - (balls (i).speed / 1.5)
end if
%%%%
end if
if balls (i).y < -15 then
new removearray, upper (removearray) + 1
removearray (upper (removearray)) := i
end if
end for
drawdropbox
View.Update
for i : 1 .. upper (removearray)
for j : removearray (i) .. upper (balls) - 1
balls (j) := balls (j + 1)
end for
new balls, upper (balls) - 1
for l : 1 .. upper (removearray)
removearray (l) -= 1
end for
end for
cls
Time.DelaySinceLast (FRAMEDELAY)
end loop
|
I really like these programs that use physics, i wish there where moer of them |
|
|
|
|
|
|
|
Register
Wiki
Blog
Search
Turing
Chat Room
Members
