ImplicitAnimateImpl.mesa
Copyright Ó 1985, 1990 by Xerox Corporation. All rights reserved.
Bloomenthal, August 11, 1992 4:03 pm PDT
DIRECTORY CedarProcess, Commander, Controls, Convert, Draw2d, FS, G3dBasic, G3dControl, G3dMatrix, G3dOctree, G3dShape, G3dTube, Imager, ImplicitDefs, ImplicitDraw, ImplicitMisc, ImplicitPoints, ImplicitSurface, ImplicitTube, IO, MessageWindow, Real, RealFns, Rope, ViewerClasses, ViewerOps;
ImplicitAnimateImpl: CEDAR PROGRAM
IMPORTS CedarProcess, Commander, Controls, Convert, Draw2d, FS, G3dControl, G3dShape, G3dTube, Imager, ImplicitDraw, ImplicitMisc, ImplicitPoints, ImplicitSurface, ImplicitTube, IO, MessageWindow, Real, RealFns, Rope, ViewerOps
~ BEGIN
Imported Types
ClickProc:   TYPE ~ Controls.ClickProc;
Control:    TYPE ~ Controls.Control;
OuterData:   TYPE ~ Controls.OuterData;
Triple:    TYPE ~ G3dBasic.Triple;
Camera:    TYPE ~ G3dControl.Camera;
Matrix:    TYPE ~ G3dMatrix.Matrix;
Cube:     TYPE ~ G3dOctree.Cube;
OctreeMode:   TYPE ~ G3dOctree.OctreeMode;
Tube:     TYPE ~ G3dTube.Tube;
TubeRep:    TYPE ~ G3dTube.TubeRep;
TubeSequenceRep: TYPE ~ G3dTube.TubeSequenceRep;
NormalProc:   TYPE ~ ImplicitDefs.NormalProc;
StatusProc:   TYPE ~ ImplicitDefs.StatusProc;
Surface:    TYPE ~ ImplicitDefs.Surface;
SurfaceRep:   TYPE ~ ImplicitDefs.SurfaceRep;
TextureProc:   TYPE ~ ImplicitDefs.TextureProc;
ValueProc:   TYPE ~ ImplicitDefs.ValueProc;
ROPE:     TYPE ~ Rope.ROPE;
Viewer:    TYPE ~ ViewerClasses.Viewer;
Local Types
UserData:    TYPE ~ RECORD [o: OuterData, p: ProgramData];
ProgramData:   TYPE ~ REF ProgramDataRep;
ProgramDataRep:  TYPE ~ RECORD [
Miscellany:
directory:     ROPE ¬ NIL,
Controls:
camera:     Camera ¬ NIL,
frame:      Control ¬ NIL,
Viewing:
outer:      Viewer ¬ NIL,
outerData:    OuterData ¬ NIL,
graphics:     Viewer ¬ NIL,
view:      Matrix ¬ NIL,
Diagnostics:
currentCube:    Cube ¬ NIL,
State:
abort:      BOOL ¬ FALSE,
Animation:
nFrames:     NAT ¬ 20,
nFrame:     NAT ¬ 0,
Options:
drawSplines:    BOOL ¬ TRUE,
drawPolygons:   BOOL ¬ TRUE,
drawEdges:    BOOL ¬ TRUE,
Geometry:
startPoint:    Triple ¬ [],
size:      REAL ¬ 0.15,
spread:     REAL ¬ 0.9,
thresh:     REAL ¬ 0.5,
surface:     Surface ¬ NIL,
adaptLimit:    Control ¬ NIL,     -- limit to adaptive subdivision
flatness:     Control ¬ NIL,     -- minimum flatness: adaptive test
tube:      Tube ¬ NIL
];
Implicit Animate
ImplicitAnimate: Commander.CommandProc ~ {
p: ProgramData ~ NEW[ProgramDataRep];
p.camera ¬ G3dControl.InitCamera[scale: 0.7, proc: CameraControl, data: p];
p.frame ¬ Controls.NewControl["frame", , p, 0.0, p.nFrames, 0.0, FrameControl, , 0];
p.adaptLimit ¬ Controls.NewControl["adapt", , p, 0.0, 6.0, 0.0, NIL, , 0];
p.flatness ¬ Controls.NewControl["flat", , p, 0.01, 40.0, 15.0, NIL,,,,,,,,,,, exp];
SetTube[p];
p.outer ¬ Controls.OuterViewer[
name: "Implicit Animate",
buttons: LIST[
Controls.ClickButton["Size", NewParameter],
Controls.ClickButton["Threshold", NewParameter],
Controls.ClickButton["Spread", NewParameter],
Controls.ClickButton["Abort", Abort],
Controls.ClickButton["Explore", Explore],
Controls.ClickButton["Animate", Animate],
Controls.ClickButton["PP-Out", PPOut],
Controls.ClickButton["Splines-On", ToggleSplines],
Controls.ClickButton["Edges-On", ToggleEdges],
Controls.ClickButton["Polygons-On", TogglePolygons]],
controls: LIST[
p.camera.par.xRot, p.camera.par.yRot, p.camera.par.zRot, p.camera.scale,
p.frame, p.adaptLimit, p.flatness],
controlSizes: [20, 200, 60, 20, 60, 150, 150],
typescriptHeight: 30,
graphicsHeight: 300,
drawProc: DrawProc,
clientData: p];
p.outerData ¬ NARROW[p.outer.data];
p.graphics ¬ p.outerData.graphics;
p.directory ¬ NARROW[ViewerOps.FetchProp[p.outerData.parent, $WorkingDirectory]];
};
CameraControl: G3dControl.CameraProc ~ {
p: ProgramData ~ NARROW[data];
ImplicitPoints.SetVertexScreenCoordsInvalid[p.surface];
IF control.mouse.button = right AND control.mouse.state # up THEN Repaint[p];
};
Display
Repaint: PROC [p: ProgramData, whatChanged: REF ANY ¬ NIL] ~ {
ViewerOps.PaintViewer[p.graphics, client, FALSE, whatChanged];
};
DrawProc: Draw2d.DrawProc ~ {
p: ProgramData ~ NARROW[data];
Action: PROC ~ {
SELECT whatChanged FROM
NIL => {
p.view ¬ G3dControl.InitContext[context, p.camera, viewer, , p.view];
ImplicitPoints.SetVertexScreenCoordsInvalid[p.surface];
ImplicitDraw.DrawSurface[context, p.surface, p.view,, p.drawPolygons, TRUE];
IF p.drawSplines THEN G3dTube.DrawSplines[context, p.tube, p.view];
};
$Tube => {
Draw2d.Clear[context];
IF p.drawSplines THEN G3dTube.DrawSplines[context, p.tube, p.view];
};
ENDCASE =>
ImplicitDraw.DiagramProgress[context, whatChanged, p.currentCube.refAny, p.view, p.surface, p.currentCube, p.drawEdges, p.drawPolygons];
};
IF (whatChanged # NIL AND whatChanged # $Tube) OR
(p.drawEdges AND p.surface.octree # NIL) OR
(p.surface # NIL AND (p.drawEdges OR (p.drawPolygons AND p.surface.nPolygons > 1000)))
THEN Action[]
ELSE Draw2d.DoWithBuffer[context, Action];
};
Surface Exploration
abort: ERROR = CODE;
Abort: ClickProc ~ {UserDataFromClientData[clientData].p.abort ¬ TRUE};
Reset: PROC [p: ProgramData] ~ {p.surface ¬ NIL; Repaint[p]};
Explore: ClickProc ~ {
u: UserData ¬ UserDataFromClientData[clientData];
DoExplore[u.p ! abort => {TSWrite[u.p, ". . . aborted.\n"]; CONTINUE}];
};
DoExplore: PROC [p: ProgramData] ~ {
Status: StatusProc ~ {
IF p.abort THEN RETURN[$Abort];
WITH ref SELECT FROM
a: ATOM => {
IF surfaceState = $Vertex AND a = $Polygon
THEN ImplicitPoints.SetVertexScreenCoords[p.surface, p.view];
surfaceState ¬ a;
};
r: ROPE => TSWrite[p, r];
c: Cube => {
p.currentCube ¬ c;
Repaint[p, surfaceState];
};
ENDCASE;
CedarProcess.CheckAbort[];
};
Normal: NormalProc ~ {
RETURN[ImplicitPoints.GetPointNormal[point, Value, value, delta]];
};
Value: ValueProc ~ {
value ¬ ImplicitTube.SampleTube[point, p.tube, $Segment, p.thresh, p.spread].value;
};
Texture: TextureProc ~ {
RETURN[ImplicitTube.TextureOfTube[vertex.point, p.tube]];
};
limit: NAT ~ Real.InlineRoundI[p.adaptLimit.value];
pt: Triple ¬ p.startPoint ¬
ImplicitTube.StartPoint[p.tube, Value, p.thresh, $Segment, p.spread, p];
octreeMode: OctreeMode ¬ [limit, p.flatness.value, 0.0001, track[p.size, pt]];
delta: REAL ~ 0.01*p.size;
surfaceState: ATOM;
p.abort ¬ FALSE;
CedarProcess.SetPriority[background];
Reset[p];
p.surface ¬ NEW[SurfaceRep];
ImplicitSurface.MakeSurface[p.surface, octreeMode, Value,,, Normal, Texture, Status,,, p];
p.shape ¬ ImplicitSurface.ShapeFromSurface[p.surface];
};
Parameters
NewParameter: ClickProc ~ {
E: PROC [rope: ROPE] RETURNS [BOOL] ~ {RETURN[Rope.Equal[parent.name, rope, FALSE]]};
N: PROC [old: REAL] RETURNS [REAL] ~ {
RETURN[Controls.TypescriptReadValue[u.o.typescript, parent.name, old]];
};
u: UserData ¬ UserDataFromClientData[clientData];
SELECT TRUE FROM
E["Threshold"] => u.p.thresh ¬ N[u.p.thresh];
E["Spread"]  => u.p.spread ¬ N[u.p.spread];
E["Size"]   => u.p.size ¬ N[u.p.size];
ENDCASE;
MessageWindow.Append[InfoRope[u.p], TRUE];
};
InfoRope: PROC [p: ProgramData] RETURNS [ROPE] ~ {
RETURN[IO.PutFR["threshold: %g, size: %g, spread: %g", IO.real[p.thresh], IO.real[p.size], IO.real[p.spread]]];
};
Animation
Animate: ClickProc ~ {
u: UserData ¬ UserDataFromClientData[clientData];
EachName: FS.NameProc ~ {
i: INTEGER ¬ Rope.Index[fullFName, 0, "ImplicitTube."]+Rope.Length["ImplicitTube."];
rope: ROPE ¬ Rope.Substr[fullFName, i, Rope.Index[fullFName, i+1, "."]-i];
n: NAT ¬ Convert.IntFromRope[rope];
IF n >= u.p.nFrame THEN u.p.nFrame ¬ n+1;
RETURN[TRUE];
};
u.p.nFrame ¬ 0;
FS.EnumerateForNames[Rope.Concat[u.p.directory, "ImplicitTube*.pp"], EachName];
WHILE u.p.nFrame <= u.p.nFrames DO
Controls.SetSliderDialValue[u.p.frame, u.p.nFrame];
NextFrame[u.p ! abort => {TSWrite[u.p, ". . . aborted.\n"]; EXIT}];
ENDLOOP;
};
PPOut: ClickProc ~ {
u: UserData ¬ UserDataFromClientData[clientData];
IF u.p.surface = NIL
THEN Controls.TypescriptWrite[u.o.typescript, "No surface to write.\n"]
ELSE ImplicitMisc.WriteToFile[
Controls.TypescriptReadFileName[u.o.typescript], u.p.surface, InfoRope[u.p]];
};
NextFrame: PROC [p: ProgramData] ~ {
SetTube[p];
Reset[p];
DoExplore[p];
IF p.surface = NIL
THEN Controls.TypescriptWrite[p.outerData.typescript, "No surface to write.\n"]
ELSE ImplicitMisc.WriteToFile[Rope.Cat[p.tube.name, ".pp"], p.surface, InfoRope[p]];
p.nFrame ¬ p.nFrame+1;
};
FrameControl: Controls.ControlProc ~ {
p: ProgramData ¬ NARROW[control.clientData];
p.nFrame ¬ Real.InlineRoundI[control.value];
IF control.mouse.button = right AND control.mouse.state # up THEN {
SetTube[p];
Repaint[p, $Tube];
};
};
Tube Procs
SetTube: PROC [p: ProgramData] ~ {
t: REAL ¬ REAL[p.nFrame]/REAL[p.nFrames];
angle: REAL ¬ 90.0-180.0*t;
p1: Triple ¬ [RealFns.CosDeg[angle], RealFns.SinDeg[angle], 0.0];
p.tube ¬ NEW[TubeRep ¬ [p0: [0, -1, 0], p1: [0, 0, 0], v0: [0, 0.5, 0], v1: [0, 0.5, 0]]];
p.tube.next ¬ NEW[TubeRep ¬ [p0: [0, 0, 0], p1: [0, 1, 0], v0: [0, 0.5, 0], v1: [0, 0.5, 0]]];
p.tube.branches ¬ NEW[TubeSequenceRep[1]];
p.tube.branches.length ¬ 1;
p.tube.branches[0] ¬ NEW[TubeRep ¬ [p0: [0,0,0], p1: p1, v0: [0,1,0], v1: p1]];
G3dTube.SetSpline[p.tube];
p.tube.name ¬ IO.PutFR["%gImplicitTube.%g", IO.rope[p.directory], IO.int[p.nFrame]];
G3dTube.SelectAll[p.tube];
G3dTube.SetRadii[p.tube, 0.1];
ImplicitTube.PrepareTube[p.tube, [$Segment, inverse]];
};
Options
Toggle: PROC [u: UserData, state: BOOL, name: ROPE, repaint: BOOL ¬ TRUE] ~ {
Controls.ButtonToggle[u.o, state, Rope.Concat[name, "-On"], Rope.Concat[name, "-Off"]];
IF repaint THEN Repaint[u.p];
};
ToggleSplines: ClickProc ~ {
u: UserData ¬ UserDataFromClientData[clientData];
Toggle[u, u.p.drawSplines ¬ NOT u.p.drawSplines, "Splines", mouseButton = blue];
};
TogglePolygons: ClickProc ~ {
u: UserData ¬ UserDataFromClientData[clientData];
Toggle[u, u.p.drawPolygons ¬ NOT u.p.drawPolygons, "Polygons", mouseButton = blue];
};
ToggleEdges: ClickProc ~ {
u: UserData ¬ UserDataFromClientData[clientData];
Toggle[u, u.p.drawEdges ¬ NOT u.p.drawEdges, "Edges", mouseButton = blue];
};
Support
UserDataFromClientData: PROC [clientData: REF ANY] RETURNS [u: UserData] ~ {
u.p ¬ NARROW[(u.o ¬ NARROW[clientData]).clientData];
};
TSWrite: PROC [p: ProgramData, rope: ROPE] ~ {
Controls.TypescriptWrite[p.outerData.typescript, rope];
};
Start Code
Commander.Register["ImplicitAnimate", ImplicitAnimate, "\nAnimate various designs."];
END.