
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

~ BEGIN
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
];
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];
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];
};
Commander.Register["ImplicitSpheres", ImplicitSpheres, "\nShow subdivided spheres."];

END.

   `  
ImplicitSpheresCmdImpl.mesa
Copyright س 1985, 1990 by Xerox Corporation.  All rights reserved.
Bloomenthal, November 21, 1992 5:49 pm PST
Types
Converging to a Simple Surface
ImplicitDraw.DrawSurface[
context: context,
surface: p.surfaces[n],
view: p.views[n],
drawPolygons: TRUE,
drawBackFaces: FALSE,
forInterpress: forInterpress];
Start Code
‌تة  •NewlineDelimiter
™ ™JڑœB™BJ™*Jک Jڑدk	œéکٍJک —ڑذblœ‌œ‌ک%Jڑ‌œہکاJک —Jڑœ‌کheadڑدl™Jڑœ
‌œک$Jڑœ‌œک'Jڑœ
‌œک#Jڑœ	‌œک#Jڑœ‌œک Jڑœ‌œک&Jڑœ
‌œک#Jڑœ
‌œک#Jڑœ‌œک"Jڑœ‌œک-Jڑœ‌œک(Jڑœ‌œک/Jڑœ‌œک-Jڑœ‌œک+Jڑ‌œ‌œ‌œکJڑœ‌œک,Jڑœ‌œک/ڑœ
‌œک'Jک —Jڑœ‌œک$Jڑ	œ‌œ‌œ‌œ‌œک(Jک Jڑœ‌œ+ک;Jڑ	œ‌œ‌œ	‌œ‌œک*Jک Jڑœ‌œ‌œک)ڑœ‌œ‌œک Jڑœ‌œدcک1Jڑœ‌œ ک<Jڑœ‌œ ک8Jڑœ‌œ‌œ ک:Jڑœ‌œ ک2Jڑœ&‌œ 	ک5Jڑœ‌œ‌œ ک9Jڑœ ک*Jڑ
œ‌œ‌œ‌œ‌œ کAJڑœ‌œ ک0Jڑœ‌œ ک=Jڑœ‌œ ک3Jڑ
œ‌œ‌œ
‌œ‌œ کFJڑ
œ‌œ‌œ‌œ‌œ کMJڑœ‌œ‌œ ک<Jک——ڑں™ڑدbœک*Jڑœ‌œک%JکHJکQJکLJکUڑœ#ک#Jکڑœ	‌œکJک/Jک5Jک&Jک.—ڑœ
‌œکJکJک5Jک5Jک —JکJکJکJکJک—JڑœکJک"JکJک —ڑدn
œ‌œ3‌œ‌œکTJڑœ-‌œک;ڑ‌œ‌œ‌œ‌کJڑ‌œ‌œ0کEڑ‌œ‌œک3Jڑœ%‌œ‌œ‌œ	کN—Jک'™J™J™J™Jڑœ‌œ™Jڑœ‌œ™J™—Jڑ‌œک—JکJک —ڑ،œکJڑœ‌œک$JککJڑœ/‌œکL—JکJکJک —codeڑذbnœک+Lڑœ‌œکLڑ‌œ‌œک)Jڑ‌œ‌œ‌œکFJڑœ?‌œکELکLک —ڑ£œک'Jڑœ‌œک$Jک&Jڑœ=‌œکBJڑ‌œ‌œک1JکJک —ڑ¢
œک$Jڑœ‌œک,Jڑ‌œ‌œ‌œ‌œک'Jڑœ‌œکJکJکJک —ڑ¢œ‌œک#Jڑ¢œ‌œ‌œ=کVJکJڑœ‌œک%Jڑœ‌œک%ڑ¢œکڑ‌œ‌کJڑ‌œ	‌œ	‌œ‌œکBڑ‌œکJکJک,Jڑ‌œ‌œ	‌œکAJکAJک——Jڑ‌œ‌œ
کJک—Jڑ£œ‌œ	‌œ‌œ
ک6Jڑ،œ‌œک>ڑ¢œکJک#Jک#Jڑ‌œ‌œ‌œ9‌œکVJڑ‌œ‌œ‌œ9‌œکVJڑ‌œکJک—Jڑœ‌œکJڑœ
‌œکJڑœ‌œک ک$Jک]—JکHJڑœ<‌œکAJکJک —ڑ،	œکJڑœ‌œک/Jڑœ‌œک*ڑ‌œ‌کJک=Jک=Jک=Jڑ‌œک—Jڑœ‌œک$JکJک —ڑ¢œکJڑœ‌œک*Jڑœ‌œک.Jڑœ
‌œ9کGڑ‌œ‌œ‌œکJک>ڑ¢œ‌œک(Lڑœ‌œک"Lک'Lک$Lک$کJکT—Jک1Jڑœ‌œکJک—Jک*JکJک—JکJک —Jڑ£œ>کIڑ¢œCکQJک —ڑ
£œ‌œ‌œ‌œ*‌œکKJڑœ‌œک$Jڑœ‌œک.Jڑœ‌œ‌œک1Jک\Jڑœ‌œکJڑ‌œ‌œ6‌œکRLکLک —ڑ،œکJڑ‌œ‌œ9‌œکKJکJک —ڑ¢œ‌œ1‌œ‌œکKJک —ڑ¢
œ‌œ‌œ‌œک6Jڑ‌œ‌œکBJک——ڑں
™
JکUJک —Jڑ‌œکJک — …—    t  (‌  