Проблемы с трением

← →
$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 - íàïðàâëåíèå, z - ðàññòîÿíèå 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; // ------------ Âåêòîðíàÿ àëãåáðà çàêîí÷èëàñü ------------ \\ // ------------------------------------------------------- \\ 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))); // Ñòàíäàðòíûå óñòàíîâêè íîìåðà âåðñèè è ÷èñëà ýëåìåíòîâ ïàëèòðû 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 (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); // Âåêòîð äâèæåíèÿ 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}

Убрать

Не могу похвастаться пониманием этого кода, но:
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); // ну, вниз еще куда ни шло..

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