ShadingProcs.mesa
Copyright Ó 1987 by Xerox Corporation. All rights reserved.
Example SpotProcs for solid texturing
Last Edited by: Crow, March 15, 1989 5:24:45 pm PST
Perlin, August 5, 1985 0:23:18 am PDT
DIRECTORY
Atom     USING [ GetPropFromList, PropList ],
Checksum   USING [ ComputeChecksum ],
Real     USING [ Fix ],
RealFns    USING [ Sin, Cos, Power ],
G3dMatrix    USING [ Transform ],
ThreeDBasics  USING [ RGB, RealSequence, ShadingClass, ShapeInstance, Spot, SpotProc,
         Xfm3D ],
MappedAndSolidTexture USING [ RegisterTextureFunction ];
ShadingProcs: CEDAR PROGRAM
IMPORTS Atom, Checksum, G3dMatrix, Real, RealFns, MappedAndSolidTexture
~ BEGIN
RGB: TYPE ~ ThreeDBasics.RGB;
Xfm3D: TYPE ~ ThreeDBasics.Xfm3D;
RealSequence: TYPE ~ ThreeDBasics.RealSequence;
SpotProc: TYPE ~ ThreeDBasics.SpotProc;
ShapeInstance: TYPE ~ ThreeDBasics.ShapeInstance;
ShadingClass: TYPE ~ ThreeDBasics.ShadingClass;
GetProp: PROC [propList: Atom.PropList, prop: REF ANY] RETURNS [REF ANY] ~
                     Atom.GetPropFromList;
                    
