Computer Science Canada

Cool screen effect
Author:  petree08 [ Tue Nov 28, 2006 10:52 am ]
Post subject:  Cool screen effect
This program randomly selects a point on the screen and a ball will follow it
this is done for a bunch of balls and it looks kinda cool

code:


const NUM_OF := 10

var X, Y : array 1 .. NUM_OF of int


var XT, YT : array 1 .. NUM_OF of int
procedure Blur_Screen
    const BLUR_FACTOR := 50
    for Blur : 1 .. BLUR_FACTOR
        drawline (Rand.Int (1, 800) * 2 - 400, Rand.Int (1, 600) * 2 - 300,
            Rand.Int (1, 800) * 2 - 400,
            Rand.Int (1, 600) * 2 - 300, 7)
    end for

end Blur_Screen
setscreen ("graphics:max,max,nobuttonbar,offscreenonly")
colorback (7)
cls
const COLOUR := 12
const SIZE := 5
const MID_X := maxx div 2
const SPEED := 2
const MID_Y := maxy div 2






for Index : 1 .. NUM_OF


    randint (XT (Index), 1, maxx)
    randint (YT (Index), 1, maxy)

    X (Index) := MID_X
    Y (Index) := MID_Y
end for

loop
    Blur_Screen

    for Index : 1 .. NUM_OF


        if X (Index) > XT (Index) - 2 and X (Index) < XT (Index) + 2 and

                Y (Index) > YT (Index) - 2 and Y (Index) < YT (Index) + 2 then


            for Index2 : 1 .. NUM_OF

                randint (XT (Index2), 1, maxx)
                randint (YT (Index2), 1, maxy)


            end for

        else

            if X (Index) > XT (Index) then
                X (Index) := X (Index) - SPEED

            else


                X (Index) := X (Index) + SPEED

            end if

            if Y (Index) > YT (Index) then
                Y (Index) := Y (Index) - SPEED

            else




                Y (Index) := Y (Index) + SPEED
            end if



        end if


        drawfilloval (X (Index), Y (Index), SIZE, SIZE, COLOUR)


    end for

    View.Update

end loop


Author:  Cervantes [ Tue Nov 28, 2006 3:39 pm ]
Post subject: 
First, you should take a look at the Turing Style Guideline. You're using way more whitespace than necessary, and you've got a pretty unconventional capitlizing/underscoring scheme.

Now, ordinarily, I would say, "Please DON'T post omfg sooo trippy cool flashes!", but this is a pretty cool effect. I just think it could use smoother animation. Wouldn't it be cool if the balls moved smoothly? How about if they moved under the effects of gravity?

Try this on for size. Smile
code:

var balls : flexible array 1 .. 4 of
    record
        x, y, vx, vy, m : real
        r : int
    end record

procedure blur_screen
    for rep : 1 .. 40
        drawline (Rand.Int (1, 800) * 2 - 400, Rand.Int (1, 600) * 2 - 300,
            Rand.Int (1, 800) * 2 - 400,
            Rand.Int (1, 600) * 2 - 300, 7)
    end for
end blur_screen
setscreen ("graphics:900;900,nobuttonbar,offscreenonly")
colorback (7)
cls

const G := 0.35

balls (1).x := maxx / 2
balls (1).y := maxy / 2 - 250
balls (2).x := maxx / 2
balls (2).y := maxy / 2 + 250
balls (1).vx := 8
balls (1).vy := 0
balls (2).vx := -8
balls (2).vy := 0
balls (3).x := maxx / 2 + 50
balls (3).y := maxy / 2
balls (4).x := maxx / 2 - 50
balls (4).y := maxy / 2
balls (3).vx := 0
balls (3).vy := 3
balls (4).vx := 0
balls (4).vy := -3
for i : 1 .. upper (balls)
    balls (i).m := 100
    balls (i).r := ceil (sqrt (balls (i).m / 3.14159))
end for

loop
    blur_screen

    % Check for collisions
    var ind := 0
    loop
        ind += 1
        exit when ind > upper (balls)
        for j : ind + 1 .. upper (balls)
            var dist := Math.Distance (balls (ind).x, balls (ind).y, balls (j).x, balls (j).y)
            if dist <= (balls (ind).r + balls (j).r) * 1.5 then
                % Combine balls i and j
                var total_mass := balls (ind).m + balls (j).m
                balls (ind).vx := ((balls (ind).vx * balls (ind).m) + (balls (j).vx * balls (j).m)) / total_mass
                balls (ind).vy := ((balls (ind).vy * balls (ind).m) + (balls (j).vy * balls (j).m)) / total_mass
                balls (ind).x := ((balls (ind).x * balls (ind).m) + (balls (j).x * balls (j).m)) / total_mass
                balls (ind).y := ((balls (ind).y * balls (ind).m) + (balls (j).y * balls (j).m)) / total_mass
                balls (ind).m := total_mass
                balls (ind).r := ceil (sqrt (balls (ind).m / 3.14159))

                % Remove ball j
                balls (j) := balls (upper (balls))
                new balls, upper (balls) - 1
                exit
            end if
        end for
    end loop

    % Update speeds
    for i : 1 .. upper (balls)

        % Apply gravity from other balls
        for j : i + 1 .. upper (balls)
            var dist := Math.Distance (balls (i).x, balls (i).y, balls (j).x, balls (j).y)
            var force := G * balls (i).m * balls (j).m / (dist * dist)
            var delta_x := balls (i).x - balls (j).x
            var delta_y := balls (i).y - balls (j).y

            balls (i).vx -= force * delta_x / dist
            balls (i).vy -= force * delta_y / dist
            balls (j).vx += force * delta_x / dist
            balls (j).vy += force * delta_y / dist
        end for

        % Apply a repulsive force from the walls
        balls (i).vx += G * balls (i).m ** 2 / (balls (i).x ** 2)
        balls (i).vx -= G * balls (i).m ** 2 / ((maxx - balls (i).x) ** 2)
        balls (i).vy += G * balls (i).m ** 2 / (balls (i).y ** 2)
        balls (i).vy -= G * balls (i).m ** 2 / ((maxy - balls (i).y) ** 2)
    end for

    % Update positions and draw
    for i : 1 .. upper (balls)
        balls (i).x += balls (i).vx
        balls (i).y += balls (i).vy
        Draw.FillOval (round (balls (i).x), round (balls (i).y), balls (i).r, balls (i).r, red)
    end for
    View.Update
    delay (12)
    exit when hasch
end loop

Let it run for a while. It doesn't get stuck in any particular orbit pattern (until the very end, when you only have one ball left).

:


You can syndicate this boards posts using the file backend.php or view the topic map using sitemap.php.

Terms of Use | Privacy Policy