|
|
Регистрация Восстановить пароль |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
10.03.2013, 02:22 | #1 |
Новичок
Джуниор
Регистрация: 10.03.2013
Сообщений: 1
|
Карты высот в OpenGL
Доброе время суток!
Друзья, недавно начал изучать OpenGL на Delphi. Делаю программу, которая генерирует псевдо-случайные ландшафты через шум Перлина, но столкнулся с такой проблемой, что получается что-то непонятное. Подскажите, где ошибка? Почему рисует некорректный ландшафт? Вроде карта высот заполняется нормально... unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, OpenGL; const n=25; p=0.05; type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); procedure FormPaint(Sender: TObject); procedure SetDCPixelFormat; procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); private dc:HDC; hrc:HGLRC; public { Public declarations } end; var Form1: TForm1; x,y:array [0..n-1] of GLFloat; z:array [0..n-1,0..n-1] of GLFloat; i,j,k:integer; implementation {$R *.dfm} {Генерация шума Перлина} function Noise(x,y:integer):single; var n:integer; begin n:=x + y*57; n:=(n shl 13) xor n; Result:=( 1.0 - ( (n * (n * n * 15731 + 789221) + 1376312589) and $7FFFFFFF) /1073741824.0); end; function Interpolate(a,b,x:Single):single; var ft,f:Single; begin ft:=x*3.1415927; f:= (1 - cos(ft)) * 0.5; Result:=a*(1-f) + b*f; end; function SmoothedNoise(x,y:single):single; var corners:single; sides,center:Single; begin corners:= ( Noise(round(x-1), round(y-1))+Noise(round(x+1), round(y-1))+Noise(round(x-1), round(y+1))+Noise(round(x+1), round(y+1)) ) / 16; sides:= ( Noise(Round(x-1), Round(y)) +Noise(Round(x+1),Round( y)) + Noise(Round(x),Round( y-1)) +Noise(Round(x), Round(y+1)) ) / 8; center:= Noise(Round(x),Round( y)) / 4; Result:=corners+sides+center; end; function CompleteNoise(x,y:single):Single; var xint,yint:integer; xfrac,yfrac,v1,v2,v3,v4,i1,i2:Singl e; begin xint:=trunc(x); xfrac:=frac(x); yint:=trunc(y); yfrac:=frac(y); v1 := SmoothedNoise(xint,yint); v2 := SmoothedNoise(xint + 1,yint); v3 := SmoothedNoise(xint,yint + 1); v4 := SmoothedNoise(xint + 1, yint + 1); i1 := Interpolate(v1,v2,xfrac); i2 := Interpolate(v3,v4 ,xfrac); Result:=Abs(Interpolate(i1,i2,yfrac )); end; function PerlinNoisef(x,y,factor:Single):sin gle; var total,pres,freq,ampl:Single; i:integer; begin total:=0; pres:=1.25*1;//presistance ampl:=2.5*1;//amplitude freq:=0.00001;//frquerncy x:=x+factor; y:=y+factor; for i:=0 to (12) do // octavs begin total :=total+ CompleteNoise(x*freq, y*freq) * ampl; ampl := ampl*pres; freq:=freq*2; end; total:=(total)*2; Result:=total;//Trunc(Total); end; {Установка формата пикселя} Procedure TForm1.SetDCPixelFormat; var i:integer; pfd:TPixelFormatDescriptor; begin FillChar(pfd,sizeOf(pfd),0); pfd.dwFlags:=pfd_Draw_to_Window or pfd_Support_OpenGL or pfd_DoubleBuffer; i:=ChoosePixelFormat(dc,@pfd); SetPixelFormat(dc,i,@pfd); end; {Установка сессии устройства и заполнение массива высот} procedure TForm1.FormCreate(Sender: TObject); var fac:Real; begin fac:=Random(1000); dc:=GetDC(handle); SetDCPixelFormat; hrc:=wglCreateContext(dc); wglMakeCurrent(dc,hrc); for i:=0 to n-1 do begin x[i]:=i*p-1; y[i]:=x[i]; end; for i:=1 to n-2 do for j:=1 to n-2 do z[i,j]:=PerlinNoisef(i,j,fac); for k:=1 to 5 do for i:=1 to n-2 do for j:=1 to n-2 do z[i,j]:=(z[i-1,j-1]+z[i-1,j]+z[i-1,j+1]+z[i,j-1]+ z[i,j]+z[i,j+1]+z[i+1,j-1]+z[i+1,j]+z[i+1,j+1])/9; end; {рендеринг} procedure TForm1.FormPaint(Sender: TObject); var i,j:GLInt; begin glpushmatrix; glClearColor(0.0,0.0,0.0,0.0); glClear(Gl_Color_Buffer_Bit or GL_DEPTH_Buffer_Bit); for i:=0 to n-1 do for j:=0 to n-2 do begin glBegin(Gl_Line_loop); glVertex3f(x[i],y[j],z[i,j]); glVertex3f(x[i+1],y[j],z[i+1,j]); glVertex3f(x[i],y[j+1],z[i,j+1]); glVertex3f(x[i+1],y[j+1],z[i+1,j+1]); glend; end; SwapBuffers(dc); glpopmatrix; end; procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var wrkX, wrkY: Integer; begin wrkX:=1; wrkY:=1; If down then begin glRotatef(X-wrkX, 0.0, 1.0, 0.0); glRotatef(Y-wrkY, 1.0, 0.0, 0.0); InvalidateRect(Handle, nil, False); wrkX:=X; wrkY:=Y; end; end; end. Если повертеть, то получится нечто невнятно-кубическое (скрин во вложении). |
21.03.2013, 00:06 | #2 | |
Негодник
Форумчанин
Регистрация: 10.11.2009
Сообщений: 880
|
В formpaint добавить
Код:
Код:
Код:
Цитата:
Если помог, проси поставить минус. Будь оригинален!
Последний раз редактировалось Rin; 21.03.2013 в 00:09. |
|
24.08.2013, 11:11 | #3 |
Новичок
Джуниор
Регистрация: 24.08.2013
Сообщений: 1
|
Приветствую! Вставил выше написанный код в Дельфи 7, но почему-то выдает пустое окно при нажатии F9. В чем может быть ошибка?
|
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
найти произведение высот | Lizonka-88 | Паскаль, Turbo Pascal, PascalABC.NET | 2 | 25.01.2012 11:20 |
Ищем специалиста(смарт-карты,бонус.карты и т.п) | modob1 | Фриланс | 3 | 20.01.2012 11:09 |
Доказательства о пересечении высот и биссектрис в треугольнике (Maple) | sidestep | Помощь студентам | 0 | 20.09.2011 16:23 |
Матрица высот | babysun27 | Помощь студентам | 0 | 19.05.2011 18:47 |
вычислите длины высот равнобедренного треугольника | Feil | Помощь студентам | 1 | 23.12.2009 14:19 |