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;
Vertex: TYPE ~ RECORD[v: Triple, index: INT];
Color: TYPE ~ Triple;
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]
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"];
};
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;

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;
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;
IO.PutRope[outStream, "Vertices ~ index: Integer, xyzCoords: Triple\n"];
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;
IO.PutRope[outStream, "\nSurfaces ~ rgbColor: Triple, vertices: Nats\n\n"];
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];
FOR i: NAT IN [0..5) DO
vtx: ARRAY [0..10) OF Vertex;
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];
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];
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];
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];
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;
};
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]
];

IO.PutRope[outStream, "Vertices ~ index: Integer, xyzCoords: Triple\n\n"];
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;
IO.PutRope[outStream, "Polygons ~ rgbColor: Triple, vertices: Nats\n"];
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
};
MakeHedronCmd: Commander.CommandProc ~ {
ENABLE Convert.Error, IO.Rubout => GOTO Done;
argv: CommanderOps.ArgumentVector ¬ CommanderOps.Parse[cmd];

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


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
Types
Constants
Support Procedures
Truncated Icosidodecahedron
Initialize decagons' vertices
First side face
Other four side faces
Print header for vertices
Print every vertex and its index
Print header for polygons
Create decagon faces of hedron
Create square and hexagonal faces of hedron
Squares between top decagon and side decagons
Squares between side decagons
Squares between upper side decagons and lower side decagons
Hexagons between top decagon and side decagons
Hexagons between upper side decagons and lower side decagons
Triangular Torus that Interlocks with Itself
Print header for vertices
Print every vertex and its index
Print header for polygons
Print polygons
User Command
IO.PutF[cmd.out,"aReal:%g,aLimit:%g\n",IO.real[IO.GetReal[cmd.in]],IO.int[IO.GetInt[cmd.in]]];
Icosahedron
Start Code
Κ•NewlineDelimiter

–
"cedarcode" style™™HJšœ
Οe
œ7™BJ™.J™'J˜—šΟk	œ6žœ˜QJ˜—šΡblnœžœ
ž˜Jšžœ!žœ˜9J˜—šœž˜J˜Jšžœ
˜Jšžœžœžœ
žœ
˜Jšœžœ˜—
headš
Οl™Jšœžœžœžœ˜-Jšœžœ
˜—š
 	™	JšœžœΟc˜7Jšœžœ‘˜AJšœ
žœ‘˜JJšœ
žœ‘˜6Jšœžœ˜Jšœžœ˜Jšœžœ‘˜1Jšœžœ‘˜9Jšœžœ˜Jšœžœ˜Jšœžœ‘˜5Jšœžœ‘˜9Jšœžœ‘
˜2Jšœžœ˜#Jšœžœ˜#Jšœžœ˜#Jšœžœ˜#J˜Jšžœ˜Jšžœ˜Jšžœ˜Jšžœ˜ Jšžœ˜Jšžœ˜!Jšžœ˜Jšžœ˜Jš
œ2˜2Jš
œ2˜2Jš
œ1˜1Jš
œ1˜1š
œ3˜3J˜—Jšœžœ‘˜8Jšœžœ‘
˜6—š
 ™šΟnœžœ˜Jšœžœ
˜Jšœžœ
˜Jšœžœžœ˜Jšœžœ
˜J˜Jšžœžœžœžœ˜Zšžœžœ
žœž˜Jšžœžœ˜4Jšžœ
˜—Jšžœ˜J˜J˜—š’œžœ˜Jšœžœ
˜Jšœžœ
˜Jšœžœ	žœ˜Jšœžœ
˜J˜Jšžœžœžœžœ˜Zš	žœžœ
ž
œ
žœž˜"Jšžœžœ˜4Jšžœ
˜—Jšžœ˜J˜——š
 ™š’œžœžœ˜3J˜J˜(Jšœ*žœ˜1J˜J˜—š’œžœ˜Jšœžœ
˜Jšœžœ
˜Jšœžœ	žœ˜Jšœžœ
˜%J˜Jšœžœ	žœ˜J˜šžœžœ
žœž˜J˜"Jšžœ
˜—J˜Jš
œ*˜*Jš
œ)˜)J˜J˜—š’
œžœ
žœ
˜$Jš
œ˜šœ	žœ	žœ˜$J˜'J˜;J˜=J˜)J˜AJ˜>J˜—Jš	œžœžœ
žœ	žœ˜/Jšœžœ˜J˜™J™šžœžœ
žœ	ž˜J˜!J˜>J˜>J˜*Jšžœ
˜—J™šžœžœ
žœž˜Jšœžœ	žœ˜Jšœ	žœ˜šžœžœ
žœ	ž˜J˜DJ˜DJ˜$J˜,J˜J˜EJ˜EJ˜$J˜.Jšžœ
˜—Jšžœ
˜——™JšžœF˜H—™ šžœžœ
žœ	ž˜šžœ,žœ
žœ˜LJšžœžœžœ˜L—šžœ,žœ
žœ˜PJšžœžœžœ˜O—Jšžœ
˜—šžœžœ
žœž˜šžœžœ
žœ	ž˜šžœ,žœ
žœ˜MJšžœžœžœ˜O—šžœ,žœ
žœ˜QJšžœžœžœ˜R—Jšžœ
˜—Jšžœ
˜——™JšžœI˜K—™Jš
œ8˜8Jš
œ:˜:Jš
œ;˜;Jš
œ<˜<Jš
œ8˜8Jš
œ>˜>—™+šžœžœ
žœž˜Jšœžœ	žœ˜™-J˜J˜Jšœžœ˜!Jšœžœ˜!Jš
œ2˜2—™J˜J˜Jšœžœ˜Jšœžœ˜Jš
œ2˜2—™;J˜J˜Jšœžœ˜)Jšœžœ˜)Jš
œ2˜2—™.J˜J˜Jšœžœ˜Jšœžœ˜Jšœžœ˜!Jšœžœ˜!Jš
œ6˜6—™<J˜J˜Jšœžœ˜)Jšœžœ˜)Jšœžœ˜Jšœžœ˜Jš
œ6˜6—Jšžœ
˜——J˜——š
 ,™,š’œžœ
