DIRECTORY
Atom USING [GetPropFromList],
CADTypes USING [VertexSequence, TriangleSequence],
FS USING [StreamOpen],
Imager USING [black, Context, MaskFill, MaskStroke, PathProc, SetColor, SetStrokeEnd, SetStrokeJoint, SetStrokeWidth, StrokeEnd, StrokeJoint],
ImagerColor USING [RGB],
IO USING [Close, int, PutF, real, STREAM, RopeFromROS, ROS],
RealFns USING [SqRt],
Rope USING [ROPE],
ThreeDBasics USING [Context, ShadingValue, ShadingSequence, ShapeInstance, Vertex, VertexSequence],
ThreeDHacks USING [],
ThreeDScenes USING [NewShape, PutShading],
ThreeDSurfaces USING [PatchDisplayProc, PatchProcs, PtrPatch, PtrPatchSequence, ReadShape, RegisterSurfaceType],
Vector3d USING [Triple, TripleSequence];
ThreeDHacksImpl:
CEDAR
PROGRAM
IMPORTS Atom, FS, Imager, IO, RealFns, ThreeDScenes, ThreeDSurfaces
EXPORTS ThreeDHacks
~ BEGIN
RegisterNewClasses:
PUBLIC
PROC [context3d:
REF ThreeDBasics.Context] ~
BEGIN
fatPointProcs:
REF ThreeDSurfaces.PatchProcs ←
NEW[ThreeDSurfaces.PatchProcs ← [
expand: NIL,
subdivide: NIL,
display: FatPointDisplayProc,
displayLines: NIL]];
fatSegProcs:
REF ThreeDSurfaces.PatchProcs ←
NEW[ThreeDSurfaces.PatchProcs ← [
expand: NIL,
subdivide: NIL,
display: FatSegDisplayProc,
displayLines: NIL]];
ThreeDSurfaces.RegisterSurfaceType[context3d, $FatPoint, fatPointProcs];
ThreeDSurfaces.RegisterSurfaceType[context3d, $FatSeg, fatSegProcs];
END;
FatPointDisplayProc: ThreeDSurfaces.PatchDisplayProc ~
BEGIN
This procedure is called when ThreeDWorld wants to render the polygon comprising the FatPoint.
This procedure was inspired, in part, by Tilers.ConstantTiler
Parameters
patch: REF Patch is the lone triangular patch of the FatPoint.
PROC[ context: REF Context, patch: REF Patch, limitType: ATOM, limit: REAL, action: PROC[context: REF Context, patch: REF Patch] ];
Get the screen coordinates of the first vertex in the patch, which will be the center of the FatPoint circle.
screenX: REAL ← patch.vtx[0].coord.sx;
screenY: REAL ← patch.vtx[0].coord.sy;
Get the imager context to draw in.
imagerContext: Imager.Context ← NARROW [Atom.GetPropFromList [context.display.props, $ImagerContext], Imager.Context];
Define the outline of the FatPoint.
Path: Imager.PathProc ~
BEGIN
moveTo[[screenX+10, screenY]];
arcTo[[screenX-10, screenY], [screenX+10, screenY]];
END;
Fill in the outline, colored black.
Imager.SetColor[imagerContext, Imager.black];
Imager.MaskFill[imagerContext, Path];
END;
FatSegDisplayProc: ThreeDSurfaces.PatchDisplayProc ~
BEGIN
Get the screen coordinates of the first two vertices in the patch, which will be the endpoints of the section of the FatSeg being drawn.
firstScreenX: REAL ← patch.vtx[0].coord.sx;
firstScreenY: REAL ← patch.vtx[0].coord.sy;
secondScreenX: REAL ← patch.vtx[1].coord.sx;
secondScreenY: REAL ← patch.vtx[1].coord.sy;
Get the imager context to draw in.
imagerContext: Imager.Context ← NARROW [Atom.GetPropFromList [context.display.props, $ImagerContext], Imager.Context];
Define the path the stroke will take.
Path: Imager.PathProc ~
BEGIN
moveTo[[firstScreenX, firstScreenY]];
lineTo[[secondScreenX, secondScreenY]];
END;
Bail out if the patch is clipped.
IF patch.clipState = clipped THEN RETURN;
Set the stroke parameters and draw it.
Imager.SetColor[imagerContext, Imager.black];
Imager.SetStrokeWidth[imagerContext, 5];
Imager.SetStrokeEnd[imagerContext, round];
Imager.SetStrokeJoint[imagerContext, round];
Imager.MaskStroke[imagerContext, Path];
END;
MakeFatPoint:
PUBLIC PROC [name: Rope.
ROPE, position: Vector3d.Triple]
RETURNS [newFatPoint:
REF ThreeDBasics.ShapeInstance] ~
BEGIN
A FatPoint is, ideally, a single point located at position. To force ThreeDWorld to call the drawing procedure, it is necessary to have FatPoints contain a polygonal patch. So a FatPoint is composed of three vertices, the first one located at position and the others nearby, and one triangular patch defined by the three vertices.
Scratch variables.
nullVertex: ThreeDBasics.Vertex;
nullShade: ThreeDBasics.ShadingValue;
surface: REF ThreeDSurfaces.PtrPatchSequence;
Begin creating the newFatPoint.
newFatPoint ← ThreeDScenes.NewShape[name];
newFatPoint.fileName ← "";
newFatPoint.numSurfaces ← 1;
newFatPoint.type ← $FatPoint;
newFatPoint.insideVisible ← TRUE;
Initialize the vertex and shade sequences.
newFatPoint.vertex ← NEW[ThreeDBasics.VertexSequence[3]];
newFatPoint.shade ← NEW[ThreeDBasics.ShadingSequence[3]];
FOR i:
NAT
IN [0..3)
DO
newFatPoint.vertex[i] ← NEW[ThreeDBasics.Vertex ← nullVertex];
newFatPoint.shade[i] ← NEW[ThreeDBasics.ShadingValue ← nullShade];
ENDLOOP;
ThreeDScenes.PutShading[newFatPoint, $Color, NEW[ImagerColor.RGB ← [0.7, 0.7, 0.7]]];
Put in the coordinates of the vertices.
newFatPoint.vertex[0].x ← position.x;
newFatPoint.vertex[0].y ← position.y;
newFatPoint.vertex[0].z ← position.z;
newFatPoint.vertex[1].x ← position.x + 0.10;
newFatPoint.vertex[1].y ← position.y;
newFatPoint.vertex[1].z ← position.z;
newFatPoint.vertex[2].x ← position.x;
newFatPoint.vertex[2].y ← position.y + 0.01;
newFatPoint.vertex[2].z ← position.z;
Build the patch.
newFatPoint.surface ← NEW[ThreeDSurfaces.PtrPatchSequence[1]];
surface ← NARROW[newFatPoint.surface, REF ThreeDSurfaces.PtrPatchSequence];
surface[0] ← NEW[ThreeDSurfaces.PtrPatch[3]];
surface[0].nVtces ← 3;
surface[0].type ← $FatPoint;
surface[0].oneSided ← FALSE;
surface[0].vtxPtr[0] ← 0;
surface[0].vtxPtr[1] ← 1;
surface[0].vtxPtr[2] ← 2;
Do the centroid and bounding radius.
newFatPoint.centroid.x ← position.x;
newFatPoint.centroid.y ← position.y;
newFatPoint.centroid.z ← position.z;
newFatPoint.boundingRadius ← 0.1;
END;
MakeFatSeg:
PUBLIC
PROC [name: Rope.
ROPE, points: Vector3d.TripleSequence]
RETURNS [newFatSeg:
REF ThreeDBasics.ShapeInstance] ~
BEGIN
Scratch variables.
nullVertex: ThreeDBasics.Vertex;
nullShade: ThreeDBasics.ShadingValue;
surface: REF ThreeDSurfaces.PtrPatchSequence;
radius: REAL;
There must be at least two points to make the FatSeg.
Error: SIGNAL = CODE;
IF points.length < 2 THEN SIGNAL Error;
Begin creating the newFatSeg.
newFatSeg ← ThreeDScenes.NewShape[name];
newFatSeg.fileName ← "";
newFatSeg.numSurfaces ← points.length - 1;
newFatSeg.type ← $FatSeg;
newFatSeg.insideVisible ← TRUE;
Initialize the vertex and shade sequences.
newFatSeg.vertex ← NEW[ThreeDBasics.VertexSequence[points.length]];
newFatSeg.shade ← NEW[ThreeDBasics.ShadingSequence[points.length]];
FOR i:
NAT
IN [0..points.length)
DO
newFatSeg.vertex[i] ← NEW[ThreeDBasics.Vertex ← nullVertex];
newFatSeg.shade[i] ← NEW[ ThreeDBasics.ShadingValue ← nullShade];
ENDLOOP;
ThreeDScenes.PutShading[newFatSeg, $Color, NEW[ImagerColor.RGB ← [0.7, 0.7, 0.7]]];
Put in the coordinates of the vertices.
FOR i:
NAT
IN [0..points.length)
DO
newFatSeg.vertex[i].x ← points[i].x;
newFatSeg.vertex[i].y ← points[i].y;
newFatSeg.vertex[i].z ← points[i].z;
ENDLOOP;
Build the patches.
newFatSeg.surface ← NEW[ThreeDSurfaces.PtrPatchSequence[points.length - 1]];
surface ← NARROW[newFatSeg.surface, REF ThreeDSurfaces.PtrPatchSequence];
FOR i:
NAT
IN [0..points.length - 1)
DO
surface[i] ← NEW[ThreeDSurfaces.PtrPatch[3]];
surface[i].nVtces ← 3;
surface[i].type ← $FatSeg;
surface[i].oneSided ← FALSE;
surface[i].vtxPtr[0] ← i;
surface[i].vtxPtr[1] ← i + 1;
surface[i].vtxPtr[2] ← i;
ENDLOOP;
Do the centroid and bounding radius.
newFatSeg.centroid.x ← newFatSeg.vertex[0].x;
newFatSeg.centroid.y ← newFatSeg.vertex[0].y;
newFatSeg.centroid.z ← newFatSeg.vertex[0].z;
newFatSeg.boundingRadius ← 0;
FOR i:
NAT
IN [0..points.length)
DO
radius ← RealFns.SqRt[
Sqr[newFatSeg.vertex[i].x - newFatSeg.centroid.x]
+ Sqr[newFatSeg.vertex[i].y - newFatSeg.centroid.y]
+ Sqr[newFatSeg.vertex[i].z - newFatSeg.centroid.z]];
IF radius > newFatSeg.boundingRadius
THEN newFatSeg.boundingRadius ← radius;
ENDLOOP;
END;
MakeTwoCell:
PUBLIC PROC [name: Rope.
ROPE, vertices:
REF CADTypes.VertexSequence, triangles:
REF CADTypes.TriangleSequence]
RETURNS [newTwoCell:
REF ThreeDBasics.ShapeInstance] ~
BEGIN
Streams and other variables
shapeOutStream: IO.STREAM;
shapeFileRope: Rope.ROPE;
tempFileName: Rope.ROPE ~ "[]<>Foo>TemporaryTwoCellFile";
tempFileOutStream: IO.STREAM;
Open a rope output stream to write the shape file to.
shapeOutStream ← IO.ROS[];
Write some keylines.
IO.PutF[shapeOutStream, "TemporaryTwoCellFile\n"];
IO.PutF[shapeOutStream, "\nSurfaceType ~ ConvexPolygon, InsideVisible, CountFromOne\n"];
IO.PutF[shapeOutStream, "\nVertices ~ xyz: triple\n"];
Write the vertices, ignoring the first one (it's garbage).
FOR i: NAT IN [0..vertices.nVertices) DO
IO.PutF[
shapeOutStream,
"\t%g\t%g\t%g\n",
IO.real[vertices[i].x],
IO.real[vertices[i].y],
IO.real[vertices[i].z]];
ENDLOOP;
Write the polygons.
IO.PutF[shapeOutStream, "\nPolygons ~ index: integer vertices: nats\n"];
FOR i: NAT IN [0..triangles.nTriangles) DO
IO.PutF[
shapeOutStream,
"\t%g\t%g\t%g\t%g\n",
IO.int[3],
IO.int[triangles[i].firstVertex],
IO.int[triangles[i].secondVertex],
IO.int[triangles[i].thirdVertex]];
ENDLOOP;
Close up the stream, get it as a rope, and write it to a temporary file.
shapeFileRope ← IO.RopeFromROS[shapeOutStream];
tempFileOutStream ← FS.StreamOpen[tempFileName, $create];
IO.PutF[tempFileOutStream, shapeFileRope];
IO.Close[tempFileOutStream];
Feed the file to ThreeDWorld constructors.
newTwoCell ← ThreeDScenes.NewShape[name];
ThreeDSurfaces.ReadShape[newTwoCell, tempFileName];
END;
AnotherMakeTwoCell:
PROC [name: Rope.
ROPE, vertices:
REF CADTypes.VertexSequence, triangles:
REF CADTypes.TriangleSequence]
RETURNS [newTwoCell:
REF ThreeDBasics.ShapeInstance] ~
BEGIN
Scratch variables.
min, max: Vector3d.Triple;
nullVertex: ThreeDBasics.Vertex;
nullShade: ThreeDBasics.ShadingValue;
surface: REF ThreeDSurfaces.PtrPatchSequence;
Begin creating the newTwoCell.
newTwoCell ← ThreeDScenes.NewShape[name];
newTwoCell.fileName ← "";
newTwoCell.numSurfaces ← triangles.nTriangles;
newTwoCell.type ← $ConvexPolygon;
newTwoCell.insideVisible ← TRUE;
Initialize the vertex and shade sequences.
newTwoCell.vertex ← NEW[ThreeDBasics.VertexSequence[vertices.nVertices]];
newTwoCell.shade ← NEW[ThreeDBasics.ShadingSequence[vertices.nVertices]];
FOR i:
NAT
IN [0..vertices.nVertices)
DO
newTwoCell.vertex[i] ← NEW[ThreeDBasics.Vertex ← nullVertex];
newTwoCell.shade[i] ← NEW[ ThreeDBasics.ShadingValue ← nullShade];
ENDLOOP;
ThreeDScenes.PutShading[newTwoCell, $Color, NEW[ImagerColor.RGB ← [0.2, 0.8, 0.8]]];
Put in the coordinates of the vertices.
FOR i:
NAT
IN [0..vertices.nVertices)
DO
newTwoCell.vertex[i].x ← vertices[i].x;
newTwoCell.vertex[i].y ← vertices[i].y;
newTwoCell.vertex[i].z ← vertices[i].z;
ENDLOOP;
Build the patches.
newTwoCell.surface ← NEW[ThreeDSurfaces.PtrPatchSequence[triangles.nTriangles]];
surface ← NARROW[newTwoCell.surface, REF ThreeDSurfaces.PtrPatchSequence];
FOR i:
NAT
IN [0..triangles.nTriangles)
DO
surface[i] ← NEW[ThreeDSurfaces.PtrPatch[3]];
surface[i].nVtces ← 3;
surface[i].type ← $ConvexPolygon;
surface[i].oneSided ← FALSE;
surface[i].vtxPtr[0] ← triangles[i].firstVertex;
surface[i].vtxPtr[1] ← triangles[i].secondVertex;
surface[i].vtxPtr[2] ← triangles[i].thirdVertex;
ENDLOOP;
Find approximation to the bounding sphere. (Shamelessly stolen from ThreeDSurfacesImpl)
min ← max ← [newTwoCell.vertex[0].x, newTwoCell.vertex[0].y, newTwoCell.vertex[0].z];
FOR i:
NAT
IN (0..newTwoCell.vertex.length)
DO
IF newTwoCell.vertex[i] #
NIL
THEN
BEGIN
IF newTwoCell.vertex[i].x < min.x
THEN min.x ← newTwoCell.vertex[i].x
ELSE IF newTwoCell.vertex[i].x > max.x THEN max.x ← newTwoCell.vertex[i].x;
IF newTwoCell.vertex[i].y < min.y
THEN min.y ← newTwoCell.vertex[i].y
ELSE IF newTwoCell.vertex[i].y > max.y THEN max.y ← newTwoCell.vertex[i].y;
IF newTwoCell.vertex[i].z < min.z
THEN min.z ← newTwoCell.vertex[i].z
ELSE IF newTwoCell.vertex[i].x > max.z THEN max.z ← newTwoCell.vertex[i].z;
END;
ENDLOOP;
newTwoCell.centroid.x ← (min.x + max.x) / 2;
newTwoCell.centroid.y ← (min.y + max.y) / 2;
newTwoCell.centroid.z ← (min.z + max.z) / 2;
newTwoCell.boundingRadius ← 0.;
FOR i:
NAT
IN [0..newTwoCell.vertex.length)
DO
radius: REAL ← RealFns.SqRt[
Sqr[newTwoCell.vertex[i].x - newTwoCell.centroid.x]
+ Sqr[newTwoCell.vertex[i].y - newTwoCell.centroid.y]
+ Sqr[newTwoCell.vertex[i].z - newTwoCell.centroid.z] ];
IF radius > newTwoCell.boundingRadius
THEN newTwoCell.boundingRadius ← radius;
ENDLOOP;
newTwoCell ← ThreeDScenes.NewShape[name];
ThreeDSurfaces.ReadShape[newTwoCell, "[]<>Users>Rauen.pa>AlgebraicSurfaces>ChampagneGlass.shape"];
END;
Sqr:
PROC [number:
REAL]
RETURNS [result:
REAL] ~
BEGIN
result ← number * number;
END;