[Cyan]<CedarChest6.1>Texture2D>Texture2DImpl.mesa!1

Texture2DImpl.mesa

Michael Plass, January 17, 1986 9:37:03 am PST

Perlin, September 13, 1985 5:53:07 pm PDT

McCreight, December 20, 1985 12:39:50 pm PST

DIRECTORY Basics, AIS, Real, RealFns, Random, Rope, Process, CedarProcess, Texture2D;

Texture2DImpl: CEDAR PROGRAM

IMPORTS Basics, AIS, Real, RealFns, Random, Process, CedarProcess

EXPORTS Texture2D

~ BEGIN

Noise routines

christmas: BOOL ← TRUE;

ROPE: TYPE ~ Rope.ROPE;

XF: PROC[x, x0, x1: REAL] RETURNS [REAL] ~ {

RETURN [x0 + x * x1]

};

epsilon: REAL ← 0.002; -- small differential amount for simulating gradients

res: INT ← 100; -- image resolution (square)

n: INT ← 6;

f0: REAL ← 0.5;

Surface: TYPE = {noise, bumps, rock, bark, elevation, elevationGrad, drops, sine, dots, swirl1, marble1, swirl, marble, chmarble, dotRoil, smoke, tree};

type: Surface ← noise;

x0: REAL ← 10;

x1: REAL ← 8;

y0: REAL ← -2.2;

y1: REAL ← 8;

z0: REAL ← -0.1;

z1: REAL ← 1;

zlo: REAL ← 0.07;

zhi: REAL ← 1;

evScale: REAL ← 1.0;

Sqr: PROC[x: REAL] RETURNS [REAL] ~ {RETURN [x*x]};

fudgeCone: REAL ← 0.02;

zTreeMean: REAL ← 0;

zTreeSum: REAL ← 0;

zTreeN: INT ← 0;

waveNumber: REAL ← 10.0;

Cone: PROC [x, y: REAL] RETURNS [REAL] ~ {

IF y < 0.95 THEN {

t: REAL ← 4*(x-0.5)*(x-0.5)/((0.95-y)*(0.95-y));

v: REAL ← 1-2*t;

k: REAL ← y - (ABS[x-0.5]*0.2+0.1);

wave: REAL ← 0.5+0.4*RealFns.CosDeg[y*waveNumber*360];

IF k < 0 THEN v ← v - 100*k*k;

v ← v * wave;

RETURN [MAX[v, 0.0]];

};

RETURN [0.0];

};

