<> <> <> <> <> 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 ~ { <> <> 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 ~ { <> <> 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: 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 ~ { <> <> 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 ~ { <> 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 ~ { <> <> 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 ~ { <> 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 ~ { <> 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] ~ { <> 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] ~ { <> 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] ~ { <> <> 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] ~ { <> 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] ~ { <