| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Проблемы с трением [Delphi, Windows]

$00FF00 ©   (2007-04-26 19:11:00) 

Доброго времени суток, господа эксперты. Я тут пишу движок на 2D - игру. И всё вроде кудряво - физика там и всё такое, но ужасно доконала высокая сила трения, появляющаяся не пойми откуда (я её не прописывал). Вот привожу исходник:


program Bounce;
uses                
 Windows, Messages, OpenGL;

{$Warnings off}
{$Hints off}

type
 PT3D = record
   x, y, z : single;
 end;

 PN3D = record
   p : PT3D;
   n : PT3D;
 end;

 CBK = procedure(uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD); stdcall;

const
 CN = 'Win32OGL';
 WN = 'Bounce';

 B_SML = 0.125;
 B_BIG = 0.175;
 
 DTR = pi/180;
 RTD = 180/pi;

 vl = 0.025;
 nvl = 1/vl;

 ASpd = 15;

var
 W : HWND;
 M : MSG;
 WC : WNDCLASS;
 P : HPALETTE;
 DC : HDC;
 hrc : HGLRC;
 T : UINT;
 q : GLUquadricObj;

 nv : Word;
 bs : single = B_SML;
 c : array [1..65535] of PN3D;
 vm : PN3D; // Âåêòîð äâèæåíèÿ (n.z õðàíèò óãîë)

function SetMMTimer(uDelay, uResolution: UINT; lpFunction: CBK; dwUser: DWORD; uFlags: UINT): Cardinal; stdcall; external 'winmm.dll' name 'timeSetEvent';
function KillMMTimer(uTimerID: UINT): Cardinal; stdcall; external 'winmm.dll' name 'timeKillEvent';
function KeyDown(key:Word):boolean; forward;

// ------------------------------------------------------- \\
// ------------------ Âåêòîðíàÿ àëãåáðà ------------------ \\

function qLen2D(v:PT3D):single;
begin
Result:=v.x*v.x+v.y*v.y;
end;

function Len2D(v:PT3D):single;
begin
Result:=sqrt(qLen2D(v));
end;

procedure Norm2D(var v:PT3D);
var l:Single;
begin
 l:=Len2D(v);
 if l0 then begin
   v.x:=v.x/l;
   v.y:=v.y/l;
 end;
end;

function MkPt2D(x, y : single; n:boolean=false):PT3D;
begin
Result.x:=x;
Result.y:=y;

if n then Norm2D(Result);
end;

procedure Sum2D(var t : PT3D; px, py : single);
begin
t:=MkPt2D(t.x+px, t.y+py);
end;

procedure Mult2D(var t : PT3D; px, py : single);
begin
t:=MkPt2D(t.x*px, t.y*py);
end;

function Prod2D(v1, v2: PT3D): single;
begin
Result:= v1.x*v2.x + v1.y*v2.y;
end;

procedure Inv2D(var t : PT3D);
begin
t:=MkPt2D(-t.x, -t.y);
end;

function Angle2D(v1, v2:PT3D):single;
// ------------------------------------------------------- \\
function ArcTg(const Y, X: Extended): Extended;
asm
 FLD Y
 FLD X
 FPATAN
 FWAIT
end;
// ------------------------------------------------------- \\
var n:Single;
begin
Norm2D(v1);
Norm2D(v2);

n:=Prod2D(v1, v2);
if nb.z then begin
 vm.p.x:=l1.X;
 vm.p.y:=l1.Y;
end;
Result:=b;
end;

procedure ComputeVect;
var
 dot, l1, l2, b : PT3D;
 vA : Single;
 i : Word;

const
 fadeOut = 0.65;
 Dn = 0.0125;

begin
if KeyDown(VK_LEFT) then AddToMovVec(-vl*Dn, 0) else
if KeyDown(VK_RIGHT) then AddToMovVec(vl*Dn, 0) else
if (not KeyDown(VK_LEFT))and(not KeyDown(VK_RIGHT)) then
 AddToMovVec(-vm.n.x*Dn, 0);

AddToMovVec(0, -vl*Dn);

for i:=1 to nv do begin
 b:=tryExceedBdr(i);
 if b.z

---

Леон   (2007-05-02 19:52:00) [1]

Не могу похвастаться пониманием этого кода, но:

procedure ComputeVect;
var
 {dot,} l1, l2, b : PT3D;
 vA : Single;
 i : Word;
const
 fadeOut = 0.65;
 Dn = 0.0125;
