<<>> <> <> <> 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 <> 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; <> 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]; }; <> 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]; }; <> 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]; }; <> 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; }; <> 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]; < 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] ~ { <> 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]]]; }; <> 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] ~ { <> 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; }; }; }; <> G3dTool.Register["Texture", Texture, "texture "]; END. .. <> 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; }; }; <> 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]; };