SolidTexturesImpl:
CEDAR
PROGRAM
IMPORTS Rope, Atom, Checksum, Real, RealFns, ScanConvert, TextureMaps, Tilers, SolidTextures
EXPORTS SolidTextures
~ BEGIN
RealSequence: TYPE ~ ThreeDBasics.RealSequence;
RGB: TYPE ~ ThreeDBasics.RGB;
SolidTexturesError: PUBLIC SIGNAL [reason: ATOM] = CODE;
RopeToProc:
PUBLIC
PROC[ name: Rope.
ROPE]
RETURNS[ScanConvert.GetColorProc] ~ {
SELECT
TRUE
FROM
Rope.Equal[ "Spots", name, FALSE] => RETURN[SolidTextures.Spots];
Rope.Equal[ "Wurlitzer", name, FALSE] => RETURN[SolidTextures.Wurlitzer];
Rope.Equal[ "TwistedStripes", name, FALSE] => RETURN[SolidTextures.TwistedStripes];
Rope.Equal[ "BurlWood", name, FALSE] => RETURN[SolidTextures.BurlWood];
Rope.Equal[ "ZebraBurl", name, FALSE] => RETURN[SolidTextures.ZebraBurl];
Rope.Equal[ "Marble", name, FALSE] => RETURN[SolidTextures.Marble];
ENDCASE;
SIGNAL SolidTexturesError[$ProcNotFound];
RETURN[NIL];
};
ProcToRope:
PUBLIC
PROC[ proc: ScanConvert.GetColorProc]
RETURNS[Rope.
ROPE] ~ {
SELECT
TRUE
FROM
proc = SolidTextures.Spots => RETURN["Spots"];
proc = SolidTextures.Wurlitzer => RETURN["Wurlitzer"];
proc = SolidTextures.TwistedStripes => RETURN["TwistedStripes"];
proc = SolidTextures.BurlWood => RETURN["BurlWood"];
proc = SolidTextures.ZebraBurl => RETURN["ZebraBurl"];
proc = SolidTextures.Marble => RETURN["Marble"];
proc = Spots => RETURN["Spots"]; -- sometimes wants impl procs
proc = Wurlitzer => RETURN["Wurlitzer"];
proc = TwistedStripes => RETURN["TwistedStripes"];
proc = BurlWood => RETURN["BurlWood"];
proc = ZebraBurl => RETURN["ZebraBurl"];
proc = Marble => RETURN["Marble"];
ENDCASE;
SIGNAL SolidTexturesError[$ProcNotFound];
RETURN[NIL];
};
GetLerpedVals:
PUBLIC 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:
PUBLIC ScanConvert.GetColorProc ~ {
RETURN RecoverColor[spot, AddSpots];
};
Wurlitzer:
PUBLIC ScanConvert.GetColorProc ~ {
RETURN RecoverColor[spot, AddWurlitzer];
};
TwistedStripes:
PUBLIC ScanConvert.GetColorProc ~ {
RETURN RecoverColor[spot, AddTwistedStripes];
};
BurlWood:
PUBLIC ScanConvert.GetColorProc ~ {
RETURN RecoverColor[spot, AddBurlWood];
};
ZebraBurl:
PUBLIC ScanConvert.GetColorProc ~ {
RETURN RecoverColor[spot, AddZebraBurl];
};
Marble:
PUBLIC 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];
};
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];
};
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];
};
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;
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 ARRAY [0..3) OF REAL ~ @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.