žœ
˜%Jš
œ˜šœžœžœ˜!J˜;J˜;J˜LJ˜—J˜™JšžœH˜J—™ šžœžœ
žœž˜šžœ,žœ
žœ˜JJšžœžœžœ˜F—Jšžœ
˜——™JšžœE˜G—™JšœO‘
˜YJšœO‘
˜YJšœO‘
˜YJšœO‘
˜YJšœO‘
˜YJšœO‘
˜YJšœO‘˜ZJšœO‘˜ZJšœO‘˜Z—J˜——š
 ™š’
œ˜(Jšžœžœžœ˜-J˜<J˜Jšžœ%žœžœžœ™^šžœ˜šžœ˜Jš
œ
˜
—šžœ˜J˜——šžœ˜Jšžœ
žœ˜šžœ
žœ
žœ
ž˜Jšœ)žœ˜GJšœžœ˜>Jšœ#žœ˜FJšžœ
˜——š
ž˜Jšœžœ
˜
—J˜——š
 ™š’œžœžœ˜%Jšœžœ&˜-Jšœžœ˜$Jšœžœ/‘(˜^Jšœžœžœ˜J˜šžœžœ
žœ
ž˜Jšœžœ
˜J˜CJ˜J˜BJšžœ
˜—J˜Jšžœ0˜2Jšžœ-˜/Jšžœ<˜>šžœžœ
žœž˜šžœ˜Jš
žœ
žœ	žœžœžœ˜J—Jšžœ
˜—Jšžœ:˜<šžœžœ
žœ
ž˜Jš
žœžœ	žœžœžœ˜LJš
žœžœžœžœžœ˜Ošžœ˜Jšžœ
žœžœ
žœžœžœ˜D—šžœ˜Jšžœ
žœžœ
žœžœžœ˜D—Jšžœ
˜—J˜——š
 
™
Jšœžœρ
˜J˜˜5J˜——Jšžœ
˜J˜—…—&΄5Ο