Hi,
I've run into a little problem while writing a terrain generator in PASCAL for a sandbox-type game.
I am storing all block data in an array of records, each with a "noiseID" entry, which is the data generated by the "PerlinNoise" function, and decides what the block should be.
The PerlinNoise function, however, is not working. I followed the instructions on this site and transferred the code over to pascal:
http://freespace.virgin.net/hugo.elias/models/m_perlin.htm
However, the "smoothNoise" function is not working properly. Once called, the program exits with code 217. The output says "range check error", but I don't see how anything is out of range.
Here is part of the code:
program 2dSandBox;
uses crt,math;
type
BlockType = Record
Appearance,ID : string;
Durability,
BackColor,
TextColor : integer;
NoiseID : double;
end;
PlayerStats = Record
Health, oxygen, x_, y_, xOff, yOff : integer;
inWater, inLava, creative : boolean;
facing : string;
end;
var
blocks : Array[1..512,1..512] of BlockType;
inventory : Array[1..10] of string;
invIcons : Array[1..10] of BlockType;
invAmounts : Array[1..10] of integer;
swapBlock : BlockType;
render,activeInv,seed : integer;
stats : PlayerStats;
help,invDisp,disp : boolean;
total : double;
function noise(a,b : integer) : double;
var
tmpNoise : double;
xl,n : integer;
begin
n := a + b*57 + seed;
xl := (n shl 13) xor n;
xl := (xl * (xl * xl * 15731 + 789221) + 1376312589) and $7fffffff;
Noise := xl / 1073741824.0;
end;
function smoothNoise(x,y : integer) : double;
var
corners, sides, center : double;
begin
corners := ( Noise(x-1, y-1) + Noise(x+1, y-1) + Noise(x-1, y+1) + Noise(x+1, y+1) ) * 0.0625;
sides := ( Noise(x-1, y) + Noise(x+1, y) + Noise(x, y-1) + Noise(x, y+1) ) * 0.125;
center := Noise(x, y) / 4;
smoothNoise := corners + sides + center;
end;
function Interpolate(a,b,x : double) : double;
begin
Interpolate := a*(1-x) + b*x;
end;
function InterpolatedNoise(x,y : double) : double;
var
intx, inty : integer;
fracx,fracy,v1,v2,v3,v4,i1,i2: double;
begin
intx := floor(x);
inty := floor(y);
fracx := x-intx;
fracy := y-inty;
v1 := SmoothNoise(intX, intY);
v2 := SmoothNoise(intX + 1, intY);
v3 := SmoothNoise(intX, intY + 1);
v4 := SmoothNoise(intX + 1, intY + 1);
i1 := Interpolate(v1 , v2 , fracX);
i2 := Interpolate(v3 , v4 , fracX);
InterpolatedNoise := Interpolate(intx , inty , fracY);
end;
function PerlinNoise(x,y : integer) : double;
var
p,frequency,amplitude,tempNoise : double;
i,n : integer;
begin
PerlinNoise := 0;
tempNoise := 0;
randomize;
p := 1;
n := 3;
for i := 0 to n do
begin
frequency := exp(i*ln(n));
amplitude := exp(i*ln(p));
PerlinNoise := tempNoise + InterpolatedNoise(x*frequency, y*frequency) * amplitude;
end;
end;
procedure generateWorld();
var
a,b : integer;
low,high : double;
begin
clrscr;
total := 0;
low := 500000000000000000000;
high := 0;
seed := random(1000);
for a := 1 to 512 do
begin
for b := 1 to 512 do
begin
Blocks[a,b].NoiseID := PerlinNoise(a,b);
end;
end;
for a := 1 to 512 do
begin
for b := 1 to 512 do
begin;
total := total + Blocks[a,b].NoiseID;
if (Blocks[a,b].NoiseID<low) then
if not (Blocks[a,b].NoiseID = 0) then
low := Blocks[a,b].NoiseID;
if (Blocks[a,b].NoiseID>high) then
high := Blocks[a,b].NoiseID;
end;
end;
writeln('Average: ',total/262144);
writeln('Low : ',low);
writeln('High : ',high);
readln;
end;
begin
GenerateWorld;
InitVar;
Splash(1000);
Display(render);
Repeat
ResetTextColor;
if disp then
Display(render);
GetInput;
Until (render = 0);
end.
