<> <> <> <> <> 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 ~ { <> <> 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 ~ { <> <> 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); <> 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 ~ { <> <> 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 ~ { <> <> 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 ~ { <> 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 ~ { <> 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 ~ { <> <> 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 ~ { <> 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] ~ { <> 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] ~ { <> RETURN [x * x * (3 - 2 * x)]; }; <> ix, iy, iz: INT; x, y, z, jx, jy, jz, sx, sy, sz, tx, ty, tz, s, f: REAL; <> x _ vx + 1000.; y _ vy + 1000.; z _ vz + 1000.; <> ix _ Real.Fix[x]; iy _ Real.Fix[y]; iz _ Real.Fix[z]; <> sx _ SCurve[x - ix]; sy _ SCurve[y - iy]; sz _ SCurve[z - iz]; <> 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; <> f _ f + s * (R[jx, jy, jz] * realScale - 1.0); ENDLOOP; RETURN [f]; }; Noise: PUBLIC PROC[vx, vy, vz: REAL] RETURNS [REAL] ~ { <> 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] ~ { <> RETURN [x * x * (3 - 2 * x)]; }; <> m: NAT; ix, iy, iz: INT; x, y, z, jx, jy, jz, sx, sy, sz, tx, ty, tz, s, f: REAL; <> 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; }; <> x _ vx + 1000.; y _ vy + 1000.; z _ vz + 1000.; <> ix _ Real.Fix[x]; iy _ Real.Fix[y]; iz _ Real.Fix[z]; <> sx _ SCurve[x - ix]; sy _ SCurve[y - iy]; sz _ SCurve[z - iz]; <> 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; <> 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.