- Fractal Terrain Generation
- 05 Jun 2020 05:05:49 pm
- Last edited by KosmicCyclone on 07 Jun 2020 10:36:25 am; edited 3 times in total
I have lately been getting more and more interested in terrain generation, which is how I stumbled upon this way of creating realistic-looking terrain. Using this webpage http://paulbourke.net/fractals/noise/ as a start to get the basic idea of how it works, I was able to create this code. It runs fairly quickly, but can probably be optimized, which is one of the things I have planned for it.
Other planned features:
I am completely open to suggestions and ideas!
Code:
Edit: The current version of the code is below.
Code:
Edit 2: See the latest post for an updated version
Other planned features:
- Optimizations for speed and size
A progress bar
Converting from a matrix to either a list or a string, to allow for higher-resolution terrain
Option to skip to the highest resolution
Different elevations are drawn in different colors
A more user-friendly UI
Ability to rotate the terrain
A display in the top left of the graph screen that shows the current settings
I am completely open to suggestions and ideas!
Code:
ClrDraw:ClrHome
Input "RESOLUTION (1-4): ",A
int(min(4,max(1,A->A
Input "SEED (pi FOR RAND SEED): ",S
Input "SMOOTHNESS (0-2): ",R
1+min(2,max(0.1,R->R
Input "OVERALL HEIGHT (1,5): ",P
.1min(5,max(1,P->P
startTmr->T:T->rand
If not(S=pi
S->rand
~4->Xmin:33->Xmax
~6->Ymin:19->Ymax
15->L
{2,4,8,16->|LR
{10,14,18->|LC
|LR(A->B
seq(X,X,0,L,L/B)->|LX
dim(Ans->B
Ans->G
{Ans,Ans->dim([A]
For(Y,1,G
For(X,1,G
YL/G->[A](Y,X
End:End
For(I,A,1,~1
{[A](1,1),[A](1,G),[A](G,1),[A](G,G->L1
[A]+PrandM(G,G)->[A]
L1(1->[A](1,1
L1(2->[A](1,G
L1(3->[A](G,1
L1(4->[A](G,G
For(V,1,G
For(W,1,G
If 0>([A](V,W)-VL/G
VL/G->[A](V,W
End:End
ClrDraw
0.5|LR(I->S
Pt-On(0,0,White
Lsin(15)/A->B
Lsin(5)/A->C
For(X,1,G,S
For(Y,1,G,S
If X!=G and Y and X+S<=G
Line(YB+|LX(X),~XC+[A](Y,X),YB+|LX(X+S),~(X+S)C+[A](Y,X+S)
If Y!=G and Y and Y+S<=G
Line(YB+|LX(X),~XC+[A](Y,X),(Y+S)B+|LX(X),~XC+[A](Y+S,X)
End:End
P/R->P
End
checkTmr(T->T
Text(1,1,Ans
Edit: The current version of the code is below.
Code:
ClrDraw:ClrHome:Degree
Input "Resolution (1-4): ",A
int(min(4,max(1,A->A
Input "Seed ([i] For Rand Seed): ",S
Input "Smoothness (0-2): ",R
1+min(2,max(0.1,R->R
Input "Height Scaling (1,5): ",P
min(5,max(1,P->P
Input "Sea Level (0,1): ",M
min(1,max(0,M->M
Disp "Skip to last
Input "iteration? (0-1) ",J
ClrHome
startTmr->T
If imag(S:int(.01randT->S
S->rand
Output(1,1,"Seed: "+eval(S
Output(10,1,"Initializing..."
~4->Xmin:33->Xmax
~6->Ymin:19->Ymax
15->L
DelVar [A]
{2,4,8,16->|LR
{10,14,18->|LC
|LR(A->B
seq(X,X,0,L,L/B)->|LX
dim(Ans->B
Ans->G
{Ans,Ans->dim([A]
For(I,A,1,~1
ClrHome
Output(1,1,"Seed: "+eval(S
Output(3,1,"Iteration "+eval(1+A-I
.5|LR(I->S
Output(10,1,"Tweaking Height... "
{[A](1,1),[A](1,G),[A](G,1),[A](G,G->L1
DelVar Q
For(V,1,G,S
For(W,1,G,S
Q+1->Q
[A](V,W)+Prand->[A](V,W
Output(10,20,eval(int(100Q/int(1+(G-1)/S)^^2))+"% "
End
End
L1(1->[A](1,1
L1(2->[A](1,G
L1(3->[A](G,1
L1(4->[A](G,G
Output(10,1,"Flooding... "
DelVar Q
For(V,1,G,S
For(W,1,G,S
Q+1->Q
max(0,[A](V,W)-M->[A](V,W
Output(10,13,eval(int(100Q/int(1+(G-1)/S)^^2))+"% "
End:End
Output(10,1,"Making Midpoints... "
DelVar Q
For(V,1,G
For(W,S+1,G-S,S
Q+1->Q
If not([A](V,W
.5([A](V,W-S)+[A](V,W+S)->[A](V,W
Output(10,21,eval(int(100Q/(Gint((G-1)/S-1))))+"%"
End:End
If I=1 or not(J:Then
ClrDraw
Pt-On(0,0,White
Lsin(15)/A->B
Lsin(5)/A->C
DelVar Q
TextColor(Black
For(X,1,G,S)
For(Y,1,G,S)
Q+1->Q
YL/G
If X!=G and Y and X+S<=G
Line(YB+|LX(X),Ans-XC+[A](Y,X),YB+|LX(X+S),Ans-(X+S)C+[A](Y,X+S)
YL/G
If Y!=G and Y and Y+S<=G
Line(YB+|LX(X),Ans-XC+[A](Y,X),(Y+S)B+|LX(X),(Y+S)L/G-XC+[A](Y+S,X)
Text(0,0,"Rendering... "+eval(int(100Q/int(1+(G-1)/S)^^2))+"%
End:End
Wait 1
End
P/R->P
End
checkTmr(T->T
Text(150,1,"ELAPSED TIME: ",Ans
Edit 2: See the latest post for an updated version