ImplicitSpheresCmdImpl.mesa
Copyright Ó 1985, 1990 by Xerox Corporation. All rights reserved.
Bloomenthal, November 21, 1992 5:49 pm PST
DIRECTORY CedarProcess, Commander, Controls, Draw2d, G3dControl, G3dCubeDraw, G3dMatrix, G3dOctree, G3dVector, G3dView, Imager, ImagerFont, ImagerInterpress, ImplicitDefs, ImplicitPoints, ImplicitSurface, Real, Rope, ViewerOps, ViewerClasses;
ImplicitSpheresCmdImpl:
CEDAR
PROGRAM
IMPORTS CedarProcess, Commander, Controls, Draw2d, G3dControl, G3dCubeDraw, G3dOctree, G3dVector, G3dView, Imager, ImagerFont, ImagerInterpress, ImplicitSurface, ImplicitPoints, Real, Rope, ViewerOps
Types
Control: TYPE ~ Controls.Control;
OuterData: TYPE ~ Controls.OuterData;
Matrix: TYPE ~ G3dMatrix.Matrix;
Corner: TYPE ~ G3dOctree.Corner;
Cube: TYPE ~ G3dOctree.Cube;
CubeProc: TYPE ~ G3dOctree.CubeProc;
Octant: TYPE ~ G3dOctree.Octant;
Octree: TYPE ~ G3dOctree.Octree;
Context: TYPE ~ Imager.Context;
StatusProc: TYPE ~ ImplicitDefs.StatusProc;
Surface: TYPE ~ ImplicitDefs.Surface;
SurfaceProc: TYPE ~ ImplicitDefs.SurfaceProc;
SurfaceRep: TYPE ~ ImplicitDefs.SurfaceRep;
ValueProc: TYPE ~ ImplicitDefs.ValueProc;
ROPE: TYPE ~ Rope.ROPE;
ClickProc: TYPE ~ ViewerClasses.ClickProc;
MouseButton: TYPE ~ ViewerClasses.MouseButton;
Viewer:
TYPE ~ ViewerClasses.Viewer;
Option: TYPE ~ {edges, contours};
Options: TYPE ~ ARRAY Option OF BOOL;
Pending: TYPE ~ {converge, shape, render, paint, pairs};
Pendings: TYPE ~ ARRAY Pending OF BOOL;
ProgramData: TYPE ~ REF ProgramDataRep;
ProgramDataRep:
TYPE ~
RECORD [
outer: Viewer ← NIL, -- parent viewer
outerData: OuterData ← NIL, -- parent viewer's data
graphics: Viewer ← NIL, -- viewer for display
options: Options ← ALL[FALSE], -- viewing options
surfaceId: NAT ← 0, -- current sphere
cam: G3dControl.CameraControl ← NIL, -- camera
pendings: Pendings ← ALL[FALSE], -- program state
octree: Octree, -- the octree
roots: ARRAY [0..3) OF Cube ← ALL[NIL], -- the octree roots
rootSize: Control ← NIL, -- root size
level: Control ← NIL, -- limit to recursion depth
size: Control ← NIL, -- size of surface
views: ARRAY [0..3) OF Matrix ← ALL[NIL], -- view transformations
surfaces: ARRAY [0..3) OF Surface ← ALL[NIL], -- the subdivided surfaces
abort: BOOL ← FALSE -- flag to abort subdivision
];
Converging to a Simple Surface
ImplicitSpheres: Commander.CommandProc ~ {
p: ProgramData ~ NEW[ProgramDataRep];
p.size ← Controls.NewControl["size", , p, 0.001, 0.25, 0.1, Controller];
p.rootSize ← Controls.NewControl["cSize", , p, 0.001, 1.0, 0.25,,,,,,,,,,,, exp];
p.level ← Controls.NewControl["level", , p, 0.0, 6.0, 1.0, Controller, , 0];
p.cam ← G3dControl.InitCameraControl[scale: 3.0, proc: CameraControl, clientData: p];
p.outerData ← Controls.OuterViewer[
name: "Implicit Spheres",
buttons:
LIST[
Controls.ClickButton["Edges-Off", ToggleEdges],
Controls.ClickButton["Contours-Off", ToggleContours],
Controls.ClickButton["IP Out", IPOut],
Controls.ClickButton["Surface 0", SurfaceId]],
controls:
LIST[
p.cam.proxySelect,
p.cam.proxy.xMov, p.cam.proxy.yMov, p.cam.proxy.zMov,
p.cam.proxy.xRot, p.cam.proxy.yRot, p.cam.proxy.zRot,
p.cam.scale, p.cam.fieldOfView],
graphicsHeight: 120,
drawProc: DrawProc,
typescriptHeight: 30,
clientData: p
];
p.outer ← p.outerData.parent;
p.graphics ← p.outerData.graphics;
};
DrawAction:
PROC [p: ProgramData, context: Context, forInterpress:
BOOL ←
FALSE] ~ {
vp: G3dMatrix.Viewport ← G3dView.GetViewport[NIL, context];
FOR n:
NAT
IN [0..3)
DO
IF forInterpress THEN Imager.SetColor[context, Imager.MakeGray[0.5]];
IF p.options[edges]
THEN G3dCubeDraw.TerminalCubes[
context, p.roots[n], p.views[n], vp, IF forInterpress THEN solid ELSE dashed];
Imager.SetColor[context, Imager.black];
ImplicitDraw.DrawSurface[
context: context,
surface: p.surfaces[n],
view: p.views[n],
drawPolygons: TRUE,
drawBackFaces: FALSE,
forInterpress: forInterpress];
ENDLOOP;
};
DrawProc: Draw2d.DrawProc ~ {
p: ProgramData ~ NARROW[clientData];
Draw2d.Clear[context];
p.views[p.surfaceId] ←
G3dControl.InitContext[context, p.cam, viewer, FALSE, p.views[p.surfaceId]];
DrawAction[p, context];
};
CheckPending: CedarProcess.ForkableProc ~ {
p: ProgramData ~ NARROW[data];
IF p.pendings[converge] THEN Converge[p];
IF p.pendings[paint] OR p.pendings[converge] THEN Repaint[p.graphics];
p.pendings[converge] ← p.pendings[paint] ← p.pendings[pairs] ← FALSE;
};
CameraControl: Controls.ControlProc ~ {
p: ProgramData ~ NARROW[clientData];
G3dControl.UpdateCameraControl[p.cam];
p.pendings[render] ← p.pendings[paint] ← p.pendings[pairs] ← TRUE;
IF RespondNow[control] THEN [] ← CheckPending[p];
};
Controller: Controls.ControlProc ~ {
p: ProgramData ~ NARROW[control.clientData];
IF NOT RespondNow[control] THEN RETURN;
p.pendings[converge] ← TRUE;
[] ← CheckPending[p];
};
Converge:
PROC [p: ProgramData] ~ {
TSWrite: PROC [rope: ROPE] ~ {Controls.TypescriptWrite[p.outerData.typescript, rope]};
octant0, octant1: Octant;
r2: REAL ~ p.size.value*p.size.value;
max: NAT ~ Real.Round[p.level.value];
Report: CubeProc ~ {
IF cube =
NIL
THEN TSWrite[IF p.abort THEN ". . . aborted." ELSE ". . . done; "]
ELSE {
octant0 ← cube.octant;
octant1 ← G3dOctree.OppositeOctant[octant0];
IF cube.octant = FIRST[Octant] THEN TSWrite["Beginning octant "];
TSWrite[Rope.Concat[G3dOctree.RopeFromOctant[cube.octant], " "]];
};
RETURN[NOT p.abort];
};
Status: StatusProc ~ {IF p.abort THEN RETURN[$Abort]};
sphereValue: ValueProc ~ {RETURN[r2-G3dVector.Square[point]]};
sphereSurface: SurfaceProc ~ {
c0: Corner ~ cube.corners[octant0];
c1: Corner ~ cube.corners[octant1];
IF NOT c0.valueSet THEN ImplicitPoints.SetCornerValue[c0, sphereValue[c0.point, NIL]];
IF NOT c1.valueSet THEN ImplicitPoints.SetCornerValue[c1, sphereValue[c1.point, NIL]];
RETURN[c0.inside # c1.inside];
};
n: NAT ~ p.surfaceId;
p.abort ← FALSE;
p.surfaces[n] ← NEW[SurfaceRep];
p.roots[n] ← (p.surfaces[n].octree ←
ImplicitSurface.ConvergeOctree[p.rootSize.value, 1, max, sphereValue, 0.0,, Status, p]).root;
ImplicitSurface.MakePolygons[p.surfaces[n], sphereValue, 0.0,,,,,,,, p];
p.pendings[paint] ← p.pendings[pairs] ← p.pendings[shape] ← TRUE;
};
SurfaceId: ClickProc ~ {
outer: Controls.OuterData ← NARROW[clientData];
p: ProgramData ~ NARROW[outer.clientData];
SELECT p.surfaceId
FROM
0 => Controls.ButtonRelabel[outer, "Surface 0", "Surface 1"];
1 => Controls.ButtonRelabel[outer, "Surface 1", "Surface 2"];
2 => Controls.ButtonRelabel[outer, "Surface 2", "Surface 0"];
ENDCASE;
p.surfaceId ← (p.surfaceId+1) MOD 3;
};
IPOut: ClickProc ~ {
outerData: OuterData ~ NARROW[clientData];
p: ProgramData ~ NARROW[outerData.clientData];
fileName: ROPE ← Controls.TypescriptReadFileName[outerData.typescript];
IF fileName #
NIL
THEN {
ref: ImagerInterpress.Ref ← ImagerInterpress.Create[fileName];
ContextProc:
PROC [context: Context] ~ {
metersPerPoint: REAL ~ .0254/72.0;
Imager.ScaleT[context, metersPerPoint];
Imager.SetStrokeWidth[context, 1.0];
Imager.SetStrokeEnd[context, round];
Imager.SetFont[
context, ImagerFont.Scale[ImagerFont.Find["xerox/pressfonts/helvetica-mrr"], 12.0]];
Imager.TranslateT[context, [0.0, 0.5*11.0*72.0]];
DrawAction[p, context, TRUE];
};
ImagerInterpress.DoPage[ref, ContextProc];
ImagerInterpress.Close[ref];
};
};
ToggleEdges: ClickProc ~ {Tog[clientData, mouseButton, edges, "Edges"]};
ToggleContours: ClickProc ~ {Tog[clientData, mouseButton, contours, "Contours"]};
Tog:
PROC [data:
REF
ANY, button: MouseButton, opt: Option, name:
ROPE] ~ {
outerData: OuterData ~ NARROW[data];
p: ProgramData ~ NARROW[outerData.clientData];
bool: BOOL ~ p.options[opt] ← NOT p.options[opt];
Controls.ButtonToggle[outerData, bool, Rope.Concat[name, "-On"], Rope.Concat[name, "-Off"]];
p.pendings[paint] ← TRUE;
IF button = blue THEN [] ← CedarProcess.Fork[CheckPending, p, [background, TRUE]];
};
Abort: ClickProc ~ {
NARROW[NARROW[clientData, OuterData].clientData, ProgramData].abort ← TRUE;
};
Repaint:
PROC [v: Viewer] ~ {ViewerOps.PaintViewer[v, client,
FALSE,
NIL]};
RespondNow:
PROC [control: Control]
RETURNS [
BOOL] ~ {
RETURN[control.mouse.button = right AND control.mouse.state # up];
};