NoiseTest: PROC[x, y: REAL] RETURNS [REAL] ~ {

x01: REAL ~ x;

y01: REAL ~ y;

x ← XF[x, x0, x1];

y ← XF[y, y0, y1];

SELECT type FROM

noise => RETURN [Noise01[x * y, y]]; -- noise: [x0, x1, y0, y1] ← [10, 8, -2.2, 8]

bumps => { -- bumps: [x0, x1, y0, y1] ← [10, 8, -2.2, 8]

freq: REAL ← f0;

dz: REAL ← 0;

FOR i: INT IN [0..1) DO

FNoise: PROC[x, y: REAL] RETURNS [REAL] ~ {

RETURN [Noise01[x * freq, y * freq] / freq];

};

dz ← dz + (FNoise[x + epsilon, y] - FNoise[x, y]) / epsilon;

freq ← freq * 2;

ENDLOOP;

dz ← (1 + dz)/2;

IF dz < 0 THEN RETURN [0]

ELSE IF dz > 1 THEN RETURN [1]

ELSE RETURN [dz]

};

bark, -- bark: [x0, x1, y0, y1] ← [10, 8, -2.2, 4]

rock => { -- rock: [x0, x1, y0, y1] ← [10, 4, -2.2, 4]

freq: REAL ← f0;

dz: REAL ← 0;

FOR i: INT IN [0..n) DO

FNoise: PROC[x, y: REAL] RETURNS [REAL] ~ {

RETURN [Noise01[x * freq, y * freq] / freq];

};

dz ← dz + (FNoise[x + epsilon, y] - FNoise[x, y]) / epsilon;

freq ← freq * 2;

ENDLOOP;

dz ← dz / n * 2;

dz ← (1 + dz)/2;

IF dz < 0 THEN RETURN [0]

ELSE IF dz > 1 THEN RETURN [1]

ELSE RETURN [dz]

};

elevation => { -- elevation: [x0, x1, y0, y1] ← [10, 4, -2.2, 4]

freq: REAL ← f0;

dz: REAL ← 0;

FOR i: INT IN [0..n) DO

dz ← dz + Noise3[x * freq, y * freq, 0.5] / freq;

freq ← freq * 2;

ENDLOOP;

dz ← dz / n * evScale;

IF christmas THEN {

t: REAL ~ 4*(x01-0.5)*(x01-0.5)/((1.001-y01)*(1.001-y01));

dz ← dz / (1-t);

dz ← dz + 0.5-t;

RETURN [0.5-t];

};

dz ← (1 + dz)/2;

RETURN [dz]

};

elevationGrad => { -- elevationGrad: [x0, x1, y0, y1] ← [10, 4, -2.2, 4]

freq: REAL ← f0;

dz: REAL ← 0;

FOR i: INT IN [0..n) DO

z0: REAL ← Noise3[x * freq, y * freq, 0.5];

z1: REAL ← Noise3[(x+epsilon) * freq, (y-epsilon) * freq, 0.5];

dz ← dz + (z1-z0)/(epsilon * freq);

freq ← freq * 2;

ENDLOOP;

dz ← (1 + dz*evScale)/2;

RETURN [MIN[MAX[dz, 0], 1]]

};

drops => { -- drops: [x0, x1, y0, y1] ← [10, 4, -2.2, 4]

za, zb, z, dz: REAL;

za ← Noise3[x, y, 0];

zb ← Noise3[x+epsilon, y, 0];

z← XF[za, z0, z1];

dz← XF[(zb-za)/epsilon, 0, z1];

IF z < zlo THEN RETURN [0]

ELSE IF dz < -1 THEN RETURN [0]

ELSE IF dz > 1 THEN RETURN [1]

ELSE RETURN [(1 + dz)/2]

};

sine => { -- sine: [x0, x1, y0, y1] ← [10, 8, -2.2, 8]

RETURN [Wave[x]]

};

dots => { -- dots: [x0, x1, y0, y1] ← [10, 8, -2.2, 8]

RETURN [DotGrid[x, y]]

};

swirl1 => { -- swirl1: [x0, x1, y0, y1] ← [10, 8, -2.2, 8]

freq: REAL ← f0;

z: REAL ← 0;

FOR i:INT IN [0..1) DO

FNoise: PROC[x, y: REAL] RETURNS [REAL] ~ {

RETURN [Noise3[x * freq, y * freq, 0] / freq];

};

zz: REAL ← FNoise[x, y];

z ← z + zz * zz * freq;

freq ← freq * 2;

ENDLOOP;

z ← z * 6;

RETURN [Wave[x + z]]

};

marble1 => { -- marble1: [x0, x1, y0, y1] ← [10, 8, -2.2, 8]

freq: REAL ← f0;

z: REAL ← 0;

FOR i:INT IN [0..1) DO

FNoise: PROC[x, y: REAL] RETURNS [REAL] ~ {

RETURN [Noise3[x * freq, y * freq, 0] / freq];

};

z ← z + ABS[FNoise[x, y]];

freq ← freq * 2;

ENDLOOP;

z ← z * 3;

RETURN [Wave[x + z]]

};

tree => {

freq: REAL ← f0 / 2;

famp: REAL ← 1.0;

z: REAL ← 0;

IF 2*ABS[x01-0.5] > 1-y01 THEN RETURN [0];

FOR i:INT IN [0..n) DO

FNoise: PROC[x, y: REAL] RETURNS [REAL] ~ {

RETURN [Noise3[x * freq, y * freq, 0] * famp];

};

z ← z + ABS[FNoise[x, y]];

z ← z + FNoise[x, y];

freq ← freq * 2;

famp ← famp * 0.7;

ENDLOOP;

z ← z / n * 24;

zTreeSum ← zTreeSum + z;

zTreeN ← zTreeN + 1;

z ← (z-zTreeMean) * fudgeCone;

RETURN [Cone[x01 + z, y01 + z]]

};

swirl => { -- swirl: [x0, x1, y0, y1] ← [10, 8, -2.2, 8]

freq: REAL ← f0 / 2;

z: REAL ← 0;

FOR i:INT IN [0..n) DO

FNoise: PROC[x, y: REAL] RETURNS [REAL] ~ {

RETURN [Noise3[x * freq, y * freq, 0] / freq];

};

zz: REAL ← FNoise[x, y];

z ← z + zz * zz * freq;

freq ← freq * 2;

ENDLOOP;

z ← z / n * 16;

RETURN [Wave[x + z] ]

};

marble => { -- marble: [x0, x1, y0, y1] ← [10, 8, -2.2, 8]

freq: REAL ← f0 / 2;

z: REAL ← 0;

FOR i:INT IN [0..n) DO

FNoise: PROC[x, y: REAL] RETURNS [REAL] ~ {

RETURN [Noise3[x * freq, y * freq, 0] / freq];

};

z ← z + ABS[FNoise[x, y]];

freq ← freq * 2;

ENDLOOP;

z ← z / n * 8;

RETURN [Wave[x + z] ]

};

chmarble => { -- chmarble: [x0, x1, y0, y1] ← [10, 8, -2.2, 8]

freq: REAL ← f0 / 2;

z: REAL ← 0;

FOR i:INT IN [0..n) DO

FNoise: PROC[x, y: REAL] RETURNS [REAL] ~ {

RETURN [Noise3[x * freq, y * freq, 0] / freq];

};

z ← z + ABS[FNoise[x, y]];

freq ← freq * 2;

ENDLOOP;

z ← z / n * 8;

RETURN [Wave[x + z] * Wave[y + z]]

};

dotRoil => { -- dotRoil: [x0, x1, y0, y1] ← [10, 8, -2.2, 8]

freq: REAL ← f0 / 2;

z: REAL ← 0;

FOR i:INT IN [0..n) DO

FNoise: PROC[x, y: REAL] RETURNS [REAL] ~ {

RETURN [Noise3[x * freq, y * freq, 0] / freq];

};

z ← z + ABS[FNoise[x, y]];

freq ← freq * 2;

ENDLOOP;

z ← z / n * 24;

RETURN [DotGrid[x + z, y]]

};

smoke => { -- smoke: [x0, x1, y0, y1] ← [10, 8, -2.2, 8]

freq: REAL ← f0;

z: REAL ← 0;

FOR i:INT IN [0..n) DO

FNoise: PROC[x, y: REAL] RETURNS [REAL] ~ {

RETURN [Noise3[x * freq, y * freq, 0] / freq];

};

z ← z + ABS[FNoise[x, y]];

freq ← freq * 2;

ENDLOOP;

z ← z / n * 8;

z ← Wave[x + z];

IF z < 0 THEN RETURN [0]

ELSE IF z > 1 THEN RETURN [1]

ELSE RETURN [z]

};

ENDCASE => RETURN [0];

};

