G3dTextureCmdImpl.mesa
Copyright Ó 1985, 1992 by Xerox Corporation. All rights reserved.
Bloomenthal, October 20, 1992 4:59 pm PDT
DIRECTORY Args, CedarProcess, Commander, Controls, Draw2d, G3dDraw, G3dMatrix, G3dBasic, G3dShape, G3dTool, G3dVector, FileNames, IO, MessageWindow, Random, Real, RealFns, Rope, Vector2;
G3dTextureCmdImpl: CEDAR PROGRAM
IMPORTS Args, CedarProcess, Controls, Draw2d, G3dDraw, G3dShape, G3dTool, G3dVector, FileNames, IO, MessageWindow, Random, Real, RealFns, Rope, Vector2
~ BEGIN
Types
ROPE:       TYPE ~ Rope.ROPE;
Viewer:      TYPE ~ Controls.Viewer;
ClickProc:     TYPE ~ Controls.ClickProc;
OuterData:     TYPE ~ Controls.OuterData;
Control:      TYPE ~ Controls.Control;
NatSequence:     TYPE ~ G3dBasic.NatSequence;
NatSequenceRep:    TYPE ~ G3dBasic.NatSequenceRep;
Pair:       TYPE ~ G3dBasic.Pair;
PairSequence:    TYPE ~ G3dBasic.PairSequence;
PairSequenceRep:   TYPE ~ G3dBasic.PairSequenceRep;
Triple:      TYPE ~ G3dBasic.Triple;
Matrix:      TYPE ~ G3dMatrix.Matrix;
Shape:      TYPE ~ G3dShape.Shape;
Vertex:      TYPE ~ G3dShape.Vertex;
Tool:       TYPE ~ G3dTool.Tool;
Command
Data:    TYPE ~ REF DataRep;
DataRep:   TYPE ~ RECORD [
tool:      Tool ¬ NIL,
fileName:     ROPE ¬ NIL,
labelsOn, lengthsOn: BOOL ¬ FALSE,
ratiosOn, texturesOn: BOOL ¬ FALSE,
textureScale:    REAL ¬ 1.0,
shape:      Shape ¬ NIL
];
Texture: Commander.CommandProc ~ {
p: Data ¬ NEW[DataRep];
IF Args.GetRope[cmd] = NIL THEN RETURN[$Failure, "Specify pp file."];
p.fileName ¬ FileNames.ResolveRelativePath[Args.GetRope[cmd]];
p.tool ¬ G3dTool.MakeTool[
name: Rope.Concat["Texture ", p.fileName],
extraButtons: LIST[
Controls.TextButton["Texture Scale", "1.00", TextureScale, p],
Controls.ClickButton["Texture", TextureButton, p],
Controls.ClickButton["Relax Once", RelaxOnceButton, p],
Controls.ClickButton["Relax", RelaxButton, p],
Controls.ClickButton["Diagnostics", DiagnosticsButton, p],
Controls.ClickButton["Output", OutputButton, p]],
graphicsHeight: 300,
client: [draw: DrawProc, data: p]];
IF (msg ¬ G3dTool.ReadFromShapeFile[
p.tool, FileNames.ResolveRelativePath[Args.GetRope[cmd]], TRUE]) # NIL
THEN RETURN[$Failure, msg];
p.shape ¬ p.tool.shapes[0];
};
Buttons
Blink: PROC [message: ROPE] ~ {
MessageWindow.Append[message, TRUE];
MessageWindow.Blink[];
};
TextureScale: ClickProc ~ {
p: Data ¬ NARROW[clientData];
p.textureScale ¬ Controls.GetTextButtonValue[p.tool.outerData, "Texture Scale"
! Controls.ControlError => {Blink["Bad Value"]; CONTINUE}];
};
MaybeFork: PROC [clientData: REF ANY, proc: CedarProcess.ForkableProc] ~ {
p: Data ¬ NARROW[clientData];
[] ¬ G3dTool.MaybeFork[p.tool, proc, p];
};
TextureButton: ClickProc ~ {MaybeFork[clientData, ForkTexture]};
RelaxOnceButton: ClickProc ~ {MaybeFork[clientData, ForkRelaxOnce]};
RelaxButton:  ClickProc ~ {MaybeFork[clientData, ForkRelax]};
OutputButton: ClickProc ~ {
p: Data ¬ NARROW[clientData];
IF p.shape = NIL
THEN Controls.TypescriptWrite[p.tool.typescript, "No shape to write.\n"]
ELSE {
fileName: ROPE ¬ Controls.TypescriptReadFileName[p.tool.typescript];
IF fileName # NIL THEN G3dShape.ShapeToFile[fileName, p.shape];
};
};
BoolRequest: PROC [b: BOOL, r: ROPE] RETURNS [req: Controls.Request] ~ {
req.choice ¬ IO.PutFR["%g is %g", IO.rope[r], IO.rope[IF b THEN "On" ELSE "Off"]];
req.doc ¬ IO.PutFR["Turn %g %g", IO.rope[IF b THEN "Off" ELSE "On"], IO.rope[r]];
};
DiagnosticsButton: ClickProc ~ {
p: Data ¬ NARROW[clientData];
SELECT Controls.PopUpRequest[["Display Options"], LIST[
BoolRequest[p.labelsOn, "Labels"],
BoolRequest[p.texturesOn, "Textures"],
BoolRequest[p.ratiosOn, "Ratios"],
BoolRequest[p.lengthsOn, "Lengths"]]] FROM
1 => p.labelsOn ¬ NOT p.labelsOn;
2 => p.texturesOn ¬ NOT p.texturesOn;
3 => p.ratiosOn ¬ NOT p.ratiosOn;
4 => p.lengthsOn ¬ NOT p.lengthsOn;
ENDCASE => RETURN;
IF Controls.GetPopUpButton[] = right THEN G3dTool.Repaint[p.tool];
};
Display
DrawProc: G3dTool.DrawProc ~ {
Action: PROC ~ {
DoWithSpans: PROC [proc: SpanProc] ~ {
FOR n: NAT IN [0..p.shape.vertices.length) DO
v: Vertex ¬ p.shape.vertices[n];
IF v.ref # NIL THEN {
spans: SpanSequence ¬ NARROW[v.ref];
FOR i: NAT IN [0..spans.length) DO
s: Span ¬ spans[i];
proc[v, s, G3dVector.Midpoint[v.point, s.otherVertex.point]];
ENDLOOP;
};
ENDLOOP;
};
Proc: SpanProc ~ {
IF p.lengthsOn THEN
G3dDraw.Mark[context, mid, view, vp, IO.PutFR1["%6.3f", IO.real[s.geoDistance]]];
IF p.ratiosOn THEN
G3dDraw.Mark[context, mid, view, vp, IO.PutFR1["%6.3f", IO.real[s.textureRatio]]];
};
screens: G3dShape.ScreenSequence ¬ v.screens[0];
IF p.texturesOn THEN FOR n: NAT IN [0..p.shape.vertices.length) DO
t: Pair ¬ p.shape.vertices[n].texture;
Draw2d.Label[context, screens[n].pos, IO.PutFR["%3.2f, %3.2f", IO.real[t.x], IO.real[t.y]]];
ENDLOOP;
IF p.labelsOn THEN FOR n: NAT IN [0..p.shape.vertices.length) DO
Draw2d.Label[context, screens[n].pos, IO.PutFR1["%g", IO.int[n]]];
ENDLOOP;
IF p.lengthsOn OR p.ratiosOn THEN DoWithSpans[Proc];
};
p: Data ~ NARROW[clientData];
SpanProc: TYPE ~ PROC [v: Vertex, s: Span, mid: Triple];
IF p.shape = NIL THEN RETURN;
IF p.shape.vertices # NIL AND p.shape.surfaces # NIL AND
(p.shape.vertices.length > 1000 OR p.shape.surfaces.length > 500)
THEN Action[]
ELSE Draw2d.DoWithBuffer[context, Action];
};
Spans
SpanSequence:  TYPE ~ REF SpanSequenceRep;
SpanSequenceRep: TYPE ~ RECORD [
length:      CARDINAL ¬ 0,
element:      SEQUENCE maxLength: CARDINAL OF Span
];
Span:     TYPE ~ REF SpanRep;
SpanRep:    TYPE ~ RECORD [
otherVertex:     Vertex ¬ NIL,
geoDistance:     REAL ¬ 0.0,
textureDistance:    REAL ¬ 0.0,
textureRatio:     REAL ¬ 0.0
];
noSpan: ERROR = CODE;
GetSpan: PROC [v0, v1: Vertex] RETURNS [Span] ~ {
spans: SpanSequence ¬ NARROW[v0.ref];
IF spans # NIL THEN
FOR i: NAT IN [0..spans.length) DO
IF spans[i].otherVertex = v1 THEN RETURN[spans[i]];
ENDLOOP;
ERROR noSpan;
};
AddSpan: PUBLIC PROC [spans: SpanSequence, spanRep: SpanRep] RETURNS [SpanSequence] ~ {
span: Span ¬ NEW[SpanRep ¬ spanRep];
IF spans = NIL THEN spans ¬ NEW[SpanSequenceRep[1]];
IF spans.length = spans.maxLength THEN {
new: SpanSequence ¬ NEW[SpanSequenceRep[MAX[Real.Round[1.3*spans.length],3]]];
FOR i: NAT IN [0..spans.length) DO new[i] ¬ spans[i]; ENDLOOP;
new.length ¬ spans.length;
spans ¬ new;
};
spans[spans.length] ¬ span;
spans.length ¬ spans.length+1;
RETURN[spans];
};
MakeSpans: PROC [shape: Shape, textureScale: REAL ¬ 1.0] ~ {
IF shape = NIL OR shape.surfaces = NIL OR shape.vertices = NIL THEN RETURN;
FOR n: NAT IN [0..shape.surfaces.length) DO
poly: NatSequence ¬ shape.surfaces[n].vertices;
v0: Vertex ¬ shape.vertices[poly[poly.length-1]];
FOR nn: NAT IN [0..poly.length) DO
v1: Vertex ¬ shape.vertices[poly[nn]];
[] ¬ GetSpan[v0, v1 ! noSpan => {
geoDistance: REAL ¬ textureScale*G3dVector.Distance[v0.point, v1.point];
v0.ref ¬ AddSpan[NARROW[v0.ref], [v1, geoDistance]];
v1.ref ¬ AddSpan[NARROW[v1.ref], [v0, geoDistance]];
CONTINUE;
}];
v0 ¬ v1;
ENDLOOP;
ENDLOOP;
};
Texture
sqRtPt5:   REAL ~ RealFns.SqRt[0.5];
unTextured:  Pair ~ [-1.0, -1.0];
defaultTexture: Pair ~ [0.5, 0.5];
VertexProc:  TYPE ~ PROC [v: Vertex, spans: SpanSequence];
MakeTextures: PROC [s: Shape, action: PROC ¬ NIL] ~ {
IF s # NIL AND s.surfaces # NIL AND s.vertices # NIL THEN {
pairs: PairSequence ¬ NEW[PairSequenceRep[1000]];
s.vertices.valid[texture] ¬ FALSE;
FOR n: NAT IN [0..s.vertices.length) DO s.vertices[n].texture ¬ unTextured; ENDLOOP;
SetTexture[s.vertices[0], defaultTexture];
DO
v: Vertex ¬ UntexturedVertexWithMostTexturedSpans[s];
IF v = NIL THEN EXIT;
CedarProcess.CheckAbort[];
AdjustTexture[v, pairs];
RelaxTextures[s];
IF action # NIL THEN action[];
ENDLOOP;
s.vertices.valid[texture] ¬ TRUE;
};
};
AverageShapeTextureRatio: PROC [m: Shape] RETURNS [ave: REAL ¬ 0.0] ~ {
count: REAL ¬ 0.0;
FOR n: NAT IN [0..m.vertices.length) DO
v: Vertex ¬ m.vertices[n];
IF Textured[v] THEN {
spans: SpanSequence ¬ NARROW[v.ref];
FOR nn: NAT IN [0..spans.length) DO
s: Span ¬ spans[nn];
IF Textured[s.otherVertex] THEN {
ave ¬ ave+s.textureRatio;
count ¬ count+1.0;
};
ENDLOOP;
};
ENDLOOP;
IF count # 0.0 THEN ave ¬ ave/count;
};
Distance: PROC [p0, p1: Pair] RETURNS [r: REAL] ~ {r ¬ Vector2.Length[Vector2.Sub[p0, p1]]};
AdjustTexture: PROC [v: Vertex, pairs: PairSequence ¬ NIL] ~ {
count: NAT ¬ NTexturedSpans[v];
IF count = 0
THEN SetTexture[v, defaultTexture]
ELSE {
AddPair: PROC [p: Pair] ~ {pairs[pairs.length] ¬ p; pairs.length ¬ pairs.length+1};
factorial: NAT ¬ Factorial[count];
spans: SpanSequence ¬ NARROW[v.ref];
center: Pair ¬ CenterOfTexturedSpans[spans];
IF pairs = NIL THEN pairs ¬ NEW[PairSequenceRep[factorial]];
IF pairs.maxLength < factorial THEN pairs ¬ NEW[PairSequenceRep[factorial]];
pairs.length ¬ 0;
FOR n: NAT IN [0..spans.length) DO
s0: Span ¬ spans[n];
c0: Pair ¬ s0.otherVertex.texture;
IF c0 # unTextured THEN FOR nn: NAT IN (n..spans.length) DO
s1: Span ¬ spans[nn];
c1: Pair ¬ s1.otherVertex.texture;
IF c1 # unTextured THEN {
i: CirclesIntersection ¬ IntersectTwoCircles[c0, c1, s0.geoDistance, s1.geoDistance];
IF Distance[c0, c1] > sqRtPt5 THEN { -- moduloerize?
SELECT i.type FROM
enclosed => {
v: Pair ¬ Vector2.Unit[Vector2.Sub[i.minCenter, i.maxCenter]];
d: REAL ¬ 0.5*(i.maxRadius-i.minRadius-i.ccDistance);
AddPair[[i.maxCenter.x+d*v.x, i.maxCenter.y+d*v.y]];
};
disjoint => {
q: REAL ¬ 0.5*(i.ccDistance-s0.geoDistance-s1.geoDistance);
a0: REAL ¬ (s0.geoDistance+q)/i.ccDistance;
a1: REAL ¬ (s1.geoDistance+q)/i.ccDistance;
AddPair[[a0*c1.x+a1*c0.x, a0*c1.y+a1*c0.y]];
};
tangent => AddPair[i.pair0];
crossed => {
d0: REAL ¬ Vector2.Square[Vector2.Sub[i.pair0, center]];
d1: REAL ¬ Vector2.Square[Vector2.Sub[i.pair1, center]];
AddPair[IF d0 < d1 THEN i.pair0 ELSE i.pair1];
};
ENDCASE;
};
ENDLOOP;
ENDLOOP;
IF pairs.length > 0
THEN SetTexture[v, AverageOfPairSequence[pairs]]  -- tah-dah!!
ELSE FOR n: NAT IN [0..spans.length) DO
IF Textured[spans[n].otherVertex] THEN {
s: Span ¬ spans[n];
distance: REAL ¬ MIN[0.25, s.geoDistance];
SetTexture[v, Vector2.Add[s.otherVertex.texture, [distance, s.geoDistance]]];
EXIT;
};
ENDLOOP;
};
};
SetTexture: PROC [v: Vertex, texture: Pair] ~ {
spans: SpanSequence ¬ NARROW[v.ref];
v.texture ¬ texture;
ModuloTexture[v];
FOR n: NAT IN [0..spans.length) DO
s: Span ¬ spans[n];
IF Textured[s.otherVertex] THEN {
otherSpans: SpanSequence ¬ NARROW[s.otherVertex.ref];
s.textureDistance ¬ TextureDistance[v, s.otherVertex];
s.textureRatio ¬ s.textureDistance/s.geoDistance;
FOR nn: NAT IN [0..otherSpans.length) DO
ss: Span ¬ otherSpans[nn];
IF ss.otherVertex = v THEN {
ss.textureDistance ¬ s.textureDistance;
ss.textureRatio ¬ s.textureRatio;
EXIT;
};
ENDLOOP;
};
ENDLOOP;
};
Textured: PROC [v: Vertex] RETURNS [BOOL] ~ {RETURN[v.texture # unTextured]};
UntexturedVertexWithMostTexturedSpans: PROC [shape: Shape] RETURNS [v: Vertex] ~ {
max: NAT ¬ 0;
FOR n: NAT IN [0..shape.vertices.length) DO
vv: Vertex ¬ shape.vertices[n];
IF NOT Textured[vv] THEN {
nTexturedSpans: NAT ¬ NTexturedSpans[vv];
IF nTexturedSpans > max THEN {v ¬ vv; max ¬ nTexturedSpans};
};
ENDLOOP;
};
NTexturedVertices: PROC [shape: Shape] RETURNS [count: NAT ¬ 0] ~ {
FOR n: NAT IN [0..shape.vertices.length) DO
IF Textured[shape.vertices[n]] THEN count ¬ count+1;
ENDLOOP;
};
NTexturedSpans: PROC [v: Vertex] RETURNS [count: NAT ¬ 0] ~ {
spans: SpanSequence ¬ NARROW[v.ref];
IF spans # NIL THEN FOR n: NAT IN [0..spans.length) DO
IF Textured[spans[n].otherVertex] THEN count ¬ count+1;
ENDLOOP;
};
Factorial: PROC [n: NAT] RETURNS [factorial: NAT ¬ 1] ~ {
FOR i: NAT IN [2..n] DO factorial ¬ factorial*i; ENDLOOP;
};
CenterOfTexturedSpans: PROC [spans: SpanSequence] RETURNS [center: Pair] ~ {
count: REAL ¬ 0.0;
center ¬ [0.0, 0.0];
FOR n: NAT IN [0..spans.length) DO
v: Vertex ¬ spans[n].otherVertex;
IF Textured[v] THEN {
center ¬ Vector2.Add[center, v.texture];
count ¬ count+1;
};
ENDLOOP;
IF count > 0.0 THEN center ¬ Vector2.Div[center, count];
};
AverageOfPairSequence: PROC [pairs: PairSequence] RETURNS [average: Pair] ~ {
average ¬ [0.0, 0.0];
FOR n: NAT IN [0..pairs.length) DO
average ¬ Vector2.Add[average, pairs[n]];
ENDLOOP;
IF pairs.length > 0 THEN average ¬ Vector2.Div[average, pairs.length];
};
ModuloTexture: PROC [v: Vertex] ~ {
MakeGood: PROC [r: REAL] RETURNS [REAL] ~ {
WHILE r > 1.0 DO r ¬ r-1.0; ENDLOOP;
WHILE r < 0.0 DO r ¬ r+1.0; ENDLOOP;
RETURN[r];
};
v.texture.x ¬ MakeGood[v.texture.x];
v.texture.y ¬ MakeGood[v.texture.y];
};
DoWithVerticesInRandomOrder: PROC [m: Shape, vertexProc: VertexProc] ~ {
nats: NatSequence ¬ NEW[NatSequenceRep[m.vertices.length]];
nats.length ¬ m.vertices.length;
FOR n: NAT IN [0..nats.length) DO nats[n] ¬ n; ENDLOOP;
FOR n: NAT IN [0..nats.length) DO
i: NAT ¬ Random.ChooseInt[NIL, 0, nats.length-1];
v: Vertex ¬ m.vertices[i];
vertexProc[v, NARROW[v.ref]];
nats[i] ¬ nats[nats.length-1];
nats.length ¬ nats.length-1;
ENDLOOP;
};
RelaxTextures: PROC [m: Shape] ~ {
RelaxLocally: PROC ~ {
vertexProc: VertexProc ~ {IF Textured[v] THEN AdjustTexture[v, pairs]};
pairs: PairSequence ¬ NEW[PairSequenceRep[1000]];
DoWithVerticesInRandomOrder[m, vertexProc];
};
RelaxGlobally: PROC ~ {
FOR n: NAT IN [0..1000) DO
SomethingSpecial: PROC [v: Vertex] ~ {
SetOtherVertexTexture: PROC [a: REAL] ~ {
a = 1: Set to aveRatio, a = 0, Set to s.textureRatio.
desiredRatio: REAL ¬ a*aveRatio+(1.0-a)*s.textureRatio;
desiredDistance: REAL ¬ desiredRatio*s.geoDistance;
vec: Pair ¬ Vector2.Div[Vector2.Sub[vOther.texture, v.texture], s.textureDistance];
SetTexture[vOther, Vector2.Add[v.texture, Vector2.Mul[vec, desiredDistance]]];
};
ResetOtherVertexTexture: PROC [a: REAL] ~ {
SetTexture[s.otherVertex, oldTexture];
SetOtherVertexTexture[a];
};
s: Span ¬ MostAberrantSpan[v, aveRatio];
vOther: Vertex ¬ s.otherVertex;
oldTexture: Pair ¬ vOther.texture;
IF NOT Textured[v] OR NOT Textured[vOther] THEN ERROR;
SetOtherVertexTexture[0.25];
IF VertexBadness[vOther, aveRatio] > badness
THEN ResetOtherVertexTexture[0.125]
ELSE {
vOtherSpans: SpanSequence ¬ NARROW[vOther.ref];
FOR n: NAT IN [0..vOtherSpans.length) DO
IF VertexBadness[vOtherSpans[n].otherVertex, aveRatio] > badness THEN {
ResetOtherVertexTexture[0.125];
RETURN;
};
ENDLOOP;
};
};
aveRatio: REAL ¬ AverageShapeTextureRatio[m];
v: Vertex ¬ MostAberrantVertex[m, aveRatio];
badness: REAL ¬ VertexBadness[v, aveRatio];
CedarProcess.CheckAbort[];
IF badness < 1.25 THEN EXIT;
SomethingSpecial[v];
ENDLOOP;
};
RelaxLocally[];
RelaxGlobally[];
};
VertexBadness: PROC [v: Vertex, aveRatio: REAL] RETURNS [REAL] ~ {
RETURN[SpanBadness[MostAberrantSpan[v, aveRatio], aveRatio]];
};
SpanBadness: PROC [s: Span, aveRatio: REAL] RETURNS [REAL] ~ {
RETURN[MAX[s.textureRatio, aveRatio]/MIN[s.textureRatio, aveRatio]];
};
TextureDistance: PROC [v0, v1: Vertex] RETURNS [REAL] ~ {
dx: REAL ¬ ABS[v1.texture.x-v0.texture.x];
dy: REAL ¬ ABS[v1.texture.y-v0.texture.y];
IF dx > 0.5 THEN dx ¬ 1.0-dx;  -- moduloerize?
IF dy > 0.5 THEN dy ¬ 1.0-dy; -- moduloerize?
RETURN[RealFns.SqRt[dx*dx+dy*dy]];
};
TextureRatio: PROC [v: Vertex, s: Span] RETURNS [REAL] ~ {
RETURN[TextureDistance[v, s.otherVertex]/s.geoDistance];
};
AverageVertexTextureRatio: PROC [v: Vertex] RETURNS [ave: REAL ¬ 0.0] ~ {
count: REAL ¬ 1.0;
spans: SpanSequence ¬ NARROW[v.ref];
FOR nn: NAT IN [0..spans.length) DO
s: Span ¬ spans[nn];
IF s.geoDistance # 0.0 AND Textured[s.otherVertex] THEN {
ave ¬ ave+s.textureRatio;
count ¬ count+1.0;
};
ENDLOOP;
IF count # 0.0 THEN ave ¬ ave/count;
};
MostAberrantVertex: PROC [m: Shape, ave: REAL] RETURNS [vMax: Vertex] ~ {
maxBadness: REAL ¬ 0.0;
FOR n: NAT IN [0..m.vertices.length) DO
v: Vertex ¬ m.vertices[n];
IF Textured[v] THEN {
badness: REAL ¬ SpanBadness[MostAberrantSpan[v, ave], ave];
IF badness > maxBadness THEN {maxBadness ¬ badness; vMax ¬ v};
};
ENDLOOP;
};
MostAberrantSpan: PROC [v: Vertex, ave: REAL] RETURNS [sMax: Span] ~ {
maxBadness: REAL ¬ 0.0;
spans: SpanSequence ¬ NARROW[v.ref];
FOR n: NAT IN [0..spans.length) DO
s: Span ¬ spans[n];
IF s.geoDistance # 0.0 AND Textured[s.otherVertex] THEN {
badness: REAL ¬ SpanBadness[s, ave];
IF badness > maxBadness THEN {maxBadness ¬ badness; sMax ¬ s};
};
ENDLOOP;
};
TexturesValid: PROC [m: Shape] RETURNS [b: BOOL] ~ {
IF NOT (b ¬ m.vertices.valid[texture]) THEN Blink["Make textures first"];
};
ForkRelax: CedarProcess.ForkableProc ~ {
p: Data ¬ NARROW[data];
IF TexturesValid[p.shape] THEN DO
RelaxTextures[p.shape];
Update[p];
ENDLOOP;
};
ForkRelaxOnce: CedarProcess.ForkableProc ~ {
p: Data ¬ NARROW[data];
IF TexturesValid[p.shape] THEN {
RelaxTextures[p.shape];
Update[p];
};
};
ForkTexture: CedarProcess.ForkableProc ~ {
EachVertex: PROC ~ {Update[p]};
p: Data ¬ NARROW[data];
m: Shape ¬ p.shape;
Controls.TypescriptWrite[p.tool.typescript, "\n"];
MakeSpans[m];
MakeTextures[m, EachVertex];
};
Update: PROC [p: Data] ~ {
IF p.ratiosOn OR p.texturesOn THEN G3dTool.Repaint[p.tool];
Controls.TypescriptWrite[p.tool.typescript, TextureInfo[p.shape]];
};
TextureInfo: PROC [m: Shape] RETURNS [ROPE] ~ {
ave: REAL ¬ AverageShapeTextureRatio[m];
v: Vertex ¬ MostAberrantVertex[m, ave];
s: Span ¬ MostAberrantSpan[v, ave];
max: REAL ¬ SpanBadness[s, ave];
RETURN[IO.PutFR["ave ratio: %5.3f, max aberration: %5.3f\n", IO.real[ave], IO.real[max]]];
};
Circles
CirclesIntersection: TYPE ~ RECORD [
type:       {enclosed, disjoint, tangent, crossed, concentric},
pair0, pair1:     Pair,
minCenter, maxCenter:  Pair,
minRadius, maxRadius:  REAL,
ccDistance:     REAL
];
IntersectTwoCircles: PROC [center0, center1: Pair, radius0, radius1: REAL]
RETURNS [i: CirclesIntersection]
~ {
Thanks to Eric Bier and GGCirclesImpl.CircleMeetsCircle.
IF center0 = center1
THEN i.type ¬ concentric
ELSE {
radiusSum: REAL ¬ radius0+radius1;
cc: Pair ¬ Vector2.Sub[center1, center0];
IF radius0 > radius1
THEN {
i.minRadius ¬ radius1; i.minCenter ¬ center1;
i.maxRadius ¬ radius0; i.maxCenter ¬ center0;
}
ELSE {
i.minRadius ¬ radius0; i.minCenter ¬ center0;
i.maxRadius ¬ radius1; i.maxCenter ¬ center1;
};
i.ccDistance ¬ Vector2.Length[cc];
SELECT i.ccDistance FROM
< i.maxRadius-i.minRadius => i.type ¬ enclosed;
> radiusSum => i.type ¬ disjoint;
= radiusSum => {
i.type ¬ tangent;
i.pair0 ¬ [(radius0*center1.x+radius1*center0.x)/radiusSum,
   (radius0*center1.y+radius1*center0.y)/radiusSum];
};
= i.maxRadius-i.minRadius => {
ccUnit: Pair ¬ Vector2.Unit[cc];
IF radius0 < radius1 THEN ccUnit ¬ Vector2.Neg[ccUnit];
i.pair0 ¬ Vector2.Add[center0, Vector2.Mul[ccUnit, radius0]];
i.type ¬ tangent;
};
ENDCASE => {
p, normal: Pair;
ccUnit: Pair ¬ Vector2.Div[cc, i.ccDistance];
s: REAL ¬ 0.5*(radiusSum+i.ccDistance);
h: REAL ¬ 2.0*RealFns.SqRt[s*(s-i.ccDistance)*(s-radius0)*(s-radius1)]/i.ccDistance;
m: REAL ¬ IF h > i.maxRadius
THEN 0.0 ELSE RealFns.SqRt[i.maxRadius*i.maxRadius- h*h];
p ¬ Vector2.Add[i.maxCenter, Vector2.Mul[ccUnit, m]];
normal ¬ [-h*ccUnit.y, h*ccUnit.x];
i.pair0 ¬ Vector2.Sub[p, normal];
i.pair1 ¬ Vector2.Add[p, normal];
i.type ¬ crossed;
};
};
};
Start Code
G3dTool.Register["Texture", Texture, "texture <FileName>"];
END.
..
Unused Relaxation Techniques
RelaxButton: ClickProc ~ {
p: Data ¬ NARROW[clientData];
FOR n: NAT IN [0..100) DO
RelaxTextures[p.shape];
ENDLOOP;
Controls.TypeScriptWrite[p.outerData, TextureInfo[p.shape]];
IF p.ratiosOn OR p.texturesOn THEN G3dTool.Repaint[p.tool];
};
RelaxTextures: PROC [shape: Shape] ~ {
maxDist, maxDistSoFar: REAL ¬ 0.0;
start: NAT ¬ Random.ChooseInt[NIL, 0, shape.vertices.length-1];
FOR n: NAT IN [0..shape.vertices.length) DO
RelaxVertex[shape.vertices[(start+n) MOD shape.vertices.length]];
ENDLOOP;
};
RelaxTextures: PROC [m: Shape, aveRatio: REAL] ~ {
aveRatio: REAL ¬ AverageShapeTextureRatio[m];
pairs: PairSequence ¬ NEW[PairSequenceRep[1000]];
nats: NatSequence ¬ NEW[NatSequenceRep[m.vertices.length]];
nats.length ¬ m.vertices.length;
FOR n: NAT IN [0..nats.length) DO nats[n] ¬ n; ENDLOOP;
FOR n: NAT IN [0..nats.length) DO
i: NAT ¬ Random.ChooseInt[NIL, 0, nats.length-1];
nats[i] ¬ nats[nats.length-1];
nats.length ¬ nats.length-1;
AdjustTexture[m.vertices[i], pairs];
ENDLOOP;
};
RelaxVertex: PROC [v: Vertex] ~ {   -- wooboy!
ave: REAL ¬ AverageVertexTextureRatio[v];
IF ave # 0.0 THEN {
sMax: Span ¬ MostAberrantSpan[v, ave];
f: REAL ¬ TextureRatio[v, sMax];
fix: REAL ¬ 0.5*(f+ave)/f;    -- factor to adjust f to be halfway towards average
otherTexture, vec: Pair ¬ sMax.otherVertex.texture;
IF ABS[otherTexture.x-v.texture.x] > 0.5 THEN otherTexture.x ¬ otherTexture.x+1.0;
IF ABS[otherTexture.y-v.texture.y] > 0.5 THEN otherTexture.y ¬ otherTexture.y+1.0;
vec ¬ Vector2.Sub[v.texture, otherTexture];
v.texture ¬ Vector2.Add[otherTexture, Vector2.Mul[vec, fix]];
ModuloTexture[v];
IF v.texture.x < 0.0 OR v.texture.y < 0.0 THEN ERROR;
};
};
Circle Intersection Test
CircleData: TYPE ~ REF CircleDataRep;
CircleDataRep: TYPE ~ RECORD [
graphics, outer:   Viewer ¬ NIL,
outerData:    OuterData ¬ NIL,
center0, center1:   Pair ¬ [150, 150],
radius0, radius1:   REAL ¬ 75,
intersection:    CirclesIntersection
];
CommandProc: Commander.CommandProc ~ {
p: CircleData ¬ NEW[CircleDataRep];
p.outer ¬ Controls.OuterViewer[
buttons: LIST[
Controls.ClickButton["Circle0", Circle0, p],
Controls.ClickButton["Circle1", Circle1, p]],
graphicsHeight: 300,
drawProc: DrawCircles,
typeScriptHeight: 18,
clientData: p];
p.outerData ¬ NARROW[p.outer.data];
p.intersection ¬ IntersectTwoCircles[p.center0, p.center1, p.radius0, p.radius1];
p.graphics ¬ p.outerData.graphics;
};
Circle0: ClickProc ~ {
p: CircleData ¬ NARROW[clientData];
[p.center0, p.radius0] ¬ ReadCircle[p, p.center0, p.radius0];
NewStuff[p];
};
Circle1: ClickProc ~ {
p: CircleData ¬ NARROW[clientData];
[p.center1, p.radius1] ¬ ReadCircle[p, p.center1, p.radius1];
NewStuff[p];
};
NewStuff: PROC [p: CircleData] ~ {
p.intersection ¬ IntersectTwoCircles[p.center0, p.center1, p.radius0, p.radius1];
ViewerOps.PaintViewer[p.graphics, client, FALSE];
};
ReadCircle: PROC [p: CircleData, center: Pair, radius: REAL] RETURNS [c: Pair, r: REAL] ~ {
reals: Controls.RealSequence ¬ Controls.TypeScriptReadValues[p.outerData, ["center x", center.x], ["y", center.y], ["r", radius]];
IF reals # NIL AND reals.length = 3 THEN RETURN[[reals[0], reals[1]], reals[2]];
};
DrawCircles: G3dTool.DrawProc ~ {
p: CircleData ~ NARROW[clientData];
Action: PROC ~ {
Draw2d.Circle[context, p.center0, p.radius0];
Draw2d.Circle[context, p.center1, p.radius1];
SELECT p.intersection.type FROM
disjoint => Draw2d.Label[context, p.center0, "Disjoint"];
tangent => {
Draw2d.Label[context, p.intersection.pair0, "Tangent"];
Draw2d.Mark[context, p.intersection.pair0, asterisk];
};
crossed => {
Draw2d.Label[context, p.center0, "Crossed"];
Draw2d.Mark[context, p.intersection.pair0, asterisk];
Draw2d.Mark[context, p.intersection.pair1, asterisk];
};
concentric => Draw2d.Label[context, p.center0, "Concentric"];
ENDCASE;
};
Draw2d.DoWithBuffer[context, Action];
};