Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Мультимедиа в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 10.03.2013, 02:22   #1
hitk1iff
Новичок
Джуниор
 
Регистрация: 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.

Если повертеть, то получится нечто невнятно-кубическое (скрин во вложении).
hitk1iff вне форума Ответить с цитированием
Старый 21.03.2013, 00:06   #2
Rin
Негодник
Форумчанин
 
Аватар для Rin
 
Регистрация: 10.11.2009
Сообщений: 880
По умолчанию

В formpaint добавить
Код:
......
  glClear(Gl_Color_Buffer_Bit or GL_DEPTH_Buffer_Bit);
  glRotate(ry,1,0,0);
  glRotate(rx,0,1,0);
  glScale(0.1,0.1,0.1);
  for i:=0 to n-1 do
  for j:=0 to n-2 do
.........
Добавить события onResize, OnMouseMove, onMouseUp, а так же глобальные переменные
Код:
  OldX,OldY,rx,ry:integer;// служат для поворота сцены
  mouse_down:boolean;// нажата ли левая кнопка мыши
И добавить код
Код:
procedure TForm2.FormResize(Sender: TObject);
begin
  glViewport(0,0,ClientWidth,ClientHeight);// размеры вывода
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;// возвратиться в исходное состояние
  gluPerspective(30,// угол видимости в направлении оси Y
   1,// угол видимости в направлении оси X
   1,// расстояние от наблюдателя до ближней плоскости отсечения
   5);// расстояние от наблюдателя до дальней плоскости отсечения
  glTranslatef(0, 0, -2);//передвигаем начало координат по OZ на 2
  InvalidateRect(Handle, nil, False);
end;


procedure TForm2.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 if (Button=MBLeft) then
 begin
   mouse_down:=true;
   OldX:=rx+x;
   OldY:=ry+y;
 end;
end;


procedure TForm2.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if mouse_down then
  begin
    rx:=OldX-x;
    ry:=OldY-y;
    FormPaint(nil);
  end;
end;


procedure TForm2.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
mouse_down:=false;
end;
Цитата:
Если повертеть, то получится нечто невнятно-кубическое (скрин во вложении).
Невнятно-кубическое из-за того, что не влезает весь объект в камеру. Объект у вас вытянутый. glScale поправил ситуацию.
Если помог, проси поставить минус. Будь оригинален!

Последний раз редактировалось Rin; 21.03.2013 в 00:09.
Rin вне форума Ответить с цитированием
Старый 24.08.2013, 11:11   #3
NewProgrammer
Новичок
Джуниор
 
Регистрация: 24.08.2013
Сообщений: 1
По умолчанию

Приветствую! Вставил выше написанный код в Дельфи 7, но почему-то выдает пустое окно при нажатии F9. В чем может быть ошибка?
NewProgrammer вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
найти произведение высот 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