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

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

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 07.09.2014, 11:21   #1
ZBEP
Форумчанин
 
Аватар для ZBEP
 
Регистрация: 23.03.2009
Сообщений: 334
По умолчанию Маленькая планета с помозью Perlin Noise

Здравствуйте!
Необходимо сгенерировать 2D изображение планеты 64х64
Наткнулся на Perlin Noise:
http://freespace.virgin.net/hugo.eli...s/m_perlin.htm
http://wiki.delphigl.com/index.php/Perlin_Noise

Попытался реализовать, но в итоге что-то не то получается..

Вот полный код проекта, рисую прямо на форме:
Код:
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    procedure FormClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Seed,Number_Of_Octaves,persistence:integer;
  tXY:array [0..256,0..256] of Real;

implementation

{$R *.dfm}

//Создание шумовой функции
function Noise(x,y:integer):Real;
var n:integer;
begin
  n := x + y * 57 + Seed;
  n := ( n shl 13 ) xor n;
  Result := 1 - ( (n * (n * n * 15731 + 789221) + 1376312589) and $7fffffff) / 1073741824;
end;

//Косинусная интерполяция
function InterpoliereCos(a, b, x: Real): Real;
var f:Real;
begin
  result := a*((cos(pi/2*x)+1)/2) + b*(1-(cos(pi/2*x)+1)/2)
end;

//Сглажевание шума
function SmoothedNoise(x,y:integer):Real;
var corners,sides,center:Real;
begin
  corners := ( Noise(x-1, y-1)+Noise(x+1, y-1)+Noise(x-1, y+1)+Noise(x+1, y+1) ) / 16;
  sides   := ( Noise(x-1, y)  +Noise(x+1, y)  +Noise(x, y-1)  +Noise(x, y+1) ) /  8;
  center  :=  Noise(x, y) / 4;
  Result  := corners + sides + center;
end;


function InterpolatedNoise(x,y:Real):Real;
var integer_X,integer_Y:integer;
fractional_X,fractional_Y:Real;
v1,v2,v3,v4,i1,i2:Real;
begin
  integer_X    := Trunc(x);
  fractional_X := x - integer_X;
  integer_Y    := round(y);
  fractional_Y := y - integer_Y;

  v1 := SmoothedNoise(integer_X,     integer_Y);
  v2 := SmoothedNoise(integer_X + 1, integer_Y);
  v3 := SmoothedNoise(integer_X,     integer_Y + 1);
  v4 := SmoothedNoise(integer_X + 1, integer_Y + 1);
  i1 := InterpoliereCos(v1 , v2 , fractional_X);
  i2 := InterpoliereCos(v3 , v4 , fractional_X);
  Result := InterpoliereCos(i1 , i2 , fractional_Y);
end;

function PerlinNoise_2D(x,y:Real):Real;
var i,n,p:integer;
total,frequency,amplitude:Real;
begin
  total := 0;
  p := persistence;
  n := Number_Of_Octaves - 1;
  for i:=0 to n do
  begin
    frequency := 2 xor i;
    amplitude := p xor i;
    total := total + InterpolatedNoise(x * frequency, y * frequency) * amplitude;
  end;
  Result := total
end;

procedure TForm1.FormClick(Sender: TObject);
var x,y:integer;
begin
  Seed:=128;
  Number_Of_Octaves:=4;
  persistence:=25;

  Form1.Canvas.FillRect(rect(0,0,Form1.Width,Form1.Height));
  for x:=0 to 256 do
  for y:=0 to 256 do
  tXY[x,y]:=PerlinNoise_2D(x,y);

  for x:=0 to 256 do
  for y:=0 to 256 do
  if tXY[x,y]>0 then
  Form1.Canvas.Pixels[x,y]:=RGB(round(255*    tXY[x,y] ),round(255*    tXY[x,y] ),round(255*    tXY[x,y])) else
  Form1.Canvas.Pixels[x,y]:=RGB(round(255*abs(tXY[x,y])),round(255*abs(tXY[x,y])),round(255*abs(tXY[x,y])));
end;

end.
Подскажите пожалуйста в чем ошибка.

Прикрепил изображение на котором показал, как сейчас отрабатывает алгоритм.
Изображения
Тип файла: jpg 12.JPG (103.8 Кб, 74 просмотров)
ZBEP вне форума Ответить с цитированием
Старый 07.09.2014, 11:27   #2
ZBEP
Форумчанин
 
Аватар для ZBEP
 
Регистрация: 23.03.2009
Сообщений: 334
По умолчанию

И да, если вдруг есть более подходящие методы, чем Perlin Noise, то подскажите куда копать.
ZBEP вне форума Ответить с цитированием
Старый 07.09.2014, 18:13   #3
ZBEP
Форумчанин
 
Аватар для ZBEP
 
Регистрация: 23.03.2009
Сообщений: 334
По умолчанию

Наткнулся на пример когерентного шума и понял что не верно определял цвет пикселя.
Вложения
Тип файла: txt Perlin3.txt (8.7 Кб, 179 просмотров)
ZBEP вне форума Ответить с цитированием
Старый 10.08.2016, 17:49   #4
ProQsy
Пользователь
 
Регистрация: 06.05.2016
Сообщений: 25
По умолчанию

Спасибо за пример)
ProQsy вне форума Ответить с цитированием
Ответ


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

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Шум Перлина(Pelin Noise) Демик Помощь студентам 6 24.02.2013 16:14
OpenGL планета dimon13 Помощь студентам 1 14.02.2011 20:35
Планета Земля Syltan Свободное общение 42 08.05.2010 00:52
Планета Нибиру [MoNAMur] Свободное общение 6 08.10.2009 13:38