Nothing
## Write out a triangle mesh scene as an OFF format file. This only
## outputs the geometry; color and transparency are ignored for now.
## The format supports adding three or four rgb values to each face
## line, but MeshLab seems to ignore these.
saveTrianglesAsOFF <- function(scene, filename = "scene.OFF") {
scene <- colorScene(scene)
triangles <- canonicalizeAndMergeScene(scene, "color", "color2",
"alpha", "col.mesh",
"fill", "smooth")
ve <- t2ve(triangles)
f <- file(filename, open = "w")
on.exit(close(f))
write("OFF", f)
write(c(ncol(ve$vb), ncol(ve$ib), 3 * ncol(ve$ib)), f, 3)
write(ve$vb, f, 3)
write(rbind(3, ve$ib - 1), f, 4)
invisible(NULL)
}
## write an asymptote program for recreating a triangular mesh
## scene. Color and transparency are supported; mesh drawing, color2,
## and material properties are not currently supported. The loops
## could be vectorized but seem adequate for now.
saveTrianglesAsASY <- function(scene, filename = "scene.asy") {
scene <- colorScene(scene)
triangles <- canonicalizeAndMergeScene(scene, "color",
"color2", "alpha",
"col.mesh", "fill",
"smooth")
ve <- t2ve(triangles)
f <- file(filename, open = "w")
on.exit(close(f))
## write out header information and vertices
cat("//generated by saveTrianglesAsASY\n\n",
"import three;\n\n",
"size(20cm);\n\n",
"//currentprojection=perspective(250,-250,250);\n",
"currentlight=Viewport;\n\n",
"typedef path3[] trimesh;\n\n",
"// Vertices\n",
"triple[] V;\n",
sep = "", file = f)
nv <- ncol(ve$vb)
x <- ve$vb[1,]
y <- ve$vb[2,]
z <- ve$vb[3,]
for (i in 1 : nv)
cat(sprintf("V[%d] = (%f, %f, %f);\n",
i - 1, x[i], y[i], z[i]), file = f)
## write out the faces
cat("\n",
"guide3 triface_(int i, int j, int k) {\n",
" guide3 gh; gh=V[i-1]--V[j-1]--V[k-1]--cycle;\n",
" return gh;\n",
"};\n\n",
"// Faces\n",
"trimesh F;\n",
sep = "", file = f)
nf <- ncol(ve$ib)
v1 <- ve$ib[1,]
v2 <- ve$ib[2,]
v3 <- ve$ib[3,]
for (i in 1 : nf)
cat(sprintf("F[%d] = triface_(%d, %d, %d);\n",
i - 1, v1[i], v2[i], v3[i]), file = f)
## write out color and transparency values
cat("\n",
"// Colors\n",
"material M[];\n",
sep = "", file = f)
cols <- col2rgb(triangles$color)
alpha <- triangles$alpha
r <- cols[1,]
g <- cols[2,]
b <- cols[3,]
if (any(alpha < 1))
for (i in 1 : nf)
cat(sprintf("M[%d] = rgb(%f, %f, %f) + opacity(%f);\n",
i - 1, r[i], g[i], b[i], alpha[i]),
file = f)
else
for (i in 1 : nf)
cat(sprintf("M[%d] = rgb(%f, %f, %f);\n",
i - 1, r[i], g[i], b[i]),
file = f)
cat("\ndraw(surface(F), M);\n", file = f)
invisible(NULL)
}
## write out a triangle mesh scene as an IDTF format file.
saveTrianglesAsIDTF <- function(scene, filename = "scene.idtf") {
ns <- length(scene)
f <- file(filename, open = "w")
on.exit(close(f))
## write out header information
cat("FILE_FORMAT \"IDTF\"\n",
"FORMAT_VERSION 100\n\n",sep="", file=f)
## write out group information
cat("NODE \"GROUP\" {\n",
"\tNODE_NAME \"Mesh_Group\"\n",
"\tPARENT_LIST {\n",
"\t\tPARENT_COUNT 1\n",
"\t\tPARENT 0 {\n",
"\t\t\tPARENT_NAME \"<NULL>\"\n",
"\t\t\tPARENT_TM {\n",
"\t\t\t\t1.000000 0.000000 0.000000 0.000000\n",
"\t\t\t\t0.000000 1.000000 0.000000 0.000000\n",
"\t\t\t\t0.000000 0.000000 1.000000 0.000000\n",
"\t\t\t\t0.000000 0.000000 0.000000 1.000000\n",
"\t\t\t}\n",
"\t\t}\n",
"\t}\n",
"}\n\n", sep="", file=f)
## write out node "model"
for(i in 1:ns){
cat("NODE \"MODEL\" {\n", sep="", file=f)
cat(sprintf("\tNODE_NAME \"Mesh%d\"\n", i), file=f)
cat("\tPARENT_LIST {\n",
"\t\tPARENT_COUNT 1\n",
"\t\tPARENT 0 {\n",
"\t\t\tPARENT_NAME \"Mesh_Group\"\n",
"\t\t\tPARENT_TM {\n",
"\t\t\t\t1.000000 0.000000 0.000000 0.000000\n",
"\t\t\t\t0.000000 1.000000 0.000000 0.000000\n",
"\t\t\t\t0.000000 0.000000 1.000000 0.000000\n",
"\t\t\t\t0.000000 0.000000 0.000000 1.000000\n",
"\t\t\t}\n",
"\t\t}\n",
"\t}\n", sep="", file=f)
cat(sprintf("\tRESOURCE_NAME \"MyMesh%d\"\n", i), file=f)
cat("}\n\n", sep="", file=f)
}
## write out resource_list "model"
cat("RESOURCE_LIST \"MODEL\" {\n", sep="", file=f)
cat(sprintf("\tRESOURCE_COUNT %d\n", ns), file=f)
for(s in 1:ns){
cat(sprintf("\tRESOURCE %d {\n", s-1), file=f)
cat(sprintf("\t\tRESOURCE_NAME \"MyMesh%d\"\n", s), file=f)
cat("\t\tMODEL_TYPE \"MESH\"\n",
"\t\tMESH {\n", sep="", file=f)
ve <- t2ve(scene[[s]])
nv <- ncol(ve$vb)
x <- ve$vb[1,]
y <- ve$vb[2,]
z <- ve$vb[3,]
nf <- ncol(ve$ib)
v1 <- ve$ib[1,]
v2 <- ve$ib[2,]
v3 <- ve$ib[3,]
N <- triangleNormals(scene[[s]])
vt <- vertexTriangles(ve)
VN <- vertexNormals(vt, N)
cat(sprintf("\t\t\tFACE_COUNT %d\n", nf), file=f)
cat(sprintf("\t\t\tMODEL_POSITION_COUNT %d\n", nv), file=f)
cat(sprintf("\t\t\tMODEL_NORMAL_COUNT %d\n", nv), file=f)
cat("\t\t\tMODEL_DIFFUSE_COLOR_COUNT 0\n",
"\t\t\tMODEL_SPECULAR_COLOR_COUNT 0\n",
"\t\t\tMODEL_TEXTURE_COORD_COUNT 0\n",
"\t\t\tMODEL_BONE_COUNT 0\n",
"\t\t\tMODEL_SHADING_COUNT 1\n",
"\t\t\tMODEL_SHADING_DESCRIPTION_LIST {\n",
"\t\t\t\tSHADING_DESCRIPTION 0 {\n",
"\t\t\t\t\tTEXTURE_LAYER_COUNT 0\n",
"\t\t\t\t\tSHADER_ID 0\n",
"\t\t\t\t}\n",
"\t\t\t}\n", sep="", file=f)
#face position
cat("\t\t\tMESH_FACE_POSITION_LIST {\n", sep="", file=f)
for(i in 1:nf)
cat(sprintf("\t\t\t\t%d %d %d \n", v1[i]-1, v2[i]-1, v3[i]-1), file=f)
cat("\t\t\t}\n", sep="", file=f)
#face normal
cat("\t\t\tMESH_FACE_NORMAL_LIST {\n", sep="", file=f)
for(i in 1:nf)
cat(sprintf("\t\t\t\t%d %d %d \n", v1[i]-1, v2[i]-1, v3[i]-1), file=f)
cat("\t\t\t}\n", sep="", file=f)
#shading list---not sure what that is use 0 for all
cat("\t\t\tMESH_FACE_SHADING_LIST {\n", sep="", file=f)
for(i in 1:nf)
cat(sprintf("\t\t\t\t%d\n", 0), file=f)
cat("\t\t\t}\n", sep="", file=f)
#model position
cat("\t\t\tMODEL_POSITION_LIST {\n", sep="", file=f)
for(i in 1:nv)
cat(sprintf("\t\t\t\t%f %f %f \n", x[i], y[i], z[i]), file=f)
cat("\t\t\t}\n", sep="", file=f)
#model normal
cat("\t\t\tMODEL_NORMAL_LIST {\n", sep="", file=f)
for(i in 1:nv)
cat(sprintf("\t\t\t\t%f %f %f \n", VN[i,1], VN[i,2], VN[i,3]), file=f)
cat("\t\t\t}\n", sep="", file=f)
#
cat("\t\t}\n", sep="", file=f)
cat("\t}\n", sep="", file=f)
}
cat("}\n\n", sep="", file=f)
## write out resource_list "shader"
cat("RESOURCE_LIST \"SHADER\" {\n", sep="", file=f)
cat(sprintf("\tRESOURCE_COUNT %d\n", ns), file=f)
for(s in 1:ns){
cat(sprintf("\tRESOURCE %d {\n", s-1), file=f)
cat(sprintf("\t\tRESOURCE_NAME \"Box0%d0\"\n", s), file=f)
cat(sprintf("\t\tSHADER_MATERIAL_NAME \"Box0%d0\"\n", s), file=f)
cat("\t\tSHADER_ACTIVE_TEXTURE_COUNT 0\n",
"\t}\n", sep="", file=f)
}
cat("}\n\n", sep="", file=f)
## write out resource_list "material"
## need to be more flexible
cat("RESOURCE_LIST \"MATERIAL\" {\n", sep="", file=f)
cat(sprintf("\tRESOURCE_COUNT %d\n", ns), file=f)
for(s in 1:ns){
cat(sprintf("\tRESOURCE %d {\n", s-1), file=f)
cat(sprintf("\t\tRESOURCE_NAME \"Box0%d0\"\n", s), file=f)
cat("\t\tMATERIAL_AMBIENT 0.0 0.0 0.0\n", sep="", file=f)
rgb <- col2rgb(scene[[s]]$color)/255
cat(sprintf("\t\tMATERIAL_DIFFUSE %f %f %f\n", rgb[1], rgb[2], rgb[3]), file=f)
cat("\t\tMATERIAL_SPECULAR 0.0 0.0 0.0\n",
"\t\tMATERIAL_EMISSIVE 0.0 0.0 0.0\n",
"\t\tMATERIAL_REFLECTIVITY 0.000000\n", sep="", file=f)
cat(sprintf("\t\tMATERIAL_OPACITY %f\n", scene[[s]]$alpha), file=f)
cat("\t}\n", sep="", file=f)
}
cat("}\n\n", sep="", file=f)
## write out modifier "shading"
for(s in 1:ns){
cat("MODIFIER \"SHADING\" {\n", sep="", file=f)
cat(sprintf("\tMODIFIER_NAME \"Mesh%d\"\n", s), file=f)
cat("\tPARAMETERS {\n",
"\t\tSHADER_LIST_COUNT 1\n",
"\t\tSHADER_LIST_LIST {\n",
"\t\t\tSHADER_LIST 0 {\n",
"\t\t\t\tSHADER_COUNT 1\n",
"\t\t\t\tSHADER_NAME_LIST {\n", sep="", file=f)
cat(sprintf("\t\t\t\t\tSHADER 0 NAME: \"Box0%d0\"\n", s), file=f)
cat("\t\t\t\t}\n",
"\t\t\t}\n",
"\t\t}\n",
"\t}\n",
"}\n\n", sep="", file=f)
}
invisible(NULL)
}
exportScene <- function(scene, filename, format=c("OFF", "IDTF", "ASY")){
format <- match.arg(format)
switch(format,
OFF = saveTrianglesAsOFF(scene, filename = paste(filename, ".off", sep="")),
IDTF = saveTrianglesAsIDTF(scene, filename = paste(filename, ".idtf", sep="")),
ASY = saveTrianglesAsASY(scene, filename = paste(filename, ".asy", sep=""))
)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.