Anonymous user
Catmull–Clark subdivision surface: Difference between revisions
Catmull–Clark subdivision surface (view source)
Revision as of 06:51, 16 January 2010
, 14 years agoMathematica (this was fun to write!)
(added a full description) |
(Mathematica (this was fun to write!)) |
||
Line 42:
## in all the edges the point belongs to, only take in account the middles of the edges that are on the border of the hole then calculate the average between these points and the old coordinates.
==
=={{header|Mathematica}}==
This implementation supports tris, quads, and higher polys, as well as surfaces with holes.
<lang Mathematica>CatmullClark[{v_, i_}] := Block[{e, vc, fp, ep, vp},
e = Function[a, {a, Select[Transpose[{i, Range@Length@i}],
Length@Intersection[#[[1]], a] == 2 &][[All, 2]]}] /@
Union[Sort /@ Flatten[Partition[#, 2, 1, 1] & /@ i, 1]];
vc = Table[{n, Select[Transpose[{i, Range@Length@i}], MemberQ[#[[1]], n] &][[All, 2]],
Select[Transpose[{e[[All, 1]], Range@Length@e[[All, 1]]}], MemberQ[#[[1]], n] &][[All, 2]]}, {n, Length@v}];
fp = Mean[v[[#]]] & /@ i;
ep = If[Length[#[[2]]] == 1, Mean[v[[#[[1]]]]], Mean@Join[v[[#[[1]]]], fp[[#[[2]]]]]] & /@ e;
vp = If[Length[#[[2]]] != Length[#[[3]]], Mean@Join[{v[[#[[1]]]]}, ep[[Select[#[[3]],
Length[e[[#, 2]]] != 2 &]]]], ((Length@#[[2]] - 3) v[[#[[1]]]] + Mean@fp[[#[[2]]]] +
2 Mean@ep[[#[[3]]]])/Length@#[[2]]] & /@ vc;
{Join[vp, ep, fp], Flatten[Function[a, Function[
b, {a[[1]], #[[1]] + Length[vc], b + Length[vc] + Length[e], #[[2]] + Length[vc]} &@
Sort[Select[Transpose[{e, Range@Length@e}], MemberQ[#[[1, 1]], a[[1]]] && MemberQ[#[[1, 2]], b] &],
With[{f = i[[Intersection[#[[1, 2]], #2[[1, 2]]][[1]]]],
n = Intersection[#[[1, 1]], #2[[1, 1]]][[1]]},
Xor[Abs[#] == 1, # < 0] &@(Position[f, Complement[#[[1, 1]], {n}][[1]]] -
Position[f, n])[[1, 1]]] &][[All, 2]]] /@ a[[2]]] /@ vc, 1]}]
v = PolyhedronData["Cube", "VertexCoordinates"] // N
i = PolyhedronData["Cube", "FaceIndices"]
NestList[CatmullClark, {v, i}, 4];
Graphics3D[{FaceForm[{Opacity[0.3]}, {Opacity[0.1]}], GraphicsComplex[#[[1]], Polygon[#[[2]]]]}] & /@ %
Graphics3D[{EdgeForm[], FaceForm[White, Black],
GraphicsComplex[#[[1]], Polygon[#[[2]]], VertexNormals -> #[[1]]]}, Boxed -> False] & /@ %%
</lang>
The last few lines, after the function definition, do a test by using the built-in polyhedron data to generate the vertices and face indices. Then it repeatedly applies the method and graphs the results. Note that this was written in Mathematica 7, although it should be easy enough to port to maybe v5.2.
=={{header|OCaml}}==
| |||