-
Доброго времени суток, господа эксперты. Я тут пишу движок на 2D - игру. И всё вроде кудряво - физика там и всё такое, но ужасно доконала высокая сила трения, появляющаяся не пойми откуда (я её не прописывал). Вот привожу исходник:
program Bounce;
uses
Windows, Messages, OpenGL;
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;
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;
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;
Щас выложу остальное.
-
Вот продолжение:
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.
Помогите чем могёте, Плз!
-
Ах да забыл: контролы - передвижение курсорными клавишами (вперед, назад, вверх), менять размер - пробел. Это на всякий случай, в принципе это можно взять из исходника :) А трение возникает при попытке проехать по горизонтальной поверхности без прыжков и при спуске вдоль верт. стены (если пытаться двигаться ей навстречу).
-
> {$Warnings off}
> {$Hints off}
Убрать
-
Не могу похвастаться пониманием этого кода, но:
procedure ComputeVect;
var
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);
|
Есть новые 
Нет новых [134430 +0][b:0][p:0.012]