Wave: PROC[x: REAL] RETURNS [REAL] ~ {

z: REAL ← RealFns.Sin[x];

z ← z * z;

RETURN [1 - z * z];

};

DotGrid: PROC[x, y: REAL] RETURNS [REAL] ~ {

zx: REAL ← RealFns.Sin[x];

zy: REAL ← RealFns.Sin[y];

z:REAL ← zx * zy;

z ← z * z;

RETURN [1 - z * z];

};

Noise01: PROC[x, y: REAL] RETURNS [REAL] ~ {

s: REAL;

s ← Noise3[x, y, 0];

RETURN [(s + 1)/2]

};

Permutation: TYPE ~ REF PermutationRecord;

PermutationRecord: TYPE ~ RECORD[SEQUENCE length: CARDINAL OF CARDINAL];

randomSeed: INT ← 0;

NewSeed: PROC [seed: INT] ~ { randomSeed ← seed; pp ← NIL };

RandomPermutation: PROC[n: INT] RETURNS [Permutation] ~ {

p: Permutation ← NEW[PermutationRecord[2 * n]];

rs: Random.RandomStream ← Random.Create[seed: randomSeed];

FOR i: INT IN [0..n) DO

p[i] ← i;

ENDLOOP;

FOR i: INT IN [0..n-1) DO

j: INT ← Random.ChooseInt[rs: rs, min: i+1, max: n-1];

k: INT ← p[i];

p[i] ← p[j];

p[j] ← k;

p[n + i] ← p[i];

ENDLOOP;

RETURN [p];

};

Static data needed by Noise:

pp: Permutation ← NIL;

np: INT ← 2048;

TripleSeq: TYPE ~ REF TripleSeqRecord;

TripleSeqRecord: TYPE ~ RECORD[SEQUENCE length: CARDINAL OF Triple];

Triple: TYPE ~ RECORD [ x, y, z: REAL];

grad: TripleSeq ← NIL;

Noise3: PUBLIC PROC[x, y, z: REAL] RETURNS [REAL] ~ { -- band limited noise over ]3.

declare local variables.

jx, jy, jz: INT;

sx, sy, sz, s, f: REAL;

initialize random permutation table

