Forum > Games

Simple ball bounce

<< < (6/6)

BobDog:

Slightly improved version.
Detectballcollisions function added.
This removes the necessity of calculating a distance (sqrt(sqr,sqr)) for every combination of two balls, and only uses abs(subtract).
The sqrt(sqr,sqr) is only used if the absolute (subtract) is getting close to a collision.
Should be faster for many balls, but not noticeable for a few balls.
Gdi non flicker method for the graphics.
Added custom text methods.

--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---   program balls;{$mode delphi} uses windows,sysutils;     const    DC_BRUSH=18;    DC_PEN=19;     xres=1024;     yres=768;         Type V2=object     x,y,dx,dy:single;     radius:integer;     c:longword;      procedure SetF(xx,yy,ddx,ddy:single;rradius:integer;cc:longword);     End;          procedure V2.SetF(xx,yy,ddx,ddy:single;rradius:integer;cc:longword);    begin    x:=xx;y:=yy;dx:=ddx;dy:=ddy;radius:=rradius;c:=cc;    end;    type aov=array[1..9] of v2;     function SetDCBrushColor(p:hdc;colour:COLORREF): COLORREF; stdcall external 'gdi32.dll' name 'SetDCBrushColor';    function SetDCPenColor(p:hdc;colour:COLORREF): COLORREF; stdcall external 'gdi32.dll' name 'SetDCPenColor';    Function settimer(n:longword=1):MMRESULT;stdcall external 'winmm.dll' name 'timeBeginPeriod';     Function freetimer(n:longword=1):MMRESULT;stdcall external 'winmm.dll' name 'timeEndPeriod';        procedure ClearScreen(h:hdc);   var   colour:longword;   begin    colour:=rgb(55,255,255);    SetDCBrushColor(h,colour);    SetDCPenColor(h,colour);    rectangle(h,0,0,xres,yres);   end;        procedure MoveAndDraw(Memory:hdc;GDIScreen:hdc;var b:aov;var energy:single);     var i,r:integer;     begin     energy:=0;     for i:=low(b) to high(b) do     begin     r:=b[i].radius;     b[i].x:=b[i].x+b[i].dx;     b[i].y:=b[i].y+b[i].dy;     SetDCBrushColor(Memory,b[i].c);     SetDCPenColor(Memory,b[i].c);     ellipse(Memory,trunc(b[i].x-r),trunc(b[i].y-r),trunc(b[i].x+r),trunc(b[i].y+r));     energy:=energy+ 0.5*(b[i].radius*b[i].radius)*(b[i].dx*b[i].dx + b[i].dy*b[i].dy);     end;     BitBlt(GDIScreen, 0, 0, xres, yres,Memory, 0, 0,SRCCOPY);     end;          procedure HandleEdges(var b:aov);     var i,r:integer;     begin     for i:=low(b) to high(b) do     begin     r:=b[i].radius;     if (b[i].x<r) then begin b[i].x:=r;b[i].dx:=-b[i].dx; end;     if (b[i].x>(xres-r)) then begin b[i].x:=xres-r;b[i].dx:=-b[i].dx; end;          if (b[i].y<r) then begin b[i].y:=r;b[i].dy:=-b[i].dy; end;     if (b[i].y>(yres-r-25)) then begin b[i].y:=yres-r-25;b[i].dy:=-b[i].dy; end     end;          end;  function DetectBallCollisions(b1:V2;b2:V2):single; var    xdiff,ydiff,L:single;    begin    xdiff:=b2.x-b1.x;    ydiff:=b2.y-b1.y;    If Abs(xdiff) > (b2.radius+b1.radius) Then exit(0);    If Abs(ydiff) > (b2.radius+b1.radius) Then exit(0);    L:=Sqrt(xdiff*xdiff+ydiff*ydiff);    If (L<=(b2.radius+b1.radius)) Then exit(L) else exit(0);End;            function HandleBallCollisions(Var b:aov):boolean ;Var  L,impulsex,impulsey,dot,impactx,impacty: single;  ma,mb,f1,f2,ln: single;  n1,n2: Integer;  flag:boolean=false;Begin  For n1 :=low(b) To high(b) -1 Do    Begin      For n2 :=n1+1 To high(b) Do        Begin        L:=DetectBallCollisions(b[n1],b[n2]);                   if (L<>0) then            Begin            flag:=true;                          impulsex := (b[n1].x-b[n2].x) ;              impulsey := (b[n1].y-b[n2].y) ;              ln:=Sqrt(impulsex*impulsex+impulsey*impulsey);              impulsex:=impulsex/ln; // normalize impulse              impulsey:=impulsey/ln;                            // in case of large overlap (non analogue motion)              b[n1].x := b[n2].x+(b[n1].radius+b[n2].radius)*impulsex ;              b[n1].y := b[n2].y+(b[n1].radius+b[n2].radius)*impulsey ;               impactx := b[n1].dx-b[n2].dx ;              impacty := b[n1].dy-b[n2].dy ;              dot := impactx*impulsex+impacty*impulsey ;              ma := b[n1].radius;              mb := b[n2].radius;              ma := ma*ma;   // weigh by area (radius squared)              mb := mb*mb;              f1 := 2*mb/(ma+mb);   // ball weight factors              f2 := 2*ma/(ma+mb);              b[n1].dx:= b[n1].dx-dot*impulsex *f1;              b[n1].dy:= b[n1].dy-dot*impulsey *f1;               b[n2].dx:=b[n2].dx+ dot*impulsex *f2 ;               b[n2].dy:= b[n2].dy+dot*impulsey *f2 ;            End;        End; // n2    End;  // n1    exit(flag);End;      Function Regulate(const MyFps:int32;var fps:int32):int32; const timervalue:double =0;_lastsleeptime:double=0;t3:double=0;frames:double=0;    Var t,sleeptime:double;    begin    t:=gettickcount64/1000;    frames:=frames+1;    If (t-t3)>=1.0 Then begin t3:=t;fps:=trunc(frames);frames:=0; end;     sleeptime:=(_lastsleeptime+((1/myfps)-(t)+timervalue)*1000);    If (sleeptime<1) Then sleeptime:=1;    _lastsleeptime:=sleeptime;    timervalue:=t;    exit( trunc(sleeptime));End; procedure setfontsize(h:hdc;size:int32;style:ansistring);begin SelectObject(h,CreateFont(size,0,0,0,400,0,0,0,DEFAULT_CHARSET,OUT_OUTLINE_PRECIS,CLIP_DEFAULT_PRECIS,ANTIALIASED_QUALITY,VARIABLE_PITCH,pchar(style))); end; procedure setfontcolours(h:hdc;text:longword;background:longword);beginSetTextColor(h,text); SetBkColor(h,background);end; procedure text(h:hdc;x:int32;y:int32;s:ansistring);varL:int32;beginl:=length(s);textouta(h,x,y,pchar(s),L);end; Var  p:hwnd;  b:aov;  emsg:msg;  fps:int32=0; Memhdc,Membitmap,wh:hdc; myfps:integer=60; energy:single=0; j:integer;  beginb[1].setf(100,100,2.75,2.75,35,rgb(255,100,0));b[2].setf(300,300,0,0,35,rgb(0,255,0));b[3].setf(400,400,0,0,40,rgb(0,0,255));b[4].setf(500,500,0,0,30,rgb(0,100,255));b[5].setf(200,200,0,0,20,rgb(200,100,255));b[6].setf(200,300,0,0,35,rgb(255,255,255));b[7].setf(600,300,0,0,27,rgb(255,100,0));b[8].setf(600,600,0,0,25,rgb(255,255,0));b[9].setf(650,650,0,0,23,rgb(255,55,255));        p:=CreateWindowEx( WS_EX_TOPMOST Or WS_EX_TOOLWINDOW ,'#32770','Press ESCAPE key to finish . . .',(WS_OVERLAPPEDWINDOW Or WS_SYSMENU) - (WS_MINIMIZEBOX Or WS_MAXIMIZEBOX Or WS_THICKFRAME) Or WS_VISIBLE,200,200,xres,yres,0,0,0,nil);    wh:=GetDC(p);    Memhdc := CreateCompatibleDC(wh);        Membitmap := CreateCompatibleBitmap(wh, xres, yres);// 810, 630        SelectObject(Memhdc,GetStockObject(DC_BRUSH));    SelectObject(Memhdc,GetStockObject(DC_PEN));        SelectObject(Memhdc, Membitmap);        setfontsize(Memhdc,20,'courier new');    setfontcolours(Memhdc,rgb(0,0,200),rgb(55,255,255));       freeconsole();      while true do    begin  while(int64(PeekMessage(@eMsg,0, 0, 0, PM_REMOVE)) > 0) do    begin     TranslateMessage (@eMsg);     DispatchMessage (@eMsg);        if boolean(GetAsyncKeyState(VK_DOWN)) then myfps:=myfps-1;    if boolean(GetAsyncKeyState(VK_UP)) then myfps:=myfps+1;        if boolean(GetAsyncKeyState(VK_LEFT))  then     begin    for j:=low(b) to high(b) do    if b[j].dx>=0 then b[j].dx:=b[j].dx-0.01 else b[j].dx:=b[j].dx+0.01    end;        if boolean(GetAsyncKeyState(VK_RIGHT)) then     begin    for j:=low(b) to high(b) do     if b[j].dx>=0 then b[j].dx:=b[j].dx+0.01 else b[j].dx:=b[j].dx-0.01    end;        if boolean(GetAsyncKeyState($1B)) then    begin    DeleteObject(Membitmap);        DeleteDC    (Memhdc);    exit;    end;    if myfps<5 then myfps:=5;     end; HandleEdges(b);HandleBallCollisions(b);ClearScreen(Memhdc); text(Memhdc,10,10,'Use up/down arrowkeys to adjust framerate');text(Memhdc,10,30,'Use left/right arrowkeys to adjust energy per frame');text(Memhdc,10,50,'fps required = '+(IntToStr(myfps)));text(Memhdc,10,70,'         fps = '+(IntToStr(fps)));text(Memhdc,10,90,'energy per frame = '+(FloatToStr((energy)))); MoveAndDraw(Memhdc,wh,b,energy); settimer();sleep(regulate(myfps,fps));freetimer();    end;end.  


Navigation

[0] Message Index

[*] Previous page

Go to full version