Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Игры";
Текущий архив: 2009.03.29;
Скачать: [xml.tar.bz2];

Вниз

Проблемы с трением   Найти похожие ветки 

 
$00FF00   (2007-04-26 19:11) [0]

Доброго времени суток, господа эксперты. Я тут пишу движок на 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 l<>0 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 n<1 then Result:=RTD*ArcTg(Sqrt(1-n*n), n) else Result:=0;
end;

procedure AddToMovVec(tx, ty : single);
var
 t : PT3D;
begin
 t:=MkPt2D(vm.n.x, vm.n.y);
 Sum2D(t, tx, ty);

 vm.n.x:=t.X;
 vm.n.y:=t.Y;
end;

// x, y - &#237;&#224;&#239;&#240;&#224;&#226;&#235;&#229;&#237;&#232;&#229;, z - &#240;&#224;&#241;&#241;&#242;&#238;&#255;&#237;&#232;&#229;
function GetDist(pt, pt1, pt2: PT3D):PT3D;
var
 d, t: single;
 V1, V2, V3, p, p1, p2: PT3D;

begin
p:=pt;
p1:=pt1;
p2:=pt2;

V1:=MkPt2D(p.x-p1.x, p.y-p1.y);
V2:=MkPt2D(p2.x-p1.x, p2.y-p1.y, True);

p1:=MkPt2D(p2.x-p1.x, p2.y-p1.y);
d:=Len2D(p1);
p1:=pt1;

t:=Prod2D(V1, V2);

if t<=0 then begin
 Result:=p1;
 p:=MkPt2D(p1.x-p.x, p1.y-p.y);
 Result.z:=Len2D(p);
end else
if t>=d then begin
 Result:=p2;
 p:=MkPt2D(p2.x-p.x, p2.y-p.y);
 Result.z:=Len2D(p);
end else begin
 V3:=MkPt2D(V2.x*t, V2.y*t);
 Sum2D(V3, p1.x, p1.y);
 Result:=V3;
 p:=MkPt2D(v3.x-p.x, v3.y-p.y);
 Result.z:=Len2D(p);
end;
end;

function TryExceedBdr(i:Word):PT3D;
var
 dot, l1, l2, b : PT3D;
begin
dot:=MkPt2D(vm.p.x, vm.p.y);
l1:=MkPt2D(c[i].p.x, c[i].p.y);
l2:=MkPt2D(c[i+1].p.x, c[i+1].p.y);

b:=GetDist(dot, l1, l2);

l2:=MkPt2D(b.x, b.y);
Sum2D(l2, -vm.p.x, -vm.p.y);
Inv2D(l2);
Sum2D(l2, c[i].n.x, c[i].n.y);
Norm2D(l2);
Mult2D(l2, bs-b.z, bs-b.z);

l1:=MkPt2D(vm.p.x, vm.p.y);
Sum2D(l1, l2.x, l2.y);

if bs>b.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<=bs then begin
   l1:=MkPt2D(vm.n.x, vm.n.y);
   l2:=MkPt2D(1, 0);
   vA:=Angle2D(l1, l2);
   if vm.n.y<=0 then vm.n.z:=360-vA else vm.n.z:=360+vA;

   l2:=MkPt2D(c[i+1].p.x-c[i].p.x, c[i+1].p.y-c[i].p.y);

   vA:=Angle2D(l1, l2);
   vm.n.z:=vm.n.z+vA+vA;

   vm.n.x:=cos(DTR*vm.n.z)*Len2D(l1)*FadeOut;
   vm.n.y:=sin(DTR*vm.n.z)*Len2D(l1)*FadeOut;

   if (KeyDown(VK_UP))and(b.y+0.001<vm.p.y) then
     AddToMovVec(0, vl*0.35);
 end;
end;

 vm.p.x:=vm.p.x+vm.n.x;
 vm.p.y:=vm.p.y+vm.n.y;
end;

procedure CalcNormals;
var i:Word;
begin
for i:=1 to length(c) do
 c[i].n:=MkPt2D(c[i].p.y-c[i+1].p.y, c[i+1].p.x-c[i].p.x, true);
end;

procedure CAdd(x, y:single);
begin
nv:=nv+1;
c[nv].p:=MkPt2D(x, y);
end;

// ------------ &#194;&#229;&#234;&#242;&#238;&#240;&#237;&#224;&#255; &#224;&#235;&#227;&#229;&#225;&#240;&#224; &#231;&#224;&#234;&#238;&#237;&#247;&#232;&#235;&#224;&#241;&#252; ------------ \\
// ------------------------------------------------------- \\

function KeyDown(key:Word):boolean;
begin
result:=GetAsyncKeyState(key)<>0;
end;

procedure NewFrame;
begin
if W<>0 then
InvalidateRect(W, nil, false);
end;


Щас выложу остальное.


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

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


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)));

   // &#209;&#242;&#224;&#237;&#228;&#224;&#240;&#242;&#237;&#251;&#229; &#243;&#241;&#242;&#224;&#237;&#238;&#226;&#234;&#232; &#237;&#238;&#236;&#229;&#240;&#224; &#226;&#229;&#240;&#241;&#232;&#232; &#232; &#247;&#232;&#241;&#235;&#224; &#253;&#235;&#229;&#236;&#229;&#237;&#242;&#238;&#226; &#239;&#224;&#235;&#232;&#242;&#240;&#251;
   lpPal^.palVersion := $300;
   lpPal^.palNumEntries := nCl;

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

   // &#199;&#224;&#239;&#238;&#235;&#237;&#255;&#229;&#236; &#239;&#224;&#235;&#232;&#242;&#240;&#243; &#246;&#226;&#229;&#242;&#224;&#236;&#232;
   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;

   // &#209;&#238;&#231;&#228;&#224;&#229;&#236; &#239;&#224;&#235;&#232;&#242;&#240;&#243;
   P:=CreatePalette(lpPal^);
   HeapFree(hHeap, 0, lpPal);

   // &#211;&#241;&#242;&#224;&#237;&#224;&#226;&#235;&#232;&#226;&#224;&#229;&#236; &#239;&#224;&#235;&#232;&#242;&#240;&#243; &#226; &#234;&#238;&#237;&#242;&#229;&#234;&#241;&#242;&#229; &#243;&#241;&#242;&#240;&#238;&#233;&#241;&#242;&#226;&#224;
   if (P<>0) 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);

       // &#194;&#229;&#234;&#242;&#238;&#240; &#228;&#226;&#232;&#230;&#229;&#237;&#232;&#255;
       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.


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


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

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


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


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


Убрать


 
Леон ©   (2007-05-02 19:52) [4]

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

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); // ну, вниз еще куда ни шло..



Страницы: 1 вся ветка

Форум: "Игры";
Текущий архив: 2009.03.29;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.5 MB
Время: 0.043 c
15-1233155675
Чудак
2009-01-28 18:14
2009.03.29
Delphi for PHP


15-1232753631
trsteep
2009-01-24 02:33
2009.03.29
Модель базы данных.


15-1232174993
Tirael
2009-01-17 09:49
2009.03.29
двухкомпьютерный компьютер


15-1233223249
desc
2009-01-29 13:00
2009.03.29
Как обновить набор данных ?


15-1232851838
Vjik
2009-01-25 05:50
2009.03.29
Очень важные сообщения





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский