Linear 2D Noise Code

program LinearNoise96;
	uses
		simpleWindows, Cwindows, stringTools, IOTools, randomTools;
	const
		size = 39;{multiple of 3 for splines}
	type
		noiseArray = array[0..size, 0..size] of real;
	var
		noiseB, noiseR, noiseG: noiseArray;

		h, v: longint;							{pixel coordinates}
		divisor: longint;						{for spreading out the noise}

		x, y: real;								{x = h/divisor, y= v/divisor are sent to LinearNoise function}
		factorR, factorG, factorB, factor: real;{to set the proportions of Red, Green, Blue}
		myColor: rgbColor;						{The color that the pixel is set to}
		start: integer;							{for starting scale}
		choice: integer;						{ which procedure to call}
		normalize: boolean;
	procedure openWindows;
	begin
{ set defaults for drawing window - see simpleCwindows }
		with Coptions do
			begin
				title := '';
				framewidth := 3;
				framecolor := white;
				fieldcolor := black;
			end;

		hideall;
		macii_minitext;
		miniCdraw;
		writeln('Uniform Linear Noise Samples');
		random_seed(tickCount);
	end;

	procedure setNoises;
		var
			i, j, k: integer;
			sum: real;
	begin
		for i := 0 to size - 1 do
			for j := 0 to size - 1 do
				begin
					noiseR[i, j] := random_real(0, 1);	{set all but last row and column to random reals between 0 and 1}
					noiseG[i, j] := random_real(0, 1);
					noiseB[i, j] := random_real(0, 1);
				end;
		for j := 1 to size - 1 do
			begin
				noiseR[size, j] := noiseR[0, j];		{set the last row and column to match the first row and column}
				noiseR[j, size] := noiseR[j, 0];
				noiseG[size, j] := noiseG[0, j];
				noiseG[j, size] := noiseG[j, 0];
				noiseB[size, j] := noiseB[0, j];
				noiseB[j, size] := noiseB[j, 0];
			end;

		noiseR[size, size] := noiseR[0, 0];			{set the last corner to complete the wrap}
		noiseG[size, size] := noiseG[0, 0];
		noiseB[size, size] := noiseB[0, 0];
	end;

	function linearNoise (u, v: real; var noise: noiseArray): real;
		var
			iu, iv, ip, iq: integer;
			du, dv, bot, top: real;
	begin
		iu := trunc(u);
		iv := trunc(v);
		du := u - iu;
		dv := v - iv;

		iu := iu mod size;
		iv := iv mod size;
		ip := (iu + 1);
		iq := (iv + 1);

		bot := noise[iu, iv] + du * (noise[ip, iv] - noise[iu, iv]);
		top := noise[iu, iq] + du * (noise[ip, iq] - noise[iu, iq]);

		linearNoise := bot + dv * (top - bot);
	end;

	function Lturbulence (u, v: real; var noise: noiseArray): real;
		var
			t, scale: real;
	begin
		scale := start;
		t := 0;
		while scale >= 1 / divisor do {1 / divisor}
			begin
				t := t + linearNoise(u / scale, v / scale, noise) * scale;
				scale := scale / 2;
			end;
		if normalize then {normalized turbulence}
			t := t / 2 / start;
		Lturbulence := t;
	end;

	function marble (x, y: real; var noise: noiseArray): real;
		var
			marb: real;
	begin
		marble := abs(sin(x + Lturbulence(x, y, noise)));
	end;

	function cloud (x, y: real; var noise: noiseArray): real;
	begin
		cloud := sin(x + Lturbulence(x, y, noise));
	end;

	procedure noiseColor (x, y: real);
	begin
		factorR := linearNoise(x, y, noiseR);
		factorG := linearNoise(x, y, noiseG);
		factorB := linearNoise(x, y, noiseB);

		with myColor do
			begin
				red := round(2 * factorR * maxint);
				green := round(2 * factorG * maxint);
				blue := round(2 * factorB * maxint);
			end;
	end;

	procedure turbulenceColor (x, y: real);
	begin
		factorR := Lturbulence(x, y, noiseR);
		factorG := Lturbulence(x, y, noiseG);
		factorB := Lturbulence(x, y, noiseB);

		with myColor do
			begin
				red := round(2 * factorR * maxint);
				green := round(2 * factorG * maxint);
				blue := round(2 * factorB * maxint);
			end;
	end;

	procedure marbleColor (x, y: real);
	begin
{    factorR := marble(x, y, noiseR);	}
{square factorR to make a narrower band of yellow where red adds to green}
{    factorR := factorR * factorR;}
		factorG := sqrt(marble(x, y, noiseG));{take the square root to fatten the green bands, leaving thin blue veins}
		with myColor do
			begin
				red := 0;{trunc(factorR * maxint);}
				green := trunc(2 * factorG * maxint);
				blue := trunc(maxint);
			end;
	end;

	procedure cloudColor (x, y: real);
	begin
		factorR := abs(cloud(x, y, noiseR));
		factorG := abs(cloud(y, x, noiseG));	{note that x and y are flipped; fuzziness in two directions}
		factor := abs(factorR + factorG) / 2;	{factor scales from blue to white}

		with myColor do
			begin
				red := maxint + trunc(factor * maxint);
				green := maxint + trunc(factor * maxint);
				blue := maxint + trunc((1 - factor / 2) * maxint);
			end;
	end;

{------main----------------------------------------------------------------------}
begin
	openWindows;
	setNoises;
	divisor := 1;
	start := 1;
	choice := 2;
	repeat
		start := request_integer('Enter scale = ', start);
		divisor := request_integer('Enter divisor = ', divisor);
		writeln('Choose one: 1. noise');
		writeln('            2. turbulence');
		writeln('            3. marble');
		writeln('            4. clouds');
		choice := request_integer('Enter choice = ', choice);
		if (choice = 2) or (choice = 3) or (choice = 4) then
			normalize := confirm('Normalize turbulence? ', false);
		with CdrawingRect do
			begin
				for v := 0 to bottom do
					for h := 0 to right do
						begin
							x := h / divisor;
							y := v / divisor;

							case choice of
								1: 
									noiseColor(x, y);
								2: 
									turbulenceColor(x, y);
								3: 
									marbleColor(x, y);
								4: 
									cloudColor(x, y);
								otherwise
									;
							end; {case}
							setCPixel(h, v, myColor);
						end;
			end;

	until not confirm('Continue? ', true);
	readln;
end.

Last Updated: December 20, 2005, 10:56 a.m.
The URL for this document is: http://www.ccs.neu.edu/home/fell/COM3370/noiseCode.html