Multi directional gravity bouncing ball : or 70s fx

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
redcrab
Posts: 623
Joined: Feb 07, 2006 15:29
Location: France / Luxemburg
Contact:

Multi directional gravity bouncing ball : or 70s fx

Post by redcrab »

Bouncing balls that bounce in all direction ... yes each ball has its own gravity force direction ...
BTW: that remind me some 70s fashion moving fx...

for screenshot see at http://csgp.suret.net/blabla/viewtopic.php?f=5&t=43

Code: Select all

'******************************
'* CSGP Fun code
'* Bouncing balls :70s ambiance
'* by Redcrab 09/07/2008
'******************************
'================================
' We are in a 2 dimensional world
'================================
Type vect
  dim as double x,y
end type

'========================================================================================
' a ball move is made with a position 'p' a velocity 'v' and a gravity(acceleration) 'g'
' a radius 'r' and a color 'c' ;)
'========================================================================================
type ball
   dim as vect p,v,g
   dim as integer r,c 
end type

'==========================
' init gfx and space limit
'==========================
#define maxx 1023
#define maxy 767
#define minx 0
#define miny 0
#define maxball 200
#define pi 3.141592654
screenres maxx-minx+1,maxy-miny+1,8,2,1
screenset 0,1

'=============
' init balls
'=============
dim as ball  balls(1 to maxball)
dim as integer i
dim as double alpha

for i= 1 to maxball
   balls(i).r= int(rnd*40)+10
   balls(i).p.x= maxx/2
   balls(i).p.y = maxy/2 'miny+ balls(i).r + rnd *(maxy-miny-2*balls(i).r)
   balls(i).v.x = 0
   balls(i).v.y = 0
   alpha = rnd * 2 *pi
   balls(i).g.x = cos(alpha)*0.1
   balls(i).g.y = sin(alpha)*0.1
   balls(i).c = int(rnd *15)+17
next i

'===========
' main loop
'===========
do
   cls ' screen clean up
   for i = 1 to maxball
           '--- apply physics
      balls(i).v.x += balls(i).g.x
      balls(i).v.y += balls(i).g.y
      balls(i).p.x += balls(i).v.x
      balls(i).p.y += balls(i).v.y
   
           '--- apply horizontal limit
      if balls(i).p.x > maxx-balls(i).r or balls(i).p.x < minx+balls(i).r then
         balls(i).v.x = -balls(i).v.x
         balls(i).p.x += balls(i).v.x
      end if
   
           '--- apply vertical limit
      if balls(i).p.y > maxy-balls(i).r or balls(i).p.y < miny+balls(i).r then
         balls(i).v.y = -balls(i).v.y
         balls(i).p.y += balls(i).v.y
      end if
      
      circle(balls(i).p.x,balls(i).p.y),balls(i).r,balls(i).c,,,,f
   next i
   '--- try to do a smooth animation
   sleep 1,1
   screensync
   flip
'--- wait for ESC key to exit   
loop until multikey(1)

'End of program
End
tinram
Posts: 89
Joined: Nov 30, 2006 13:35
Location: UK

Post by tinram »

Cool.

(I had to change the screenres line to SCREENRES 1024,768,8)
duke4e
Posts: 717
Joined: Dec 04, 2005 0:16
Location: Varazdin, Croatia, Europe
Contact:

Post by duke4e »

I've made some tweaks, hope you like it.

Code: Select all

#include "fbgfx.bi"
Using FB

'******************************
'* CSGP Fun code
'* Bouncing balls :70s ambiance
'* by Redcrab 09/07/2008
'******************************

Type vect
    Dim As Single x,y
End Type

Type ball
    Dim As vect p,v,g
    Dim As Integer r
    Dim As Uinteger c
End Type

'==========================
' init gfx and space limit
'==========================
#define maxx 1023
#define maxy 767
#define minx 0
#define miny 0
#define maxball 400
#define pi 3.141592654
Screenres maxx - minx + 1, maxy - miny + 1, 32,, GFX_FULLSCREEN Or GFX_ALPHA_PRIMITIVES

Dim As ball  balls(1 To maxball)
Dim As Integer i
Dim As Single alpha

For i = 1 To maxball
    balls(i).r= Int(Rnd * 40)+10
    balls(i).p.x= maxx / 2
    balls(i).p.y = maxy / 2
    balls(i).v.x = 0
    balls(i).v.y = 0
    alpha = Rnd * 2 * pi
    balls(i).g.x = Cos(alpha) * 0.1f
    balls(i).g.y = Sin(alpha) * 0.1f
    balls(i).c = Int(Rnd * 215) + 17
    balls(i).c = Rgba(balls(i).c, balls(i).c, balls(i).c, 50)
Next

Do
    Screenlock
    Cls
    For i = 1 To maxball
        balls(i).v.x += balls(i).g.x
        balls(i).v.y += balls(i).g.y
        balls(i).p.x += balls(i).v.x
        balls(i).p.y += balls(i).v.y
        
        If balls(i).p.x > maxx-balls(i).r OrElse balls(i).p.x < minx+balls(i).r Then
            balls(i).v.x = -balls(i).v.x
            balls(i).p.x += balls(i).v.x
        elseIf balls(i).p.y > maxy-balls(i).r OrElse balls(i).p.y < miny+balls(i).r Then
            balls(i).v.y = -balls(i).v.y
            balls(i).p.y += balls(i).v.y
        End If
        
        Circle(balls(i).p.x,balls(i).p.y),balls(i).r,balls(i).c,,,,f
    Next
    
    Sleep 1
    Screenunlock
Loop Until Multikey(SC_ESCAPE)
Last edited by duke4e on Jul 09, 2008 23:09, edited 1 time in total.
Tusike
Posts: 207
Joined: Jan 03, 2008 16:53
Location: Hungary

Post by Tusike »

Try it with all balls having the same radius. It look really good in the beginning.

-Tusike
redcrab
Posts: 623
Joined: Feb 07, 2006 15:29
Location: France / Luxemburg
Contact:

Post by redcrab »

Thx for the comments :)

@duke4e
Sorry I can't find out what did you modify...
Please, where are the tweaks ?
I see no difference .... May be I've to clean up my glasses ;P


Have fun !
duke4e
Posts: 717
Joined: Dec 04, 2005 0:16
Location: Varazdin, Croatia, Europe
Contact:

Post by duke4e »

sorry, i've pasted the original code... recheck my post for update :)
redcrab
Posts: 623
Joined: Feb 07, 2006 15:29
Location: France / Luxemburg
Contact:

Post by redcrab »

Thank you that's great !
I've credited you into the "csgp fun code"
I've added also a ScreenSync to have smoother move... the motion of your version is too quick !

EDIT: If you have a good cpu you may try with 4000 balls , the fx is really explosiv.


That's fun.
Post Reply