1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
unit Textures;
{***********************************************************
Project: C-evo External Map Generator
Copyright: 1999-2024 P Blackman
License: GPLv3+
Unit to provide mapping interface to lower level texture routines.
***********************************************************}
interface
type
Ttexture = class
private
fTable: array of Double;
fHeight,
fWidth: Integer;
procedure SetTexture(X, Y: Integer; V: Double);
public
Max, Min: Double;
function Texture(X, Y: Integer): Double;
function Scale (X, Y: Integer): Integer;
constructor Create(Width, Height: Integer);
destructor Destroy; override;
procedure GenData(Wave, Dim, Lac, Oct: Double; ResetNoise: Boolean);
end;
implementation uses SysUtils, Utils, Noise, Fractal, Message;
procedure Ttexture.SetTexture(X, Y: Integer; V: Double);
begin
fTable[(X-1) + (Y-1) * fWidth] := V;
end;
function Ttexture.Texture(X, Y: Integer): Double;
begin
Result := fTable[(X-1) + (Y-1) * fWidth];
end;
{ Scale raw texture values into range 0 -> 255 }
function Ttexture.Scale(X, Y: Integer): Integer;
begin
Result := Trunc(255 * JumpStep(Min, Max, Texture(X, Y)));
end;
procedure Ttexture.GenData(Wave, Dim, Lac, Oct: Double; ResetNoise: Boolean);
var X, Y: Integer;
F, P: Double;
Vec: Vector;
fBm: TfBm;
radius, Sn, Cs, angle: Double;
begin
{ Arbitrary Large Numbers }
Max := -10000000;
Min := 10000000;
fBm := TfBm.Create(Dim, Lac, Oct, ResetNoise);
radius := fWidth / (wave * 2 * PI);
Sn := 0;
Cs := 0;
try
for X := 1 to fWidth do
begin
P := X;
{ Use a real cylinder to get round world effect }
angle := (2 * PI) * P / fwidth;
Sn := Sin(Angle);
cs := Cos(Angle);
for Y := 1 to fHeight do
begin
Vec.X := 2 * radius * Sn;
Vec.z := 2 * radius * Cs;
Vec.y := Y / (wave);
F := 1.0 + fBM.Compute(Vec);
if F > Max then
Max := F
else
if F < Min then
Min := F;
SetTexture(X, Y, F);
end;
end;
except
on E: Exception do
begin
Showmessage(E.Message);
Halt (1);
end;
end;
fBm.Free;
end;
constructor ttexture.Create(Width, Height: Integer);
begin
inherited Create;
fWidth := Width;
fHeight := Height;
SetLength(fTable, fHeight * fWidth);
end;
destructor ttexture.Destroy;
begin
SetLength(fTable, 0);
inherited;
end;
end.
|
