<> <> <> DIRECTORY Basics USING [BITOR, BITAND], Atom USING [PropList, PutPropOnList, GetPropFromList, GetPName], Real USING [Fix, Float, FixC, RoundC, RoundI], RealFns USING [CosDeg, SinDeg, SqRt, TanDeg], Rope USING [ROPE, Equal, Cat, FromChar], IO USING [STREAM, GetAtom, GetBool, GetChar, GetInt, GetReal, PutRope, EndOfStream, SkipWhitespace, SP, CR], FS USING [StreamOpen], Convert USING [RopeFromReal], Terminal USING [Current], QuickViewer USING [Reset], Imager USING [Context, Rectangle, MaskRectangle, ClipRectangle, TranslateT, SetColor], ImagerColor USING [ColorFromRGB, RGB], ImagerBackdoor USING [GetBounds], SampleMapOps USING [FromSubMap], Vector3d USING [Dot, Pair, Triple, Quad, Normalize, Sub, Cross, Add, Mag, Mul], Matrix3d USING [Matrix, MatrixRep, Mul, Identity, MakeRotate, Transform, TransformVec], Plane3d USING [DistanceToPt], Pixels USING [PixelBuffer, Extent, GetSampleSet, SampleSet, PixelOp, GetFromImagerContext, Create], ScanConvert USING [IntRGB, MappedRGB, justNoticeable, GetColorProc], TextureMaps USING [MakeTxtrCoordsFromVtxNos, MakeTxtrCoordsFromNormals, SetTexture, SumTexture, TextureMap, TextureFromAIS], SolidTextures USING [ProcToRope], ThreeDSurfaces USING [GetVtxNormals], ThreeDMisc USING [AddShapeAt, GetImagerContext, GetMappedColor, GetPolygonColors, GetVertexColors, LoadColorRamp, LoadStd8BitClrMap, SetFacetedColor, SetSmoothColor, SetShininess, SetTransmittance, ShadingProcName], ThreeDScenes USING [ErrorDesc, ScaleAndAddXfm, SixSides, OutCode, NoneOut, AllOut, ShapeInstance, ShapeSequence, Context, ShadingSequence, ShadingValue, ClipState, Vertex, VertexInfo, VertexSequence, VtxToRealSeqProc, ShadingProcs]; ThreeDScenesImpl: CEDAR PROGRAM IMPORTS Atom, Real, RealFns, Imager, Rope, IO, FS, Basics, ImagerColor, Vector3d, Matrix3d, ThreeDMisc, Pixels, QuickViewer, ImagerBackdoor, Terminal, ScanConvert, Plane3d, SampleMapOps, TextureMaps, ThreeDSurfaces, Convert, SolidTextures EXPORTS ThreeDScenes ~ BEGIN Error: PUBLIC SIGNAL [reason: ThreeDScenes.ErrorDesc] = CODE; <> RGB: TYPE ~ ImagerColor.RGB; IntRGB: TYPE ~ ScanConvert.IntRGB; Pair: TYPE ~ Vector3d.Pair; -- RECORD [ x, y: REAL]; Triple: TYPE ~ Vector3d.Triple; -- RECORD [ x, y, z: REAL]; Quad: TYPE ~ Vector3d.Quad; -- RECORD [ x, y, z, w: REAL]; Rectangle: TYPE ~ Pixels.Extent; SampleSet: TYPE ~ Pixels.SampleSet; Xfm3d: TYPE ~ Matrix3d.Matrix; -- REF ARRAY [0..4) OF ARRAY [0..4) OF REAL; Xfm3dRep: TYPE ~ Matrix3d.MatrixRep; ScaleAndAddXfm: TYPE ~ ThreeDScenes.ScaleAndAddXfm; <> SixSides: TYPE ~ ThreeDScenes.SixSides; -- {Left, Right, Bottom, Top, Near, Far} ClipState: TYPE ~ ThreeDScenes.ClipState; -- {in, out, clipped} OutCode: TYPE ~ ThreeDScenes.OutCode; -- RECORD[bottom,top,left,right,near,far: BOOLEAN] NoneOut: OutCode ~ ThreeDScenes.NoneOut; -- [FALSE,FALSE,FALSE,FALSE,FALSE,FALSE] AllOut: OutCode ~ ThreeDScenes.AllOut; -- [TRUE, TRUE, TRUE, TRUE, TRUE, TRUE] Context: TYPE ~ ThreeDScenes.Context; ShapeInstance: TYPE ~ ThreeDScenes.ShapeInstance; ShapeSequence: TYPE ~ ThreeDScenes.ShapeSequence; ShadingSequence: TYPE ~ ThreeDScenes.ShadingSequence; ShadingValue: TYPE ~ ThreeDScenes.ShadingValue; Vertex: TYPE ~ ThreeDScenes.Vertex; VertexInfo: TYPE ~ ThreeDScenes.VertexInfo; VertexSequence: TYPE ~ ThreeDScenes.VertexSequence; <> aLilBit: REAL _ ScanConvert.justNoticeable * ScanConvert.justNoticeable; <> Sqr: PROCEDURE [number: REAL] RETURNS [REAL] ~ INLINE { RETURN[number * number]; }; Ceiling: PROC[number: REAL] RETURNS[result: INTEGER] ~ { result _ Real.RoundI[number]; IF result < number THEN result _ result + 1; }; <> GetFromImagerContext: PUBLIC PROC[ imagerCtx: Imager.Context, alpha, depth, grey: BOOLEAN _ FALSE ] RETURNS [REF Context] ~ { <> bounds: Imager.Rectangle; context: REF ThreeDScenes.Context _ NEW[ThreeDScenes.Context]; [context.display, bounds] _ Pixels.GetFromImagerContext[ imagerCtx, alpha, depth ]; IF context.display.samplesPerPixel > 2 THEN context.renderMode _ $Dorado24 ELSE IF Atom.GetPropFromList[ context.display.props, $RenderMode ] = $LF THEN { context.renderMode _ $LF; alpha _ FALSE; } ELSE IF grey OR alpha THEN context.renderMode _ $Grey ELSE context.renderMode _ $PseudoClr; SELECT context.renderMode FROM $PseudoClr => ThreeDMisc.LoadStd8BitClrMap[ Terminal.Current[] ]; $Grey => ThreeDMisc.LoadColorRamp[ Terminal.Current[], [0.,0.,0.], [1.,1.,1.], [.43, .43, .43] ]; ENDCASE; context.alphaBuffer _ alpha; context.depthBuffer _ depth; context.eyeSpaceXfm _ Matrix3d.Identity[]; context.viewPort _ bounds; context.window _ WindowFromViewPort[context.viewPort]; RETURN[context]; }; Create: PUBLIC PROC[width, height: NAT, renderMode: ATOM, alpha, depth: BOOLEAN _ FALSE] RETURNS [REF Context] ~ { pixelSizes: SampleSet; context: REF ThreeDScenes.Context _ NEW[ThreeDScenes.Context]; addOn: NAT _ 0; AddAuxBuffers: PROC[] ~ { IF alpha THEN pixelSizes[pixelSizes.length-addOn] _ 8; IF depth THEN pixelSizes[pixelSizes.length-1] _ 16; }; IF alpha THEN addOn _ addOn+1; IF depth THEN addOn _ addOn+1; context.alphaBuffer _ alpha; context.depthBuffer _ depth; context.renderMode _ renderMode; SELECT renderMode FROM $LF => { pixelSizes _ Pixels.GetSampleSet[1+addOn]; pixelSizes[0] _ 1; AddAuxBuffers[]; context.display _ Pixels.Create[ width, height, pixelSizes ]; }; $Grey, $Dithered, $PseudoClr => { pixelSizes _ Pixels.GetSampleSet[1+addOn]; pixelSizes[0] _ 8; AddAuxBuffers[]; context.display _ Pixels.Create[ width, height, pixelSizes ]; }; $Dorado24 => { big1: NAT; pixelSizes _ Pixels.GetSampleSet[3+addOn]; big1 _ 0; pixelSizes[1] _ 0; pixelSizes[0] _ 16; pixelSizes[2] _ 8; AddAuxBuffers[]; context.display _ Pixels.Create[ width, height, pixelSizes ]; context.display.pixels[big1].subMap.sampleMap.bitsPerSample _ 8; -- make byte samples context.display.pixels[big1].subMap.sampleMap.fSize _ context.display.pixels[big1].subMap.sampleMap.fSize * 2; context.display.pixels[big1+1].subMap.sampleMap _ SampleMapOps.FromSubMap[ [ sampleMap: context.display.pixels[big1].subMap.sampleMap, start: [f: 1, s: 0] -- offset by one to get lower bytes ] ]; context.display.pixels[big1+1].df _ context.display.pixels[big1].df _ 2; context.display.pixels[big1+1].subMap.size.f _ 2 * context.display.pixels[big1+1].subMap.size.f; context.display.pixels[big1].subMap.size.f _ 2 * context.display.pixels[big1].subMap.size.f; }; $FullClr => { pixelSizes _ Pixels.GetSampleSet[3+addOn]; FOR i: NAT IN [0..3) DO pixelSizes[i] _ 8; ENDLOOP; AddAuxBuffers[]; context.display _ Pixels.Create[ width, height, pixelSizes ]; }; ENDCASE => SIGNAL Error[[$Unimplemented, "Unknown render mode"]]; IF alpha THEN context.display.props _ Atom.PutPropOnList[ context.display.props, $Alpha, NEW[NAT _ pixelSizes.length-addOn] ]; IF depth THEN context.display.props _ Atom.PutPropOnList[ context.display.props, $Depth, NEW[NAT _ pixelSizes.length-1] ]; context.eyeSpaceXfm _ Matrix3d.Identity[]; context.viewPort _ [0, 0, width, height]; context.window _ WindowFromViewPort[context.viewPort]; RETURN[context]; }; <> SetEyeSpace: PUBLIC PROC[ context: REF Context ] ~ { in, right, up, normal: Triple; mtx: Xfm3d; wndw: Imager.Rectangle; aspectRatio, viewWidth, viewHeight: REAL; bounds: Pixels.Extent _ [ 0, 0, Real.RoundC[context.viewPort.w], Real.RoundC[context.viewPort.h] ]; aspectRatio _ IF bounds.h > 0 THEN Real.Float[bounds.w] / bounds.h ELSE 1.0; <> in _ Vector3d.Normalize[Vector3d.Sub[context.ptOfInterest, context.eyePoint]]; right _ Vector3d.Normalize[Vector3d.Cross[in, context.upDirection]]; up _ Vector3d.Normalize[Vector3d.Cross[right, in]]; <> context.eyeSpaceXfm _ Matrix3d.Identity[]; context.eyeSpaceXfm[0][0] _ right.x; context.eyeSpaceXfm[1][0] _ right.y; context.eyeSpaceXfm[2][0] _ right.z; context.eyeSpaceXfm[3][0] _ -Vector3d.Dot[right, context.eyePoint]; context.eyeSpaceXfm[0][1] _ up.x; context.eyeSpaceXfm[1][1] _ up.y; context.eyeSpaceXfm[2][1] _ up.z; context.eyeSpaceXfm[3][1] _ -Vector3d.Dot[up, context.eyePoint]; context.eyeSpaceXfm[0][2] _ in.x; context.eyeSpaceXfm[1][2] _ in.y; context.eyeSpaceXfm[2][2] _ in.z; context.eyeSpaceXfm[3][2] _ -Vector3d.Dot[in, context.eyePoint]; mtx _ Matrix3d.Identity[]; -- Roll about z-axis, clockwise mtx[0][0] _ RealFns.CosDeg[context.rollAngle]; mtx[0][1] _ -RealFns.SinDeg[context.rollAngle]; mtx[1][0] _ RealFns.SinDeg[context.rollAngle]; mtx[1][1] _ RealFns.CosDeg[context.rollAngle]; context.eyeSpaceXfm _ Matrix3d.Mul[context.eyeSpaceXfm, mtx]; <> viewWidth _ 2.*RealFns.TanDeg[context.fieldOfView/2.]; wndw.x _ MIN[1.0, MAX[-1.0, context.window.x] ]; wndw.w _ MIN[1.0-wndw.x, MAX[0.0, context.window.w] ]; wndw.y _ MIN[1.0, MAX[-1.0, context.window.y] ]; wndw.h _ MIN[1.0-wndw.y, MAX[0.0, context.window.h] ]; context.clippingPlanes[Near] _ [0., 0., 1., -context.hitherLimit]; context.clippingPlanes[Far] _ [0., 0., -1., context.yonLimit]; <> normal _ Vector3d.Normalize[[1., 0., -(wndw.x * viewWidth/2.)]]; context.clippingPlanes[Left] _ [normal.x, 0., normal.z, 0.]; normal _ Vector3d.Normalize[[-1., 0., (wndw.x + wndw.w) * viewWidth/2.]]; context.clippingPlanes[Right] _ [normal.x, 0., normal.z, 0.]; normal _ Vector3d.Normalize[[0., 1., -(wndw.y * viewWidth/2.)]]; context.clippingPlanes[Bottom] _ [0., normal.y, normal.z, 0.]; normal _ Vector3d.Normalize[[0., -1., (wndw.y + wndw.h) * viewWidth/2.]]; context.clippingPlanes[Top] _ [0., normal.y, normal.z, 0.]; <> IF aspectRatio > 1.0 -- set angle of view on smallest viewport dimension THEN { viewHeight _ viewWidth; viewWidth _ viewWidth * aspectRatio; } ELSE { viewHeight _ viewWidth / aspectRatio; }; IF wndw.w / wndw.h > 1.0 THEN { viewWidth _ viewWidth * wndw.h / wndw.w; } ELSE { viewHeight _ viewHeight * wndw.w / wndw.h; }; context.eyeToNDC.addX _ -(wndw.x / wndw.w); context.eyeToNDC.addY _ -(wndw.y / wndw.h); context.eyeToNDC.addZ _ 1./(1. - context.hitherLimit/context.yonLimit); context.eyeToNDC.scaleX _ 1./(wndw.w * viewWidth / 2.0); context.eyeToNDC.scaleY _ 1./(wndw.h * viewHeight / 2.0); context.eyeToNDC.scaleZ _ -context.hitherLimit/(1. - context.hitherLimit/context.yonLimit); }; SetWindow: PUBLIC PROC[context: REF Context, size: Imager.Rectangle] ~{ context.window _ size; SetEyeSpace[context]; IF context.shapes # NIL THEN FOR i: NAT IN [0..context.shapes.length) DO context.shapes[i].vtcesInValid _ TRUE; -- eyespace and image space will change ENDLOOP; }; WindowFromViewPort: PUBLIC PROC[viewPort: Imager.Rectangle] RETURNS[Imager.Rectangle] ~ { window: Imager.Rectangle; IF viewPort.h <= 0.0 THEN RETURN[ [0.0, 0.0, 0.0, 0.0] ]; IF viewPort.w > viewPort.h THEN { window.x _ -1.0; window.w _ 2.0; window.y _ -viewPort.h / viewPort.w; window.h _ 2.0 * viewPort.h / viewPort.w; } ELSE { window.y _ -1.0; window.h _ 2.0; window.x _ -viewPort.w / viewPort.h; window.w _ 2.0 * viewPort.w / viewPort.h; }; RETURN[ window ]; }; SetViewPort: PUBLIC PROC[context: REF Context, size: Imager.Rectangle, clear: BOOLEAN _ FALSE] ~{ <> bounds: Imager.Rectangle _ size; imagerCtx: Imager.Context _ NARROW[ Atom.GetPropFromList[context.display.props, $ImagerContext] ]; IF size.w <= 0.0 OR size.h <= 0.0 THEN SIGNAL Error[[$MisMatch, "Null clipper"]]; IF context.renderMode # $LF THEN FOR i: NAT IN [0..context.display.pixels.length) DO x: INTEGER _ MAX[ 0, MIN[ Real.RoundI[MAX[size.x, bounds.x]], context.display.width ] ]; y: INTEGER _ MAX[ 0, MIN[ Real.RoundI[MAX[size.y, bounds.y]], context.display.height ]]; w: INTEGER _ MIN[Real.RoundC[MIN[size.w, bounds.w] ], context.display.width]; h: INTEGER _ MIN[Real.RoundC[MIN[size.h, bounds.h] ], context.display.height]; y _ context.display.height - (y + h); -- invert for upside-down sampleMap context.display.pixels[i].subMap.start _ [ f: x, s: y ]; -- upper left corner context.display.pixels[i].subMap.size _ [f: w, s: h]; -- dimensions ENDLOOP; context.viewPort _ size; IF imagerCtx # NIL THEN { QuickViewer.Reset[imagerCtx]; Imager.ClipRectangle[imagerCtx, [size.x, size.y, size.w, size.h] ]; Imager.TranslateT[ imagerCtx, [size.x, size.y] ]; IF clear THEN FillViewPort[context, [0.0, 0.0, 0.0] ]; }; }; FillViewPort: PUBLIC PROC[context: REF Context, clr: RGB] ~ { iClr: IntRGB _ [ Real.RoundC[clr.R*255], Real.RoundC[clr.G*255], Real.RoundC[clr.B*255] ]; pixelBytes: SampleSet _ Pixels.GetSampleSet[1]; addOn: NAT _ 0; IF context.alphaBuffer THEN addOn _ addOn + 1; IF context.depthBuffer THEN addOn _ addOn + 1; SELECT context.renderMode FROM $Dithered, $LF => { -- use imager, where possible, in this mode imagerCtx: Imager.Context _ ThreeDMisc.GetImagerContext[context]; bounds: Imager.Rectangle _ ImagerBackdoor.GetBounds[imagerCtx]; Imager.SetColor[ imagerCtx, ImagerColor.ColorFromRGB[clr] ]; Imager.MaskRectangle[ imagerCtx, bounds ]; RETURN; }; $PseudoClr => { IF pixelBytes.length < 1+addOn THEN pixelBytes _ Pixels.GetSampleSet[1+addOn]; pixelBytes[0] _ ThreeDMisc.GetMappedColor[ context, iClr ]; }; $Grey => { IF pixelBytes.length < 1+addOn THEN pixelBytes _ Pixels.GetSampleSet[1+addOn]; pixelBytes[0] _ (iClr.r + iClr.g + iClr.b)/3; }; $FullClr, $Dorado24 => { IF pixelBytes.length < 3+addOn THEN pixelBytes _ Pixels.GetSampleSet[3+addOn]; pixelBytes[0] _ iClr.r; pixelBytes[1] _ iClr.g; pixelBytes[2] _ iClr.b }; ENDCASE => SIGNAL Error[[$Unimplemented, "Unknown renderMode"]]; IF context.alphaBuffer THEN { alpha: REF NAT _ NARROW[ Atom.GetPropFromList[context.display.props, $Alpha] ]; pixelBytes[alpha^] _ 0; -- clear alpha buffer to transparent (or uncovered) <> context.extentCovered _ [Real.RoundC[context.viewPort.w], 0, -- left, right Real.RoundC[context.viewPort.h], 0]; -- bottom, top }; IF context.depthBuffer THEN { depth: REF NAT _ NARROW[ Atom.GetPropFromList[context.display.props, $Depth] ]; pixelBytes[depth^] _ LAST[CARDINAL]; -- clear depth buffer to max depth }; Pixels.PixelOp[ buf: context.display, area: [ 0, 0, Real.RoundC[context.viewPort.w], Real.RoundC[context.viewPort.h] ], pixel: pixelBytes ]; }; FillInBackGround: PUBLIC PROC[context: REF Context] ~ { <> WITH Atom.GetPropFromList[context.props, $BackGround] SELECT FROM bkgrdClr: REF RGB => IF context.alphaBuffer -- constant color THEN FillInConstantBackGround[context, bkgrdClr^] ELSE FillViewPort[context, bkgrdClr^]; bkgrdImage: REF Pixels.PixelBuffer => SIGNAL Error[[$Unimplemented, "No background images yet"]]; ENDCASE => IF NOT context.alphaBuffer THEN FillViewPort[context, [0.0,0.0,0.0] ]; -- NIL }; FillInConstantBackGround: PROC[context: REF Context, bkgrdClr: RGB] ~ { <> addOn: NAT _ 0; bkgrdBytes: SampleSet; alpha: REF NAT _ NARROW[ Atom.GetPropFromList[context.display.props, $Alpha] ]; depth: REF NAT _ NARROW[ Atom.GetPropFromList[context.display.props, $Depth] ]; IF depth # NIL THEN addOn _ addOn + 1; SELECT context.renderMode FROM $LF => SIGNAL Error[[$MisMatch, "Improper renderMode"]]; $FullClr, $Dorado24 => { bkgrdBytes _ Pixels.GetSampleSet[4+addOn]; bkgrdBytes[0] _ Real.FixC[bkgrdClr.R * 255.0]; bkgrdBytes[1] _ Real.FixC[bkgrdClr.G * 255.0]; bkgrdBytes[2] _ Real.FixC[bkgrdClr.B * 255.0]; }; $Grey => { bkgrdBytes _ Pixels.GetSampleSet[2+addOn]; bkgrdBytes[0] _ Real.FixC[(bkgrdClr.R+bkgrdClr.G+bkgrdClr.B)/3.0 * 255.0]; }; ENDCASE => { bkgrdBytes _ Pixels.GetSampleSet[2+addOn]; bkgrdBytes[0] _ ScanConvert.MappedRGB[ context.renderMode, [ Real.FixC[bkgrdClr.R * 255.0], Real.FixC[bkgrdClr.G * 255.0], Real.FixC[bkgrdClr.B * 255.0] ] ]; }; bkgrdBytes[alpha^] _ 255; -- fill in behind, full coverage IF depth # NIL THEN bkgrdBytes[depth^] _ LAST[CARDINAL]; -- set uncovered to max depth IF context.extentCovered.bottom > context.extentCovered.top THEN Pixels.PixelOp[ -- whole viewport, nothing covered context.display, [ 0, 0, Real.FixC[context.viewPort.w], Real.FixC[context.viewPort.h] ], bkgrdBytes, $Write ] ELSE { Pixels.PixelOp[ -- below previously affected area context.display, [ 0, 0, Real.FixC[context.viewPort.w], context.extentCovered.bottom ], bkgrdBytes, $Write ]; IF Real.FixC[context.viewPort.h] > context.extentCovered.top THEN Pixels.PixelOp[ context.display, -- above previously affected area [ 0, context.extentCovered.top, Real.FixC[context.viewPort.w], Real.FixC[context.viewPort.h] - context.extentCovered.top ], bkgrdBytes, $Write ]; Pixels.PixelOp[ -- left of previously affected area context.display, [ 0, context.extentCovered.bottom, context.extentCovered.left, context.extentCovered.top - context.extentCovered.bottom ], bkgrdBytes, $Write ]; IF Real.FixC[context.viewPort.w] > context.extentCovered.right THEN Pixels.PixelOp[ context.display, -- right of previously affected area [ context.extentCovered.right, context.extentCovered.bottom, Real.FixC[context.viewPort.w] - context.extentCovered.right, context.extentCovered.top - context.extentCovered.bottom ], bkgrdBytes, $Write ]; Pixels.PixelOp[ -- previously affected area context.display, [ context.extentCovered.left, context.extentCovered.bottom, context.extentCovered.right - context.extentCovered.left, context.extentCovered.top - context.extentCovered.bottom ], bkgrdBytes, $WriteUnder ]; }; <> context.extentCovered _ [Real.RoundC[context.viewPort.w], 0, Real.RoundC[context.viewPort.h], 0]; }; SetView: PUBLIC PROC[context: REF Context, eyePoint, ptOfInterest: Triple, fieldOfView: REAL _40.0, rollAngle: REAL _ 0.0, upDirection: Triple _ [ 0., 0., 1.], hitherLimit: REAL _ .01, yonLimit: REAL _ 1000.0] ~ { context.eyePoint _ eyePoint; context.ptOfInterest _ ptOfInterest; context.fieldOfView _ fieldOfView; context.rollAngle _ rollAngle; context.upDirection _ upDirection; context.hitherLimit _ hitherLimit; context.yonLimit _ yonLimit; SetEyeSpace[ context ]; FOR i: NAT IN [0..context.shapes.length) DO context.shapes[i].vtcesInValid _ TRUE; -- eyespace and image space will change IF GetShading[ context.shapes[i], $Shininess] # NIL THEN context.shapes[i].shadingInValid _ TRUE; -- highlights will move ENDLOOP; }; SetLight: PUBLIC PROC[context: REF Context, name: Rope.ROPE, position: Triple, color: RGB _ [1.,1.,1.] ] RETURNS[REF ShapeInstance] ~ { light: REF ShapeInstance _ FindShape[ context.shapes, name ! Error => IF reason.code = $MisMatch THEN RESUME ]; IF light = NIL THEN { light _ NewShape[ name ]; -- name not used before context.lights _ AddShape[ context.lights, light ]; -- used just for lighting context.shapes _ AddShape[ context.shapes, light ]; -- all shapes }; light.type _ $Light; light.location _ position; light.boundingRadius _ 2 * 93000000.0 * 1609.344; -- twice solar distance in meters light.orientation _ [0.,0.,0.]; -- no orientation by default light.positionInValid _ TRUE; light.vtcesInValid _ TRUE; PutShading[ light, $Color, NEW[RGB _ color] ]; light.props _ Atom.PutPropOnList[light.props, $Hidden, $DoIt]; -- hide from display routines FOR i: NAT IN [0..context.shapes.length) DO context.shapes[i].shadingInValid _ TRUE; ENDLOOP; RETURN[light]; }; DeleteLight: PUBLIC PROC[context: REF Context, name: Rope.ROPE] ~ { context.shapes _ DeleteShape[context.shapes, name]; context.lights _ DeleteShape[context.lights, name]; FOR i: NAT IN [0..context.shapes.length) DO context.shapes[i].shadingInValid _ TRUE; ENDLOOP; }; GetAmbientLight: PUBLIC PROC[context: REF Context, normal: Triple] RETURNS[ambnt: RGB] ~ { <> IF context.environment = NIL THEN RETURN[[.2, .2, .2]]; WITH Atom.GetPropFromList[context.environment, $AmbientLight] SELECT FROM clr: REF RGB => ambnt _ clr^; light: REF ShapeInstance => { -- light must be far away, treated as simple direction dotNL: REAL _ Vector3d.Dot[ Vector3d.Normalize[ [light.centroid.ex, light.centroid.ey, light.centroid.ez] ], Vector3d.Normalize[ normal ] ]; dotNL _ (dotNL + 1.0) / 2.0; -- range ambient light over shadowed portions too ambnt _ NARROW[GetShading[light, $Color], REF RGB]^; ambnt.R _ ambnt.R*dotNL; ambnt.G _ ambnt.G*dotNL; ambnt.B _ ambnt.B*dotNL; }; ENDCASE => ambnt _ [.2, .2, .2]; }; ReadScene: PUBLIC PROC[context: REF Context, input: IO.STREAM] ~ { GetRope: PROC[input: IO.STREAM] RETURNS[Rope.ROPE] ~ { -- chars bound by white space output: Rope.ROPE _ NIL; char: CHAR; [] _ IO.SkipWhitespace[input]; -- Strip whitespace and comments char _ IO.GetChar[input]; WHILE char # IO.SP AND char # IO.CR DO -- do until trailing space or CR output _ Rope.Cat[ output, Rope.FromChar[char] ]; char _ IO.GetChar[input]; ENDLOOP; RETURN[output]; }; shape: REF ThreeDScenes.ShapeInstance _ NIL; done: BOOLEAN _ FALSE; WHILE NOT done DO keyWd: Rope.ROPE _ GetRope[ input ! IO.EndOfStream => EXIT ]; SELECT TRUE FROM Rope.Equal[ "View:", keyWd, FALSE] => { context.eyePoint _ [ IO.GetReal[input], IO.GetReal[input], IO.GetReal[input] ]; context.ptOfInterest _ [ IO.GetReal[input], IO.GetReal[input], IO.GetReal[input] ]; context.upDirection _ [ IO.GetReal[input], IO.GetReal[input], IO.GetReal[input] ]; context.rollAngle _ IO.GetReal[input]; context.fieldOfView _ IO.GetReal[input]; context.hitherLimit _ IO.GetReal[input]; context.yonLimit _ IO.GetReal[input]; SetEyeSpace[context]; }; Rope.Equal[ "ViewPort:", keyWd, FALSE] => { SetViewPort[ context, [ x: IO.GetReal[input], y: IO.GetReal[input], w: IO.GetReal[input], h: IO.GetReal[input] ] ]; }; Rope.Equal[ "Window:", keyWd, FALSE] => { SetWindow[ context, [ x: IO.GetReal[input], y: IO.GetReal[input], w: IO.GetReal[input], h: IO.GetReal[input] ] ]; }; Rope.Equal[ "BackgroundColor:", keyWd, FALSE] => { bkgrdColor: REF RGB _ NEW[RGB]; bkgrdColor^ _ [ IO.GetReal[input], IO.GetReal[input], IO.GetReal[input] ]; context.props _ Atom.PutPropOnList[context.props, $BackGround, bkgrdColor]; }; Rope.Equal[ "Light:", keyWd, FALSE] => { [] _ SetLight[ context: context, name: GetRope[input], position: [ IO.GetReal[input], IO.GetReal[input], IO.GetReal[input] ], color: [ IO.GetReal[input], IO.GetReal[input], IO.GetReal[input] ] ]; }; Rope.Equal[ "Shape:", keyWd, FALSE] => { -- get shape. name: Rope.ROPE _ GetRope[input]; fileName: Rope.ROPE _ GetRope[input]; type: ATOM _ IO.GetAtom[ input ]; insideVisible: BOOLEAN _ IO.GetBool[ input ]; ThreeDMisc.AddShapeAt[context, name, fileName, [0.,0.,0.], type, insideVisible]; shape _ FindShape[context.shapes, name]; }; Rope.Equal[ "Position:", keyWd, FALSE] => { position: Triple _ [ IO.GetReal[input], IO.GetReal[input], IO.GetReal[input] ]; PlaceShape[ shape, position ]; }; Rope.Equal[ "ShapeXfm:", keyWd, FALSE] => { shape.position _ NEW[ Matrix3d.MatrixRep _ [ [ IO.GetReal[input], IO.GetReal[input], IO.GetReal[input], IO.GetReal[input] ], [ IO.GetReal[input], IO.GetReal[input], IO.GetReal[input], IO.GetReal[input] ], [ IO.GetReal[input], IO.GetReal[input], IO.GetReal[input], IO.GetReal[input] ], [ IO.GetReal[input], IO.GetReal[input], IO.GetReal[input], IO.GetReal[input] ] ] ]; shape.positionInValid _ FALSE; }; Rope.Equal[ "FacetedColor:", keyWd, FALSE] => { color: RGB; color.R _ IO.GetReal[input]; color.G _ IO.GetReal[input]; color.B _ IO.GetReal[input]; ThreeDMisc.SetFacetedColor[context, shape.name, color]; }; Rope.Equal[ "SmoothColor:", keyWd, FALSE] => { color: RGB; color.R _ IO.GetReal[input]; color.G _ IO.GetReal[input]; color.B _ IO.GetReal[input]; ThreeDMisc.SetSmoothColor[context, shape.name, color]; }; Rope.Equal[ "Shininess:", keyWd, FALSE] => { shininess: REAL _ IO.GetReal[input]; ThreeDMisc.SetShininess[context, shape.name, shininess]; }; Rope.Equal[ "Transmittance:", keyWd, FALSE] => { transmittance: REAL _ IO.GetReal[input]; ThreeDMisc.SetTransmittance[context, shape.name, transmittance]; }; Rope.Equal[ "VertexColorFile:", keyWd, FALSE] => { filename: Rope.ROPE _ GetRope[input]; ThreeDMisc.GetVertexColors[ context, shape.name, filename ]; }; Rope.Equal[ "PatchColorFile:", keyWd, FALSE] => { filename: Rope.ROPE _ GetRope[input]; ThreeDMisc.GetPolygonColors[ context, shape.name, filename ]; }; Rope.Equal[ "MapTexture:", keyWd, FALSE] => { IF shape # NIL THEN { textureFile: Rope.ROPE _ NIL; textureImageFileName: Rope.ROPE _ GetRope[input]; textureType: ATOM _ IO.GetAtom[ input ]; SELECT IO.GetAtom[ input ] FROM $FromVtxNos => TextureMaps.MakeTxtrCoordsFromVtxNos[ shape, Real.FixC[IO.GetReal[input]], Real.FixC[IO.GetReal[input]], [ IO.GetReal[input], IO.GetReal[input] ], [ IO.GetReal[input], IO.GetReal[input] ], [ IO.GetReal[input], IO.GetReal[input] ], [ IO.GetReal[input], IO.GetReal[input] ] ]; $FromNormals => { ThreeDSurfaces.GetVtxNormals[ shape ! Error => IF reason.code = $OnlyForPolygons THEN CONTINUE ]; -- make sure there are normals to calculate from TextureMaps.MakeTxtrCoordsFromNormals[shape, [ IO.GetReal[input], IO.GetReal[input] ], [ IO.GetReal[input], IO.GetReal[input] ], [ IO.GetReal[input], IO.GetReal[input] ], [ IO.GetReal[input], IO.GetReal[input] ] ]; }; $File => textureFile _ GetRope[input]; ENDCASE => Error[[$MisMatch, "Bad texture coord type"]]; TextureMaps.SetTexture[ shape: shape, texture: TextureMaps.TextureFromAIS[ context: context, fileName: textureImageFileName, type: textureType ] ]; TextureMaps.SumTexture[ shape ]; } ELSE Error[[$MisMatch, "No shape for texture"]]; -- shape not defined }; Rope.Equal[ "SolidTexture:", keyWd, FALSE] => { IF shape # NIL THEN ThreeDMisc.ShadingProcName[context, shape.name, GetRope[input]] ELSE Error[[$MisMatch, "No shape for texture"]]; -- shape not defined }; Rope.Equal[ "EndOfScene:", keyWd, FALSE] => done _ TRUE; ENDCASE => Error[[$MisMatch, Rope.Cat[keyWd, " - not understood"]]]; ENDLOOP; }; WriteScene: PUBLIC PROC[context: REF Context, output: IO.STREAM] ~ { Vec3toRope: PROC[ r1, r2, r3: REAL] RETURNS[Rope.ROPE] ~ { rope: Rope.ROPE; rope _ Rope.Cat[ " ", Convert.RopeFromReal[r1], " ", Convert.RopeFromReal[r2] ]; rope _ Rope.Cat[ rope, " ", Convert.RopeFromReal[r3], " " ]; RETURN[ rope ]; }; Vec4toRope: PROC[ r1, r2, r3, r4: REAL] RETURNS[Rope.ROPE] ~ { rope: Rope.ROPE; rope _ Rope.Cat[ " ", Convert.RopeFromReal[r1], " ", Convert.RopeFromReal[r2], " " ]; rope _ Rope.Cat[ rope, Convert.RopeFromReal[r3], " ", Convert.RopeFromReal[r4], " " ]; RETURN[ rope ]; }; ref: REF; line: Rope.ROPE; <<>> line _ Rope.Cat["View: ", Vec3toRope[context.eyePoint.x, context.eyePoint.y, context.eyePoint.z], Vec3toRope[context.ptOfInterest.x, context.ptOfInterest.y, context.ptOfInterest.z], Vec3toRope[context.upDirection.x, context.upDirection.y, context.upDirection.z] ]; IO.PutRope[ output, Rope.Cat[line, Vec4toRope[ context.rollAngle, context.fieldOfView, context.hitherLimit, context.yonLimit ], "\n" ] ]; IO.PutRope[ output, Rope.Cat["ViewPort: ", Vec4toRope[context.viewPort.x, context.viewPort.y, context.viewPort.w, context.viewPort.h], "\n" ] ]; IO.PutRope[ output, Rope.Cat["Window: ", Vec4toRope[context.window.x, context.window.y, context.window.w, context.window.h], "\n" ] ]; ref _ Atom.GetPropFromList[context.props, $BackGround]; -- get background color IF ref # NIL THEN { color: RGB _ NARROW[ref, REF RGB]^; IO.PutRope[ output, Rope.Cat[ "BackgroundColor: ", Vec3toRope[color.R, color.G, color.B], "\n" ] ]; }; <> FOR i: NAT IN [0..context.lights.length) DO color: REF RGB _ NARROW[ GetShading[ context.lights[i], $Color ] ]; IO.PutRope[ output, Rope.Cat["Light: ", context.lights[i].name, Vec3toRope[ context.lights[i].location.x, context.lights[i].location.y, context.lights[i].location.z ], Vec3toRope[color.R, color.G, color.B], "\n" ] ]; ENDLOOP; <> FOR i: NAT IN [0..context.shapes.length) DO shape: REF ThreeDScenes.ShapeInstance _ context.shapes[i]; IF shape # NIL AND Atom.GetPropFromList[shape.props, $Hidden] = NIL AND shape.clipState # out AND shape.surface # NIL THEN { ref: REF ANY _ NIL; xfm: Matrix3d.Matrix _ shape.position; color: REF RGB _ NARROW[ GetShading[ shape, $Color ] ]; shadingType: ATOM _ NARROW[GetShading[ shape, $Type ] ]; transmtnce: REF REAL _ NARROW[GetShading[ shape, $Transmittance]]; shininess: REF REAL _ NARROW[GetShading[ shape, $Shininess ] ]; texture: REF TextureMaps.TextureMap _ NARROW[ GetShading[ shape, $TextureMap ] ]; <> line _ Rope.Cat[ "Shape: ", shape.name, " ", shape.fileName, " " ]; line _ Rope.Cat[ line, Atom.GetPName[shape.type] ]; IF shape.insideVisible THEN line _ Rope.Cat[line, " TRUE \n"] ELSE line _ Rope.Cat[line, " FALSE \n"]; IO.PutRope[ output, line]; <> IF xfm = NIL THEN { SetPosition[shape]; xfm _ shape.position; }; line _ Rope.Cat[" ShapeXfm: ", Vec4toRope[xfm[0][0], xfm[0][1], xfm[0][2], xfm[0][3]], Vec4toRope[xfm[1][0], xfm[1][1], xfm[1][2], xfm[1][3]] ]; line _ Rope.Cat[line, Vec4toRope[xfm[2][0], xfm[2][1], xfm[2][2], xfm[2][3]], Vec4toRope[xfm[3][0], xfm[3][1], xfm[3][2], xfm[3][3]], "\n" ]; IO.PutRope[ output, line]; <> IF shadingType = $Smooth AND color # NIL THEN IO.PutRope[output, Rope.Cat[" SmoothColor: ", Vec3toRope[color.R, color.G, color.B], "\n"] ]; IF shadingType = $Faceted AND color # NIL THEN IO.PutRope[output, Rope.Cat[" FacetedColor: ", Vec3toRope[color.R, color.G, color.B], "\n"] ]; IF transmtnce # NIL THEN IO.PutRope[ output, Rope.Cat[" Transmittance: ", Convert.RopeFromReal[transmtnce^], "\n" ] ]; IF shininess # NIL THEN IO.PutRope[ output, Rope.Cat[" Shininess: ", Convert.RopeFromReal[shininess^], "\n" ] ]; <> ref _ GetShading[ shape, $VertexColorFile ]; IF ref # NIL THEN IO.PutRope[ output, Rope.Cat[" VertexColorFile: " , NARROW[ref, Rope.ROPE], "\n"] ]; ref _ GetShading[ shape, $PatchColorFile ]; IF ref # NIL THEN IO.PutRope[ output, Rope.Cat[" PatchColorFile: " , NARROW[ref, Rope.ROPE], "\n"] ]; <> IF texture # NIL THEN { fileName: Rope.ROPE _ NARROW[ Atom.GetPropFromList[texture.props, $FileName] ]; coordType: ATOM _ NARROW[ Atom.GetPropFromList[texture.props, $CoordType] ]; coords: REF _ Atom.GetPropFromList[texture.props, $Coords]; IF coordType = NIL THEN coordType _ $NoCoords; line _ Rope.Cat[" MapTexture: ", fileName, " ", Atom.GetPName[texture.type] ]; line _ Rope.Cat[line, " ", Atom.GetPName[coordType], " " ]; SELECT coordType FROM $FromVtxNos, $FromNormals => { argList: LIST OF REAL _ NARROW[coords]; WHILE argList # NIL DO line _ Rope.Cat[line, Convert.RopeFromReal[argList.first], " " ]; argList _ argList.rest; ENDLOOP; }; $File => line _ Rope.Cat[line, " ", NARROW[coords, Rope.ROPE] ]; ENDCASE => SIGNAL Error[[$Unimplemented, "Unknown texture coordType"]]; IO.PutRope[ output, Rope.Cat[line, "\n"] ]; }; <> ref _ GetShading[ shape, $ShadingProcs]; IF ref # NIL THEN { getVtxProc: ThreeDScenes.VtxToRealSeqProc _ NIL; getColorProc: ScanConvert.GetColorProc _ NIL; [getVtxProc, getColorProc] _ NARROW[ ref, REF ThreeDScenes.ShadingProcs ]^; IF getColorProc # NIL THEN { procName: Rope.ROPE _ SolidTextures.ProcToRope[getColorProc]; IO.PutRope[ output, Rope.Cat[" SolidTexture: ", procName, "\n"] ]; }; }; }; ENDLOOP; IO.PutRope[ output, "EndOfScene:\n"]; }; <> NewShape: PUBLIC PROC[ name: Rope.ROPE ] RETURNS[REF ShapeInstance] ~ { shape: REF ShapeInstance _ NEW [ShapeInstance ]; shape.name _ name; RETURN [shape]; }; FindShape: PUBLIC PROC[ set: REF ShapeSequence, name: Rope.ROPE ] RETURNS[REF ShapeInstance] ~ { IF set = NIL THEN RETURN [NIL]; FOR i: NAT IN [0..set.length) DO IF Rope.Equal[ name, set[i].name, FALSE ] THEN RETURN[set[i]]; ENDLOOP; SIGNAL Error[[$MisMatch, "No such shape name"]]; RETURN [NIL]; }; AddShape: PUBLIC PROC[ set: REF ShapeSequence, shape: REF ShapeInstance ] RETURNS[REF ShapeSequence] ~ { newSet: REF ShapeSequence; IF set # NIL THEN { newSet _ NEW [ ShapeSequence[set.length + 1] ]; FOR i: NAT IN [0..set.length) DO newSet[i] _ set[i]; ENDLOOP; newSet[set.length] _ shape; } ELSE { newSet _ NEW [ ShapeSequence[1] ]; newSet[0] _ shape; }; RETURN [newSet]; }; DeleteShape: PUBLIC PROC[ set: REF ShapeSequence, name: Rope.ROPE ] RETURNS[REF ShapeSequence] ~ { newSet: REF ShapeSequence; j: NAT _ 0; IF set # NIL THEN newSet _ NEW [ ShapeSequence[set.length - 1] ] ELSE SIGNAL Error[[$MisMatch, "No shapes to delete from"]]; FOR i: NAT IN [0..set.length) DO IF NOT Rope.Equal[ name, set[i].name, FALSE ] THEN IF j < newSet.length THEN { newSet[j] _ set[i]; j _ j + 1; } ELSE { SIGNAL Error[[$MisMatch, "Can't delete - not there"]]; RETURN[set]; }; ENDLOOP; RETURN [newSet]; }; CopyShape: PUBLIC PROC[ shape: REF ShapeInstance, newName: Rope.ROPE ] RETURNS[REF ShapeInstance] ~ { list: Atom.PropList; newShape: REF ShapeInstance _ NEW[ShapeInstance]; newShape^ _ shape^; newShape.name _ newName; newShape.vertex _ NEW[ VertexSequence[shape.vertex.length] ]; FOR i: NAT IN [0..shape.vertex.length] DO newShape.vertex[i] _ NEW[ThreeDScenes.Vertex _ shape.vertex[i]^ ]; ENDLOOP; newShape.shade _ NEW[ ShadingSequence[shape.shade.length] ]; FOR i: NAT IN [0..shape.shade.length] DO newShape.shade[i] _ NEW[ThreeDScenes.ShadingValue _ shape.shade[i]^ ]; ENDLOOP; <> <<- Can't copy this since we can't know the type here, will point to the original>> newShape.shadingProps _ NIL; list _ shape.shadingProps; WHILE list # NIL DO newShape.shadingProps _ CONS[list.first, newShape.shadingProps]; list _ list.rest; ENDLOOP; newShape.props _ NIL; list _ shape.props; WHILE list # NIL DO newShape.props _ CONS[list.first, newShape.props]; list _ list.rest; ENDLOOP; RETURN[newShape]; }; PlaceShape: PUBLIC PROC[ shape: REF ShapeInstance, location: Triple ] ~ { shape.location _ location; shape.positionInValid _ TRUE; shape.vtcesInValid _ TRUE; shape.shadingInValid _ TRUE; }; MoveShape: PUBLIC PROC[ shape: REF ShapeInstance, delta: Triple ] ~ { shape.location _ Vector3d.Add[shape.location, delta]; shape.positionInValid _ TRUE; shape.vtcesInValid _ TRUE; shape.shadingInValid _ TRUE; }; OrientShape: PUBLIC PROC[ shape: REF ShapeInstance, axis: Triple] ~ { shape.orientation _ axis; shape.positionInValid _ TRUE; shape.vtcesInValid _ TRUE; shape.shadingInValid _ TRUE; }; RotateShape: PUBLIC PROC[ shape: REF ShapeInstance, axisBase, axisEnd: Triple, theta: REAL ] ~ { shape.axisBase _ axisBase; shape.axisEnd _ axisEnd; shape.rotation _ theta; shape.positionInValid _ TRUE; shape.vtcesInValid _ TRUE; shape.shadingInValid _ TRUE; }; SetPosition: PUBLIC PROC[shape: REF ShapeInstance, concat: BOOLEAN _ FALSE] ~ { hypotenuse: REAL _ RealFns.SqRt[ Sqr[shape.orientation.x] + Sqr[shape.orientation.y] ]; IF NOT concat THEN shape.position _ Matrix3d.Identity[]; -- clear to identity transform shape.position _ Matrix3d.Mul[ shape.position, -- rotation about arbitrary axis Matrix3d.MakeRotate[ axis: Vector3d.Sub[shape.axisEnd, shape.axisBase], theta: shape.rotation, base: shape.axisBase ] ]; IF hypotenuse > 0.0 -- orientation THEN { length: REAL _ Vector3d.Mag[shape.orientation]; cosA, sinA, cosB, sinB: REAL; cosA _ shape.orientation.x / hypotenuse; sinA _ shape.orientation.y / hypotenuse; shape.position _ Matrix3d.Mul[ shape.position, -- longitudinal rotation into x-z plane, left handed about z-up NEW[ Xfm3dRep _ [ [cosA,-sinA,0.,0.], [sinA,cosA,0.,0.], [0.,0.,1.,0.], [0.,0.,0.,1.] ] ] ]; cosB _ shape.orientation.z / length; sinB _ hypotenuse / length; shape.position _ Matrix3d.Mul[ shape.position, -- latitudinal rotation, right-handed about y-north NEW[ Xfm3dRep _ [ [cosB,0.,-sinB,0.], [0.,1.,0.,0.], [sinB,0.,cosB,0.], [0.,0.,0.,1.] ] ] ]; shape.position _ Matrix3d.Mul[ shape.position, -- longitudinal rotation from x-z plane, right handed about z-up NEW[ Xfm3dRep _ [ [cosA,sinA,0.,0.], [-sinA,cosA,0.,0.], [0.,0.,1.,0.], [0.,0.,0.,1.] ] ] ]; } ELSE IF shape.orientation.z < 0.0 THEN shape.position _ Matrix3d.Mul[ shape.position, -- turn upside down NEW[ Xfm3dRep _ [ [-1.,0.,0.,0.], [0.,1.,0.,0.], [0.,0.,-1.,0.], [0.,0.,0.,1.] ] ] ]; shape.position _ Matrix3d.Mul[ shape.position, -- translation NEW[ Xfm3dRep _ [[1.,0.,0.,0.], [0.,1.,0.,0.], [0.,0.,1.,0.], [shape.location.x, shape.location.y, shape.location.z, 1.]] ] ]; shape.positionInValid _ FALSE; }; PutShading: PUBLIC PROC[ shape: REF ShapeInstance, key: ATOM, value: REF ANY] ~ { shape.shadingProps _ Atom.PutPropOnList[ shape.shadingProps, key, value ]; }; GetShading: PUBLIC PROC[ shape: REF ShapeInstance, key: ATOM ] RETURNS [value: REF ANY] ~ { value _ Atom.GetPropFromList[ shape.shadingProps, key ]; }; <> InitShades: PUBLIC PROC[shape: REF ShapeInstance] RETURNS[shade: REF ShadingSequence] ~{ color: RGB; transmittance: REAL; IF GetShading[ shape, $Color ] # NIL THEN color _ NARROW[ GetShading[shape, $Color], REF RGB ]^ ELSE color _ [0.7, 0.7, 0.7]; -- default grey IF GetShading[ shape, $Transmittance ] # NIL THEN transmittance _ NARROW[ GetShading[shape, $Transmittance], REF REAL ]^ ELSE transmittance _ 0.0; shade _ shape.shade; FOR i: NAT IN [0..shape.shade.length) DO shade[i].r _ color.R; shade[i].g _ color.G; shade[i].b _ color.B; shade[i].t _ transmittance; ENDLOOP; }; SetUpStandardFile: PUBLIC PROC[file: Rope.ROPE] RETURNS [stream: IO.STREAM, numEntries: NAT] ~{ char: CHAR _ ' ; stream _ FS.StreamOpen[file]; [] _ IO.GetChar[stream]; -- in case file has leading CR WHILE char # 15C DO char _ IO.GetChar[stream]; ENDLOOP; -- burn 1st line (comment) numEntries _ IO.GetInt[stream]; -- number of items should be first number in file }; ReadVertexCoords: PUBLIC PROC[vtx: REF VertexSequence, in: IO.STREAM, nVtces: NAT] ~ { FOR i: NAT IN [0..nVtces) DO -- Read Vertices IF vtx[i] = NIL THEN vtx[i] _ NEW[Vertex]; vtx[i].x _ IO.GetReal[in]; vtx[i].y _ IO.GetReal[in]; vtx[i].z _ IO.GetReal[in]; ENDLOOP; }; ReadTextureCoords: PUBLIC PROC[shade: REF ShadingSequence, in: IO.STREAM, nVtces: NAT] ~ { FOR i: NAT IN [0..nVtces) DO IF shade[i] = NIL THEN shade[i] _ NEW[ShadingValue]; shade[i].txtrX _ IO.GetReal[in]; shade[i].txtrY _ IO.GetReal[in]; shade[i].txtrZ _ IO.GetReal[in]; ENDLOOP; }; ReadColors: PUBLIC PROC[shade: REF ShadingSequence, in: IO.STREAM, length: NAT] ~ { FOR i: NAT IN [0..length) DO -- Read Vertices IF shade[i] = NIL THEN shade[i] _ NEW[ShadingValue]; shade[i].r _ IO.GetReal[in]; shade[i].g _ IO.GetReal[in]; shade[i].b _ IO.GetReal[in]; shade[i].t _ IO.GetReal[in]; ENDLOOP; }; ReadNormals: PUBLIC PROC[shade: REF ShadingSequence, in: IO.STREAM, length: NAT] ~ { FOR i: NAT IN [0..length) DO -- Read Vertices IF shade[i] = NIL THEN shade[i] _ NEW[ShadingValue]; shade[i].xn _ IO.GetReal[in]; shade[i].yn _ IO.GetReal[in]; shade[i].zn _ IO.GetReal[in]; ENDLOOP; }; GetClipCodeForPt: PUBLIC PROC[context: REF Context, pt: Triple] RETURNS[clip: OutCode] ~ { <> clip.bottom_ Plane3d.DistanceToPt[ pt, context.clippingPlanes[Bottom]] < 0.; clip.top _ Plane3d.DistanceToPt[ pt, context.clippingPlanes[Top] ] < 0.; clip.left _ Plane3d.DistanceToPt[ pt, context.clippingPlanes[Left] ] < 0.; clip.right _ Plane3d.DistanceToPt[ pt, context.clippingPlanes[Right] ] < 0.; clip.near _ Plane3d.DistanceToPt[ pt, context.clippingPlanes[Near] ] < 0.; clip.far _ Plane3d.DistanceToPt[ pt, context.clippingPlanes[Far] ] < 0.; }; XfmPtToEyeSpace: PUBLIC PROC[context: REF Context, pt: Triple] RETURNS[Triple, OutCode] ~ { << Transform Vertex to Eye Space >> pt _ Matrix3d.Transform[ pt, context.eyeSpaceXfm ]; RETURN[ pt, GetClipCodeForPt[context, pt] ]; }; XfmTripleToDisplay: PROC[pt: Triple, xfm: ScaleAndAddXfm, resFctr: Triple, offset: REAL] RETURNS[result: Triple] ~ { << Transform vertex from eyespace to display coordinates - local utility>> result.x _ xfm.scaleX*pt.x/pt.z + xfm.addX; -- convert to normalized display coords result.y _ xfm.scaleY*pt.y/pt.z + xfm.addY; result.z _ xfm.scaleZ/pt.z + xfm.addZ; result.x _ MAX[0.0, MIN[resFctr.x - aLilBit, resFctr.x * result.x] ]; -- convert to screen space result.y _ MAX[0.0, MIN[resFctr.y - aLilBit, resFctr.y * result.y] ]; result.z _ MAX[0.0, MIN[resFctr.z - aLilBit, resFctr.z * result.z] ]; result.x _ result.x - offset; -- nojaggy tiler offsets by 1/2 pixel and spreads out by 1 result.y _ result.y - offset; RETURN [ result ]; }; XfmPtToDisplay: PUBLIC PROC[context: REF Context, pt: Triple] RETURNS[Triple] ~ { << Transform vertex from eyespace to display coordinates>> RETURN [ XfmTripleToDisplay[ pt: pt, xfm: context.eyeToNDC, resFctr: [context.viewPort.w, context.viewPort.h, context.depthResolution], offset: IF context.alphaBuffer THEN .5 ELSE 0.0 -- nojaggy tiler offsets by 1/2 pixel ] ]; }; ShadePt: PUBLIC PROC [context: REF Context, pt: VertexInfo, shininess: REAL] RETURNS [result: RGB, transmittance: REAL _ 0.0] ~ { shinyPwr: NAT _ Real.Fix[shininess] * 2; -- makes highlights same size as in ShinyTiler toLightSrc, toEye: Triple; dotNL, dotNE, specularSum: REAL _ 0.0; ambient, diffuse, specular: RGB _ [0.0, 0.0, 0.0]; result _ [0., 0., 0.]; toEye _ Vector3d.Normalize[[-pt.coord.ex, -pt.coord.ey, -pt.coord.ez]]; -- direction to eye [ [pt.shade.exn, pt.shade.eyn, pt.shade.ezn] ] _ Vector3d.Normalize[ [pt.shade.exn, pt.shade.eyn, pt.shade.ezn] -- often not normalized ]; <> ambient _ GetAmbientLight[ context, [pt.shade.exn, pt.shade.eyn, pt.shade.ezn] ]; result.R _ ambient.R * pt.shade.r; result.G _ ambient.G * pt.shade.g; result.B _ ambient.B * pt.shade.b; FOR i: NAT IN [0..context.lights.length) DO -- do for each light source lightClr: RGB _ NARROW[GetShading[ context.lights[i], $Color], REF RGB ]^; -- get color <> toLightSrc _ Vector3d.Normalize[ [ -- vector to light source from surface pt. context.lights[i].centroid.ex - pt.coord.ex, context.lights[i].centroid.ey - pt.coord.ey, context.lights[i].centroid.ez - pt.coord.ez ] ]; <> IF context.lights[i].orientation # [0.0, 0.0, 0.0] THEN { -- spotlight, get direction dotLS, intensity: REAL; shineDirection: Triple _ Matrix3d.TransformVec[ context.lights[i].orientation, context.eyeSpaceXfm ]; spotSpread: NAT _ Real.Fix[ NARROW[GetShading[context.lights[i], $Shininess], REF REAL]^ ]; dotLS _ -Vector3d.Dot[toLightSrc, shineDirection]; IF dotLS > 0. THEN { -- compute spotlight factor binaryCount: NAT _ spotSpread; intensity _ 1.; WHILE binaryCount > 0 DO -- compute power by repeated squares IF (binaryCount MOD 2) = 1 THEN intensity _ intensity*dotLS; dotLS _ dotLS*dotLS; binaryCount _ binaryCount/2; ENDLOOP; } ELSE intensity _ 0.; IF intensity < ScanConvert.justNoticeable THEN LOOP; -- no effect, skip this light lightClr.R _ lightClr.R*intensity; lightClr.G _ lightClr.G*intensity; lightClr.B _ lightClr.B*intensity; }; <> dotNL _ Vector3d.Dot[toLightSrc, [pt.shade.exn, pt.shade.eyn, pt.shade.ezn]]; IF dotNL <= 0. THEN LOOP; -- surface faces away from light, skip diffuse.R _ (1. - ambient.R) * dotNL * lightClr.R * pt.shade.r; -- surface facing the light diffuse.G _ (1. - ambient.G) * dotNL * lightClr.G * pt.shade.g; diffuse.B _ (1. - ambient.B) * dotNL * lightClr.B * pt.shade.b; <> IF shinyPwr > 0 THEN { -- compute Phong specular component pctHilite: REAL _ 0.0; halfWay: Triple _ Vector3d.Normalize[ -- normalized average of vectors Vector3d.Mul[ Vector3d.Add[toEye, toLightSrc], 0.5 ] ]; dotNormHalfWay: REAL _ Vector3d.Dot[ -- cos angle betw. normal and average [pt.shade.exn, pt.shade.eyn, pt.shade.ezn], halfWay ]; IF dotNormHalfWay > 0. THEN { binaryCount: NAT _ shinyPwr; pctHilite _ 1.0; WHILE binaryCount > 0 DO -- compute power by repeated squares IF (binaryCount MOD 2) = 1 THEN pctHilite _ pctHilite*dotNormHalfWay; dotNormHalfWay _ dotNormHalfWay*dotNormHalfWay; binaryCount _ binaryCount/2; ENDLOOP; }; <> specular.R _ (1.0 - diffuse.R - ambient.R) * pctHilite * lightClr.R; specular.G _ (1.0 - diffuse.G - ambient.G) * pctHilite * lightClr.G; specular.B _ (1.0 - diffuse.B - ambient.B) * pctHilite * lightClr.B; specularSum _ specularSum + pctHilite; }; result.R _ result.R + diffuse.R + specular.R; result.G _ result.G + diffuse.G + specular.G; result.B _ result.B + diffuse.B + specular.B; ENDLOOP; <> IF pt.shade.t > 0.0 THEN { -- transmittance is cosine of angle between to eye and normal dotNE _ ABS[ Vector3d.Dot[toEye, [pt.shade.exn, pt.shade.eyn, pt.shade.ezn]] ]; transmittance _ MIN[1.0 - specularSum, dotNE*pt.shade.t]; -- make highlights more opaque transmittance _ MAX[0.0, MIN[transmittance, 1.]]; }; result.R _ MAX[0.0, MIN[result.R, 1.]]; result.G _ MAX[0.0, MIN[result.G, 1.]]; result.B _ MAX[0.0, MIN[result.B, 1.]]; }; XfmToEyeSpace: PUBLIC PROC[context: REF Context, shape: REF ShapeInstance] RETURNS[ClipState] ~ { <> ClipBoundingBall: PROC[] RETURNS[ClipState] ~ { <> clipFlag: BOOLEAN _ FALSE; FOR plane: SixSides IN SixSides DO distance: REAL _ Plane3d.DistanceToPt[ [shape.centroid.ex, shape.centroid.ey, shape.centroid.ez], context.clippingPlanes[plane] ]; IF distance < -shape.boundingRadius THEN RETURN[out] ELSE IF distance < shape.boundingRadius THEN clipFlag _ TRUE; ENDLOOP; IF clipFlag THEN RETURN[clipped] ELSE RETURN[in]; }; xfm: Xfm3d; IF shape.positionInValid THEN SetPosition[shape]; -- fix bnding ball & position matrix xfm _ Matrix3d.Mul[shape.position, context.eyeSpaceXfm]; [[shape.centroid.ex, shape.centroid.ey, shape.centroid.ez]] _ Matrix3d.Transform[ [shape.centroid.x, shape.centroid.y, shape.centroid.z], -- Update shape centroid xfm ]; shape.clipState _ ClipBoundingBall[]; IF shape.clipState # out THEN { -- run through vertices and shading and transform patchInfo: REF ThreeDScenes.ShadingSequence _ NARROW[ GetShading[ shape, $PatchColors ] ]; andOfCodes: OutCode _ AllOut; -- test for trivially out orOfCodes: OutCode _ NoneOut; -- test for trivially in IF shape.vertex # NIL THEN FOR i: NAT IN [0..shape.vertex.length) DO IF shape.vertex[i] # NIL THEN { OPEN shape.vertex[i]; [ [ex, ey, ez] ] _ Matrix3d.Transform[ [x, y, z] , xfm]; -- transform points to eyespace IF shape.clipState # in THEN { clip _ GetClipCodeForPt[ context, [ex, ey, ez] ]; orOfCodes _ LOOPHOLE[ Basics.BITOR[LOOPHOLE[orOfCodes], LOOPHOLE[ clip] ], OutCode]; andOfCodes _ LOOPHOLE[ Basics.BITAND[ LOOPHOLE[andOfCodes], LOOPHOLE[ clip] ], OutCode]; } ELSE clip _ NoneOut; }; ENDLOOP; IF orOfCodes = NoneOut THEN shape.clipState _ in ELSE IF andOfCodes # NoneOut THEN shape.clipState _ out; IF shape.shade # NIL AND shape.clipState # out THEN FOR i: NAT IN [0..shape.shade.length) DO IF shape.shade[i] # NIL THEN { OPEN shape.shade[i]; -- transform normal vectors [ [exn, eyn, ezn] ] _ Matrix3d.TransformVec[ [xn, yn, zn] , xfm]; }; ENDLOOP; IF patchInfo # NIL AND shape.clipState # out THEN FOR i: NAT IN [0..patchInfo.length) DO IF patchInfo[i] # NIL THEN { OPEN patchInfo[i]; -- transform normal vectors [ [exn, eyn, ezn] ] _ Matrix3d.TransformVec[ [xn, yn, zn] , xfm]; }; ENDLOOP; }; shape.vtcesInValid _ FALSE; RETURN[shape.clipState]; }; XfmToDisplay: PUBLIC PROC[context: REF Context, shape: REF ShapeInstance] ~ { xMin, yMin: REAL _ context.viewPort.w; xMax, yMax: REAL _ 0.0; <> IF shape.vertex # NIL THEN FOR i: NAT IN [0..shape.vertex.length) DO IF shape.vertex[i] # NIL THEN { OPEN shape.vertex[i]; IF clip = NoneOut THEN { [ [sx, sy, sz] ] _ XfmTripleToDisplay[ pt: [ex, ey, ez], xfm: context.eyeToNDC, resFctr: [context.viewPort.w, context.viewPort.h, context.depthResolution], offset: IF context.alphaBuffer THEN .5 ELSE 0.0 -- nojaggy tiler offsets by 1/2 pixel ]; IF sx < xMin THEN xMin _ sx; IF sy < yMin THEN yMin _ sy; IF sx > xMax THEN xMax _ sx; IF sy > yMax THEN yMax _ sy; } ELSE { IF clip.left THEN xMin _ 0.0; IF clip.right THEN xMax _ context.viewPort.w; IF clip.bottom THEN yMin _ 0.0; IF clip.top THEN yMax _ context.viewPort.h; }; }; ENDLOOP; xMin _ MAX[0.0, xMin-2.0]; xMax _ MIN[context.viewPort.w, xMax+2.0]; yMin _ MAX[0.0, yMin-2.0]; yMax _ MIN[context.viewPort.h, yMax+2.0]; shape.screenExtent _ [ left: Real.FixC[xMin], right: Ceiling[xMax], bottom: Real.FixC[yMin], top: Ceiling[yMax] ]; }; GetVtxShades: PUBLIC PROC[ context: REF Context, shape: REF ShapeInstance] ~ { clr: RGB; IF shape.shade # NIL THEN FOR i: NAT IN [0..shape.shade.length) DO IF shape.shade[i] # NIL THEN { trns: REAL _ 0.0; -- transmittance pt: VertexInfo _ [ shape.vertex[i]^, shape.shade[i]^, NIL ]; [clr, trns] _ ShadePt[context, pt, 0.0]; -- calculate shade shape.shade[i].ir _ Real.FixC[clr.R * 255.0]; shape.shade[i].ig _ Real.FixC[clr.G * 255.0]; shape.shade[i].ib _ Real.FixC[clr.B * 255.0]; shape.shade[i].it _ Real.FixC[ trns * 255.0]; }; ENDLOOP; }; END.