ShadingProcs.mesa
Copyright Ó 1987 by Xerox Corporation. All rights reserved.
Example SpotProcs for solid texturing
Last Edited by: Crow, September 6, 1989 5:56:51 pm PDT
Perlin, August 5, 1985 0:23:18 am PDT
DIRECTORY Atom, Checksum, G3dMappedAndSolidTexture, G3dMatrix, G3dRender, Real, RealFns;
ShadingProcs: CEDAR PROGRAM
IMPORTS Atom, Checksum, G3dMappedAndSolidTexture, G3dMatrix, Real, RealFns
~ BEGIN
RGB:     TYPE ~ G3dRender.RGB;
Matrix:   TYPE ~ G3dRender.Matrix;
RealSequence: TYPE ~ G3dRender.RealSequence;
SpotProc:   TYPE ~ G3dRender.SpotProc;
Shape:   TYPE ~ G3dRender.Shape;
ShadingClass: TYPE ~ G3dRender.ShadingClass;
GetProp: PROC [propList: Atom.PropList, prop: REF ANY] RETURNS [REF ANY] ~
                     Atom.GetPropFromList;
                    
Sqr: PROCEDURE [number: REAL] RETURNS [REAL] ~ INLINE { RETURN[number * number]; };
Log2: PROC [n: INT] RETURNS [lg: NAT ← 0] ~ {-- finds log base 2 of input (from M. Plass)
nn: CARD32 ~ n;
k: CARD32 ← 1;
UNTIL k=0 OR k>= nn DO
lg ← lg + 1;
k ← k + k;
ENDLOOP;
};
RegisterEverything: PROC[] ~ {
G3dMappedAndSolidTexture.RegisterTextureFunction[ $GreenSpotsAMoving,
                     GreenSpotsAMoving ];
G3dMappedAndSolidTexture.RegisterTextureFunction[ $GreenSpots, GreenSpots ];
G3dMappedAndSolidTexture.RegisterTextureFunction[ $ChecksAMoving, ChecksAMoving ];
G3dMappedAndSolidTexture.RegisterTextureFunction[ $Checks, Checks ];
G3dMappedAndSolidTexture.RegisterTextureFunction[ $Swirl, Swirl ];
G3dMappedAndSolidTexture.RegisterTextureFunction[ $Segue, Segue ];
G3dMappedAndSolidTexture.RegisterTextureFunction[ $Crack, Crack ];
G3dMappedAndSolidTexture.RegisterTextureFunction[ $BurlWood, BurlWood ];
G3dMappedAndSolidTexture.RegisterTextureFunction[ $PartialBurl, PartialBurl ];
G3dMappedAndSolidTexture.RegisterTextureFunction[ $ZebraBurlAMoving,
                     ZebraBurlAMoving ];
G3dMappedAndSolidTexture.RegisterTextureFunction[ $ZebraBurl, ZebraBurl ];
G3dMappedAndSolidTexture.RegisterTextureFunction[ $Marble, Marble ];
G3dMappedAndSolidTexture.RegisterTextureFunction[ $TestNoise, TestNoise ];
G3dMappedAndSolidTexture.RegisterTextureFunction[ $TestOneOverFNoise,
                     TestOneOverFNoise ];
};
GreenSpotsAMoving: SpotProc ~ {
PROC[context: 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: Matrix ← NARROW[ GetProp[NARROW[data], $Shape], Shape].matrix ;
[[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: 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: 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: Matrix ← NARROW[ GetProp[NARROW[data], $Shape], Shape].matrix ;
[[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: 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];
};
};
Swirl: SpotProc ~ {
PROC[context: 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[
SimpleOneOverFNoise[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 ← OneOverFNoise[ 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;
radius: REAL ← ( spot.xIncr[x] + spot.xIncr[y] + spot.xIncr[z]
    + spot.yIncr[x] + spot.yIncr[y] + spot.yIncr[z] ) / 2.0;
chaos: REAL ← OneOverFNoise[ spot.val[x], spot.val[y], spot.val[z], radius ];
midBrown: REAL ← RealFns.Sin[ chaos*8 + 7*spot.val[x] + 3* spot.val[y] ];
brownLayer: REAL ← RealFns.Sin[midBrown];
IF brownLayer > 0.0 THEN {
brownPerturb, greenPerturb, grnPerturb: REAL;
greenLayer: REAL ← - brownLayer;
perturb: REAL ← ABS[RealFns.Sin[40 * chaos + 50*spot.val[z] ]];
IF radius < 1.0/64.0 THEN {
a: REAL ← MAX[0.4, 64.0*radius]; -- blend with undertexture when < 1/64
perturb ← perturb * (a + (1.0-a)*ABS[RealFns.Sin[40*chaos + 150*spot.val[x]]])
};
IF radius < 1.0/256.0 THEN {
a: REAL ← 256.0 * MAX[0.0, 2*(radius-1.0/768.0)]; -- blend with undertexture when < 1/256
perturb ← perturb * (a + (1.0-a)*ABS[RealFns.Sin[900*chaos + 900*spot.val[x]]])
};
IF radius < 1.0/1024.0 THEN {
a: REAL ← MAX[0.5, 1024.0*radius]; -- blend undertexture when < 1/1024
adjust: REAL ← RealFns.Sin[25000*chaos + 25000*spot.val[z]];
IF adjust > 0.0
THEN perturb ← a * perturb + (1.0-a) * (perturb + (1.0 - perturb)*adjust)
ELSE perturb ← a * perturb + (1.0-a) * (perturb + perturb*adjust);
};
brownPerturb ← perturb * .6 + .3;  -- perturb up to .6
greenPerturb ← perturb * .2 + .8;  -- perturb up to .2
grnPerturb ← 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: 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: Matrix ← NARROW[ GetProp[NARROW[data], $Shape], Shape].matrix ;
[[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, brownPerturb, greenPerturb, grnPerturb: REAL;
radius: REAL ← ( ABS[spot.xIncr[x]] + ABS[spot.xIncr[y]] + ABS[spot.xIncr[z]]
    + ABS[spot.yIncr[x]] + ABS[spot.yIncr[y]] + ABS[spot.yIncr[z]] ) / 2.0;
chaos: REAL ← OneOverFNoise[ spot.val[x]-.5, spot.val[y], spot.val[z], 40*radius ];
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   -- should be integrated when radius large
THEN ABS[RealFns.Sin[40 * chaos + 50*spot.val[z] ]]
ELSE ABS[RealFns.Sin[24 * chaos + 30*spot.val[x] ]];
IF radius < 1.0/64.0 THEN {
a: REAL ← MAX[0.4, 64.0*radius]; -- blend with undertexture when < 1/64
IF brownLayer > 0.0
THEN perturb ← perturb * (a + (1.0-a)*ABS[RealFns.Sin[40*chaos + 150*spot.val[x]]])
ELSE perturb ← perturb * (a + (1.0-a)*ABS[RealFns.Sin[24*chaos + 90*spot.val[z]]]);
};
IF radius < 1.0/256.0 THEN {
a: REAL ← 256.0 * MAX[0.0, 2*(radius-1.0/768.0)]; -- blend with undertexture when < 1/256
IF brownLayer > 0.0
THEN perturb ← perturb * (a + (1.0-a)*ABS[RealFns.Sin[900*chaos + 900*spot.val[x]]])
ELSE perturb ← perturb * (a + (1.0-a)*ABS[RealFns.Sin[900*chaos + 900*spot.val[z]]]);
};
IF radius < 1.0/1024.0 THEN {
a: REAL ← MAX[0.5, 1024.0*radius]; -- blend undertexture when < 1/1024
adjust: REAL;
IF brownLayer > 0.0
THEN adjust ← RealFns.Sin[25000*chaos + 25000*spot.val[z]]
ELSE adjust ← RealFns.Sin[25000*chaos + 25000*spot.val[x]];
IF adjust > 0.0
THEN perturb ← a * perturb + (1.0-a) * (perturb + (1.0 - perturb)*adjust)
ELSE perturb ← a * perturb + (1.0-a) * (perturb + perturb*adjust);
};
brownPerturb ← perturb * .6 + .3;  -- perturb up to .6
greenPerturb ← perturb * .2 + .8;  -- perturb up to .2
grnPerturb ← 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[OneOverFNoise[ 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;
};
mult: REAL ← 1.0;      -- multiplier for looking at noise at different scales
TestNoise: SpotProc ~ {
PROC[context: 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; -- texture space coordinate
r: NAT ~ 0; g: NAT ~ 1; b: NAT ~ 2; t: NAT ~ 3;
intensity: REAL ← Noise[ mult*spot.val[x], mult*spot.val[y], mult*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;
};
TestOneOverFNoise: SpotProc ~ {
x: NAT ← spot.val.length-3; y: NAT ← x+1; z: NAT ← x+2; -- texture space coordinate
r: NAT ~ 0; g: NAT ~ 1; b: NAT ~ 2; t: NAT ~ 3;
radius: REAL ← ( spot.xIncr[x] + spot.xIncr[y] + spot.xIncr[z]
    + spot.yIncr[x] + spot.yIncr[y] + spot.yIncr[z] ) / 2.0;
intensity: REAL ← OneOverFNoise[ spot.val[x], spot.val[y], spot.val[z], radius ];
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;
};
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];
};
noiseType: ATOM ← $Plain;
bulgeUp: BOOLEAN ← TRUE;  -- when true, summations use ABS and start from zero
OneOverFNoise: PROC[x, y, z: REAL, radius: REAL ← 0.006] RETURNS [REAL] ~ {
SELECT noiseType FROM
$Plain => RETURN[PlainOneOverFNoise[x, y, z]];
$Simple => RETURN[SimpleOneOverFNoise[x, y, z]];
$Limited => RETURN[LimitedOneOverFNoise[x, y, z, radius]];
$DblOctave => RETURN[DblOctaveOneOverFNoise[x, y, z]];
ENDCASE => RETURN[(1.0 + RealFns.Sin[x*8])/2.0];  -- give 'em something for screwups
};
SimpleOneOverFNoise: 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];
};
PlainOneOverFNoise: PROC[x, y, z: REAL] RETURNS [REAL] ~ {
Calculates seven octaves of 1/f noise
f: REAL ← 1.;
s, t: REAL ← 0.;
FOR n: INT IN [0..7) DO
s ← Noise[x * f, y * f, z * f] / f;
t ← IF bulgeUp THEN t + ABS[s] ELSE t + s;
f ← 2 * f;
ENDLOOP;
RETURN [t];
};
DblOctaveOneOverFNoise: PROC[x, y, z: REAL] RETURNS [REAL] ~ {
Calculates five double octaves of 1/f noise
f: REAL ← 1.;
s, t: REAL ← 0.;
FOR n: INT IN [0..5) DO
s ← Noise[x * f, y * f, z * f] / f;
t ← IF bulgeUp THEN t + ABS[s] ELSE t + s;
f ← 4 * f;
ENDLOOP;
RETURN [t];
};
lx, ly, lz: REAL ← 0.0; pSums: ARRAY [0..6) OF REAL ← ALL[0.0];
LimitedOneOverFNoise: PROC[x, y, z, radius: REAL ← 0.006] RETURNS [REAL] ~ {
Calculates up to six octaves of 1/f noise, stopping when radius indicates extra detail unusable
Saves lower octave sums to reuse when last position was nearby
f, s, a: REAL ← 1.0;
t: REAL ← IF bulgeUp THEN 0.0 ELSE 0.5;  -- initial value for result summation
start: INTEGER ← 0;
recip: REAL ← IF radius < 0.006 THEN 64.0 ELSE MAX[1.0, 1.0 / (3*radius)];
limit: INTEGER ← Log2[Real.Round[recip]];
distance: REAL ← ABS[x-lx] + ABS[y-ly] + ABS[z-lz];
SELECT TRUE FROM
distance <= .015625/3.0 => RETURN[pSums[5]];
distance <= 0.03125/3.0 => { start ← 5; t ← pSums[4] };
distance <= 0.06250/3.0 => { start ← 4; t ← pSums[3] };
distance <= 0.12500/3.0 => { start ← 3; t ← pSums[2] };
distance <= 0.25000/3.0 => { start ← 2; t ← pSums[1] };
distance <= 0.50000/3.0 => { start ← 1; t ← pSums[0] };
ENDCASE => { lx ← x; ly ← y; lz ← lz; start ← 0; };
FOR n: NAT IN [0..start) DO f ← 2 * f; ENDLOOP;
FOR n: NAT IN [start..limit) DO      -- sum to finer detail from midpoint
s ← Noise[x*f, y*f, z*f] / f;
t ← IF bulgeUp THEN t + ABS[s] ELSE t + s;
f ← 2 * f;
pSums[n] ← t;
ENDLOOP;
RETURN [MIN[1.0, MAX[0.0, 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.