Висновки

За період написання дипломної роботи я ознайомився з фрак талами та їх, класифікацію такі як алгебраїчні, стохастичні, геометричні та інші, також дізнався одне з головних застосувань фракталів - це машинна графіка. За допомогою їх можна створити (описати) поверхні дуже складної форми, а змінюючи всього декілька коефіцієнтів в рівнянні добиватися практично нескінченних варіантів початкового зображення. Фрактальна геометрія незамінна при генерації штучних хмар, гір, поверхні морить. Фактично знайдений спосіб легкого представлення складних невклідових об'єктів, образи яких вельми схожі на природні. Двовимірні стохастичні фрактали використовуються при моделюванні рельєфу місцевості і поверхні моря.

Також я вдосконалив свої знання та навички при роботі з компілятором Delphi, формами, компонентами, палітрою інструментів, інспектором об’єктів тощо. Особливо я звертав увагу на ЗD-графіку та ЗD APІ, а також основи роботи з світлом та текстурами в 3D, вивчив ядро GLScene, роботу з формами та їх властивостями, конвеєрами.

В середовищі Delphi та GLScene, було розроблено програмний додаток

“ Фрактальні ландщафти ”, який генерує карти висот за допомогою алгоритму Фрактального шуму, також ці карти можна зберігати в графічний файл з розширенням «бмп», програма вміє генерувати по картам висот 3Д-ландшафти, також вміє генерувати хмари за допомогою тогож самого фрактального шуму, для виводу на екран використовується бібліотека OpenGL і візуальна бібліотека GLScene(із завдатком ігрового ядра). Цей програмний додаток можуть використовувати розробники комп’ютерних 3D- ігор для швидкого моделювання ігрового ландшафту. або для демонстрації 3D – графіки.

Список літератури:

1. Журнал “Домашний ПК” №8. Август 2005г.

2. Журнал “Игро Мания” №3. Март 2007г.

4. Журнал “Лучшие Компьютерные Игры” №6. Июнь 2006г.

5. “Королевство Delphi - виртуальный клуб программистов”- http://www.delphikingdom.com.

6. М. Краснов, “OpenGL. Графика в проектах DELPHI” г.Москва 2000г.

7. “Delphi 7 – Для профессионалов” ЗАО Издательский Дом “Питер”, 2004г.

8. Д. Кузан, В. Шарапов, “Программирование в Delphi” г.Санкт-Петербург, 2005г.

9. Сайт Delphi World 6.0. Графика и Игры.

Режим доступу: http://delphiworld.narod.ru/_graphic_.html

10. Сайт MirGames. Статьи\Уроки по GLScene.

Режим доступу: http://www.mirgames.ru/articles/glscene.html

11. Сайт GLScene. Статьи по GLScene.

Режим доступу: http://www.glscene.ru/content.php?article

12. Сайт Мир 3D. Природное самоподобие. Режим доступу:

http://www.mir3d.ru/articles/84/

13. Клуб программистов Delphi programming. Фракталы – геометрия природы. Режим доступу: http://programmersclub.ru/gambler-fractali1/

14. Сайт GameDev. Реализация Шума Перлина.

Режим доступу: http://www.gamedev.ru/code/articles/?id=4212

15. Russian Computer Graphics. Генерация изображения облаков (Clouds image generation). Режим доступу: http://community.livejournal.com/ru_compgraphics/

16. Сайт Введение в компьютерную графику. Визуализация природных явлений. Режим доступу: http://graphicon.ru/oldgr/courses/cg02b/assigns/hw-5/hw5_cld.htm

17. Сайт Википедия. Фракталы.

Режим доступу: http://ru.wikipedia.org/wiki/Фрактал

18. «Ken Perlin's Homepage» - http://mrl.nyu.edu/perlin/

19. Е. Федер ,“Фракталы” г. Москва, 1991г. – 249c.

20. Сайт 3D Aссelerator. Статья Генерация трехмерных ландшафтов. Режим доступу: http://www.3daccelerator.com.ua/articles.html

Додаток

Програмний продукт.

unit mainFL;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, bsSkinData, BusinessSkinForm, Menus, bsSkinCtrls, bsSkinExCtrls,

GLWin32Viewer, GLCrossPlatform, BaseClasses, GLScene, GLObjects,

GLCoordinates, GLHeightData, GLCadencer, GLMaterial, GLSkydome,

GLSimpleNavigation, GLVectorFileObjects,OpenGL1x, GlRenderContextInfo,GLMesh,

bsSkinShellCtrls, GLShadowHDS, jpeg, VectorGeometry, GLGraph, VectorTypes,

GLBumpShader,ExtCtrls, StdCtrls, Mask, bsSkinBoxCtrls,GLTexture,

AsyncTimer, GLSLWater, GLProcTextures, GLHUDObjects, GLBlur;

type

TForm1 = class(TForm)

bsBusinessSkinForm1: TbsBusinessSkinForm;

bsSkinData1: TbsSkinData;

bsCompressedSkinList1: TbsCompressedSkinList;

bsSkinStatusBar1: TbsSkinStatusBar;

bsSkinStatusPanel1: TbsSkinStatusPanel;

