ShadingProcs.mesa
Last Edited by: Crow, October 2, 1986 6:16:05 pm PDT
Perlin, August 5, 1985 0:23:18 am PDT
DIRECTORY
Atom     USING [ GetPropFromList ],
Checksum   USING [ ComputeChecksum ],
Real     USING [ Fix, RoundC ],
RealFns    USING [ Sin, Cos, Power ],
ThreeDBasics  USING [ VertexInfo, VtxToRealSeqProc, RGB ],
TextureMaps   USING [ GetTxtrAt ],
Tilers     USING [ AddHighlight ],
ScanConvert   USING [ RealSequence, GetColorProc, Spot, Extend ];
ShadingProcs: CEDAR PROGRAM
IMPORTS Atom, Checksum, Real, RealFns, ScanConvert, TextureMaps, Tilers
~ BEGIN
RealSequence: TYPE ~ ScanConvert.RealSequence;
RGB: TYPE ~ ThreeDBasics.RGB;
GetLerpedVals: ThreeDBasics.VtxToRealSeqProc ~ {
PROC[dest: REF RealSequence, source: VertexInfo] RETURNS[REF RealSequence];
IF dest = NIL OR dest.maxLength < dest.length+3
THEN dest ← ScanConvert.Extend[ dest, dest.length+3];
dest[dest.length ] ← source.coord.x;
dest[dest.length+1] ← source.coord.y;
dest[dest.length+2] ← source.coord.z;
dest.length ← dest.length+3;
RETURN [dest];
};
Spots: ScanConvert.GetColorProc ~ {
RETURN RecoverColor[spot, AddSpots];
};
Wurlitzer: ScanConvert.GetColorProc ~ {
RETURN RecoverColor[spot, AddWurlitzer];
};
TwistedStripes: ScanConvert.GetColorProc ~ {
RETURN RecoverColor[spot, AddTwistedStripes];
};
BurlWood: ScanConvert.GetColorProc ~ {
RETURN RecoverColor[spot, AddBurlWood];
};
ZebraBurl: ScanConvert.GetColorProc ~ {
RETURN RecoverColor[spot, AddZebraBurl];
};
Marble: ScanConvert.GetColorProc ~ {
RETURN RecoverColor[spot, AddMarble];
};
RecoverColor: PROC[spot: ScanConvert.Spot,
       proc: PROC[spot: ScanConvert.Spot] RETURNS[ScanConvert.Spot] ]
     RETURNS[RGB, REAL] ~ {
IF Atom.GetPropFromList[spot.props, $TextureMap] # NIL
THEN spot ← TextureMaps.GetTxtrAt[spot];   -- modify with mapped texture
spot ← proc[spot];           -- modify with solid texture
spot ← Tilers.AddHighlight[spot];       -- get shading
RETURN[
[ R: spot.val[0], G: spot.val[1], B: spot.val[2] ],
spot.val[3]
];
};
AddSpots: PROC[spot: ScanConvert.Spot] RETURNS[ScanConvert.Spot] ~ {
Regular array of dark spots
x: NAT ← spot.val.length-3; y: NAT ← x+1; z: NAT ← x+2; -- object space coordinate
r: NAT ~ 0; g: NAT ~ 1; b: NAT ~ 2; t: NAT ~ 3;
intensity: REAL ← RealFns.Sin[10.0 * spot.val[x] ]
     * RealFns.Sin[14.0 * spot.val[y] ]
     * RealFns.Sin[20.0 * spot.val[z] ];
intensity ← (intensity + 1.0) / 2.0;
spot.val[r] ← spot.val[r] * intensity;
spot.val[g] ← spot.val[g] * intensity;
spot.val[b] ← spot.val[b] * intensity;
spot.val[t] ← spot.val[t] * intensity;
RETURN[spot];
};
AddWurlitzer: PROC[spot: ScanConvert.Spot] RETURNS[ScanConvert.Spot] ~ {  
Wurlitzer colors, stripes in 3-d
x: NAT ← spot.val.length-3; y: NAT ← x+1; z: NAT ← x+2; -- object space coordinate
r: NAT ~ 0; g: NAT ~ 1; b: NAT ~ 2; t: NAT ~ 3;
intensity: REAL ← RealFns.Sin[10.0 * spot.val[x] ]
     * RealFns.Sin[14.0 * spot.val[y] ]
     * RealFns.Sin[20.0 * spot.val[z] ];
intensity ← (intensity + 1.0) / 2.0;
spot.val[r] ← spot.val[r] * (RealFns.Sin[10.0*spot.val[x]] +1.0) / 2.0;
spot.val[g] ← spot.val[g] * (RealFns.Sin[14.0*spot.val[y]] +1.0) / 2.0;
spot.val[b] ← spot.val[b] * (RealFns.Sin[20.0*spot.val[z]] +1.0) / 2.0;
spot.val[t] ← spot.val[t] * intensity;
RETURN[spot];
};
AddStripes: PROC[spot: ScanConvert.Spot] RETURNS[ScanConvert.Spot] ~ {
x: NAT ← spot.val.length-3; y: NAT ← x+1; z: NAT ← x+2; -- object space coordinate
r: NAT ~ 0; g: NAT ~ 1; b: NAT ~ 2; t: NAT ~ 3;
intensity: REAL ← RealFns.Sin[40.0 * spot.val[x] ];  -- stripes vary in x
intensity ← (intensity + 1.0) / 2.0;
spot.val[r] ← spot.val[r] * intensity;
spot.val[g] ← spot.val[g] * (1.0 - intensity);
spot.val[b] ← spot.val[b] * intensity;
spot.val[t] ← spot.val[t] * (1.0 - intensity);
RETURN[spot];
};
AddTwistedStripes: PROC[spot: ScanConvert.Spot] RETURNS[ScanConvert.Spot] ~ {
Rotating stripes (barber pole)
x: NAT ← spot.val.length-3; y: NAT ← x+1; z: NAT ← x+2; -- object space coordinate
r: NAT ~ 0; g: NAT ~ 1; b: NAT ~ 2; t: NAT ~ 3;
angle: REAL ← 3.1416 * spot.val[z];    -- rotation varies with z
cosAngle: REAL ← RealFns.Cos[angle];
sinAngle: REAL ← RealFns.Sin[angle];
intensity: REAL ← RealFns.Sin[40.0 *     -- x component of rotated x-y vector
         (cosAngle * spot.val[x] + sinAngle * spot.val[y]) ];
intensity ← (intensity + 1.0) / 2.0;
spot.val[r] ← spot.val[r] * intensity;
spot.val[g] ← spot.val[g] * (1.0 - intensity);
spot.val[2] ← spot.val[b] * intensity;
spot.val[t] ← spot.val[t] * (1.0 - intensity);
RETURN[spot];
};
AddNoise: ScanConvert.GetColorProc ~ {
PROC[spot: Spot] RETURNS[RGB, REAL]
x: NAT ← spot.val.length-3; y: NAT ← x+1; z: NAT ← x+2; -- object space coordinate
r: NAT ~ 0; g: NAT ~ 1; b: NAT ~ 2; t: NAT ~ 3;
intensity: REAL ← Noise[ 2*spot.val[x],
       2*spot.val[y],
       2*spot.val[z] ];
intensity ← (intensity + 1.0) / 2.0;
IF intensity > 1. THEN intensity ← 1.;
IF intensity < 0. THEN intensity ← 0.;
intensity ← 255.0 * intensity;
RETURN[
[ R: Real.RoundC[spot.val[r] * intensity],
G: Real.RoundC[spot.val[g] * intensity],
B: Real.RoundC[spot.val[b] * intensity]
],
Real.RoundC[spot.val[t] * 255.0]
];
};
AddSwirl: ScanConvert.GetColorProc ~ {
PROC[spot: Spot] RETURNS[RGB, REAL]
x: NAT ← spot.val.length-3; y: NAT ← x+1; z: NAT ← x+2; -- object space coordinate
r: NAT ~ 0; g: NAT ~ 1; b: NAT ~ 2; t: NAT ~ 3;
intensity: REAL ← RealFns.Sin[Swirl[ spot.val[x],
           spot.val[y],
           spot.val[z] ]*30 + 10*spot.val[z]];
intensity ← (intensity + 1.0) / 2.0;
intensity ← 255.0 * RealFns.Power[intensity, 0.77];
RETURN[
[ R: Real.RoundC[spot.val[r] * intensity],
G: Real.RoundC[spot.val[g] * intensity],
B: Real.RoundC[spot.val[b] * intensity]
],
Real.RoundC[spot.val[t] * 255.0]
];
};
AddSegue: ScanConvert.GetColorProc ~ {
PROC[spot: Spot] RETURNS[RGB, REAL]
x: NAT ← spot.val.length-3; y: NAT ← x+1; z: NAT ← x+2; -- object space coordinate
r: NAT ~ 0; g: NAT ~ 1; b: NAT ~ 2; t: NAT ~ 3;
intensity: REAL ← RealFns.Sin[SCVary[
spot.val[x],
spot.val[y],
spot.val[z],
(spot.val[z] + 1.) / 2]*30 + 10*spot.val[x]
];
intensity ← (intensity + 1.0) / 2.0;
intensity ← 255.0 * RealFns.Power[intensity, 0.77];
RETURN[
[ R: Real.RoundC[spot.val[r] * intensity],
G: Real.RoundC[spot.val[g] * intensity],
B: Real.RoundC[spot.val[b] * intensity]
],
Real.RoundC[spot.val[t] * 255.0]
];
};
AddCrack: ScanConvert.GetColorProc ~ {
PROC[spot: Spot] RETURNS[RGB, REAL]
x: NAT ← spot.val.length-3; y: NAT ← x+1; z: NAT ← x+2; -- object space coordinate
r: NAT ~ 0; g: NAT ~ 1; b: NAT ~ 2; t: NAT ~ 3;
intensity: REAL;
IF RealFns.Cos[
SimpleChaos[spot.val[x], spot.val[y], spot.val[z] ]*10 + 3*spot.val[z]
] > 0. THEN
intensity ← 0. ELSE intensity ← 1.;
intensity ← 255.0 * intensity;
RETURN[
[ R: Real.RoundC[spot.val[r] * intensity],
G: Real.RoundC[spot.val[g] * intensity],
B: Real.RoundC[spot.val[b] * intensity]
],
Real.RoundC[spot.val[t] * 255.0]
];
};
AddBurlWood: PROC[spot: ScanConvert.Spot] RETURNS[ScanConvert.Spot] ~ {
x: NAT ← spot.val.length-3; y: NAT ← x+1; z: NAT ← x+2; -- object space coordinate
r: NAT ~ 0; g: NAT ~ 1; b: NAT ~ 2; t: NAT ~ 3;
red, grn, blu: REAL;
chaos: REAL ← Chaos[ spot.val[x], spot.val[y], spot.val[z] ];
midBrown: REAL ← RealFns.Sin[ chaos*8 + 7*spot.val[x] + 3* spot.val[y] ];
brownLayer: REAL ← ABS[ RealFns.Sin[midBrown] ];
greenLayer: REAL ← - brownLayer;
perturb: REAL ← IF brownLayer > 0.0
THEN ABS[RealFns.Sin[40 * chaos + 50*spot.val[z] ]]
ELSE ABS[RealFns.Sin[30 * chaos + 30*spot.val[x] ]];
brownPerturb: REAL ← perturb * .6 + .3;  -- perturb up to .6
greenPerturb: REAL ← perturb * .2 + .8;  -- perturb up to .2
grnPerturb: REAL ← perturb * .15 + .85;  -- perturb up to .15
grn ← .5 * RealFns.Power[ABS[brownLayer], 0.3]; -- makes seams
brownLayer ← RealFns.Power[(brownLayer + 1.0) / 2.0, 0.6] * brownPerturb;
greenLayer ← RealFns.Power[(greenLayer + 1.0) / 2.0, 0.6] * greenPerturb;
red ← (.6 * brownLayer + .35 * greenLayer) * 2 * grn;
blu ← (.25 * brownLayer + .35 * greenLayer) * 2 * grn;
grn ← grn * MAX[brownLayer, greenLayer] * grnPerturb;
spot.val[r] ← spot.val[r] * red;
spot.val[g] ← spot.val[g] * grn;
spot.val[b] ← spot.val[b] * blu;
RETURN[spot];
};
AddZebraBurl: PROC[spot: ScanConvert.Spot] RETURNS[ScanConvert.Spot] ~ {
x: NAT ← spot.val.length-3; y: NAT ← x+1; z: NAT ← x+2; -- object space coordinate
r: NAT ~ 0; g: NAT ~ 1; b: NAT ~ 2; t: NAT ~ 3;
red, grn, blu: REAL;
chaos: REAL ← Chaos[ spot.val[x], spot.val[y], spot.val[z] ];
midBrown: REAL ← RealFns.Sin[ chaos*8 + 7*spot.val[x] + 3* spot.val[y] ];
brownLayer: REAL ← RealFns.Sin[midBrown];
greenLayer: REAL ← - brownLayer;
perturb: REAL ← IF brownLayer > 0.0
THEN ABS[RealFns.Sin[40 * chaos + 50*spot.val[z] ]]
ELSE ABS[RealFns.Sin[24 * chaos + 30*spot.val[x] ]];
brownPerturb: REAL ← perturb * .6 + .3;  -- perturb up to .6
greenPerturb: REAL ← perturb * .2 + .8;  -- perturb up to .2
grnPerturb: REAL ← perturb * .15 + .85;  -- perturb up to .15
grn ← .5 * RealFns.Power[ABS[brownLayer], 0.3]; -- makes seams
brownLayer ← RealFns.Power[(brownLayer + 1.0) / 2.0, 0.6] * brownPerturb;
greenLayer ← RealFns.Power[(greenLayer + 1.0) / 2.0, 0.6] * greenPerturb;
red ← (.6 * brownLayer + .35 * greenLayer) * 2 * grn;
blu ← (.25 * brownLayer + .35 * greenLayer) * 2 * grn;
grn ← grn * MAX[brownLayer, greenLayer] * grnPerturb;
spot.val[r] ← spot.val[r] * red;
spot.val[g] ← spot.val[g] * grn;
spot.val[b] ← spot.val[b] * blu;
RETURN[spot];
};
AddMarble: PROC[spot: ScanConvert.Spot] RETURNS[ScanConvert.Spot] ~ {
Perlin's marble texture
x: NAT ← spot.val.length-3; y: NAT ← x+1; z: NAT ← x+2; -- object space coordinate
r: NAT ~ 0; g: NAT ~ 1; b: NAT ~ 2; t: NAT ~ 3;
intensity: REAL ← RealFns.Sin[Chaos[ spot.val[x],
           spot.val[y],
           spot.val[z] ]*8 + 7*spot.val[z]];
intensity ← (intensity + 1.0) / 2.0;
intensity ← RealFns.Power[intensity, 0.77];
spot.val[r] ← spot.val[r] * intensity;
spot.val[g] ← spot.val[g] * intensity;
spot.val[b] ← spot.val[b] * intensity;
RETURN[spot];
};
SCVary: PUBLIC PROC[x, y, z, p: REAL] RETURNS [REAL] ~ {
f: REAL ← 1.;
s, t: REAL ← 0.;
FOR n: INT IN [0..7) DO
s ← Noise[x * f, y * f, z * f];
s ← RealFns.Power[s * s, (p + 1.) / 2];
t ← t + s / f;
f ← 2 * f;
ENDLOOP;
RETURN [t];
};
Swirl: PUBLIC PROC[x, y, z: REAL] RETURNS [REAL] ~ {
f: REAL ← 1.;
s, t: REAL ← 0.;
FOR n: INT IN [0..7) DO
s ← Noise[x * f, y * f, z * f];
t ← t + s * s / f;
f ← 2 * f;
ENDLOOP;
RETURN [t];
};
SimpleChaos: PUBLIC PROC[x, y, z: REAL] RETURNS [REAL] ~ {
f: REAL ← 1.;
s, t: REAL ← 0.;
FOR n: INT IN [0..7) DO
s ← SimpleNoise[x * f, y * f, z * f];
t ← t + ABS[s] / f;
f ← 2 * f;
ENDLOOP;
RETURN [t];
};
Chaos: PUBLIC PROC[x, y, z: REAL] RETURNS [REAL] ~ {
f: REAL ← 1.;
s, t: REAL ← 0.;
FOR n: INT IN [0..7) DO
s ← Noise[x * f, y * f, z * f];
t ← t + ABS[s] / f;
f ← 2 * f;
ENDLOOP;
RETURN [t];
};
realScale: REAL ← 2.0 / LAST[CARDINAL];
RTable: TYPE ~ RECORD[SEQUENCE length: NAT OF REAL];
rTable: REF RTable ← NIL;
SimpleNoise: PUBLIC PROC[vx, vy, vz: REAL] RETURNS [REAL] ~ {
returns band limited noise over R3.
R: PROC[i, j, k: REAL] RETURNS [CARDINAL] ~ TRUSTED {
A: TYPE ~ ARRAY [0..3) OF REAL;
a: A ← [i * .12345 , j * .12345 , k * .12345 ];
aPointer: LONG POINTER ~ @a;
h: CARDINAL ← Checksum.ComputeChecksum[nWords: SIZE[A], p: aPointer];
RETURN [h];
};
SCurve: PROC[x: REAL] RETURNS [REAL] ~ {
map the unit interval into an "S shaped" cubic f[x] | f[0]=0, f'[0]=0, f[1]=1, f'[1]=0.
RETURN [x * x * (3 - 2 * x)];
};
declare local variables.
ix, iy, iz: INT;
x, y, z, jx, jy, jz, sx, sy, sz, tx, ty, tz, s, f: REAL;
Force everything to be positive
x ← vx + 1000.;
y ← vy + 1000.;
z ← vz + 1000.;
ixyz ← the integer lattice point "just below" v (identifies the surrounding unit cube).
ix ← Real.Fix[x];
iy ← Real.Fix[y];
iz ← Real.Fix[z];
sxyz ← the vector difference v - ixyz biased with an S-Curve in each dimension.
sx ← SCurve[x - ix];
sy ← SCurve[y - iy];
sz ← SCurve[z - iz];
txyz ← the complementary set of S-Curves in each dimension.
tx ← 1. - sx;
ty ← 1. - sy;
tz ← 1. - sz;
f ← 0.; -- initialize sum to zero.
FOR n: INT IN [0..8) DO -- sum together 8 local fields from neighboring lattice pts.
SELECT n FROM -- each of 8 corners of the surrounding unit cube.
0 => {jx ← ix  ; jy ← iy  ; jz ← iz  ; s ← tx * ty * tz };
1 => {jx ← ix+1          ; s ← sx * ty * tz };
2 => {jx ← ix  ; jy ← iy+1      ; s ← tx * sy * tz };
3 => {jx ← ix+1          ; s ← sx * sy * tz };
4 => {jx ← ix  ; jy ← iy  ; jz ← iz+1 ; s ← tx * ty * sz };
5 => {jx ← ix+1          ; s ← sx * ty * sz };
6 => {jx ← ix  ; jy ← iy+1     ; s ← tx * sy * sz };
7 => {jx ← ix+1         ; s ← sx * sy * sz };
ENDCASE;
Add in each weighted component
f ← f + s * (R[jx, jy, jz] * realScale - 1.0);
ENDLOOP;
RETURN [f];
};
Noise: PUBLIC PROC[vx, vy, vz: REAL] RETURNS [REAL] ~ {
returns band limited noise over R3.
R: PROC[i, j, k: REAL] RETURNS [CARDINAL] ~ TRUSTED {
A: TYPE ~ ARRAY [0..3) OF REAL;
a: A ← [i * .12345 , j * .12345 , k * .12345 ];
aPointer: LONG POINTER ~ @a;
h: CARDINAL ← Checksum.ComputeChecksum[nWords: SIZE[A], p: aPointer];
RETURN [h];
};
SCurve: PROC[x: REAL] RETURNS [REAL] ~ {
map the unit interval into an "S shaped" cubic f[x] | f[0]=0, f'[0]=0, f[1]=1, f'[1]=0.
RETURN [x * x * (3 - 2 * x)];
};
declare local variables.
m: NAT;
ix, iy, iz: INT;
x, y, z, jx, jy, jz, sx, sy, sz, tx, ty, tz, s, f: REAL;
initialize random gradient table
IF rTable = NIL THEN {
rTable ← NEW[RTable[259]];
FOR n:INT IN [0..259) DO
r:REAL ← n;
rTable[n] ← R[r, r, r] * realScale - 1.;
ENDLOOP;
};
Force everything to be positive
x ← vx + 1000.;
y ← vy + 1000.;
z ← vz + 1000.;
ixyz ← the integer lattice point "just below" v (identifies the surrounding unit cube).
ix ← Real.Fix[x];
iy ← Real.Fix[y];
iz ← Real.Fix[z];
sxyz ← the vector difference v - ixyz biased with an S-Curve in each dimension.
sx ← SCurve[x - ix];
sy ← SCurve[y - iy];
sz ← SCurve[z - iz];
txyz ← the complementary set of S-Curves in each dimension.
tx ← 1. - sx;
ty ← 1. - sy;
tz ← 1. - sz;
f ← 0.; -- initialize sum to zero.
FOR n: INT IN [0..8) DO -- sum together 8 local fields from neighboring lattice pts.
SELECT n FROM -- each of 8 corners of the surrounding unit cube.
0 => {jx ← ix  ; jy ← iy  ; jz ← iz  ; s ← tx * ty * tz };
1 => {jx ← ix+1          ; s ← sx * ty * tz };
2 => {jx ← ix  ; jy ← iy+1      ; s ← tx * sy * tz };
3 => {jx ← ix+1          ; s ← sx * sy * tz };
4 => {jx ← ix  ; jy ← iy  ; jz ← iz+1 ; s ← tx * ty * sz };
5 => {jx ← ix+1          ; s ← sx * ty * sz };
6 => {jx ← ix  ; jy ← iy+1     ; s ← tx * sy * sz };
7 => {jx ← ix+1         ; s ← sx * sy * sz };
ENDCASE;
Add in each weighted component
m ← R[jx, jy, jz] MOD 256;
f ← f + s * ( rTable[m]/2 + rTable[m+1]*(x-jx) +
    rTable[m+2]*(y-jy) + rTable[m+3]*(z-jz) );
ENDLOOP;
RETURN [f];
};
END.