IF pp = NIL THEN {

pp ← RandomPermutation[np];

grad ← NEW[TripleSeqRecord[np]];

FOR i:INT IN [0..np) DO

Random: PROC[i: INT] RETURNS [REAL] ~ {RETURN [3.2*pp[i MOD np]/np-1.6];};

Normalize: PROC[v: Triple] RETURNS[Triple] ~ {

mag: REAL ← RealFns.SqRt[v.x * v.x + v.y * v.y + v.z * v.z];

IF mag <= 0. THEN mag ← 1.;

RETURN [ [v.x/mag, v.y/mag, v.z/mag] ];

};

grad[i] ← Normalize[[Random[i+7], Random[i+13], Random[i+29]]];

ENDLOOP;

};

Map all points into the [0..np-1]3 cube by wrapping around in each dimension.

BEGIN

WrapAround: PROC[x: REAL, n: INT] RETURNS [REAL] ~ {

x ← x - Real.Fix[x/n]*n;

IF x < 0 THEN RETURN [x + n] ELSE RETURN [x]; };

x ← WrapAround[x, np];

y ← WrapAround[y, np];

z ← WrapAround[z, np];

END;

jxyz ← the integer lattice point "just below" the point (identifies the surrounding unit cube).

jx ← Real.Fix[x];

jy ← Real.Fix[y];

jz ← Real.Fix[z];

sxyz ← the vector difference (point - jxyz) biased with an S-Curve in each dimension.

BEGIN

SCurve: PROC[x: REAL] RETURNS [REAL] ~ { RETURN [x * x * (3 - 2 * x)]; };

sx ← SCurve[x - jx];

sy ← SCurve[y - jy];

sz ← SCurve[z - jz];

END;

f ← 0.; -- initialize sum to zero.

FOR n: INT IN [0..8) DO -- sum together 8 local fields from the surrounding lattice pts.

DotProd: PROC[v1, v2: Triple] RETURNS [REAL] ~ {

RETURN [v1.x * v2.x + v1.y * v2.y + v1.z * v2.z];

};

SELECT n FROM -- visit each of the 8 corners of the surrounding unit cube.

0 => { s ← (1.-sx) * (1.-sy) * (1.-sz) };

1 => {jx ← jx+1 ; s ← sx * (1.-sy) * (1.-sz) };

2 => {jx ← jx-1 ; jy ← jy+1 ; s ← (1.-sx) * sy * (1.-sz) };

3 => {jx ← jx+1 ; s ← sx * sy * (1.-sz) };

4 => {jx ← jx-1 ; jy ← jy-1 ; jz ← jz+1 ; s ← (1.-sx) * (1.-sy) * sz };

5 => {jx ← jx+1 ; s ← sx * (1.-sy) * sz };

6 => {jx ← jx-1 ; jy ← jy+1 ; s ← (1.-sx) * sy * sz };

7 => {jx ← jx+1 ; s ← sx * sy * sz };

ENDCASE;

Compute and add in weighted gradient at each corner

f ← f + s * DotProd [grad[ pp[jx + pp[jy + pp[jz]]] ], [x - jx, y - jy, z - jz] ];

ENDLOOP;

RETURN [f];

};

autoRange: INT ← 50;

confidence: REAL ← 0.9;