bsSkinPanel1: TbsSkinPanel;

bsSkinToolBarEx1: TbsSkinToolBarEx;

bsSkinPanel2: TbsSkinPanel;

GLScene1: TGLScene;

GLMaterialLibrary1: TGLMaterialLibrary;

GLCadencer1: TGLCadencer;

GLCamera1: TGLCamera;

GLEarthSkyDome1: TGLEarthSkyDome;

GLSimpleNavigation1: TGLSimpleNavigation;

Sun: TGLLightSource;

GLPlane1: TGLPlane;

bsSkinButton1: TbsSkinButton;

bsSkinButtonLabel1: TbsSkinButtonLabel;

bsSkinOpenPictureDialog1: TbsSkinOpenPictureDialog;

Landscape: TGLFreeForm;

bsSkinPanel3: TbsSkinPanel;

Image1: TImage;

bsSkinPanel4: TbsSkinPanel;

bsSkinEdit1: TbsSkinEdit;

Label1: TbsSkinShadowLabel;

bsSkinEdit2: TbsSkinEdit;

bsSkinShadowLabel1: TbsSkinShadowLabel;

bsSkinEdit3: TbsSkinEdit;

bsSkinShadowLabel2: TbsSkinShadowLabel;

bsSkinEdit4: TbsSkinEdit;

bsSkinButton2: TbsSkinButton;

AsyncTimer1: TAsyncTimer;

GLDummyCube1: TGLDummyCube;

GLDC: TGLDummyCube;

SceneViewer: TGLSceneViewer;

bsSkinTrackBar1: TbsSkinTrackBar;

bsSkinShadowLabel3: TbsSkinShadowLabel;

bsSkinButton3: TbsSkinButton;

bsSkinButton4: TbsSkinButton;

Root: TGLDummyCube;

tedtOfX: TbsSkinTrackEdit;

bsSkinShadowLabel4: TbsSkinShadowLabel;

GLBumpShader1: TGLBumpShader;

bsSkinTrackBar2: TbsSkinTrackBar;

bsSkinShadowLabel5: TbsSkinShadowLabel;

bsSkinButton5: TbsSkinButton;

procedure bsSkinButton4Click(Sender: TObject);

procedure bsSkinTrackBar2Change(Sender: TObject);

procedure tedtOfXChange(Sender: TObject);

procedure bsSkinButton3Click(Sender: TObject);

