<<>>
<<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.