Balls that are drawn consecutively in an array and have a shrinking radius that corresponds to a timed delay. I left it so you could control the starting x/y locations with the mouse, as it gives it a really cool trail effect. It also looks cool if you set them to random locations or give the main x/y's physics to bounce around/etc, so feel free to mess around.
| Turing: |
const COLORS : array 0 .. 14 of int := init (30, 29, 28, 27, 26, 25, 24, 23 , 22 , 21, 20, 19, 18, 17, 16 )
const BGCOLOR := green
const MBCOLOR := black
const STARTRAD := 50
const RADDECREASE := 1
const RDDELAY := 5 %delay for decrease in radius
const NBDELAY := 5 %delay for new implosions
View.Set ("graphics:max;max, offscreenonly, nobuttonbar, title:Ball Implosions")
colorback (BGCOLOR )
%contains ball location, color, radius, and time since last radius decrease
var ballArray : flexible array 1 .. 0 of
record
x, y, ts, col : int
rad : real
end record
%for removing expired elements from the ballArray
var removeArray : flexible array 1 .. 0 of int
%time comparing function for delays
fcn HasTimePassed (timesince, delayamount : int) : boolean
if Time.Elapsed - timesince > delayamount then
result true
end if
result false
end HasTimePassed
var TimeSinceLast : int := 0
var mx, my, mb : int
%control color changes
var iSelect : int := 0
var iTransValue : int := 1
loop
%creates a new implosion at the specified location (mx, my) after a certain amount of time has passed
if HasTimePassed (TimeSinceLast, NBDELAY ) then
Mouse.Where (mx, my, mb )
new ballArray, upper (ballArray ) + 1
ballArray (upper (ballArray )).rad := STARTRAD
ballArray (upper (ballArray )).x := mx %Rand.Int (round (ballArray (upper (ballArray)).rad), maxx - round (ballArray (upper (ballArray)).rad))
ballArray (upper (ballArray )).y := my %Rand.Int (round (ballArray (upper (ballArray)).rad), maxy - round (ballArray (upper (ballArray)).rad))
ballArray (upper (ballArray )).ts := 0
ballArray (upper (ballArray )).col := COLORS (iSelect )
TimeSinceLast := Time.Elapsed
%alternates moving up and down the color array
iSelect := (iSelect + iTransValue ) mod (upper (COLORS ) + 1)
if iSelect = 0 or iSelect = upper (COLORS ) then
iTransValue := -iTransValue
end if
end if
for i : 1 .. upper (ballArray )
%draws current ball
Draw.FillOval (ballArray (i ).x, ballArray (i ).y, round (ballArray (i ).rad ), round (ballArray (i ).rad ), ballArray (i ).col )
Draw.Oval (ballArray (i ).x, ballArray (i ).y, round (ballArray (i ).rad ), round (ballArray (i ).rad ), black)
% decreases ball radius when appropriate
if HasTimePassed (ballArray (i ).ts, RDDELAY ) then
ballArray (i ).rad - = RADDECREASE
ballArray (i ).ts := Time.Elapsed
end if
%draws a static-colored ball in the lead (otherwise it flickers from changing colors constantly)
if i = upper (ballArray ) then
Draw.FillOval (ballArray (i ).x, ballArray (i ).y, STARTRAD, STARTRAD, MBCOLOR )
end if
%records which balls have shrunk too far
if ballArray (i ).rad < 1 then
new removeArray, upper (removeArray ) + 1
removeArray (upper (removeArray )) := i
end if
end for
%removes balls that have shrunk too far
for i : 1 .. upper (removeArray )
for j : removeArray (i ) + 1 .. upper (ballArray )
ballArray (j - 1) := ballArray (j )
end for
new ballArray, upper (ballArray ) - 1
end for
new removeArray, 0
View.Update
exit when hasch
delay (5)
cls
end loop
|
|
.