begin
 if KeyDown(VK_LEFT) then AddToMovVec(-vl*Dn, 0) else
 if KeyDown(VK_RIGHT) then AddToMovVec(vl*Dn, 0) else
 if (not KeyDown(VK_LEFT))and(not KeyDown(VK_RIGHT)) then
    AddToMovVec(-vm.n.x*Dn, 0);// какая это скорость вечно влево?
 AddToMovVec(0, -vl*Dn); // ну, вниз еще куда ни шло..


---

Игорь Шевченко   (2007-04-27 10:34:00) [2]

> {$Warnings off}
> {$Hints off}


Убрать

---

$00FF00   (2007-04-26 19:36:00) [3]

Ах да забыл: контролы - передвижение курсорными клавишами (вперед, назад, вверх), менять размер - пробел. Это на всякий случай, в принципе это можно взять из исходника :) А трение возникает при попытке проехать по горизонтальной поверхности без прыжков и при спуске вдоль верт. стены (если пытаться двигаться ей навстречу).

---

$00FF00   (2007-04-26 19:12:00) [4]

Вот продолжение:


procedure SetPxFmt(D_C : HDC);
var
 hHeap: THandle;
 nCl, nPF, i: Integer;
 lpPal: PLogPalette;
 RM, GM, BM: Byte;
 pfd: PIXELFORMATDESCRIPTOR;

begin
 FillChar(pfd, SizeOf(pfd), 0);

 pfd.dwFlags:=PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
 pfd.iPixelType:=PFD_TYPE_RGBA;

 nPF:=ChoosePixelFormat(D_C, @pfd);
 SetPixelFormat(D_C, nPF, @pfd);

 DescribePixelFormat(D_C, nPF, SIZEOF(PIXELFORMATDESCRIPTOR), pfd);

 if ((pfd.dwFlags and PFD_NEED_PALETTE) 0) then begin
   nCl   := 1 shl pfd.cColorBits;
   hHeap := GetProcessHeap;
   lpPal := HeapAlloc(hHeap, 0, SIZEOF(LOGPALETTE) + (nCl * SIZEOF(PALETTEENTRY)));

   // Ñòàíäàðòíûå óñòàíîâêè íîìåðà âåðñèè è ÷èñëà ýëåìåíòîâ ïàëèòðû
   lpPal^.palVersion := $300;
   lpPal^.palNumEntries := nCl;

   RM := (1 shl pfd.cRedBits) - 1;
   GM := (1 shl pfd.cGreenBits) - 1;
   BM := (1 shl pfd.cBlueBits) - 1;

   // Çàïîëíÿåì ïàëèòðó öâåòàìè
   for i := 0 to nCl - 1 do begin
     lpPal^.palPalEntry[i].peRed   := (((i shr pfd.cRedShift)   and RM) * 255) div RM;
     lpPal^.palPalEntry[i].peGreen := (((i shr pfd.cGreenShift) and GM) * 255) div GM;
     lpPal^.palPalEntry[i].peBlue  := (((i shr pfd.cBlueShift)  and BM) * 255) div BM;
     lpPal^.palPalEntry[i].peFlags := 0;
   end;

   // Ñîçäàåì ïàëèòðó
   P:=CreatePalette(lpPal^);
   HeapFree(hHeap, 0, lpPal);

   // Óñòàíàâëèâàåì ïàëèòðó â êîíòåêñòå óñòðîéñòâà
   if (P0) then begin
     SelectPalette(D_C, P, False);
     RealizePalette(D_C);
   end;
 end;
end;

procedure _Tmr(uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD) stdcall;
begin
NewFrame;
end;

function WindowProc(hWnd : HWND; Msg, WParam, LParam : LongInt) : LongInt; stdcall;
var
 ps : PAINTSTRUCT;
 i, k : Byte;

begin
 WindowProc:=0;
 case Msg of
   WM_CREATE:
     begin
       DC:=GetDC(hWnd);
       SetPxFmt(DC);
       hrc:=wglCreateContext(DC);
       wglMakeCurrent(DC, hrc);
       T:=SetMMTimer(ASpd, 0, @_Tmr, 0, 1);
       q:=GluNewQuadric;
       glPointSize(15);

