Convert Uniform Polyhedra To POV-Ray
 Spheres, Cylinders, and Triangles

by
Russell Towle
July, 1997

Discussion

This notebook is very limited in its scope:  it reads in Roman Maeder's UniformPolyhedra.m and PolyhedraExamples.m, and then defines a function ToPOV[filename_String, n_Integer].  ToPOV creates a file containing POV-Ray (Persistence of Vision Ray Tracer) directives for spheres of radius R1 (upon each vertex of the nth uniform polyhedron), cylinders of radius R2 (upon each edge of the nth uniform polyhedron) and triangles (each face of the nth uniform polyhedron is divided into co-planar triangles).  Within POV, this file is then read into a scene file which declares the values of R1 and R2, the radii of the spheres and cyclinders, respectively.

Within POV it is at the user's disgression whether to actually render the group of spheres, or the group of cylinders, or the group of triangles, and what colors and textures to assign to them.  The example POV scene file below is merely a point of beginning.

Several of the uniform polyhedra may not be rendered at all within Mathematica, except on special machines.  PolyhedraExamples.m contains this caveat:

(* :Limitations: the polyhedra Nos. 69, 72, 74, and 75 cannot be shown with Display[] (usually used implicitly from within Show[]) because of limitations in the built-in renderer. They can be shown with Live[] on machines with suitable graphics hardware.*)

However, POV handles these easily.

Several functions used in this notebook were copied from Maeder's POVray.m package, and of course the uniform polyhedra themselves also depend upon Maeder's work.

Initialization

<<PolyhedraExamples.m

protected = Unprotect[Infix];
Infix[_[e_], h_:Null] := e;
Protect[ Evaluate[protected] ];

(* optional text followed by numbers, FortranForm with 5 digits *)

ndig = 5;
nForm[r_] := NumberForm[FortranForm[r], ndig];

writeNums[file_, txt_:"", r_?NumberQ] :=
    Write[file, txt, " ", nForm[r]]
writeNums[file_, txt_:"", r_List] :=
    Write[file, txt, " ", Infix[nForm /@ r, " "]]

(* turn n-gon into list of triangles *)

toTriangles[vlist_List] /; Length[vlist] == 3 := {vlist}

(* treat 4gons specially for efficiency *)

toTriangles[vlist_List] /; Length[vlist] == 4 :=
	{vlist[[{1, 2, 3}]], vlist[[{3, 4, 1}]]}

(* general case: use center of gravity as additional vertex *)
(* in this way, some nonconvex polygons can also be rendered correctly *)

