Quelltexte/ Codesnippets | | | | ![Sven Bader: 31.07.2023](.././../../i/a/71.gif) Sven Bader | ![](https://xprofan.net/files/ncenu.png)
Dieses Beispiel erzeugt Gradientrauschen nach Ken Perlin. Ich experimentiere gerade mit der Generierung von Welten im Stil von Minecraft wobei dieser Algorithmus sehr hilfreich ist.
Man kann Skalierung und Aussehen beliebig Anpassen und mittels "Oktaven", der Überlagerungen des Musters in verschiedenen Auflösungen, fotorealistische Wolken oder andere Texturen erzeugen.
Mit der jeweils gleichen Permutationstabelle (hier per "Seed" steuerbar) wird man immer das gleiche Ergebnis bekommen und kann so jeden beliebig weit entfernten Punkt einer Welt bestimmen, ohne ihn speichern zu müssen. Mit einem abweichenden Seed erhält man ein neues, zufälliges Muster.
Das Programm begrenzt sich auf das Nötigste aber zu herumexperimentieren reicht es.
![](https://xprofan.net/files/ecenu.png)
Def GetBitmapBits(3) !"gdi32","GetBitmapBits"
Def SetDIBitsToDevice(12) !"gdi32","SetDIBitsToDevice"
Proc perlinPrepare
Declare i&, used&[permutSize&], val&
WhileLoop 0, permutSize&-1
i& = &loop
While 1
val& = int((Rnd(10001) * 0.0001) * permutSize&)
If (used&[val&] = 0)
p&[i&] = val&
p&[i& + permutSize&] = val&
used&[val&] = 1
Break
EndIf
EndWhile
EndWhile
EndProc
Proc perlinGenerate
Parameters worldsize&, scale!, octaves&, persistence!
Declare pixels#,bmi#,size&
Dim pixels#,worldSize&*worldSize&*24
'Bitmap Header, leider nötig das unhandliche Ding, obwohl die Infos eigentlich alle da sind
Def &BI_RGB 0
Def &DIB_RGB_COLORS 0
Struct BITMAPINFOHEADER = biSize&, biWidth&, biHeight&, biPlanes%, biBitCount%, biCompression&, biSizeImage&, biXPelsPerMeter&, biYPelsPerMeter&, biClrUsed&, biClrImportant&
Dim bmi#,BITMAPINFOHEADER
Clear bmi#
With bmi#
.biSize& = sizeof(bmi#)
.biWidth& = worldSize&
.biHeight& = worldSize&
.biPlanes% = 1
.biBitCount% = 32
.biCompression& = &BI_RGB
.biSizeImage& = 0
EndWith
size& = worldsize& * worldsize& * (bmi#.biBitCount% / 8)
Dim pixels#, size&
Declare i!, j!, noiseVal!
Declare x!, y!'params
Declare total!, frequency!, amplitude!, maxValue!, i&
Declare modX&, modY&, A&, B&, AA&, AB&, BA&, BB&, u!, v!,return!,xt!,yt!
Declare g1!,g2!,g3!,g4!,u2!,v2!,h&,i1!,i2!,i3!
WhileLoop 0, worldsize& - 1
i! = &loop
WhileLoop 0, worldsize& - 1
j! = &loop
x! = i! * scale!
y! = j! * scale!
total! = 0
frequency! = 2
amplitude! = 1
maxValue! = 0
WhileLoop 0, octaves& - 1
i& = &loop
xt! = x! * frequency!
yt! = y! * frequency!
modX& = int(xt!) & (permutSize& - 1)
modY& = int(yt!) & (permutSize& - 1)
xt! = xt! - int(xt!)
yt! = yt! - int(yt!)
u! = xt! * xt! * xt! * (xt! * (xt! * 6.0 - 15.0) + 10.0)
v! = yt! * yt! * yt! * (yt! * (yt! * 6.0 - 15.0) + 10.0)
A& = p&[modX&]+modY&
AA& = p&[A&]
AB& = p&[A&+1]
B& = p&[modX&+1]+modY&
BA& = p&[B&]
BB& = p&[B&+1]
'Gradient 1
h& = (p&[AA&]) & 7
u2! = if(h& < 4, xt!, yt!)
v2! = if(h& < 4, yt!, xt!)
g1! = (if((h& & 1) <> 0, -u2!, u2!) + if((h& & 2) <> 0, -2.0 * v2!, 2.0 * v2!))
'Gradient 2
h& = (p&[BA&]) & 7
u2! = if(h& < 4, xt!-1, yt!)
v2! = if(h& < 4, yt!, xt!-1)
g2! = (if((h& & 1) <> 0, -u2!, u2!) + if((h& & 2) <> 0, -2.0 * v2!, 2.0 * v2!))
'Gradient 3
h& = (p&[AB&]) & 7
u2! = if(h& < 4, xt!, yt!-1)
v2! = if(h& < 4, yt!-1, xt!)
g3! = (if((h& & 1) <> 0, -u2!, u2!) + if((h& & 2) <> 0, -2.0 * v2!, 2.0 * v2!))
'Gradient 4
h& = (p&[BB&]) & 7
u2! = if(h& < 4, xt!-1, yt!-1)
v2! = if(h& < 4, yt!-1, xt!-1)
g4! = (if((h& & 1) <> 0, -u2!, u2!) + if((h& & 2) <> 0, -2.0 * v2!, 2.0 * v2!))
'Interpolate
i1! = g3! + u! * (g4! - g3!)
i2! = g1! + u! * (g2! - g1!)
i3! = i2! + v! * (i1! - i2!)
total! = total! + i3! * amplitude!
maxValue! = maxValue! + amplitude!
amplitude! = amplitude! * persistence!
frequency! = frequency! * 2
EndWhile
noiseVal! = total! / maxValue!
noiseVal! = (noiseVal! + 1) / 2.0 * 255.0' Normalisieren auf 0-255
'Sollte nicht vorkommen, irgendwo ist noch eine kleine Ungenauigkeit
Case (noiseVal! > 255) : noiseVal! = 255
Case (noiseVal! < 0) : noiseVal! = 0
Byte pixels#,4*(int(j!) * worldSize& + int(i!)) + 2 = noiseVal!'R
Byte pixels#,4*(int(j!) * worldSize& + int(i!)) + 1 = noiseVal!'G
Byte pixels#,4*(int(j!) * worldSize& + int(i!)) = noiseVal!'B
EndWhile
SetDIBitsToDevice(%hdc, 0, 0,worldsize&, worldsize&, 0, 0, 0, worldsize&,pixels#, bmi#, &DIB_RGB_COLORS)'DIB_RGB_COLORS = 0
EndWhile
SetDIBitsToDevice(%hdc, 0, 0,worldsize&, worldsize&, 0, 0, 0, worldsize&,pixels#, bmi#, &DIB_RGB_COLORS)'DIB_RGB_COLORS = 0
Dispose pixels#, bmi#
EndProc
Declare permutSize&, time&
permutSize& = 256
Declare p&[permutSize& * 2]
WindowStyle 27
WindowTitle "Perlin-Noise"
Window 0,0 - 720, 560;0
Cls RGB(236,236,236)
Declare edit_worldsize&, edit_scale&, edit_octaves&, edit_persistence&, edit_seed&, button&
Declare worldsize&, scale!, octaves&, persistence!, seed&
Create("Text",%hwnd,"Größe (px)",500,10,200,20)
Create("Text",%hwnd,"Skalierung",500,70,200,20)
Create("Text",%hwnd,"Oktaven",500,130,200,20)
Create("Text",%hwnd,"Persistence",500,190,200,20)
Create("Text",%hwnd,"Seed",500,250,200,20)
edit_worldsize& = Create("Edit", %hWnd, "128", 500, 30, 200, 24)
edit_scale& = Create("Edit", %hWnd, "0.02", 500, 90, 200, 24)
edit_octaves& = Create("Edit", %hWnd, "4", 500, 150, 200, 24)
edit_persistence& = Create("Edit", %hWnd, "0.5", 500, 210, 200, 24)
edit_seed& = Create("Edit", %hWnd, "12345", 500, 270, 200, 24)
button& = Create("Button", %hWnd, "Welt erstellen", 500, 330, 200, 24)
WhileNot iskey(27)
WaitInput
If Clicked(button&)
Cls RGB(236,236,236)
worldsize& = val(gettext$(edit_worldsize&))
scale! = val(gettext$(edit_scale&))
octaves& = val(gettext$(edit_octaves&))
persistence! = val(gettext$(edit_persistence&))
seed& = val(gettext$(edit_seed&))
Set("RandSeed", seed&)
perlinPrepare()
time& = &gettickcount
perlinGenerate(worldsize&, scale!, octaves&, persistence!)
Set("decimals",0)
Locate 36, 1
WindowTitle "Perlin-Noise (" +str$(&gettickcount - time&)+"ms)"
EndIf
EndWhile
Im Einsatz, noch ohne viel drum herum:
![](https://xprofan.net/files/okenu.png) |
![](/intl/i/dw.gif) | | | | |
| | ![Jens-Arne Reumschüssel: 04.08.2023](.././../../i/a/171494484748f1e66bd153d.jpg) Jens-Arne Reumschüssel | Uijeeeh! Das ist aber extremst langsam! Oben hast Du in Deiner Beispielgrafik für 480 Pixel 313 Millisekunden Erzeugungszeit angezeigt. Das geht. Aber nur, wenn man das Programm mit Profan2Cpp kompiliert. Ansonsten dauert das XProfan-kompiliert mit diesen Einstellungen auf meinem recht flotten Rechner achteinhalb Minuten!! Vielleicht könntest Du die entscheidende Berechnungs-Proc als nPROC (XPSE) bzw. als fb- oder pbPROC (JRPC3) schreiben? Es hat ja leider nicht jeder Profan2Cpp, und da kommt man auch nicht mehr ran (anders als an XPSE und JRPC3).
Beste Grüße, Jens-Arne |
| | | XProfan X4XProfan X4 * Prf2Cpp * XPSE * JRPC3 * Win11 Pro 64bit * PC i7-7700K@4,2GHz, 32 GB RAM PM: jreumsc@web.de | 04.08.2023 ▲ |
| |
| | ![Sven Bader: 05.08.2023](.././../../i/a/71.gif) Sven Bader | Was soll ich sagen? Es ist schon sehr optimiert und sogar das "SetPixel" bin ich losgeworden.
Mit XPSE habe ich mich nie beschäftigt, Inline Assembler ginge auch, da habe ich aber auch nicht viel Übung. Bei Interesse kann ich eine DLL daraus machen oder Javascript.
Der Code ist im Prinzip auch Profan2CPP optimiert, dort brauchte er nämlich auch immerhin 4 Sekunden, bis ich alle Funktionen eliminiert hatte, die produzieren dort recht viel Overhead. Jetzt ist es dort schnell aber die Lesbarkeit hat etwas gelitten. |
| | | | |
| | ![Sven Bader: 05.08.2023](.././../../i/a/71.gif) Sven Bader | JS, live im Browser... etwas langweilig ohne Button zum ändern. Vielleicht erweitere ich es irgendwann noch ![](.././../../i/s/03.gif)
<canvas id="myCanvas" width="480" height="480" style="border:1px solid #d3d3d3;"></canvas>
<script>
let worldsize = 480;
let permutSize = 256;
let canvas = document.getElementById('myCanvas');
let ctx = canvas.getContext('2d');
let imgData = ctx.createImageData(worldsize, worldsize);
function seedRandom(seed) {
let x = Math.sin(seed) * 10000;
return x - Math.floor(x);
}
let seed = 1;// Seed
let p = new Uint8Array(permutSize*2);
let used = new Array(permutSize).fill(false);
for (let i = 0; i < permutSize; ++i) {
while (true) {
let val = Math.floor(seedRandom(seed) * permutSize);
seed++;
if (!used[val]) {
p[i] = val;
p[i + permutSize] = val;
used[val] = true;
break;
}
}
}
function fade(t) {
return t * t * t * (t * (t * 6 - 15) + 10);
}
function lerp(t, a, b) {
return a + t * (b - a);
}
function grad(hash, x, y) {
let h = hash & 7;
let u = h<4 ? x : y;
let v = h<4 ? y : x;
return ((h&1) !== 0 ? -u : u) + ((h&2) !== 0 ? -2.0*v : 2.0*v);
}
function noise(x, y) {
let X = Math.floor(x) & (permutSize - 1),
Y = Math.floor(y) & (permutSize - 1);
x -= Math.floor(x);
y -= Math.floor(y);
let u = fade(x),
v = fade(y);
let A = p[X ]+Y, AA = p[A], AB = p[A+1],
B = p[X+1]+Y, BA = p[B], BB = p[B+1];
return lerp(v, lerp(u, grad(p[AA ], x , y ),
grad(p[BA ], x-1, y )),
lerp(u, grad(p[AB ], x , y-1 ),
grad(p[BB ], x-1, y-1 )));
}
function fractalNoise(x, y, octaves = 6, persistence = 0.02) {
let total = 0;
let frequency = 2;
let amplitude = 100;
let maxValue = 0;
for(let i = 0; i < octaves; i++) {
total += noise(x * frequency, y * frequency) * amplitude;
maxValue += amplitude;
amplitude *= persistence;
frequency *= 2;
}
return total/maxValue;
}
let size = worldsize;
let scale = 0.02;
for (let i = 0; i < size; i++) {
for (let j = 0; j < size; j++) {
let noiseVal = fractalNoise(i * scale, j * scale,6,0.7);
noiseVal = (noiseVal + 1) / 2 * 255;// Normalisieren auf 0-255
//if (noiseVal <128) { noiseVal = 128}
//noiseVal = noiseVal -128;
let idx = 4 * (i * size + j);
imgData.data[idx] = noiseVal;// rot
imgData.data[idx + 1] = noiseVal;// grün
imgData.data[idx + 2] = noiseVal;// blau
imgData.data[idx + 3] = 255;// Alpha-Kanal
}
}
ctx.putImageData(imgData, 0, 0);
</script>
|
| | | | |
| | ![Jens-Arne Reumschüssel: 09.08.2023](.././../../i/a/171494484748f1e66bd153d.jpg) Jens-Arne Reumschüssel | | | | XProfan X4XProfan X4 * Prf2Cpp * XPSE * JRPC3 * Win11 Pro 64bit * PC i7-7700K@4,2GHz, 32 GB RAM PM: jreumsc@web.de | 09.08.2023 ▲ |
| |
| | ![Sven Bader: 17.11.2023](.././../../i/a/71.gif) Sven Bader | So, dank GPU-Shader-Programmierung (GLSL) dauert es nun auch in XProfan nur noch 0,001 Sekunden. Da macht man mit der CPU herum, etwas in C++ auf 4 Cores zu verteilen oder müht sich mit Assembler ab dabei schafft es eine Mittelklasse Grafikkarte alles auf 3584 Cores parallel zu berechnen.
![](https://xprofan.net/files/ainmu.jpg)
Herunterladen |
| | | | |
| | ![Jens-Arne Reumschüssel: 17.11.2023](.././../../i/a/171494484748f1e66bd153d.jpg) Jens-Arne Reumschüssel | Coole Sache!!!
Gibt es irgendwo ein vernünftiges Tutorial, wie man sowas macht? Es gibt ja sicher öfter mal Dinge, die man ggf. besser auf der GPU ausführt.
Beste Grüße, Jens-Arne |
| | | XProfan X4XProfan X4 * Prf2Cpp * XPSE * JRPC3 * Win11 Pro 64bit * PC i7-7700K@4,2GHz, 32 GB RAM PM: jreumsc@web.de | 17.11.2023 ▲ |
| |
| | ![Sven Bader: 18.11.2023](.././../../i/a/71.gif) Sven Bader | Ich denke ich werde das mal in einem neuen Thread mal zusammenfassen. Letztendlich findest du alles im Download meines letzten Posts. Die Shader sind in der GLSL (OpenGL Shader Language) geschrieben, die Syntax ist im Prinzip identisch zu C. Daten rein bekommt man über Texturen oder sogenannte Uniform Variablen. Raus kommt entweder das Bild auf den Bildschirm oder einen Buffer.
Mit sogenannten Compute Shadern habe ich bisher noch nicht experimentiert aber die funktionieren wohl identisch, können aber auch beliebige Arrays und andere Datentypen wieder ausgeben. |
| | | | |
| | ![Jens-Arne Reumschüssel: 19.11.2023](.././../../i/a/171494484748f1e66bd153d.jpg) Jens-Arne Reumschüssel | Das wäre echt super, wenn Du da einen kleinen Thread draus machen würdest. Ich denke da z.B. an das Drehen großer Bilder, was ja über die Windows-API immer wieder ein echter Nervkram ist, und natürlich auch daran, irgendetwas schnell berechnen zu lassen, was mit Grafik an sich nichts zu tun hat. |
| | | XProfan X4XProfan X4 * Prf2Cpp * XPSE * JRPC3 * Win11 Pro 64bit * PC i7-7700K@4,2GHz, 32 GB RAM PM: jreumsc@web.de | 19.11.2023 ▲ |
| |
| | ![Sven Bader: 20.11.2023](.././../../i/a/71.gif) Sven Bader | Hier ist der Thread zum Thema "Shader", noch ausbaufähig aber ein Anfang: [...] ![](/intl/i/lnk.gif) |
| | | | |
|
Zum QuelltextThemenoptionen | 2.199 Betrachtungen |
ThemeninformationenDieses Thema hat 2 Teilnehmer: |