// ------------------------------------------------------- \\

       nv:=0;

       CAdd(-4, -0.5);
       CAdd(-2.5, -0.5);
       CAdd(-2.5, -0.75);
       CAdd(-2.75, -1);
       CAdd(-2.75, -1.5);
       CAdd(-1.75, -1.5);
       CAdd(-1.75, -1);
       CAdd(-2, -0.75);
       CAdd(-2, -0.5);
       CAdd(-1, -0.5);
       CAdd(-1, -1);
       CAdd(-1.25, -1.25);
       CAdd(-1.25, -1.5);
       CAdd(-0.25, -1.5);
       CAdd(-0.25, -1.25);
       CAdd(-0.5, -1);
       CAdd(-0.5, -0.5);
       CAdd(0.25, -0.5);
       CAdd(0.25, -3);
       CAdd(4, -3);
       CAdd(4, -2.5);
       CAdd(0.75, -2.5);
       CAdd(0.75, 0);
       CAdd(0.5, 0.25);
       CAdd(-0.75, 0.25);
       CAdd(-1, 0);
       CAdd(-3.5, 0);
       CAdd(-3.5, 1.5);
       CAdd(-4, 1.5);
       CAdd(-4, -0.5);

       nv:=nv-1;

       CalcNormals;
       
       vm.p:=MkPt2D(-3.75, 1.25);
       vm.n:=MkPt2D(0, 0);

// ------------------------------------------------------- \\
     end;

   WM_PAINT:
     begin
       DC:=BeginPaint(hWnd, ps);
       GlClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
       glPushMatrix;
       ComputeVect;

       GlColor3f(1, 1, 1);
       gluDisk(q, 0, bs, 16, 1);

       // Âåêòîð äâèæåíèÿ
       GlColor3f(1, 1, 0);
       glBegin(GL_LINES);
         glVertex3f(0, 0, 0);
         glVertex3f(vm.n.x*nvl, vm.n.y*nvl, 0);
       glEnd;

       glTranslatef(-vm.p.x, -vm.p.y, 0);
       GlColor3f(0, 1, 0);
       glBegin(GL_LINES);
         for i:=1 to nv do begin
           glVertex3f(c[ i ].p.x, c[ i ].p.y, 0);
           glVertex3f(c[i+1].p.x, c[i+1].p.y, 0);
         end;
       glEnd;

       glPopMatrix;
       SwapBuffers(DC);
       EndPaint(hWnd, ps);
     end;

   WM_CHAR:
     begin
       if KeyDown(VK_SPACE) then
         if bs=B_SML then bs:=B_BIG else bs:=B_SML;
       if KeyDown(VK_ESCAPE) then
         PostMessage(hWnd, WM_CLOSE, 0, 0);
     end;

   WM_DESTROY:
     begin
       gluDeleteQuadric(q);
       KillMMTimer(T);
       wglMakeCurrent(0, 0);
       wglDeleteContext(hrc);
       ReleaseDC(hWnd, DC);
       DeleteDC(DC);
       PostQuitMessage(0);
       exit;
     end;

   WM_SIZE:
     begin
       glViewport(0, 0, LOWORD(lParam), HIWORD(lParam));
       glMatrixMode(GL_PROJECTION);
       glLoadIdentity;
       gluPerspective(18, LoWord(lParam)/hiWord(lParam), 5, 70);
       glMatrixMode(GL_MODELVIEW);
       glLoadIdentity;
       glTranslatef(0, 0, -12);
     end;

   else WindowProc:=DefWindowProc (hWnd, Msg, WParam, LParam);
 end;
end;

begin
 FillChar(WC, SIZEOF(WNDCLASS), 0);
 with WC do begin
   Style:=CS_HREDRAW or CS_VREDRAW;
   lpfnWndProc:=@WindowProc;
   hInstance:=sysInit.HInstance;
   lpszClassName:=CN;
 end;
 RegisterClass(WC);
 W:=CreateWindowEx(WS_EX_TOPMOST, CN, WN, WS_POPUP
 or WS_CLIPCHILDREN or WS_CLIPSIBLINGS, 0, 0,
 GetSystemMetrics(SM_CXSCREEN),
 GetSystemMetrics(SM_CYSCREEN),
 0, 0, HInstance, nil);

 ShowCursor(false);
 SetForegroundWindow(W);
 ShowWindow(W, SW_NORMAL);
 UpdateWindow(W);

 while GetMessage(M, 0, 0, 0) do begin
   TranslateMessage(M);
   DispatchMessage(M);
 end;
 Halt(M.wParam);
end.


Помогите чем могёте, Плз!

---

Наверх