RegisterEverything: PROC[] ~ {
MappedAndSolidTexture.RegisterTextureFunction[ $GreenSpotsAMoving, GreenSpotsAMoving ];
MappedAndSolidTexture.RegisterTextureFunction[ $GreenSpots, GreenSpots ];
MappedAndSolidTexture.RegisterTextureFunction[ $ChecksAMoving, ChecksAMoving ];
MappedAndSolidTexture.RegisterTextureFunction[ $Checks, Checks ];
MappedAndSolidTexture.RegisterTextureFunction[ $ApplyNoise, ApplyNoise ];
MappedAndSolidTexture.RegisterTextureFunction[ $Swirl, Swirl ];
MappedAndSolidTexture.RegisterTextureFunction[ $Segue, Segue ];
MappedAndSolidTexture.RegisterTextureFunction[ $Crack, Crack ];
MappedAndSolidTexture.RegisterTextureFunction[ $BurlWood, BurlWood ];
MappedAndSolidTexture.RegisterTextureFunction[ $PartialBurl, PartialBurl ];
MappedAndSolidTexture.RegisterTextureFunction[ $ZebraBurlAMoving, ZebraBurlAMoving ];
MappedAndSolidTexture.RegisterTextureFunction[ $ZebraBurl, ZebraBurl ];
MappedAndSolidTexture.RegisterTextureFunction[ $Marble, Marble ];
};
GreenSpotsAMoving: SpotProc ~ {
PROC[context: REF Context, spot: REF Spot, data: REF ANY ← NIL]
Regular array of opaque green spots moves over surface with transform
x: NAT ← spot.val.length-3; y: NAT ← x+1; z: NAT ← x+2; -- object space coordinate
xfm: Xfm3D ← NARROW[ GetProp[NARROW[data], $Shape], REF ShapeInstance].position ;
[[spot.val[x], spot.val[y], spot.val[z]]] ← G3dMatrix.Transform[
[spot.val[x], spot.val[y], spot.val[z]], xfm
];
GreenSpots[context, shading, spot];
};
GreenSpots: SpotProc ~ {
PROC[context: REF Context, shading: REF ShadingClass, spot: REF Spot, data: REF ANY ← NIL]
Regular array of opaque green spots over whatever lies underneath (for layered textures)
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;
transmittance, 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;
transmittance ← intensity ← (1.0 - intensity);
Blend with underlying color using transmittance
spot.val[r] ← intensity + transmittance * (spot.val[r] - intensity);
spot.val[g] ← 1.0 + transmittance * (spot.val[g] - 1.0);        -- leave green
spot.val[b] ← intensity + transmittance * (spot.val[b] - intensity);
spot.val[t] ← spot.val[t] * transmittance;
};
ChecksAMoving: SpotProc ~ {
PROC[context: REF Context, shading: REF ShadingClass, spot: REF Spot, data: REF ANY ← NIL]
Regular array of opaque green spots moves over surface with transform
x: NAT ← spot.val.length-3; y: NAT ← x+1; z: NAT ← x+2; -- object space coordinate
xfm: Xfm3D ← NARROW[ GetProp[NARROW[data], $Shape], REF ShapeInstance].position ;
[[spot.val[x], spot.val[y], spot.val[z]]] ← G3dMatrix.Transform[
[spot.val[x], spot.val[y], spot.val[z]], xfm
];
Checks[context, shading, spot];
};
Checks: SpotProc ~ {
PROC[context: REF Context, shading: REF ShadingClass, spot: REF Spot, data: REF ANY ← NIL]
Cube tesselation of 3-space
newClr: RGB ← [0.4, 0.9, 0.2];          -- sort of lightish green
otherClr: RGB ← [0.9, 0.2, 0.2];          -- sort of very red
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;
chooseNewClr: BOOLEAN;
intensityX: BOOLEAN ← ABS[Real.Fix[8.0 * spot.val[x] ] MOD 2] = 1;  -- vary in x
intensityY: BOOLEAN ← ABS[Real.Fix[8.0 * spot.val[y] ] MOD 2] = 1;  -- vary in y
intensityZ: BOOLEAN ← ABS[Real.Fix[8.0 * spot.val[z] ] MOD 2] = 1;  -- vary in z
IF spot.val[x] < 0.0 THEN intensityX ← NOT intensityX;  -- correct for negative MOD
IF spot.val[y] < 0.0 THEN intensityY ← NOT intensityY;
IF spot.val[z] < 0.0 THEN intensityZ ← NOT intensityZ;
chooseNewClr ← (intensityX # intensityY) # intensityZ;   -- parity (XOR) fn.
IF chooseNewClr
THEN {  -- new color
spot.val[r] ← newClr.R * spot.val[r];
spot.val[g] ← newClr.G * spot.val[g];
spot.val[b] ← newClr.B * spot.val[b];
}
ELSE {  -- other color
spot.val[r] ← otherClr.R * spot.val[r];
spot.val[g] ← otherClr.G * spot.val[g];
spot.val[b] ← otherClr.B * spot.val[b];
};
};
ApplyNoise: SpotProc ~ {
PROC[context: REF Context, shading: REF ShadingClass, spot: REF Spot, data: REF ANY ← NIL]
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;
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.;
spot.val[r] ← spot.val[r] * intensity;
spot.val[g] ← spot.val[g] * intensity;
spot.val[b] ← spot.val[b] * intensity;
};
Swirl: SpotProc ~ {
PROC[context: REF Context, shading: REF ShadingClass, spot: REF Spot, data: REF ANY ← NIL]
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;
intensity: REAL ← RealFns.Sin[Swirler[ spot.val[x],
           spot.val[y],
           spot.val[z] ]*30 + 10*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;
};
Segue: SpotProc ~ {
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;
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 ← 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;
};
Crack: SpotProc ~ {
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.;
spot.val[r] ← spot.val[r] * intensity;
spot.val[g] ← spot.val[g] * intensity;
spot.val[b] ← spot.val[b] * intensity;
};
BurlWood: SpotProc ~ {
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;
};
PartialBurl: SpotProc ~ {
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;
transmittance: 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];
IF brownLayer > 0.0 THEN {
greenLayer: REAL ← - brownLayer;
perturb: REAL ← ABS[RealFns.Sin[40 * chaos + 50*spot.val[z] ]];
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;
transmittance ← MAX[0.0, 4.0 * (.25 - brownLayer)]; -- blend where brownLayer < .25
spot.val[r] ← red + transmittance * (spot.val[r] - red);
spot.val[g] ← grn + transmittance * (spot.val[g] - grn);
spot.val[b] ← blu + transmittance * (spot.val[b] - blu);
spot.val[t] ← spot.val[t] * transmittance;
spot.partShiny ← spot.partShiny * transmittance;    -- no hilite, dull texture
};
};
ZebraBurlAMoving: SpotProc ~ {
PROC[context: REF Context, shading: REF ShadingClass, spot: REF Spot, data: REF ANY ← NIL]
Regular array of opaque green spots moves over surface with transform
x: NAT ← spot.val.length-3; y: NAT ← x+1; z: NAT ← x+2; -- object space coordinate
xfm: Xfm3D ← NARROW[ GetProp[NARROW[data], $Shape], REF ShapeInstance].position ;
[[spot.val[x], spot.val[y], spot.val[z]]] ← G3dMatrix.Transform[
[spot.val[x], spot.val[y], spot.val[z]], xfm
];
ZebraBurl[context, shading, spot];
};
ZebraBurl: SpotProc ~ {
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;
};
Marble: SpotProc ~ {
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;
};
SCVary: 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];
};
Swirler: 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: 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: 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 TO A ~ @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];
};
RegisterEverything[];
END.