Міністерство освіти та науки України

Вид материала

Документы

Содержание Список літератури G2i[B + i][0] := G2i[i][0] Сергій Юрійович Вурстамагістр інформаційних технологій

Подобный материал:

• Міністерство освіти І науки України Департамент міжнародного співробітництва та європейської, 39kb.
• Міністерство освіти І науки україни міністерство економіки україни міністерство фінансів, 18.39kb.
• Міністерство освіти І науки україни донецький обласний центр туризму та краєзнавства, 189.44kb.
• Міністерство освіти І науки україни, 335.34kb.
• Міністерство освіти І науки україни, 283.15kb.
• Міністерство освіти І науки, молоді та спорту україни, 59.16kb.
• Міністерство освіти І науки україни, 32.42kb.
• Міністерство освіти І науки, молоді та спорту України, 61.58kb.
• Міністерство освіти І науки україни положенн я про організацію фізичного виховання, 306.47kb.
• Міністерство освіти І науки україни інститут інноваційних технологій І змісту освіти, 43.77kb.

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

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

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

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

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

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

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

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

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

Режим доступу: ld.narod.ru/_graphic_.phpl

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

Режим доступу: mes.ru/articles/glscene.phpl

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

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

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

.ru/articles/84/

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

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

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

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

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

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

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

18. «ссылка скрыта» - ссылка скрыта

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

20. Сайт 3D Aссelerator. Статья Генерация трехмерных ландшафтов. Режим доступу: ссылка скрыта


Додаток

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

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.


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

Побудова фрактальних поверхонь в комп’ютерній графіці


Наукове видання

       Комп’ютерний набір, верстка,        редагування і  макетування та дизайн в редакторі Microsoft ^® Offise ^® Word 2003

Ю.С.Вурста


Науковий керівник Р.М.Літнарович, доцент,                          кандидат технічних наук

Міністерство освіти та науки України

Міжнародний економіко-гуманітарний університет

імені академіка Степана Дем’янчука

Факультет кібернетики

Кафедра математичного моделювання






33027 Рівне , Україна

Вул..С.Дем’янчука, 4, корпус 1

Телефон : (+00380) 362 23 – 73 – 09

Факс :(+00380) 362 23 – 01 – 86                            E-mail:mail@regi.rovno.ua