procedure bsSkinTrackBar1Change(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure bsSkinButton1Click(Sender: TObject);

procedure GLCadencer1Progress(Sender: TObject; const deltaTime,

newTime: Double);

procedure bsSkinButtonLabel1Click(Sender: TObject);

procedure bsSkinButton2Click(Sender: TObject);

procedure AsyncTimer1Timer(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

Procedure GenLands(Image:TImage);

Procedure loadData;

end;

var

Form1: TForm1;

FRTaille: Single;

TLargeur: integer = 64;

TTaille: integer = 64;

TClasse: integer = 128;

TDeplacez: single = 32;

water: TGLSLWater;

implementation

uses GenFL, TextureForm, FAbaut;

{$R *.dfm}

function DataPath : string;

begin

Result := ExtractFilePath(Paramstr(0))+'Data\';

end;

procedure TForm1.AsyncTimer1Timer(Sender: TObject);

begin

//

end;

procedure TForm1.bsSkinButton1Click(Sender: TObject);

begin

GenerationForm.ShowModal;

end;

function HMPath : string;

begin

Result := ExtractFilePath(Paramstr(0))+'Data\HeightMap\';

end;

procedure TForm1.bsSkinButton2Click(Sender: TObject);

begin

TLargeur:=StrToInt(bsSkinEdit1.Text);

TTaille:=StrToInt(bsSkinEdit2.Text);

TClasse:=StrToInt(bsSkinEdit4.Text);

TDeplacez:=StrToFloat(bsSkinEdit3.Text);

GenLands(Image1);

Landscape.Position.X:=-StrToInt(bsSkinEdit4.Text)/2;

Landscape.Position.z:=StrToInt(bsSkinEdit4.Text)/2;

bsSkinStatusPanel1.Caption:='Triangles: '+

intToStr(Landscape.MeshObjects.Items[0].TriangleCount);

end;

procedure TForm1.bsSkinButton3Click(Sender: TObject);

begin

FormTexture.ShowModal;

end;

procedure TForm1.bsSkinButton4Click(Sender: TObject);

begin

Form2.ShowModal;

end;

Procedure TForm1.loadData;

begin

bsSkinEdit1.Text:=intToStr(TLargeur);

bsSkinEdit2.Text:=intToStr(TTaille);

bsSkinEdit4.Text:=intToStr(TClasse);

bsSkinEdit3.Text:=floatToStr(TDeplacez);

end;

procedure TForm1.tedtOfXChange(Sender: TObject);

begin

GLEarthSkyDome1.SunElevation:=tedtOfX.Value;

end;

procedure TForm1.bsSkinButtonLabel1Click(Sender: TObject);

begin

bsSkinOpenPictureDialog1.InitialDir:= HMPath;

if (bsSkinOpenPictureDialog1.Execute) and (bsSkinOpenPictureDialog1.FileName<>'')

then

begin

Image1.Picture.LoadFromFile(bsSkinOpenPictureDialog1.FileName);

GenLands(Image1);

end;

bsSkinPanel4.Enabled:=true;

loadData;

bsSkinStatusPanel1.Caption:='Triangles: '+

intToStr(Landscape.MeshObjects.Items[0].TriangleCount);

// Landscape.MoveTo(Water.Reflection);

end;

procedure TForm1.bsSkinTrackBar1Change(Sender: TObject);

begin

Landscape.Position.Y:=bsSkinTrackBar1.Value;

bsSkinShadowLabel3.Caption:='Висота моря: '+intTostr(bsSkinTrackBar1.Value);

end;

procedure TForm1.bsSkinTrackBar2Change(Sender: TObject);

begin

TGLProcTextureNoise(GLMaterialLibrary1.Materials.Items[1].Material.Texture.Image).MinCut:=bsSkinTrackBar2.Value;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

bsSkinTrackBar1.Value:=trunc(Landscape.Position.Y);

water := TGLSLWater(GLDC.AddNewChild(TGLSLWater));

water.Scene := glscene1;

water.Cadencer := GLCadencer1;

water.Light := Sun;

water.WaterWidth := 500;

water.WaterHeight := 500;

water.BumpTexture := DataPath+'textures\normal.bmp';

water.DistTexture := DataPath+'textures\dudvmap.bmp';

water.MirrorSize:=128;

water.Initalize;

GLEarthSkyDome1.MoveTo(Water.Reflection);

Landscape.MoveTo(Water.Reflection);

end;

function CreateLandsFromBitmap(Mode:integer;ABitmap:TBitmap;Largeur,Taille:Integer;scalex,scaley,scalez:Single):TMeshObject;

const

c1div255: Single = 1/255;

var

i,j,x,y: Integer;

col: Byte;

fg: TFGVertexIndexList;

begin

FRTaille:= scalex;

Result:= TMeshObject.Create;

Result.Mode:= momFaceGroups;

if mode=0 then

begin

for j:=0 to Taille-1 do

begin

for i:=0 to Largeur-1 do

begin

x:= Round(i*ABitmap.Width/Largeur);

y:= Round(j*ABitmap.Height/Taille);

col:= ABitmap.Canvas.Pixels[x,y] and $FF;

Result.Vertices.Add((((Largeur-1)-i)/(Largeur-1))*scalex,(((Taille-1)-j)/(Taille-1))*scaley,col*c1div255*scalez);

with Result.TexCoords do

begin

Add((Largeur-1-i)/(Largeur-1),(Taille-1-j)/(Taille-1),0);

end;

end;

end;

fg:= TFGVertexIndexList.CreateOwned(Result.FaceGroups);

for j:= 0 to Taille-2 do

begin

for i:= 0 to Largeur-2 do

begin

fg.VertexIndices.Add(i+Largeur*j,(i+1)+Largeur*j,(i+1)+Largeur*(j+1));

fg.VertexIndices.Add(i+Largeur*j,(i+1)+Largeur*(j+1),i+Largeur*(j+1));

end;

end;

Result.BuildNormals(fg.VertexIndices,momTriangles);

end;

end;

procedure TForm1.GenLands(Image:TImage);

var

bmp: TBitmap;

begin

bmp:= TBitmap.Create;

bmp.Assign(image.Picture.Bitmap);

if Assigned(Landscape) then

begin

Landscape.MeshObjects.Clear;

Landscape.MeshObjects.Add(CreateLandsFromBitmap(0,bmp,TLargeur,TTaille,TClasse,TClasse,TDeplacez));

Landscape.StructureChanged;

end;

bmp.Free;

end;

procedure TForm1.GLCadencer1Progress(Sender: TObject; const deltaTime,

newTime: Double);

var v:TVector;s:single;dt:single;m:TMatrix;

begin

if bsSkinButton5.Down then

TGLProcTextureNoise(GLMaterialLibrary1.Materials.Items[1].Material.Texture.Image).NoiseAnimate(deltaTime);

with GLMaterialLibrary1.Materials.GetLibMaterialByName('MatClouds') do

begin

TextureOffset.X := TextureOffset.X + deltaTime * 0.002;

TextureOffset.y := TextureOffset.y + deltaTime * 0.003;

end;

end;

end.

unit GenFL;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, BusinessSkinForm, bsSkinData, bsSkinCtrls,ExtCtrls, bsSkinExCtrls,

bsSkinBoxCtrls, StdCtrls, Mask, bsSkinShellCtrls;

type

PLongA = ^TLongA;

TLongA = array [0..0] of LongWord;

PByteA = ^TByteA;

TByteA = array [Word] of Byte;

PRGBQuadA = ^TRGBQuadA;

TRGBQuadA = array [Word] of TRGBQuad;

TLongArray = array of LongWord;

type

TGenerationForm = class(TForm)

bsCompressedSkinList1: TbsCompressedSkinList;

bsSkinData1: TbsSkinData;

bsBusinessSkinForm1: TbsBusinessSkinForm;

bsSkinPanel1: TbsSkinPanel;

bsSkinPanel2: TbsSkinPanel;

bsSkinButton1: TbsSkinButton;

bsSkinStatusBar1: TbsSkinStatusBar;

Image1: TImage;

Label1: TbsSkinShadowLabel;

bsSkinShadowLabel2: TbsSkinShadowLabel;

bsSkinShadowLabel3: TbsSkinShadowLabel;

bsSkinShadowLabel4: TbsSkinShadowLabel;

bsSkinShadowLabel5: TbsSkinShadowLabel;

tedtOfX: TbsSkinTrackEdit;

tedtOfY: TbsSkinTrackEdit;

ScaleX: TbsSkinSpinEdit;

ScaleY: TbsSkinSpinEdit;

ComboBoxOctav: TbsSkinComboBox;

bsSkinSavePictureDialog1: TbsSkinSavePictureDialog;

bsSkinButtonLabel1: TbsSkinButtonLabel;

procedure FormCreate(Sender: TObject);

procedure bsSkinButton1Click(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure ScaleXChange(Sender: TObject);

procedure ScaleYChange(Sender: TObject);

procedure tedtOfXChange(Sender: TObject);

procedure tedtOfYChange(Sender: TObject);

procedure ComboBoxOctavChange(Sender: TObject);

procedure bsSkinButtonLabel1Click(Sender: TObject);

private

bmg : TBitmap;

NrFrame: Integer;

st2, startTime: double;

Map,Map1: TLongArray;

Pal: array[0..255] of TRGBQuad;

procedure CreateMap;

procedure InitNoise(seed: Integer);

function noise1D(const x: double): double;

function noise2D(const x, y: double): double;

function noise3D(const x, y, z: double): double;

function turbulence1D(x: double; const n: integer): double;

function turbulence2D(x, y: double; const n: integer): double;

function turbulence3D(x, y, z: double; const n: integer): double;

function turbulence2Di(x, y: Integer; const n: integer): Integer;

function noise2Di(const x, y: Integer): Integer;

function turbulence3Di(x, y, z: Integer; const n: integer): Integer;

function noise3Di(const x, y, z: Integer): Integer;

procedure CreatePalette;

function GenerateMap(const SizeX, SizeY: Word;

ScaleX: double = 0;

ScaleY: double = 0;

Octaves: integer = -1;

OffsetX: double = 0;

OffSetY: double = 0): TLongArray; overload;

procedure GenerateMap(Map: TLongArray;

const SizeX, SizeY: Word;

ScaleX: double = 0;

ScaleY: double = 0;

Octaves: integer = -1;

OffsetX: double = 0;

OffSetY: double = 0); overload;

function turbulence2Dia(x, y: Integer; const n: integer): Integer;

procedure ColorizeBaseMap(Map: TLongArray; Color: integer = 0);

procedure PowMap(Map: TLongArray);

procedure MultMap(Map1, Map2: TLongArray);

public

procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;

end;

const

MapSizeX = 256;

MapSizeY = 256;

const

B: Integer = $100;

BM: Integer = $FF;

N: Integer = $1000;

Ni: Integer = $400000;

NM: Integer = $FFF;

NP: Integer = 12;

B2: Integer = $202; // B + B + 2;

var

P: array[0..$202] of Integer;

G1: array[0..$202] of Double;

G2: array[0..$202,0..1] of Double;

G2i: array[0..$202,0..1] of Integer;

G3: array[0..$202,0..2] of Double;

G3i: array[0..$202,0..2] of Integer;

var

GenerationForm: TGenerationForm;

sX,sY : Double;

oX,oY : Integer;

Oct: integer;

implementation

{$R *.dfm}

uses

math, mmsystem, mainFL;

procedure TGenerationForm.bsSkinButton1Click(Sender: TObject);

Var

s: double;

begin

CreateMap;

Image1.Canvas.Draw(0,0,bmg);

//

Inc(NrFrame);

s := (timeGetTime * 0.001) - StartTime;

startTime := timeGetTime * 0.001;

NrFrame := 0;

invalidate;

Form1.GenLands(Image1);

Form1.Image1.Picture.Bitmap.Assign(Image1.Picture.Bitmap);

Form1.bsSkinPanel4.Enabled:=true;

Form1.loadData;

Form1.bsSkinStatusPanel1.Caption:='Triangles: '+

intToStr(Form1.Landscape.MeshObjects.Items[0].TriangleCount);

end;

procedure TGenerationForm.FormCreate(Sender: TObject);

begin

Image1.Canvas.Brush.Color:=clBlack;

Image1.Canvas.Rectangle(256,256,-256,-256);

Randomize;

startTime := timeGetTime * 0.001;

NrFrame := 0;

bmg := Tbitmap.Create;

bmg.Width := MapSizeX;

bmg.Height := MapSizeY;

bmg.PixelFormat := pf32bit;

SetLength(Map, MapSizeX * MapSizeY);

SetLength(Map1, MapSizeX * MapSizeY);

CreatePalette;

InitNoise(100);

st2 := now;

sX:=ScaleX.Value;

sY:=ScaleY.Value;

oX:=tedtOfX.Value;

oY:=tedtOfY.Value;

Oct:=0;

end;

procedure TGenerationForm.FormDestroy(Sender: TObject);

begin

bmg.free;

end;

function TGenerationForm.GenerateMap(const SizeX, SizeY: Word; ScaleX,

ScaleY: double; Octaves: integer; OffsetX, OffSetY: double): TLongArray;

var

map: TLongArray;

begin

if (SizeX * SizeY) = 0 then

Exit;

SetLength(Map, Sizex * SizeY);

GenerateMap(Map, SizeX, SizeY, ScaleX, ScaleY, Octaves, OffsetX, OffsetY);

Result := map;

end;

procedure TGenerationForm.GenerateMap(Map: TLongArray; const SizeX, SizeY: Word; ScaleX,

ScaleY: double; Octaves: integer; OffsetX, OffSetY: double);

var

x,y,i: integer;

v: integer;

Xi,Yi,DXi,DYi: integer;

begin

if (SizeX * SizeY) = 0 then

Exit;

if High(Map) <> (Sizex * SizeY -1) then

SetLength(Map, Sizex * SizeY);

if octaves < 0 then

Octaves := Round(Oct);

if ScaleX = 0 then

ScaleX := sqrt(random + sX);

if ScaleY = 0 then

ScaleY := sqrt(random + sY);

if OffsetX = 0 then

OffsetX := random * oX;

if OffsetY = 0 then

OffsetY := random * oY;

Xi := Round(OffsetX * 1024);

Yi := Round(OffsetY * 1024);

DXI := Round(1024 * ScaleX/SizeX);

DYI := Round(1024 * ScaleY/SizeY);

i := 0;

for y := 0 to SizeY - 1 do begin

for x := SizeX - 1 downto 0 do begin

v := turbulence2Dia(XI,YI, Octaves) shr 2;

map[i] := (v shl 16) + (v shl 8) + v;

Inc(i);

Inc(XI, DXI);

end;

XI := Round(OffsetX * 1024);

Inc(YI, DYI);

end;

end;

procedure TGenerationForm.ComboBoxOctavChange(Sender: TObject);

begin

if ComboBoxOctav.ItemIndex>-1 then

Oct:=strToint(ComboBoxOctav.Items.Strings[ComboBoxOctav.ItemIndex]);

end;

function HMPath : string;

begin

Result := ExtractFilePath(Paramstr(0))+'Data\HeightMap\';

end;

procedure TGenerationForm.bsSkinButtonLabel1Click(Sender: TObject);

begin

bsSkinSavePictureDialog1.InitialDir:=HMPath;

if (bsSkinSavePictureDialog1.Execute) and (bsSkinSavePictureDialog1.FileName<>'')

then

begin

Image1.Picture.Bitmap.PixelFormat:=pf24bit;

Image1.Picture.SaveToFile(bsSkinSavePictureDialog1.FileName);

end;

end;

procedure TGenerationForm.ColorizeBaseMap(Map: TLongArray; Color: integer);

var

pal: array[0..255] of LongWord;

r,g,b: Integer;

i: integer;

begin

if Color <> 0 then begin

r := (Color and $FF0000) shr 16;

g := (Color and $FF00) shr 8;

b := Color and $FF;

end else begin

repeat

r := Round(255);

g := Round(255);

b := Round(255);

until ((r + g + b) > 550){ and ((r + g + b) < 250)};

end;

for i:= 0 to 255 do begin

Pal[i] := round(min((i*r)/127,255)) shl 16 +

round(min((i*g)/127,255)) shl 8 +

round(min((i*b)/127,255));

end;

for i := 0 to High(Map) do begin

Map[i] := Pal[Map[i] and $FF];

end;

end;

procedure TGenerationForm.PowMap(Map: TLongArray);

var

r,g,b,v,i: integer;

begin

for i := 0 to High(Map) do begin

v := Map[i];

r := 255 - ((v and $FF0000) shr 16);

g := 255 - ((v and $FF00) shr 8);

b := 255 - (v and $FF);

r := r * r div 256;

g := g * g div 256;

b := b * b div 256;

map[i] := r shl 16 + g shl 8 + b;

end;

end;

procedure TGenerationForm.ScaleXChange(Sender: TObject);

begin

sX:=ScaleX.Value;

end;

procedure TGenerationForm.ScaleYChange(Sender: TObject);

begin

sY:=ScaleY.Value;

end;

procedure TGenerationForm.MultMap(Map1, Map2: TLongArray);

var

v,w,i: integer;

rv,gv,bv,rw,gw,bw,r,g,b: integer;

begin

for i := 0 to High(Map) do begin

v := Map1[i];

w := Map2[i];

rv := (v and $FF0000) shr 16;

gv := (v and $FF00) shr 8;

bv := v and $FF;

rw := (w and $FF0000) shr 16;

gw := (w and $FF00) shr 8;

bw := w and $FF;

r := min(255, (((60 * 3) div 2 + 127) * rw) div 256);

g := min(255, (((60 * 3) div 2 + 127) * gw) div 256);

b := min(255, (((60 * 3) div 2 + 127) * bw) div 256);

map1[i] := r shl 16 + g shl 8 + b;

end;

end;

procedure TGenerationForm.CreateMap;

var

x,y,i: longword;

Row: PRGBQuadA;

begin

GenerateMap(Map, MapSizeX, MapSizeY);

ColorizeBaseMap(Map);

PowMap(Map);

GenerateMap(Map1, MapSizeX, MapSizeY);

ColorizeBaseMap(Map1);

PowMap(Map1);

MultMap(Map, Map1);

GenerateMap(Map1, MapSizeX, MapSizeY);

ColorizeBaseMap(Map1);

PowMap(Map1);

MultMap(Map, Map1);

i := 0;

for y := 0 to MapSizeY - 1 do begin

Row := bmg.Scanline[y];

for x := 0 to MapSizeX - 1 do begin

Row[x] := tRGBQUAD(map[i]);

Inc(i);

end;

end;

end;

procedure TGenerationForm.WMEraseBkgnd(var Message: TWMEraseBkgnd);

begin

Message.Result := 1;

end;

function TGenerationForm.noise1D(const x: double): double;

var

bx0,bx1: integer;

rx0,rx1,sx,t,u,v: double;

begin

t := x + N;

bx0 := Trunc(t) and BM;

bx1 := (bx0 + 1) and BM;

rx0 := t - trunc(t);

rx1 := rx0 - 1;

sx := rx0 * rx0 * (3 - 2 * rx0);

u := rx0 * G1[P[bx0]];

v := rx1 * G1[P[bx1]];

result := u + sx * (v - u);

end;

function TGenerationForm.noise2D(const x,y : double): double;

var

bx0,bx1,by0,by1: integer;

b00,b10,b01,b11: integer;

rx0, rx1, ry0, ry1: double;

sx, sy,t,a,b,u,v: double;

begin

t := x + N;

bx0 := Trunc(t) and BM;

bx1 := (bx0 + 1) and BM;

rx0 := t - trunc(t);

rx1 := rx0 - 1;

t := y + N;

by0 := Trunc(t) and BM;

by1 := (by0 + 1) and BM;

ry0 := t - trunc(t);

ry1 := ry0 - 1;

b00 := P[P[bx0]+by0];

b10 := P[P[bx1]+by0];

b01 := P[P[bx0]+by1];

b11 := P[P[bx1]+by1];

sx := rx0 * rx0 * (3 - 2 * rx0);

sy := ry0 * ry0 * (3 - 2 * ry0);

u := rx0 * G2[b00][0] + ry0 * G2[b00][1];

v := rx1 * G2[b10][0] + ry0 * G2[b10][1];

a := u + sx * (v - u);

u := rx0 * G2[b01][0] + ry1 * G2[b01][1];

v := rx1 * G2[b11][0] + ry1 * G2[b11][1];

b := u + sx * (v - u);

result := a + sy * (b - a);

end;

function TGenerationForm.noise2Di(const x,y: Integer): Integer;

var

bx0,bx1,by0,by1: integer;

b00,b10,b01,b11: integer;

rx0, rx1, ry0, ry1: integer;

sx, sy,t,a,b,u,v: integer;

i,j: integer;

r: integer;

begin

t := x + $40000000;

bx0 := (t shr 10) and $FF;

bx1 := (bx0 + 1) and $FF;

i := P[bx0];

rx0 := t and 1023;

rx1 := rx0 - 1024;

t := y + $40000000;

by0 := (t shr 10) and $FF;

by1 := (by0 + 1) and $FF;

j := P[bx1];

ry0 := t and 1023;

ry1 := ry0 - 1024;

b00 := P[i + by0];

b10 := P[j + by0];

b01 := P[i + by1];

b11 := P[j + by1];

sx := (rx0 * rx0 * (3072 - 2 * rx0)) shr 20;

sy := (ry0 * ry0 * (3072 - 2 * ry0)) shr 20;

u := (rx0 * G2i[b00][0] + ry0 * G2i[b00][1]);

v := (rx1 * G2i[b10][0] + ry0 * G2i[b10][1]);

a := (u shl 10) + sx * (v - u);

asm

SAR a,20

end;

u := (rx0 * G2i[b01][0] + ry1 * G2i[b01][1]);

v := (rx1 * G2i[b11][0] + ry1 * G2i[b11][1]);

b := (u shl 10) + sx * (v - u);

asm

SAR b,20

end;

r := a shl 10 + sy * (b - a);

asm

SAR r,10

end;

result := r;

end;

function TGenerationForm.noise3Di(const x,y,z: Integer): Integer;

var

bx0,bx1,by0,by1,bz0,bz1: integer;

b00,b10,b01,b11: integer;

rx0, rx1, ry0, ry1, rz0, rz1: integer;

sx, sy, sz, t,a,b,c,d,u,v: integer;

i,j: integer;

r: integer;

begin

t := x + $40000000;

bx0 := (t shr 10) and $FF;

bx1 := (bx0 + 1) and $FF;

i := P[bx0];

rx0 := t and 1023;

rx1 := rx0 - 1024;

t := y + $40000000;

by0 := (t shr 10) and $FF;

by1 := (by0 + 1) and $FF;

j := P[bx1];

ry0 := t and 1023;

ry1 := ry0 - 1024;

t := z + $40000000;

bz0 := (t shr 10) and $FF;

bz1 := (bz0 + 1) and $FF;

rz0 := t and 1023;

rz1 := rz0 - 1024;

b00 := P[i + by0];

b10 := P[j + by0];

b01 := P[i + by1];

b11 := P[j + by1];

sx := (rx0 * rx0 * (3072 - 2 * rx0)) shr 20;

sy := (ry0 * ry0 * (3072 - 2 * ry0)) shr 20;

sz := (rz0 * rz0 * (3072 - 2 * rz0)) shr 20;

u := rx0 * G3i[b00 + bz0][0] + ry0 * G3i[b00 + bz0][1] + rz0 * G3i[b00 + bz0][2];

v := rx1 * G3i[b10 + bz0][0] + ry0 * G3i[b10 + bz0][1] + rz0 * G3i[b10 + bz0][2];

a := (u shl 10) + sx * (v - u);

asm

SAR a,20

end;

u := rx0 * G3i[b01 + bz0][0] + ry1 * G3i[b01 + bz0][1] + rz0 * G3i[b01 + bz0][2];

v := rx1 * G3i[b11 + bz0][0] + ry1 * G3i[b11 + bz0][1] + rz0 * G3i[b11 + bz0][2];

b := (u shl 10) + sx * (v - u);

asm

SAR b,20

end;

c := a shl 10 + sy * (b - a);

u := rx0 * G3i[b00 + bz1][0] + ry0 * G3i[b00 + bz1][1] + rz1 * G3i[b00 + bz1][2];

v := rx1 * G3i[b10 + bz1][0] + ry0 * G3i[b10 + bz1][1] + rz1 * G3i[b10 + bz1][2];

a := u shl 10 + sx * (v - u);

asm

SAR a,20

end;

u := rx0 * G3i[b01 + bz1][0] + ry1 * G3i[b01 + bz1][1] + rz1 * G3i[b01 + bz1][2];

v := rx1 * G3i[b11 + bz1][0] + ry1 * G3i[b11 + bz1][1] + rz1 * G3i[b11 + bz1][2];

b := u shl 10 + sx * (v - u);

asm

SAR b,20

end;

d := a shl 10 + sy * (b - a);

r := c shl 10 + sz * (d - c);

asm

SAR r,20

end;

result := r;

end;

function TGenerationForm.noise3D(const x,y,z : double): double;

var

bx0,bx1,by0,by1,bz0,bz1: integer;

b00,b10,b01,b11: integer;

rx0, rx1, ry0, ry1, rz0, rz1: double;

sx,sy,sz, t,a,b,c,d,u,v: double;

begin

t := x + N;

bx0 := Trunc(t) and BM;

bx1 := (bx0 + 1) and BM;

rx0 := t - trunc(t);

rx1 := rx0 - 1;

t := y + N;

by0 := Trunc(t) and BM;

by1 := (by0 + 1) and BM;

ry0 := t - trunc(t);

ry1 := ry0 - 1;

t := z + N;

bz0 := Trunc(t) and BM;

bz1 := (bz0 + 1) and BM;

rz0 := t - trunc(t);

rz1 := rz0 - 1;

b00 := P[P[bx0]+by0];

b10 := P[P[bx1]+by0];

b01 := P[P[bx0]+by1];

b11 := P[P[bx1]+by1];

sx := rx0 * rx0 * (3 - 2 * rx0);

sy := ry0 * ry0 * (3 - 2 * ry0);

sz := rz0 * rz0 * (3 - 2 * rz0);

u := rx0 * G3[b00 + bz0][0] + ry0 * G3[b00 + bz0][1] + rz0 * G3[b00 + bz0][2];

v := rx1 * G3[b10 + bz0][0] + ry0 * G3[b10 + bz0][1] + rz0 * G3[b10 + bz0][2];

a := u + sx * (v - u);

u := rx0 * G3[b01 + bz0][0] + ry1 * G3[b01 + bz0][1] + rz0 * G3[b01 + bz0][2];

v := rx1 * G3[b11 + bz0][0] + ry1 * G3[b11 + bz0][1] + rz0 * G3[b11 + bz0][2];

b := u + sx * (v - u);

c := a + sy * (b - a);

u := rx0 * G3[b00 + bz1][0] + ry0 * G3[b00 + bz1][1] + rz1 * G3[b00 + bz1][2];

v := rx1 * G3[b10 + bz1][0] + ry0 * G3[b10 + bz1][1] + rz1 * G3[b10 + bz1][2];

a := u + sx * (v - u);

u := rx0 * G3[b01 + bz1][0] + ry1 * G3[b01 + bz1][1] + rz1 * G3[b01 + bz1][2];

v := rx1 * G3[b11 + bz1][0] + ry1 * G3[b11 + bz1][1] + rz1 * G3[b11 + bz1][2];

b := u + sx * (v - u);

d := a + sy * (b - a);

result := c + sz * (d - c);

end;

procedure TGenerationForm.initnoise(seed: Integer);

var

I,J,T: integer;

len: double;

begin

// randseed := seed;

randomize;

for i := 0 to B - 1 do begin

P[i] := i;

G1[i] := (Trunc(Random * 2 * B) - B)/B;

G2[i,0] := (Trunc(Random * 2 * B) - B)/B;

G2[i,1] := (Trunc(Random * 2 * B) - B)/B;

len := sqrt(G2[i,0] * G2[i,0] + G2[i,1] * G2[i,1]);

if len > 1E-5 then begin

G2[i,0] := G2[i,0] / len;

G2[i,1] := G2[i,1] / len;

end;

G2i[i,0] := trunc(G2[i,0] * 1024);

G2i[i,1] := trunc(G2[i,1] * 1024);

G3[i,0] := (Trunc(Random * 2 * B) - B)/B;

G3[i,1] := (Trunc(Random * 2 * B) - B)/B;

G3[i,2] := (Trunc(Random * 2 * B) - B)/B;

len := sqrt(G3[i,0] * G3[i,0] + G3[i,1] * G3[i,1] + G3[i,2] * G3[i,2]);

if len > 1E-5 then begin

G3[i,0] := G3[i,0] / len;

G3[i,1] := G3[i,1] / len;

G3[i,2] := G3[i,2] / len;

end;

G3i[i,0] := trunc(G3[i,0] * 1024);

G3i[i,1] := trunc(G3[i,1] * 1024);

G3i[i,2] := trunc(G3[i,2] * 1024);

end;

for i := 0 to B - 1 do begin

j := Trunc(Random * B);

T := P[i];

P[i] := P[j];

P[j] := T;

end;

for i := 0 to B + 1 do begin

P[B + i] := P[i];

G1[B + i] := G1[i];

G2[B + i][0] := G2[i][0];

G2[B + i][1] := G2[i][1];

G2i[B + i][0] := G2i[i][0];

G2i[B + i][1] := G2i[i][1];

G3[B + i][0] := G3[i][0];

G3[B + i][1] := G3[i][1];

G3[B + i][2] := G3[i][2];

G3i[B + i][0] := G3i[i][0];

G3i[B + i][1] := G3i[i][1];

G3i[B + i][2] := G3i[i][2];

end;

end;

procedure TGenerationForm.tedtOfXChange(Sender: TObject);

begin

oX:=tedtOfX.Value;

end;

procedure TGenerationForm.tedtOfYChange(Sender: TObject);

begin

oY:=tedtOfY.Value;

end;

function TGenerationForm.turbulence1D(x: double; const n: integer): double;

var

freq: double;

i: integer;

begin

result := 0;

freq := 1.0;

for i := n - 1 downto 0 do begin

result := result + Noise1D(x) * freq;

x := x * 2;

freq := freq * 0.5;

end;

end;

function TGenerationForm.turbulence2D(x,y: double; const n: integer): double;

var

freq: double;

i: integer;

begin

result := 0;

freq := 1.0;

for i := n - 1 downto 0 do begin

result := result + abs(Noise2D(x,y)) * freq;

x := x * 2;

y := y * 2;

freq := freq * 0.5;

end;

end;

function TGenerationForm.turbulence2Di(x,y: Integer; const n: integer): Integer;

var

r, i: integer;

a: integer;

begin

r := 0;

a := 1;

for i := n - 1 downto 0 do begin

Inc(r, Noise2Di(x,y) div a);

x := x shl 1;

y := y shl 1;

a := a shl 1;

end;

Result := abs(r);

end;

function TGenerationForm.turbulence2Dia(x,y: Integer; const n: integer): Integer;

var

r, i: integer;

a: integer;

begin

r := 0;

a := 1;

for i := n - 1 downto 0 do begin

Inc(r, abs(Noise2Di(x,y)) div a);

x := x shl 1;

y := y shl 1;

a := a shl 1;

end;

Result := r;

end;

function TGenerationForm.turbulence3D(x,y,z: double; const n: integer): double;

var

freq: double;

i: integer;

begin

result := 0;

freq := 1.0;

for i := n - 1 downto 0 do begin

result := result + Noise3D(x,y,z) * freq;

x := x * 2;

y := y * 2;

z := z * 2;

freq := freq * 0.5;

end;

result := abs(Result)

end;

function TGenerationForm.turbulence3Di(x,y,z: Integer; const n: integer): Integer;

var

r, i: integer;

a: integer;

begin

r := 0;

a := 1;

for i := n - 1 downto 0 do begin

Inc(r, Noise3Di(x,y,z) div a);

x := x shl 1;

y := y shl 1;

z := z shl 1;

a := a shl 1;

end;

Result := abs(r);

// Result := r;

end;

procedure TGenerationForm.CreatePalette;

var

i: integer;

begin

for i := 0 to 255 do begin

Pal[i].rgbRed := i;

Pal[i].rgbGreen := i;

Pal[i].rgbBlue := round(sqrt(i/255) * 255);

end;

end;

end.

Сергій Юрійович Вурста магістр інформаційних технологій