FunctionAIS: PUBLIC PROC [outputName: ROPE, width, height: NAT, f: PROC [x, y: REAL] RETURNS [REAL], bitsPerPixel: NAT ← 8] ~ TRUSTED {

raster: AIS.Raster ← NEW[AIS.RasterPart ← [

scanCount: height,

scanLength: width,

scanMode: rd,

bitsPerPixel: bitsPerPixel,

linesPerBlock: -1,

paddingPerBlock: 177777B

]];

maxPixelValue: NAT ← Real.Round[RealFns.Exp[bitsPerPixel*RealFns.Ln[2]]]-1;

output: AIS.FRef ← AIS.CreateFile[name: outputName, raster: raster];

outputWindow: AIS.WRef ← AIS.OpenWindow[output];

BufferRep8: TYPE ~ PACKED ARRAY [0..3000) OF [0..256);

lineBuffer: REF BufferRep8 ← NEW[BufferRep8];

lineBufferDesc: AIS.Buffer ← [length: SIZE[BufferRep8], addr: BASE[lineBuffer^]];

min: REAL ← 0.0;

max: REAL ← 1.0;

inner: SAFE PROC ~ TRUSTED {

scale: REAL ~ maxPixelValue/(max-min);

FOR i: NAT IN [0..outputWindow.GetWindowParams.lastScan] DO

y: REAL ← (height-0.5-i)/height;

Process.CheckForAbort[];

lineBuffer^ ← ALL[0];

FOR j: NAT IN [0..width) DO

x: REAL ← (0.5+j)/width;

pixel: [0..256) ← MIN[MAX[Real.RoundLI[(f[x,y]-min)*scale], 0], maxPixelValue];

IF pixel>0 THEN {

bitIndex: INT = LONG[j]*bitsPerPixel;

bufIndex: NAT = bitIndex/8;

lineBuffer[bufIndex] ← lineBuffer[bufIndex]+

Basics.BITSHIFT[pixel, 8-bitsPerPixel-(bitIndex MOD 8)];

};

ENDLOOP;

AIS.UnsafeWriteLine[outputWindow, lineBufferDesc, i];

ENDLOOP;

};

IF autoRange > 0 THEN {

random: Random.RandomStream ← Random.Create[];

m: REAL ← 0;

min ← 99999999.0;

max ← -99999999.0;

FOR i: INT IN [0..autoRange) DO

x: REAL ← Real.FScale[Random.ChooseInt[random, 0, LONG[256]*256*256], -24];

y: REAL ← Real.FScale[Random.ChooseInt[random, 0, LONG[256]*256*256], -24];

z: REAL ← f[x,y];

m ← m + z;

min ← MIN[min, z];

max ← MAX[max, z];

ENDLOOP;

IF max = min THEN max ← max + 3.90625e-3;

m ← (max+min)/2;

max ← m + (max-m)/confidence;

min ← m - (m-min)/confidence;

};

CedarProcess.DoWithPriority[background, inner];

AIS.CloseFile[output];

};

ValueRange: PROC [inputName: ROPE] RETURNS [minvalue, maxvalue: REAL] ~ TRUSTED {

ais: AIS.FRef ← AIS.OpenFile[name: inputName];

window: AIS.WRef ← AIS.OpenWindow[ais];

BufferRep: TYPE ~ PACKED ARRAY [0..3000) OF [0..256);

nPerLine: NAT ← window.GetWindowParams.lastPixel+1-window.GetWindowParams.firstPixel;

lineBuffer1: REF BufferRep ← NEW[BufferRep];

lineBuffer1Desc: AIS.Buffer ← [length: SIZE[BufferRep], addr: BASE[lineBuffer1^]];

minvalue ← 1.0;

maxvalue ← 0.0;

FOR i: NAT IN [0..window.GetWindowParams.lastScan] DO

AIS.UnsafeReadLine[window, lineBuffer1Desc, i];

FOR j: NAT IN [0..nPerLine) DO

pix: REAL ← lineBuffer1[j]/255.0;

minvalue ← MIN[pix, minvalue];

maxvalue ← MAX[pix, maxvalue];

ENDLOOP;

AIS.CloseFile[ais];

};

ChangeContrast: PROC [inputName, outputName: ROPE, oldminvalue, oldmaxvalue, newminvalue, newmaxvalue: REAL] ~ TRUSTED {

ais: AIS.FRef ← AIS.OpenFile[name: inputName];

raster: AIS.Raster ← AIS.ReadRaster[ais];

output: AIS.FRef ← AIS.CreateFile[name: outputName, raster: raster];

window: AIS.WRef ← AIS.OpenWindow[ais];

outputWindow: AIS.WRef ← AIS.OpenWindow[output];

BufferRep: TYPE ~ PACKED ARRAY [0..3000) OF [0..256);

nPerLine: NAT ← window.GetWindowParams.lastPixel+1-window.GetWindowParams.firstPixel;

outBuf: REF BufferRep ← NEW[BufferRep];

lineBuffer1: REF BufferRep ← NEW[BufferRep];

lineBuffer1Desc: AIS.Buffer ← [length: SIZE[BufferRep], addr: BASE[lineBuffer1^]];

outBufferDesc: AIS.Buffer ← [length: SIZE[BufferRep], addr: BASE[outBuf^]];

m: REAL ← (newmaxvalue-newminvalue)/(oldmaxvalue-oldminvalue);

FOR i: NAT IN [0..outputWindow.GetWindowParams.lastScan] DO

AIS.UnsafeReadLine[window, lineBuffer1Desc, i];

FOR j: NAT IN [0..nPerLine) DO

pix: REAL ← lineBuffer1[j]/255.0;

out: REAL ← (pix-oldminvalue)*m+newminvalue;

outBuf[j] ← MIN[MAX[Real.RoundLI[out*255], 0], 255];

ENDLOOP;

AIS.UnsafeWriteLine[outputWindow, outBufferDesc, i];

ENDLOOP;

AIS.CloseFile[ais];

AIS.CloseFile[output];

};

END.