toTriangles[vlist_List] :=
    Module[{bary = (Plus @@ vlist)/Length[vlist], circ},
        circ = Partition[ Append[vlist, First[vlist]], 2, 1 ];
        Apply[ {#1, #2, bary}&, circ, {1} ]
    ]
    
Ball[x_List,r_]:={x,r}

Rod[x_List,r_]:={x,r}

cyllmake[txt_:"", r_List] /; Length[r] == 2 :=
    SequenceForm[txt,"{", "<", Infix[nForm /@ r[[1,1]], ", "], ">",
    ",", "<", Infix[nForm /@ r[[1,2]], ", "], ">"," ",r[[2]],"}" ]
    
ballmake[txt_:"", r_List] /; Length[r] == 2 :=
    SequenceForm[txt,"{", "<", Infix[nForm /@ r[[1]], ", "], ">",
    " ",r[[2]],"}" ]
    
facemake[txt_:"", r_List] /; Length[r] == 3 :=
    SequenceForm[txt,"{", "<", Infix[nForm /@ r[[1]], ", "], ">",
    ",", "<", Infix[nForm /@ r[[2]], ", "], ">",
    ",", "<", Infix[nForm /@ r[[3]], ", "], ">","}" ]

ToPOV[filename_String,n_Integer]:=
Block[{a,b,c,f,h,q1,q2,v,balls,sticks,faces,obj,zaq},

obj=NumberedPolyhedron[n];
v=VertexCoordinates[obj];

(*find face indices and make edge indices*)
a=FaceList[obj];
b=Map[Join[#,{First[#]}]&, a ];
h=Map[Partition[#,2,1]&,b];
h=Flatten[h,1];

(*find all edges remove duplicates*)
c=Table[
Position[h,x_ /; x == h[[i]] || x == Reverse[h[[i]]] ],{i,Length[h]}];
f=Map[Take[#,1]&, Union[c]];
f=Flatten[f,2];
zaq=Table[ v[[ h[[ f[[i]] ]] ]],{i,Length[f]}];

(*create faces and divide into triangles*)
poly=Map[v[[ #]]&,a];
poly=Map[toTriangles[#]&,poly];

q1=Map[Ball[#,R1]&,Chop[v]];
q2=Map[Rod[#,R2]&,Chop[zaq]];
balls=ColumnForm[Map[ballmake["sphere",# ]&,q1],Left];
sticks=ColumnForm[Map[cyllmake["cylinder",# ]&,q2],Left];
faces=ColumnForm[Map[facemake["triangle",# ]&,Chop[Flatten[poly,1]]],Left];

strm=OpenWrite[filename,
FormatType->OutputForm,
PageWidth->Infinity];
Write[strm,"#declare RODS = union{"];
Write[strm,sticks];
Write[strm,"}"];
Write[strm,"#declare BALLS = union{"];
Write[strm,balls];
Write[strm,"}"];
Write[strm,"#declare FACES = union{"];
Write[strm,faces];
Write[strm,"}"];
Close[strm]
]

List of Uniform Polyhedra

ColumnForm[Table[{i,standard[[i]]},{i,Length[standard]}]]

Example

(*Preview the uniform polyhedron.*)
(*Do not attempt nos. 69, 72, 74, or 75.*)
ShowPolyhedron[41];

(*Set the directory to which the file will be written.*)
SetDirectory["Starlight:POV-Ray 3.0:"]

(*Write the POV file named "ditrigonal" for polyhedron 41.*)
ToPOV["ditrigonal",41]

Sample POV scene file

In this example, POV version 3.0 syntax is invoked, but version 2.x will also work, if the first line is removed altogether.  The uniform polyhedron file is called with an #include statement below, after the radii of the spheres and cylinders have been #declare-d.  In this example the file is called "shub-niggurath," which is the name assigned to uniform polyhedron #69 in Maeder's list by George Olschevsky and Bruce Chilton, who tired of the "small retrosnub ditrigonal icosidodecahedron" terminology, and turned to the stories of H.P Lovecraft for an alternative.  The text below may be copied to your Clipboard and pasted directly into an empty POV scene file.  Note:  the actual sizes of the uniform polyhedra vary, and either the camera position or its lens length (the magnitude of its "direction" vector) may need adjustment.

#version 3.0  // use POV-Ray 3.0 syntax
#include "colors.inc"
#include "shapes.inc"
#include "textures.inc"
#include "metals.inc"

#default { texture { pigment {color rgb <1,1,1>} finish {phong 0.1 ambient 0.2 diffuse .6} }}

camera {
	location <0, -3.5, 7>
	direction <0, 3, 0>
	up <0, 0, 1.>
	right <4/3, 0, 0> // 4 to3 aspect ratio (i.e., 320X240, 640X480, etc.)
	sky <0., 0., 1.>
	look_at <0, 0, 0.>
	rotate<0,5,0>
}

light_source { <0, 0, 44>
color rgb <1, 1, 1>}

plane{z,-3
  pigment{
	checker
    color rgb <1,.5,.5>
    color rgb <.5,.5,1>
	}
}

#declare R1 = .075 //Balls
#declare R2 = .0375  //Sticks

#include "shub-niggurath"

object{ RODS
texture{T_Silver_1A}
}

object{ BALLS
texture{Gold_Metal}
}

object{FACES}