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
|