REM DBP 6.2
set display mode 1024,768,32
sync on
sync rate 0
randomize timer()
 
 
Global GRAV as float = .3
Global Floory as integer : Floory = screen height() - 50
type ball
    yforce  as float
    xforce  as float
    angle   as float
    bounce  as float
    xbounce as float
    size    as integer
    x       as float
    y       as float
    hit     as boolean
endtype
dim daball(20) as ball
ALPH as integer = 2
 
 
start()
MTrans(35,ALPH)
 
 
clicked = -1
time = timer()
do
    if timer() - time > 8
        `cls 0
        paste image ALPH, 0,0,1                
        ink RGB(255,0,0), 0
        box 0, Floory, screen width(), screen height()
 
 
 
        RefreshBall()
 
        if mouseclick() = 1
            for i = 0 to array count(daball())
                if distance2d(mousex(), mousey(),daball(i).x,daball(i).y) < daball(i).size                     
                    clicked = i                                          
                endif
            next i
        endif
        prem = mouseclick()
        if clicked <> -1
            daball(clicked).x = mousex()
            daball(clicked).y = mousey()
            daball(clicked).xforce = 0
            daball(clicked).yforce = 0
            if mouseclick() = 0 
                daball(clicked).xforce = mousemovex() / 2
                daball(clicked).yforce = mousemovey() / 2                 
                if daball(clicked).xforce > 30 then daball(clicked).xforce = 30
                if daball(clicked).yforce > 30 then daball(clicked).yforce = 30
                if daball(clicked).xforce < -30 then daball(clicked).xforce = -30
                if daball(clicked).yforce < -30 then daball(clicked).yforce = -30
                clicked = -1
            endif         
        endif
        if spacekey() then start()
        text 0,0,str$(mousemovex())
        text 0,10,str$(mousemovey())
        sync
        time = timer()
    endif
loop
 
FUNCTION RefreshBall()
    ink RGB(255,255,255),0 
    for i = 0 to array count(daball())
        bhit = 0
		Circle_Fill(daball(i).x, daball(i).y,daball(i).size)
        if daball(i).y + daball(i).size >= Floory or daball(i).y - daball(i).size < 0 
            daball(i).yforce = -daball(i).yforce
            daball(i).yforce= daball(i).yforce * daball(i).bounce
            if daball(i).y + daball(i).size >= Floory
	            daball(i).y = floory - daball(i).size
            else
                daball(i).y = daball(i).size
			endif 
        else
            inc daball(i).yforce, GRAV
        endif
        inc daball(i).y, daball(i).yforce
 
 
 
        if daball(i).x + daball(i).size > screen width() or daball(i).x - daball(i).size <= 0  
            daball(i).xforce = -daball(i).xforce
            daball(i).xforce = daball(i).xforce * daball(i).xbounce
            if daball(i).x - daball(i).size <= 0
                daball(i).x = daball(i).size
            else
                daball(i).x = screen width() - daball(i).size
            endif
 
            inc daball(i).x, daball(i).xforce
        endif
        inc daball(i).x, daball(i).xforce
        for n = 0 to array count(daball())
            if n <> i
                if Distance2d(daball(i).x,daball(i).y,daball(n).x,daball(n).y)<=daball(i).size+daball(n).size
                    `bhit = 1
					`if daball(i).hit = 0 or daball(n).hit = 0
						angle1# = wrapvalue(atanfull(daball(i).xforce,daball(i).yforce))
                    	angle2# = wrapvalue(atanfull(daball(n).x - daball(i).x,daball(n).y-daball(i).y))
                    	midx = (daball(n).x + daball(i).x)/2
                        midy = (daball(n).y + daball(i).y)/2
                    	daball(n).x = (sin(angle2#)*(daball(n).size))+midx
                    	daball(n).y = (cos(angle2#)*(daball(n).size))+midy
                    	daball(i).x = (sin(angle2#+180)*(daball(i).size))+midx
                    	daball(i).y = (cos(angle2#+180)*(daball(i).size))+midy
						txf# = daball(i).xforce
                    	tyf# = daball(i).yforce                    
                    	daball(i).xforce = sin(wrapvalue(angle1#-angle2#))*Distance2d(0,0,txf#,tyf#) 
                    	daball(i).yforce = -(cos(wrapvalue(angle1#-angle2#))*Distance2d(0,0,txf#,tyf#))                    
                    	angle1# = wrapvalue(atanfull(daball(n).xforce,daball(n).yforce))                    
                    	angle2# = wrapvalue(atanfull(daball(i).x - daball(n).x,daball(i).y-daball(n).y))
                    	txf# = daball(n).xforce
                    	tyf# = daball(n).yforce
                    	daball(n).xforce = sin(wrapvalue(angle1#-angle2#))*Distance2d(0,0,txf#,tyf#) 
                    	daball(n).yforce = -(cos(wrapvalue(angle1#-angle2#))*Distance2d(0,0,txf#,tyf#))                                                            
					`endif                                                                                
                endif
            endif
        next  
        `if bhit = 0 then daball(i).hit = 0        
    next    
endfunction     
function Circle_Fill(x,y,Radius)
   for x1=0 to Radius
      y1=sqrt(Radius^2-x1^2)
      box x-x1,y-y1,x+x1,y+y1
   next x1
endfunction
function Ellipse_Fill(x,y,xRadius,yRadius)
   for x1=0 to xRadius
      y1=sqrt(xRadius^2-x1^2)*yRadius/(1.0*xRadius)
      box x-x1,y-y1,x+x1,y+y1
   next x1
endfunction
FUNCTION Distance2d(x1 as float,y1 as float,x2 as float,y2 as float)
    RV# = sqrt((x1-x2)^2+(y1-y2)^2)
endfunction RV#
FUNCTION start()
for i = 0 to array count(daball())
    daball(i).xforce = rnd(12) - 6
    daball(i).yforce = rnd(6) - 3
    daball(i).x = rnd(screen width() - 100) + 50 
    daball(i).y = rnd(400) + 12
    daball(i).bounce = .9
    daball(i).xbounce = .6
    daball(i).size = 10
next i
endfunction
FUNCTION MTrans(alpha as byte,I_N as integer)
    make memblock 1,screen width() * screen height() * 4
    write memblock dword 1, 0,screen width()
    write memblock dword 1, 4,screen height()
    write memblock dword 1, 8,32
    for i = 12 to get memblock size(1)-1 step 4        
        write memblock byte 1,i + 3,alpha
    next
    make image from memblock I_N,1
    delete memblock 1
endfunction