Author: Localhorst (posted 2013-02-25 20:09:00, viewed 85 times)
| 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
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
| unit ULibNoise;
interface uses System.Types, FMX.Types;
procedure BuildNoiseTables;
function Perlin(const x, y, xsizemax, ysizemax: integer; size: single; const noiseId: Byte = 1): Byte;
function ExpFilter(const value: Byte; const cover, sharpness: single): Byte;
procedure BuildNebulae(const Bitmap: TBitmap; const width: integer = 256; const height: integer = 256);
implementation uses Math;
const
MAX_PERMS = 10;
var
perm: array[0..511, 0..MAX_PERMS - 1] of Byte;
ms_grad4: array[0..255, 0..MAX_PERMS - 1] of single;
kkf: array[0..255] of single;
procedure BuildNoiseTables;
var i, j: integer;
begin
for i := 0 to 255 do kkf[i] := -1.0 + 2.0 * (i / 255.0);
for i := 0 to MAX_PERMS - 1 do
for j := 0 to 255 do
begin
perm[j, i] := random(255);
perm[j + 256, i] := perm[j, i];
ms_grad4[j, i] := kkf[perm[j, i]] * 0.507;
end;
end;
function FADE(const t: single): single;
begin
result := (t * t * t * (t * (t * 6 - 15) + 10));
end;
function NLERP(const t, a, b: single): single;
begin
result := (a + t * (b - a));
end;
function Noise(const x, y: single; px, py: single; const noiseId: Byte = 1): single;
var ix0, iy0, ix1, iy1: integer;
fx0, fy0: single;
s, t, nx0, nx1, n0, n1: single;
begin
ix0 := round(x - 0.5);
iy0 := round(y - 0.5);
fx0 := x - ix0;
fy0 := y - iy0;
if px < 1 then px := 1;
if py < 1 then py := 1;
ix1 := ((ix0 + 1) mod trunc(px)) and $FF;
iy1 := ((iy0 + 1) mod trunc(py)) and $FF;
ix0 := (ix0 mod trunc(px)) and $FF;
iy0 := (iy0 mod trunc(py)) and $FF;
t := FADE(fy0);
s := FADE(fx0);
nx0 := ms_grad4[perm[ix0 + perm[iy0, noiseId], noiseId], noiseId];
nx1 := ms_grad4[perm[ix0 + perm[iy1, noiseId], noiseId], noiseId];
n0 := NLERP(t, nx0, nx1);
nx0 := ms_grad4[perm[ix1 + perm[iy0, noiseId], noiseId], noiseId];
nx1 := ms_grad4[perm[ix1 + perm[iy1, noiseId], noiseId], noiseId];
n1 := NLERP(t, nx0, nx1);
result := NLERP(s, n0, n1)
end;
function Perlin(const x, y, xsizemax, ysizemax: integer;
size: single; const noiseId: Byte = 1): Byte;
var value, initialSize: single;
begin
initialSize := size;
value := 0.0;
while size > 0.5 do
begin
value := value + Noise(x / size, y / size, xsizemax / size, ysizemax / size, noiseId) * size;
size := size / 2.0;
end;
result := trunc(128 * value / initialSize) + 127;
end;
function ExpFilter(const value: Byte; const cover, sharpness: single): Byte;
var c: single;
begin
c := value - (255 - cover);
if c < 0 then c := 0;
result := trunc(255 - (Power(sharpness, c) * 255));
end;
procedure BuildNebulae(const Bitmap: TBitmap; const width: integer = 256; const height: integer = 256);
const cSize = 256;
var bmp: TBitmap;
x, y: integer;
col: Cardinal;
ptr: PAlphaColorArray;
function blendMul(const a, b: byte): byte;
begin
result := (((a) * (b)) shr 8);
end;
begin
bmp := TBitmap.Create(Width, Height);
try
BuildNoiseTables;
for y := 0 to bmp.Height - 1 do
begin
ptr := bmp.ScanLine[y];
for x := 0 to bmp.Width - 1 do
begin
col := Perlin(x, y, 1024, 1024, 128, 0);
col := ExpFilter(col, 128, 0.99);
ptr[x]:=$FF shl 24+
BlendMul(Perlin(x, y, 1024, 1024, csize, 1), col) shl 16+
BlendMul(Perlin(x, y, 1024, 1024, csize, 2), col) shl 8+
BlendMul(Perlin(x, y, 1024, 1024, csize, 3), col);
end;
end;
Bitmap.Canvas.BeginScene;
Bitmap.Canvas.DrawBitmap(Bmp, RectF(0,0,Bmp.Width,Bmp.Height),
RectF(0,0,Bitmap.Width,Bitmap.Height),1, true);
bitmap.Canvas.EndScene;
Bitmap.BitmapChanged;
finally
bmp.free;
end;
end;
end. |
Special syntax:
- To highlight a line (yellow background), prefix it with '@@'
- To indicate that a line should be removed (red background), prefix it with '-'
- To indicate that a line should be added (green background), prefix it with '+'
- To post multiple snippets, seperate them by '~~~~'
|
Add your game by posting it in the WIP section,
or publish it in Showcase.
The first screenshot will be displayed as a thumbnail.
|
|
