<> <> <> DIRECTORY Atom USING [ GetPropFromList, PropList, PutPropOnList, RemPropFromList ], List USING [ Nconc1 ], Rope USING [ ROPE, Equal ], Real USING [ Fix, Float, LargestNumber ], RealFns USING [ ArcTanDeg, Sin, Cos, Power, SqRt ], Checksum USING [ ComputeChecksum ], IO USING [ GetAtom, GetInt, GetReal, STREAM ], ImagerPixel USING [ GetPixels, ObtainScratchPixels, PixelBuffer, PixelMap, ReleaseScratchPixels ], ImagerSample USING [ SampleBuffer ], Vector2 USING [ Dot, Length, Mul, Unit ], G3dVector USING [ Cross, Normalize ], ScanConvert USING [ justNoticeable ], ThreeDBasics USING [ Box, Context, Error, IntSequence, LoadShadingClass, Pair, PairSequence, Patch, PtrPatchSequence, RealSequence, Rectangle, RegisterShadingClass, RGB, ShadingClass, ShapeClass, ShapeInstance, ShapeProc, Spot, SpotProc, SummedTexture, SumSequence, TextureFunction, TextureMap, Triple, TripleSequence, VertexInfo, VertexInfoProc, VertexInfoSequence, VtxToRealSeqProc ], RenderWithPixels USING [ AntiAliasing, GetContext, AllocatePixelMemory, ShadeSpot ], SurfaceRender USING [ ValidateContext ], ShapeUtilities USING [ ShadeVtx ], SceneUtilities USING [ FindShape, GetRope ], AISAnimation USING [ GetAIS ], MappedAndSolidTexture USING [ ]; MappedAndSolidTextureImpl: CEDAR PROGRAM IMPORTS AISAnimation, Atom, Checksum, G3dVector, ImagerPixel, IO, List, Real, RealFns, RenderWithPixels, Rope, SceneUtilities, ShapeUtilities, SurfaceRender, ThreeDBasics, Vector2 EXPORTS MappedAndSolidTexture = BEGIN <> Context: TYPE ~ ThreeDBasics.Context; RGB: TYPE ~ ThreeDBasics.RGB; Box: TYPE ~ ThreeDBasics.Box; Rectangle: TYPE ~ ThreeDBasics.Rectangle; Pair: TYPE ~ ThreeDBasics.Pair; -- [ x, y: REAL]; PairSequence: TYPE ~ ThreeDBasics.PairSequence; Triple: TYPE ~ ThreeDBasics.Triple; -- [ x, y, z: REAL] TripleSequence: TYPE ~ ThreeDBasics.TripleSequence; VertexInfo: TYPE ~ ThreeDBasics.VertexInfo; VertexInfoSequence: TYPE ~ ThreeDBasics.VertexInfoSequence; IntSequence: TYPE ~ ThreeDBasics.IntSequence; RealSequence: TYPE ~ ThreeDBasics.RealSequence; TextureFunction: TYPE ~ ThreeDBasics.TextureFunction; TextureMap: TYPE ~ ThreeDBasics.TextureMap; SumSequence: TYPE ~ ThreeDBasics.SumSequence; SummedTexture: TYPE ~ ThreeDBasics.SummedTexture; Patch: TYPE ~ ThreeDBasics.Patch; Spot: TYPE ~ ThreeDBasics.Spot; SpotProc: TYPE ~ ThreeDBasics.SpotProc; ShadingClass: TYPE ~ ThreeDBasics.ShadingClass; ShapeInstance: TYPE ~ ThreeDBasics.ShapeInstance; ShapeProc: TYPE ~ ThreeDBasics.ShapeProc; LORA: TYPE = LIST OF REF ANY; Swap: PROCEDURE [p: Pair] RETURNS [Pair] ~ INLINE { RETURN[ [p.y, p.x] ]; }; Sqr: PROCEDURE [number: REAL] RETURNS [REAL] ~ INLINE { RETURN[number * number]; }; Sgn: PROCEDURE [number: REAL] RETURNS [REAL] ~ INLINE { IF number < 0. THEN RETURN[-1.] ELSE RETURN[1.]; }; <> GetProp: PROC [propList: Atom.PropList, prop: REF ANY] RETURNS [REF ANY] ~ Atom.GetPropFromList; PutProp: PROC [propList: Atom.PropList, prop: REF ANY, val: REF ANY] RETURNS [Atom.PropList] ~ Atom.PutPropOnList; <> justNoticeable: REAL ~ ScanConvert.justNoticeable; -- 0.02 registeredTextureFunctions: Atom.PropList _ NIL; -- keeps active solid texture functions defaultAuxiliaryData: REF Pair _ NEW[Pair _ [0.0, 0.0]]; maxTxtrRange: REAL _ 32.0; -- texture coordinate range, small numbers expected <> Init: PROC[] ~ { txtrShadingClass: ShadingClass _ [ type: $MappedAndSolidTexture, cnvrtVtx: GetLerpedVals, getColor: RecoverColor, loadShapeAux: LoadShapeAux, loadVtxAux: LoadVtxAux, lerpVtxAux: LerpVtxAux, shadeVtx: ShapeUtilities.ShadeVtx ]; ThreeDBasics.RegisterShadingClass[txtrShadingClass, $MappedAndSolidTexture]; <> RegisterTextureFunction[ $Spots, Spots ]; RegisterTextureFunction[ $Wurlitzer, Wurlitzer ]; RegisterTextureFunction[ $TwistedStripes, TwistedStripes ]; RegisterTextureFunction[ $BurlWood, BurlWood ]; RegisterTextureFunction[ $ZebraBurl, ZebraBurl ]; RegisterTextureFunction[ $Marble, Marble ]; }; <> CheckAndAddProcs: PUBLIC PROC[shape: REF ShapeInstance ] ~ { IF shape.shadingClass = NIL THEN ThreeDBasics.LoadShadingClass[shape, $MappedAndSolidTexture] ELSE IF shape.shadingClass.type # $MappedAndSolidTexture THEN { shape.shadingClass.type _ $MappedAndSolidTexture; shape.shadingClass.cnvrtVtx _ GetLerpedVals; shape.shadingClass.getColor _ RecoverColor; shape.shadingClass.loadShapeAux _ LoadShapeAux; shape.shadingClass.loadVtxAux _ LoadVtxAux; shape.shadingClass.lerpVtxAux _ LerpVtxAux; shape.shadingClass.shadeVtx _ ShapeUtilities.ShadeVtx; }; }; AddSolidTexture: PUBLIC PROC[context: REF Context, shapeName: Rope.ROPE, name: ATOM ] ~{ shape: REF ShapeInstance _ SceneUtilities.FindShape[ context, shapeName ]; txtrFn: TextureFunction _ GetRegisteredTextureFunction[name]; txtrFn.props _ PutProp[txtrFn.props, $Shape, shape]; CheckAndAddProcs[shape]; shape.shadingClass.texture _ List.Nconc1[ -- append to existing list shape.shadingClass.texture, NEW[TextureFunction _ txtrFn] ]; }; AddMappedTexture: PUBLIC PROC[context: REF Context, shapeName: Rope.ROPE, texture: REF TextureMap] ~ { shape: REF ShapeInstance _ SceneUtilities.FindShape[ context, shapeName ]; CheckAndAddProcs[shape]; shape.shadingClass.texture _ List.Nconc1[ shape.shadingClass.texture, texture ]; -- append }; SumAllMappedTextures: PUBLIC PROC[context: REF Context, shapeName: Rope.ROPE] ~ { shape: REF ShapeInstance _ SceneUtilities.FindShape[ context, shapeName ]; texture: LIST OF REF ANY _ shape.shadingClass.texture; FOR txtrList: LIST OF REF ANY _ texture, txtrList.rest UNTIL txtrList = NIL DO WITH txtrList.first SELECT FROM textureMap: REF TextureMap => SumMappedTexture[textureMap]; ENDCASE; ENDLOOP; }; RemoveAllTexture: PUBLIC PROC[context: REF Context, shapeName: Rope.ROPE] ~ { shape: REF ShapeInstance _ SceneUtilities.FindShape[ context, shapeName ]; shape.shadingClass.texture _ NIL; }; <> GetLerpedVals: ThreeDBasics.VtxToRealSeqProc ~ { <> maxLength: NAT _ IF data = $PixelShading THEN 16 ELSE 10; sourceAux: REF Pair _ NARROW[ source.aux ]; IF sourceAux = NIL THEN sourceAux _ defaultAuxiliaryData; IF dest = NIL OR dest.maxLength < maxLength THEN dest _ NEW[RealSequence[maxLength]]; IF data = $PixelShading THEN { -- shade will be computed anew at each pixel dest[0] _ source.shade.r; dest[1] _ source.shade.g; dest[2] _ source.shade.b; dest[3] _ source.shade.t; dest[4] _ source.shade.exn; dest[5] _ source.shade.eyn; dest[6] _ source.shade.ezn; dest[7] _ source.coord.ex; dest[8] _ source.coord.ey; dest[9] _ source.coord.ez; dest[10] _ source.coord.sz; -- for depth buffering dest[11] _ sourceAux.x; dest[12] _ sourceAux.y; dest[13] _ source.coord.x; dest[14] _ source.coord.y; dest[15] _ source.coord.z; } ELSE { -- Shade will only be multiplied or interpolated dest[0] _ source.shade.er; dest[1] _ source.shade.eg; dest[2] _ source.shade.eb; dest[3] _ source.shade.et; dest[4] _ source.coord.sz; -- for depth buffering dest[5] _ sourceAux.x; dest[6] _ sourceAux.y; dest[7] _ source.coord.x; dest[8] _ source.coord.y; dest[9] _ source.coord.z; }; dest.length _ maxLength; RETURN [dest]; }; RecoverColor: SpotProc ~ { <> IF shading.texture # NIL THEN GetTxtrAt[context, shading, spot]; IF shading.texture # NIL OR spot.val.length > 15 THEN RenderWithPixels.ShadeSpot[context, shading, spot]; }; <> LoadShapeAux: PUBLIC ShapeProc ~ { -- load aux field in vtx <> xMin, yMin, xRng, yRng: REAL _ 0.5; auxInfo: REF PairSequence _ NEW[ PairSequence[shape.shade.length] ]; WITH data SELECT FROM vtces: REF VertexInfoSequence => { FOR i: NAT IN [0..shape.shade.length) DO auxInfo[i] _ NARROW[vtces[i].aux, REF Pair]^; ENDLOOP; auxInfo.length _ shape.shade.length; }; pairs: REF PairSequence => auxInfo _ pairs; ENDCASE => SIGNAL ThreeDBasics.Error[[$Unimplemented, "Unrecognized type"]]; FOR i: NAT IN [0..shape.shade.length) DO IF i = 0 THEN { xRng _ xMin _ auxInfo[i].x; yRng _ yMin _ auxInfo[i].y; } ELSE { IF xRng < auxInfo[i].x THEN xRng _ auxInfo[i].x; IF yRng < auxInfo[i].y THEN yRng _ auxInfo[i].y; IF xMin > auxInfo[i].x THEN xMin _ auxInfo[i].x; IF yMin > auxInfo[i].y THEN yMin _ auxInfo[i].y; }; ENDLOOP; xRng _ xRng - xMin; yRng _ yRng - yMin; shape.shadingProps _ PutProp[ shape.shadingProps, $TxtrCoordRange, NEW[ Pair _ [xRng, yRng ] ] ]; IF xRng > maxTxtrRange OR yRng > maxTxtrRange THEN SIGNAL ThreeDBasics.Error[[$MisMatch, "Suspiciously big texture coords"]]; shape.shadingProps _ PutProp[ shape.shadingProps, $AuxiliaryVtxData, auxInfo]; RETURN[ shape ]; }; LoadVtxAux: PUBLIC ThreeDBasics.VertexInfoProc ~ { -- load aux field in vtx <> vtxAux: REF Pair _ NEW[Pair]; WITH data SELECT FROM input: LORA => { auxInfo: REF PairSequence _ NARROW[ input.first ]; index: INTEGER _ NARROW[ input.rest.first, REF INTEGER ]^; vtxAux^ _ auxInfo[index]; -- texture coords }; txtr: REF Pair => { vtxAux.x _ txtr.x; vtxAux.y _ txtr.y; }; ENDCASE => SIGNAL ThreeDBasics.Error[[$Unimplemented, "Unrecognized type"]]; vtx.aux _ vtxAux; RETURN[ vtx ]; }; LerpVtxAux: PUBLIC ThreeDBasics.VertexInfoProc ~ { -- linear interpolation for texture coords <> input: LORA _ NARROW[data]; vtxAux: REF Pair _ NEW[Pair]; vtxa: REF Pair _ NARROW[ input.first ]; vtxb: REF Pair _ NARROW[ input.rest.first ]; a: REAL _ NARROW[input.rest.rest.first, REF REAL]^; b: REAL _ NARROW[input.rest.rest.rest.first, REF REAL]^; vtxAux.x _ vtxa.x*a + vtxb.x*b; vtxAux.y _ vtxa.y*a + vtxb.y*b; vtx.aux _ vtxAux; RETURN[ vtx ]; }; <> AdjustTexture: PUBLIC PROC[poly: REF Patch, texture: LORA, halfXRange, halfYRange: REAL _ .5] ~ { mappedTexture: BOOLEAN _ FALSE; FOR txtrList: LORA _ NARROW[texture], txtrList.rest UNTIL txtrList = NIL DO WITH txtrList.first SELECT FROM -- look for mapped texture texture: REF ThreeDBasics.TextureMap => mappedTexture _ TRUE; ENDCASE; ENDLOOP; IF mappedTexture THEN { maxXtxtr, maxYtxtr, minXtxtr, minYtxtr: REAL; FOR i: CARDINAL IN [0..poly.nVtces) DO -- find maxima and minima txtr: REF Pair _ NARROW[poly[i].aux]; IF i = 0 THEN { maxXtxtr _ minXtxtr _ txtr.x; maxYtxtr _ minYtxtr _ txtr.y; } ELSE { IF maxXtxtr < txtr.x THEN maxXtxtr _ txtr.x; IF maxYtxtr < txtr.y THEN maxYtxtr _ txtr.y; IF minXtxtr > txtr.x THEN minXtxtr _ txtr.x; IF minYtxtr > txtr.y THEN minYtxtr _ txtr.y; }; ENDLOOP; IF maxXtxtr - minXtxtr > halfXRange THEN { -- seam in x FOR i: CARDINAL IN [0..poly.nVtces) DO -- push small ones beyond maximum txtr: REF Pair _ NARROW[poly[i].aux]; WHILE maxXtxtr - txtr.x > halfXRange DO txtr.x _ txtr.x + 1.0; ENDLOOP; ENDLOOP; minXtxtr _ maxXtxtr; FOR i: CARDINAL IN [0..poly.nVtces) DO -- find minimum txtr: REF Pair _ NARROW[poly[i].aux]; IF minXtxtr > txtr.x THEN minXtxtr _ txtr.x; ENDLOOP; }; IF maxYtxtr - minYtxtr > halfYRange THEN { -- seam in y FOR i: CARDINAL IN [0..poly.nVtces) DO -- push small ones beyond maximum txtr: REF Pair _ NARROW[poly[i].aux]; WHILE maxYtxtr - txtr.y > halfYRange DO txtr.y _ txtr.y + 1.0; ENDLOOP; ENDLOOP; minYtxtr _ maxYtxtr; FOR i: CARDINAL IN [0..poly.nVtces) DO -- find minimum txtr: REF Pair _ NARROW[poly[i].aux]; IF minYtxtr > txtr.y THEN minYtxtr _ txtr.y; ENDLOOP; }; <<>> minXtxtr _ Real.Float[Real.Fix[minXtxtr]]; minYtxtr _ Real.Float[Real.Fix[minYtxtr]]; FOR i: CARDINAL IN [0..poly.nVtces) DO -- adjust everything to minima under 1.0 txtr: REF Pair _ NARROW[poly[i].aux]; txtr.x _ txtr.x - minXtxtr; txtr.y _ txtr.y - minYtxtr; ENDLOOP; }; }; <> GetTxtrAt: PUBLIC SpotProc ~ { <> texture: LORA _ shading.texture; FOR txtrList: LORA _ texture, txtrList.rest UNTIL txtrList = NIL DO WITH txtrList.first SELECT FROM -- textures evaluated top to bottom texture: REF TextureMap => -- modify with mapped texture WITH texture.pixels SELECT FROM buf: ImagerPixel.PixelMap => IF texture.type = $Bump THEN SIGNAL ThreeDBasics.Error[[$MisMatch, "Need summed area table"]] ELSE SimpleTexture[spot, buf, texture.type]; sumMap: REF SummedTexture => IF texture.type = $Bump THEN { ref: REF ANY _ Atom.GetPropFromList[texture.props, $BumpScale]; bumpScale: REAL _ IF ref # NIL THEN NARROW[ref, REF REAL]^ ELSE 1.0; BumpTexture[spot, sumMap, bumpScale]; } ELSE SumMapTexture[spot, sumMap, texture.type]; ENDCASE => ERROR; txtrFn: REF TextureFunction => -- solid or other function-based texture txtrFn.proc[context, shading, spot, txtrFn.props]; ENDCASE => SIGNAL ThreeDBasics.Error[[$Unimplemented, "Unknown texture type"]]; ENDLOOP; }; SimpleTexture: PROC[spot: REF Spot, map: ImagerPixel.PixelMap, type: ATOM] ~ { GetTxtrAddress: PROC[buf: ImagerPixel.PixelMap, x, y: REAL] RETURNS[ txtrX, txtrY: INTEGER ] ~ { bufWidth: NAT _ buf.box.max.f - buf.box.min.f; bufHeight: NAT _ buf.box.max.s - buf.box.min.s; txtrX _ Real.Fix[x * bufWidth] MOD bufWidth; IF txtrX < 0 THEN txtrX _ txtrX + bufWidth; txtrY _ Real.Fix[y * bufHeight] MOD bufHeight; IF txtrY < 0 THEN txtrY _ txtrY + bufHeight; }; pixel: ImagerPixel.PixelBuffer _ ImagerPixel.ObtainScratchPixels[map.samplesPerPixel, 1]; x, y: INTEGER; txtrX: NAT ~ spot.val.length - 5; txtrY: NAT ~ txtrX+1; [x, y] _ GetTxtrAddress[map, spot.val[txtrX], spot.val[txtrY]]; ImagerPixel.GetPixels[self: map, pixels: pixel, initIndex: [f: x, s: y+map.box.min.s], count: 1]; SELECT type FROM $Color => FOR i: NAT IN [0..3) DO txtrValue: REAL _ pixel[i][0] / 256.0 ; spot.val[i] _ spot.val[i] * txtrValue; ENDLOOP; $ColorAndTransmittance => { surfTrans: REAL _ 1.0 - spot.val[3]; txtrTrans: REAL _ 1.0 - pixel[3][0] /256.0; FOR i: NAT IN [0..3) DO txtrVal: REAL _ pixel[i][0] / 256.0 ; spot.val[i] _ txtrTrans * surfTrans * spot.val[i] -- lerp spot reduced by transmittance + (1.0 - txtrTrans) * spot.val[i] * txtrVal; -- with spot times texture ENDLOOP; spot.val[3] _ spot.val[3] * txtrTrans; -- transmittances multiply }; $IntensityandTransmittance => { -- alpha channels provide coverage = 1.0 - transmtnce surfTrans: REAL _ 1.0 - spot.val[3]; txtrVal: REAL _ 1.0 - pixel[0][0] / 256.0 ; txtrTrans: REAL _ 1.0 - pixel[1][0] / 256.0 ; FOR i: NAT IN [0..3) DO spot.val[i] _ txtrTrans * surfTrans * spot.val[i] -- lerp spot reduced by transmittance + (1.0 - txtrTrans) * spot.val[i] * txtrVal; -- with spot times texture ENDLOOP; spot.val[3] _ spot.val[3] * txtrTrans; -- transmittances multiply }; $Intensity => { txtrValue: REAL _ pixel[0][0] / 256.0 ; FOR i: NAT IN [0..3) DO spot.val[i] _ spot.val[i] * txtrValue; ENDLOOP; }; ENDCASE => SIGNAL ThreeDBasics.Error[[$MisMatch, "Unknown texture type"]]; ImagerPixel.ReleaseScratchPixels[pixel]; }; SumMapTexture: PROC[spot: REF Spot, txtrSum: REF SummedTexture, type: ATOM] ~ { maxTxtrX: REAL _ txtrSum[0][0].length; -- width (thus max x address) of texture maxTxtrY: REAL _ txtrSum[0].length; -- height (thus max y address) of texture txtrX: NAT ~ spot.val.length - 5; txtrY: NAT ~ txtrX+1; <> txtrXIncr: REAL _ 0.5 * MAX[ ABS[spot.yIncr[txtrX]], ABS[spot.xIncr[txtrX]] ]; txtrYIncr: REAL _ 0.5 * MAX[ ABS[spot.yIncr[txtrY]], ABS[spot.xIncr[txtrY]] ]; area: REAL _ 4 * txtrXIncr * maxTxtrX * txtrYIncr * maxTxtrY; WHILE spot.val[txtrX] - txtrXIncr < 0.0 DO spot.val[txtrX] _ spot.val[txtrX] + 1.0; ENDLOOP; WHILE spot.val[txtrY] - txtrYIncr < 0.0 DO spot.val[txtrY] _ spot.val[txtrY] + 1.0; ENDLOOP; SELECT type FROM $Color => FOR i: NAT IN [0..3) DO txtrValue: REAL _ SumValues[spot, txtrSum[i], txtrX, txtrY, txtrXIncr, txtrYIncr, area] / 256.0; spot.val[i] _ MAX[ 0.0, spot.val[i] * txtrValue ]; ENDLOOP; $ColorAndTransmittance => { surfTrans: REAL _ 1.0 - spot.val[3]; txtrTrans: REAL _ SumValues[ spot, txtrSum[3], txtrX, txtrY, txtrXIncr, txtrYIncr, area ] /256.0; txtrTrans _ 1.0 - MAX[ 0.0, txtrTrans]; -- from alpha to transmittance FOR i: NAT IN [0..3) DO txtrVal: REAL _ SumValues[ spot, txtrSum[i], txtrX, txtrY, txtrXIncr, txtrYIncr, area ] /256.0; spot.val[i] _ txtrTrans * surfTrans * spot.val[i] -- lerp spot reduced by trans. + (1.0 - txtrTrans) * spot.val[i] * txtrVal; -- with spot times texture spot.val[i] _ MAX[ 0.0, spot.val[i]]; ENDLOOP; spot.val[3] _ spot.val[3] * txtrTrans; -- transmittances multiply }; $IntensityandTransmittance => { txtrVal: REAL _ SumValues[spot, txtrSum[0], txtrX, txtrY, txtrXIncr, txtrYIncr, area] / 256.0; surfTrans: REAL _ 1.0 - spot.val[3]; txtrTrans: REAL _ SumValues[spot, txtrSum[1], txtrX, txtrY, txtrXIncr, txtrYIncr, area] / 256.0; txtrVal _ MAX[ 0.0, txtrVal]; txtrTrans _ 1.0 - MAX[ 0.0, txtrTrans]; -- from alpha to transmittance FOR i: NAT IN [0..3) DO spot.val[i] _ txtrTrans * surfTrans * spot.val[i] -- lerp spot reduced by trans. + (1.0 - txtrTrans) * spot.val[i] * txtrVal; -- with spot times texture spot.val[i] _ MAX[ 0.0, spot.val[i]]; ENDLOOP; spot.val[3] _ spot.val[3] * txtrTrans; -- transmittances multiply }; $Intensity => { txtrValue: REAL _ SumValues[spot, txtrSum[0], txtrX, txtrY, txtrXIncr, txtrYIncr, area] / 256.0; IF txtrValue < 0.0 THEN txtrValue _ 0.0; IF spot.xySwapped THEN txtrValue _ 0.5 * txtrValue; FOR i: NAT IN [0..3) DO spot.val[i] _ MAX[ 0.0, spot.val[i] * txtrValue ]; ENDLOOP; }; ENDCASE => SIGNAL ThreeDBasics.Error[[$MisMatch, "Unknown texture type"]]; }; BumpTexture: PROC[spot: REF Spot, txtrSum: REF SummedTexture, bumpScale: REAL] ~ { txtrX: NAT ~ spot.val.length - 5; txtrY: NAT ~ txtrX+1; Positivize: PROC[] ~ { WHILE spot.val[txtrX] - maxXIncr < 0.0 DO spot.val[txtrX] _ spot.val[txtrX] + 1.0; ENDLOOP; WHILE spot.val[txtrY] - maxYIncr < 0.0 DO spot.val[txtrY] _ spot.val[txtrY] + 1.0; ENDLOOP; }; nmlX: NAT ~ 4; nmlY: NAT ~ nmlX + 1; nmlZ: NAT ~ nmlX + 2; maxTxtrX: REAL _ txtrSum[0][0].length; -- width (thus max x address) of texture maxTxtrY: REAL _ txtrSum[0].length; -- height (thus max y address) of texture <> maxXIncr, maxYIncr, area, length: REAL; <> txtrXIncr: Pair _ [spot.xIncr[txtrX], spot.xIncr[txtrY]]; <> txtrYIncr: Pair _ [-txtrXIncr.y, txtrXIncr.x]; -- rotate txtrXIncr 90 deg. <> cosA: REAL _ Vector2.Dot[ Vector2.Unit[txtrYIncr], Vector2.Unit[[spot.yIncr[txtrX], spot.yIncr[txtrY]]] ]; txtrYIncr _ Vector2.Mul[txtrYIncr, ABS[cosA]]; IF spot.xySwapped THEN { -- compensate for sideways scanning in tiler txtrYIncr.x _ -txtrYIncr.x; txtrYIncr.y _ -txtrYIncr.y; [[txtrXIncr.x, txtrYIncr.x]] _ Swap[[txtrXIncr.x, txtrYIncr.x]]; [[txtrXIncr.y, txtrYIncr.y]] _ Swap[[txtrXIncr.y, txtrYIncr.y]]; }; <> maxXIncr _ 0.5 * MAX[ ABS[txtrXIncr.x], ABS[txtrYIncr.x] ]; maxYIncr _ 0.5 * MAX[ ABS[txtrXIncr.y], ABS[txtrYIncr.y] ]; area _ 4 * maxXIncr * maxTxtrX * maxYIncr * maxTxtrY; <> <<(This is independent of texture orientation, extreme aspect ratios in texture images should be avoided)>> length _ Vector2.Length[ txtrXIncr ]; IF length < 2.0/maxTxtrX THEN txtrXIncr _ Vector2.Mul[ txtrXIncr, 2.0 / (length*maxTxtrX) ]; length _ Vector2.Length[ txtrYIncr ]; IF length < 2.0/maxTxtrX THEN txtrYIncr _ Vector2.Mul[ txtrYIncr, 2.0 / (length*maxTxtrX) ]; SELECT txtrSum.length FROM 1 => { txtrValue, txtrValueX, txtrValueY, cosA, sinA, length: REAL; perturbDir, tnml, nml: Triple; Positivize[]; -- ensure positive texture coordinate values txtrValue _ SumValues[spot, txtrSum[0], txtrX, txtrY, maxXIncr, maxYIncr, area] / 256.0; spot.val[txtrX] _ spot.val[txtrX] + txtrXIncr.x; -- get txtr offset one pixel to right spot.val[txtrY] _ spot.val[txtrY] + txtrXIncr.y; Positivize[]; txtrValueX _ SumValues[spot, txtrSum[0], txtrX, txtrY, maxXIncr, maxYIncr, area] /256.0; spot.val[txtrX] _ spot.val[txtrX] - txtrXIncr.x; -- get original texture value back spot.val[txtrY] _ spot.val[txtrY] - txtrXIncr.y; spot.val[txtrX] _ spot.val[txtrX] + txtrYIncr.x; -- get txtr offset one pixel above spot.val[txtrY] _ spot.val[txtrY] + txtrYIncr.y; Positivize[]; txtrValueY _ SumValues[spot, txtrSum[0], txtrX, txtrY, maxXIncr, maxYIncr, area] /256.0; perturbDir _ G3dVector.Cross[ [maxTxtrX*txtrXIncr.x, maxTxtrY*txtrXIncr.y, bumpScale*(txtrValueX - txtrValue)], [maxTxtrX*txtrYIncr.x, maxTxtrY*txtrYIncr.y, bumpScale*(txtrValueY - txtrValue)] ]; perturbDir.z _ ABS[perturbDir.z]; perturbDir _ G3dVector.Normalize[perturbDir]; <> length _ RealFns.SqRt[ Sqr[perturbDir.x] + Sqr[perturbDir.z] ]; nml _ [spot.val[nmlX], spot.val[nmlY], spot.val[nmlZ]]; cosA _ perturbDir.z / length; sinA _ perturbDir.x / length; tnml.x _ nml.x * cosA + nml.z * sinA; tnml.y _ nml.y; tnml.z _ - nml.x * sinA + nml.z * cosA; nml _ G3dVector.Normalize[tnml]; <> length _ RealFns.SqRt[ Sqr[perturbDir.z] + Sqr[perturbDir.y] ]; cosA _ perturbDir.z / length; sinA _ perturbDir.y / length; tnml.x _ nml.x; tnml.y _ nml.y * cosA + nml.z * sinA; tnml.z _ - nml.y * sinA + nml.z * cosA; nml _ G3dVector.Normalize[tnml]; spot.val[nmlX] _ nml.x; spot.val[nmlY] _ nml.y; spot.val[nmlZ] _ nml.z; }; ENDCASE => SIGNAL ThreeDBasics.Error[[$MisMatch, "Wrong no. of samples in texture"]]; }; <> GetLerpedValue: PROC[ llVal, ulVal, urVal, lrVal: INT, xPos, yPos: REAL ] RETURNS[ intPart: INT, fracPart: REAL ] ~ { <> <> <> lowerFrac, upperFrac: REAL; lowerInt, upperInt: INT; lowerFrac _ xPos * (lrVal - llVal); -- lerp upper values lowerInt _ Real.Fix[ lowerFrac ]; lowerFrac _ lowerFrac - lowerInt; lowerInt _ llVal + lowerInt; upperFrac _ xPos * (urVal - ulVal); -- lerp lower values upperInt _ Real.Fix[ upperFrac ]; upperFrac _ upperFrac - upperInt; upperInt _ ulVal + upperInt; fracPart _ yPos * (upperInt - lowerInt); -- lerp upper and lower lerps intPart _ Real.Fix[ fracPart ]; fracPart _ fracPart - intPart; intPart _ intPart + lowerInt; fracPart _ fracPart + lowerFrac + yPos * (upperFrac - lowerFrac); }; CorrectSum: PROC[txtrSum: REF SumSequence, x, y: NAT] RETURNS[INT] ~ { maxTxtrX: NAT _ txtrSum[0].length-1; maxTxtrY: NAT _ txtrSum.length-1; IF x < txtrSum[0].length AND y < txtrSum.length THEN { RETURN[ txtrSum[y][x] ] } ELSE IF x >= txtrSum[0].length AND y >= txtrSum.length THEN { x _ x - txtrSum[0].length; y _ y - txtrSum.length; RETURN[ CorrectSum[txtrSum, x, y] + txtrSum[maxTxtrY][maxTxtrX] + CorrectSum[txtrSum, x, maxTxtrY] + CorrectSum[txtrSum, maxTxtrX, y] ]; } ELSE IF x >= txtrSum[0].length THEN { x _ x - txtrSum[0].length; RETURN[ CorrectSum[txtrSum, x, y] + txtrSum[y][maxTxtrX] ]; } ELSE { -- IF y >= txtrSum.length y _ y - txtrSum.length; RETURN[ CorrectSum[txtrSum, x, y] + txtrSum[maxTxtrY][x] ]; }; }; GetValueAt: PROC[txtrSum: REF SumSequence, x, y: REAL] RETURNS[ intPart: INT, fracPart: REAL ] ~ { xPos, yPos: REAL; lX, lY, rX, uY: NAT; xPos _ x * txtrSum[0].length; lX _ Real.Fix[xPos]; rX _ lX + 1; yPos _ y * txtrSum.length; lY _ Real.Fix[yPos]; uY _ lY + 1; xPos _ xPos - Real.Fix[xPos]; -- get fractional part yPos _ yPos - Real.Fix[yPos]; [ intPart, fracPart ] _ GetLerpedValue[ CorrectSum[txtrSum, lX, lY], CorrectSum[txtrSum, lX, uY], CorrectSum[txtrSum, rX, uY], CorrectSum[txtrSum, rX, lY], xPos, yPos ]; }; SumValues: PROC[ spot: REF Spot, txtrSum: REF SumSequence, txtrX, txtrY: NAT, txtrXIncr, txtrYIncr, area: REAL ] RETURNS[ txtrValue: REAL ] ~ { i1, i2, i3, i4: INT; f1, f2, f3, f4: REAL; IF area < 4.0 THEN { -- summed area tables don't work if all samples lie in the same pixel area _ 4.0; -- filtering works best if done over two pixel widths txtrXIncr _ 1.0 / txtrSum[0].length; txtrYIncr _ 1.0 / txtrSum.length; }; [ i1, f1 ] _ GetValueAt[ txtrSum, spot.val[txtrX] + txtrXIncr, spot.val[txtrY] + txtrYIncr ]; [ i2, f2 ] _ GetValueAt[ txtrSum, spot.val[txtrX] - txtrXIncr, spot.val[txtrY] - txtrYIncr ]; [ i3, f3 ] _ GetValueAt[ txtrSum, spot.val[txtrX] + txtrXIncr, spot.val[txtrY] - txtrYIncr ]; [ i4, f4 ] _ GetValueAt[ txtrSum, spot.val[txtrX] - txtrXIncr, spot.val[txtrY] + txtrYIncr ]; txtrValue _ (i1 + i2 - i3 - i4 ) / area; txtrValue _ txtrValue + (f1 + f2 - f3 - f4 ) / area; }; <> RegisterTextureFunction: PUBLIC PROC[ name: ATOM, proc: SpotProc, props: Atom.PropList _ NIL ] ~ { registeredTextureFunctions _ Atom.PutPropOnList[ registeredTextureFunctions, name, NEW[ TextureFunction _ [name, proc, props] ] ]; }; GetRegisteredTextureFunction: PUBLIC PROC[name: ATOM] RETURNS[ txtrFn: TextureFunction ] ~ { ref: REF TextureFunction _ NARROW[ Atom.GetPropFromList[registeredTextureFunctions, name] ]; IF ref # NIL THEN txtrFn _ ref^ ELSE SIGNAL ThreeDBasics.Error[[$MisMatch, "Unregistered procedure"]] }; Spots: 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[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; }; Wurlitzer: 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[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; }; TwistedStripes: 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; 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]) ]; transmittance: REAL; intensity _ (intensity + 1.0) / 2.0; transmittance _ (1.0 - intensity); spot.val[t] _ spot.val[t] * transmittance; spot.val[r] _ spot.val[r] * intensity; spot.val[g] _ spot.val[g] * (1.0 - 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; }; 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; }; 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] ~ { <> 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: LOOPHOLE[aPointer]]; RETURN [h]; }; SCurve: PROC[x: REAL] RETURNS [REAL] ~ { <