G3dHedronCmdImpl.mesa -- Make shape file for truncated icosidodecahedron
Copyright Ó 1988, 1992 by Xerox Corporation. All rights reserved.
Ken Shoemake, September 2, 1988 1:57:04 am PDT
Bloomenthal, July 22, 1992 11:34 pm PDT
DIRECTORY Commander, CommanderOps, Convert, G3dBasic, G3dTool, IO, RealFns, Rope;
G3dHedronCmdImpl: CEDAR MONITOR
IMPORTS CommanderOps, Convert, G3dTool, IO, RealFns, Rope
~ BEGIN
OPEN G3dBasic;
STREAM: TYPE ~ IO.STREAM;
Triple: TYPE ~ G3dBasic.Triple;
Types
Vertex: TYPE ~ RECORD[v: Triple, index: INT];
Color: TYPE ~ Triple;
Constants
phi: REAL ~ 1.61803398874989484820;    -- (1+SqRt[5])/2
decagonRadius: REAL ~ 0.42553027804273699912; -- 2/SqRt[5*phi+14]
innerRadius: REAL ~ 0.90494418748830634264; -- SqRt[(5*phi+10)/(5*phi+14)]
dihedral: REAL ~ 1.10714871779409050301;  -- ArcTan[2]
cos18d: REAL ~ 0.9510565;   
sin18d: REAL ~ 0.309017;   
cos36d: REAL ~ 0.80901699437494742410;   -- phi/2
sin36d: REAL ~ 0.58778525229247312916;   -- SqRt[3-phi]/2
cos54d: REAL ~ 0.5877852;   
sin54d: REAL ~ 0.809017;   
cos72d: REAL ~ 0.30901699437494742410;   -- (phi-1)/2
sin72d: REAL ~ 0.95105651629515357211;   -- SqRt[phi+2]/2
sqRt5: REAL ~ 2.23606797749978969640;   -- SqRt[5]
v1x: REAL ¬ decagonRadius * cos36d;
v1y: REAL ¬ decagonRadius * sin36d;
v2x: REAL ¬ decagonRadius * cos72d;
v2y: REAL ¬ decagonRadius * sin72d;
BLACK: Color ~ [0.0, 0.0, 0.0];
RED: Color ~ [0.7, 0.1, 0.1];
GREEN: Color ~ [0.1, 0.7, 0.1];
YELLOW: Color ~ [0.7, 0.7, 0.1];
BLUE: Color ~ [0.1, 0.1, 0.7];
MAGENTA: Color ~ [0.7, 0.1, 0.7];
CYAN: Color ~ [0.1, 0.7, 0.7];
WHITE: Color ~ [1.0, 1.0, 1.0];
aBlue: Color  ~ [ 15/255.0, 90/255.0, 255/255.0];
aGreen: Color ~ [ 0/255.0, 255/255.0, 75/255.0];
aTan: Color  ~ [255/255.0, 210/255.0, 110/255.0];
aRed: Color  ~ [255/255.0, 30/255.0, 55/255.0];
aYellow: Color ~ [255/255.0, 250/255.0, 30/255.0];
rootThird: REAL ~ 0.57735026918962576451;   -- 1/SqRt[3]
rootThree: REAL ~ 1.73205080756887729352;   -- SqRt[3]
Support Procedures
SpitTriRingPoly: PROC [
outStream: STREAM,
n: NAT,
verts: ARRAY [0..4) OF Vertex,
aColor: Color ¬ WHITE]
~ {
IO.PutF[outStream, "%g %g %g ", IO.real[aColor.x], IO.real[aColor.y], IO.real[aColor.z]];
FOR i: NAT IN [0..n) DO
IO.PutF1[outStream, " %3g", IO.int[verts[i].index]];
ENDLOOP;
IO.PutRope[outStream, "\n"];
};
SpitPoly: PROC [
outStream: STREAM,
n: NAT,
verts: ARRAY [0..10) OF Vertex,
aColor: Color ¬ WHITE]
~ {
IO.PutF[outStream, "%g %g %g ", IO.real[aColor.x], IO.real[aColor.y], IO.real[aColor.z]];
FOR i: NAT DECREASING IN [0..n) DO
IO.PutF1[outStream, " %3g", IO.int[verts[i].index]];
ENDLOOP;
IO.PutRope[outStream, "\n"];
};
Truncated Icosidodecahedron
Antipode: PROC [vtx: Vertex] RETURNS [aVtx: Vertex]
~{
aVtx.v ¬ [-vtx.v.x, -vtx.v.y, -vtx.v.z];
aVtx.index ¬ vtx.index + 1 - 2*(vtx.index MOD 2);
};
SpitAntipodalPolys: PROC [
outStream: STREAM,
n: NAT,
verts: ARRAY [0..10) OF Vertex,
frontColor, backColor: Color ¬ WHITE]
~ {
backV: ARRAY [0..10) OF Vertex;
FOR i: NAT IN [0..n) DO
backV[n-i-1] ¬ Antipode[verts[i]];
ENDLOOP;
SpitPoly[outStream, n, verts, frontColor];
SpitPoly[outStream, n, backV, backColor];
};
MakeHedron: PROC [outStream: STREAM]
~ {
topFace: ARRAY [0..10) OF Vertex ¬ [
[[decagonRadius, 0.0, innerRadius], 0],
[[v1x, v1y, innerRadius], 2], [[v2x, v2y, innerRadius], 4],
[[-v2x, v2y, innerRadius], 6], [[-v1x, v1y, innerRadius], 8],
[[-decagonRadius, 0.0, innerRadius], 10],
[[-v1x, -v1y, innerRadius], 12], [[-v2x, -v2y, innerRadius], 14],
[[v2x, -v2y, innerRadius], 16], [[v1x, -v1y, innerRadius], 18]
];
vList: ARRAY [0..5) OF ARRAY [0..10) OF Vertex;
vIndex: INT ¬ 18;
Initialize decagons' vertices
First side face
FOR i: NAT IN [0..10) DO
vList[0][i].v.x ¬ topFace[i].v.x;
vList[0][i].v.y ¬ (topFace[i].v.y - 2.0*topFace[i].v.z)/sqRt5;
vList[0][i].v.z ¬ (2.0*topFace[i].v.y + topFace[i].v.z)/sqRt5;
vList[0][i].index ¬ (vIndex ¬ vIndex + 2);
ENDLOOP;
Other four side faces
FOR j: NAT IN [0..2) DO
k: NAT ¬ (5-j) MOD 5;
vrIndex: INT ¬ (5-j)*20 - 2;
FOR i: NAT IN [0..10) DO
vList[j+1][i].v.x ¬ cos72d*vList[j][i].v.x - sin72d*vList[j][i].v.y;
vList[j+1][i].v.y ¬ sin72d*vList[j][i].v.x + cos72d*vList[j][i].v.y;
vList[j+1][i].v.z ¬ vList[j][i].v.z;
vList[j+1][i].index ¬ (vIndex ¬ vIndex + 2);
vList[4-j][i].v.x ¬ cos72d*vList[k][i].v.x + sin72d*vList[k][i].v.y;
vList[4-j][i].v.y ¬ -sin72d*vList[k][i].v.x + cos72d*vList[k][i].v.y;
vList[4-j][i].v.z ¬ vList[k][i].v.z;
vList[4-j][i].index ¬ (vrIndex ¬ vrIndex + 2);
ENDLOOP;
ENDLOOP;
Print header for vertices
IO.PutRope[outStream, "Vertices ~ index: Integer, xyzCoords: Triple\n"];
Print every vertex and its index
FOR i: NAT IN [0..10) DO
IO.PutFL[outStream, "%3g %12g %12g %12g\n", LIST[IO.int[topFace[i].index],
IO.real[topFace[i].v.x], IO.real[topFace[i].v.y], IO.real[topFace[i].v.z]]];
IO.PutFL[outStream, "%3g %12g %12g %12g\n", LIST[IO.int[topFace[i].index + 1],
IO.real[-topFace[i].v.x], IO.real[-topFace[i].v.y], IO.real[-topFace[i].v.z]]];
ENDLOOP;
FOR j: NAT IN [0..5) DO
FOR i: NAT IN [0..10) DO
IO.PutFL[outStream, "%3g %12g %12g %12g\n", LIST[IO.int[vList[j][i].index],
IO.real[vList[j][i].v.x], IO.real[vList[j][i].v.y], IO.real[vList[j][i].v.z]]];
IO.PutFL[outStream, "%3g %12g %12g %12g\n", LIST[IO.int[vList[j][i].index + 1],
IO.real[-vList[j][i].v.x], IO.real[-vList[j][i].v.y], IO.real[-vList[j][i].v.z]]];
ENDLOOP;
ENDLOOP;
Print header for polygons
IO.PutRope[outStream, "\nSurfaces ~ rgbColor: Triple, vertices: Nats\n\n"];
Create decagon faces of hedron
SpitAntipodalPolys[outStream, 10, topFace, aRed, aBlue];
SpitAntipodalPolys[outStream, 10, vList[0], aBlue, aBlue];
SpitAntipodalPolys[outStream, 10, vList[1], aYellow, aRed];
SpitAntipodalPolys[outStream, 10, vList[2], aBlue, aYellow];
SpitAntipodalPolys[outStream, 10, vList[3], aRed, aRed];
SpitAntipodalPolys[outStream, 10, vList[4], aYellow, aYellow];
Create square and hexagonal faces of hedron
FOR i: NAT IN [0..5) DO
vtx: ARRAY [0..10) OF Vertex;
Squares between top decagon and side decagons
vtx[0] ¬ vList[i][3];
vtx[1] ¬ vList[i][2];
vtx[2] ¬ topFace[(8+i+i) MOD 10];
vtx[3] ¬ topFace[(7+i+i) MOD 10];
SpitAntipodalPolys[outStream, 4, vtx, aTan, aTan];
Squares between side decagons
vtx[0] ¬ vList[i][1];
vtx[1] ¬ vList[i][0];
vtx[2] ¬ vList[(i+1) MOD 5][5];
vtx[3] ¬ vList[(i+1) MOD 5][4];
SpitAntipodalPolys[outStream, 4, vtx, aTan, aTan];
Squares between upper side decagons and lower side decagons
vtx[0] ¬ vList[i][9];
vtx[1] ¬ vList[i][8];
vtx[2] ¬ Antipode[vList[(i+3) MOD 5][6]];
vtx[3] ¬ Antipode[vList[(i+3) MOD 5][7]];
SpitAntipodalPolys[outStream, 4, vtx, aTan, aTan];
Hexagons between top decagon and side decagons
vtx[0] ¬ vList[i][2];
vtx[1] ¬ vList[i][1];
vtx[2] ¬ vList[(i+1) MOD 5][4];
vtx[3] ¬ vList[(i+1) MOD 5][3];
vtx[4] ¬ topFace[(9+i+i) MOD 10];
vtx[5] ¬ topFace[(8+i+i) MOD 10];
SpitAntipodalPolys[outStream, 6, vtx, aGreen, aGreen];
Hexagons between upper side decagons and lower side decagons
vtx[0] ¬ vList[i][0];
vtx[1] ¬ vList[i][9];
vtx[2] ¬ Antipode[vList[(i+3) MOD 5][7]];
vtx[3] ¬ Antipode[vList[(i+3) MOD 5][8]];
vtx[4] ¬ vList[(i+1) MOD 5][6];
vtx[5] ¬ vList[(i+1) MOD 5][5];
SpitAntipodalPolys[outStream, 6, vtx, aGreen, aGreen];
ENDLOOP;
};
Triangular Torus that Interlocks with Itself
MakeTriRing: PROC [outStream: STREAM]
~ {
vList: ARRAY [0..9) OF Vertex ¬ [
[[ 4, rootThree, 0], 0], [[ 1, 0, 1], 1], [[ 1, 0, -1], 2],
[[-4, rootThree, 0], 3], [[-1, 0, 1], 4], [[-1, 0, -1], 5],
[[ 0,-3*rootThree, 0], 6], [[ 0,-rootThree, 1], 7], [[ 0,-rootThree, -1], 8]
];
Print header for vertices
IO.PutRope[outStream, "Vertices ~ index: Integer, xyzCoords: Triple\n\n"];
Print every vertex and its index
FOR i: NAT IN [0..9) DO
IO.PutFL[outStream, "%3g %12g %12g %12g\n", LIST[IO.int[vList[i].index],
IO.real[vList[i].v.x], IO.real[vList[i].v.y], IO.real[vList[i].v.z]]];
ENDLOOP;
Print header for polygons
IO.PutRope[outStream, "Polygons ~ rgbColor: Triple, vertices: Nats\n"];
Print polygons
SpitTriRingPoly[outStream, 4, [vList[1], vList[4], vList[3], vList[0]], aRed]; -- Upper 0
SpitTriRingPoly[outStream, 4, [vList[0], vList[3], vList[5], vList[2]], aRed]; -- Lower 0
SpitTriRingPoly[outStream, 4, [vList[4], vList[7], vList[6], vList[3]], aRed]; -- Upper 1
SpitTriRingPoly[outStream, 4, [vList[3], vList[6], vList[8], vList[5]], aRed]; -- Lower 1
SpitTriRingPoly[outStream, 4, [vList[7], vList[1], vList[0], vList[6]], aRed]; -- Upper 2
SpitTriRingPoly[outStream, 4, [vList[6], vList[0], vList[2], vList[8]], aRed]; -- Lower 2
SpitTriRingPoly[outStream, 4, [vList[2], vList[5], vList[4], vList[1]], aRed]; -- Center 0
SpitTriRingPoly[outStream, 4, [vList[5], vList[8], vList[7], vList[4]], aRed]; -- Center 1
SpitTriRingPoly[outStream, 4, [vList[8], vList[2], vList[1], vList[7]], aRed]; -- Center 2
};
User Command
MakeHedronCmd: Commander.CommandProc ~ {
ENABLE Convert.Error, IO.Rubout => GOTO Done;
argv: CommanderOps.ArgumentVector ¬ CommanderOps.Parse[cmd];
IO.PutF[cmd.out,"aReal:%g,aLimit:%g\n",IO.real[IO.GetReal[cmd.in]],IO.int[IO.GetInt[cmd.in]]];
IF argv.argc = 3
THEN {
}
ELSE {
};
IF argv.argc # 2
THEN RETURN[$Failure, usage]
ELSE SELECT TRUE FROM
Rope.Equal[argv[1], "icosidodecahedron", FALSE] => MakeHedron[cmd.out];
Rope.Equal[argv[1], "triRing", FALSE] => MakeTriRing[cmd.out];
Rope.Equal[argv[1], "icosahedron", FALSE] => MakeIcosahedron[cmd.out];
ENDCASE;
EXITS
Done => NULL;
};
Icosahedron
MakeIcosahedron: PROC [s: STREAM] ~ {
a: REAL ¬ RealFns.SqRt[1.0/(2*(1.0-cos72d))];
h: REAL ¬ RealFns.SqRt[1.0 - (a*a)];
y: REAL ¬ RealFns.SqRt[1.0 - (2.0*a*a*(1.0-cos36d))]; -- actually=a, but this is more logical
pts: ARRAY [0 .. 12) OF Triple;
pts[0] ¬ [0.0, h, 0.0];
FOR i: INT IN [0 .. 5) DO
theta: REAL ¬ 72.0*i;
pts[i+1] ¬ [a*RealFns.CosDeg[theta], 0.0, a*RealFns.SinDeg[theta]];
theta ¬ 36.0+theta;
pts[i+6] ¬ [a*RealFns.CosDeg[theta], -y, a*RealFns.SinDeg[theta]];
ENDLOOP;
pts[11] ¬ [0.0, -(y+h), 0.0];
IO.PutRope[s, "ShapeHeader~ Icosahedron.shape\n"];
IO.PutRope[s, "SurfaceType ~ ConvexPolygon\n"];
IO.PutRope[s, "Vertices~ index: integer xyzCoords: triple\n"];
FOR i: INT IN [0 .. 12) DO
IO.PutFL[s, "%g %g %g %g\n",
LIST[IO.int[i], IO.real[pts[i].x], IO.real[pts[i].y], IO.real[pts[i].z]]];
ENDLOOP;
IO.PutRope[s, "Surfaces~ index: integer vertices: nats\n"];
FOR i: INT IN [0 .. 5) DO
IO.PutF[s, "%g 0 %g %g\n", IO.int[i], IO.int[i+1], IO.int[1+((i+1) MOD 5)]];
IO.PutF[s, "%g %g %g 11\n", IO.int[i+5], IO.int[i+6], IO.int[6+((i+1) MOD 5)]];
IO.PutFL[s, "%g %g %g %g\n",
LIST[IO.int[i+10],IO.int[i+1],IO.int[6+((i-1) MOD 5)],IO.int[i+6]]];
IO.PutFL[s,"%g %g %g %g\n",
LIST[IO.int[i+15],IO.int[i+6],IO.int[1+((i+1) MOD 5)],IO.int[i+1]]];
ENDLOOP;
};
Start Code
usage: Rope.ROPE ¬ "
MakeHedron <type>, make shape files; types are:
icosidodecahedron: Make shape file for truncated icosidodecahedron
triRing: Make shape file for triangular torus that interlocks with itself
icosahedron: Make shape file for icosahedron";
G3dTool.Register["MakeHedron", MakeHedronCmd, usage];
END.