I haven't tried it but there is an example on this page:
http://users.dimi.uniud.it/~gianluca.gorni/Mma/Mma.html
You mean the projected/mapped letters should be curved ? Try
projecting stencil slots onto the torus from a suitable bright point
as light source, which can be even at infinity.. as intersection with
the conical rays.
My response is a reprise of my post of a couple of weeks ago on texture
mapping, for which there were helpful responses, but no satisfying
resolution.
One straightforward approach is to map an image of the text onto a mesh
generated on a torus.
Applying the earlier method to your case, I'll use Rasterize to generate an
RGBColor array directly from the text:
map = Rasterize[
"\t\tMathematica\t\t"
, "RGBColor"
, ImageSize -> {160, 30}
, ImageResolution -> 20];
grid = Take[Dimensions[map, 2] - 1];
r = 1; r0 = 0.3;
ParametricPlot3D[{
(r1 = (r + r0 Cos[phi])) Cos[theta]
, r1 Sin[theta]
, r0 Sin[phi]}
, {phi, -Pi, Pi}
, {theta, 0, 2 Pi}
, Mesh -> Reverse[grid]
, MeshStyle -> None
, MeshFunctions -> {#5 &, -#4 &}
, MeshShading -> map
,ViewPoint -> {-1, 2, 1}
]
On the one hand, the technique evidently produces a useful result, but on
the other, it's so bog-slow that it can't possibly be the right way to do
it.
On my WinXP 6.0.1, the timing (huge difference between Timing[] report and
meat clock time elapsed) and memory (inexorable rise in page file usage)
puzzles remain when I work with meshshading.
Hth,
Fred Klingener
Hi,
here is a first attempt:
a) define a 2dim parameter space. E.g. for a Torus {0,2Pi} x {0,2Pi}
b) write your characters into the flat parameter space
c) map the 2dim parameter space into 3D
here is an example where we write two "A" characters onto a torus:
R=10;r=3;
map[p1_,p2_]:={R Sin[p1]+ r Cos[p2] Sin[p1],R Cos[p1]+ r Cos[p2]
Cos[p1],r Sin[p2]};
charA2D[p_,pos_,size_]:=Plus[#,pos]&/@{{0.5
p,p},{0.5+0.5p,1-p},{0.25+0.5p,0.5}};
txt[p_]:=Join[charA2D[p,{0,-.5},1],charA2D[p,{1.1,-.5},1]];
g1={Graphics3D[Thickness[0.02]],ParametricPlot3D[map@@@txt[p],{p,0,1}]}//Show;
g2=ParametricPlot3D[map[p1,p2],{p1,0,2Pi},{p2,0,2Pi}];
Show[g2,g1]
hope thsi helps, Daniel
--
David Park
djm...@comcast.net
http://home.comcast.net/~djmpark/
"P_ter" <peter_van...@yahoo.co.uk> wrote in message
news:fsvels$sto$1...@smc.vnet.net...
http://www.mathematicaguidebooks.org/
Kevin
--
Kevin J. McCann
Research Associate Professor
JCET/Physics
Physics Building
University of Maryland, Baltimore County
1000 Hilltop Circle
Baltimore, MD 21250
Brute force. Not much slower than MeshShading.
Make raster of text, compose Polygons on the flat raster grid, apply
FaceForm[RGBColor] to each Polygon, and display with Graphics3D:
w = 160; h = 40;
map = Rasterize["**** Mathematica ****"
, "RGBColor"
, RasterSize -> {w, h}
, Background -> White];
Graphics3D[{EdgeForm[],
Table[{FaceForm[map[[i, j]]],
Polygon[{{i, j, 0}, {i, j + 1, 0}, {i + 1, j + 1, 0}, {i + 1, j, 0}}]}
, {i, 1, h - 1}
, {j, 1, w - 1}]}
Next, map the 2D raster grid onto the 3D coordinates to on a torus:
r = 1.0; r0 = 0.3;
fx[i_, j_] := (r - r0 Cos[2 Pi i/40]) Cos[(2 Pi j)/160];
fy[i_, j_] := (r - r0 Cos[2 Pi i/40]) Sin[(2 Pi j)/160];
fz[i_, j_] := r0 Sin[2 Pi i/40];
w = 160; h = 40;
map = Rasterize["**** Mathematica ****"
, "RGBColor"
, Background -> White
, RasterSize -> {w, h}];
Graphics3D[{EdgeForm[]
, Table[{FaceForm[map[[i, j]]], Polygon[{{fx[i, j], fy[i, j], fz[i, j]}
, {fx[i, j + 1], fy[i, j + 1], fz[i, j + 1]}
, {fx[i + 1, j + 1], fy[i + 1, j + 1], fz[i + 1, j + 1]}
, {fx[i + 1, j], fy[i + 1, j], fz[i + 1, j]}}]}
, {i, 1, h - 1}
, {j, 1, w - 1}]}
]
It could be prettied up some, but it'd still be a pig.
Cheers,
Fred Klingener
It should be mentioned that the mapping can never be faithful ( per
isometric mappings between flat to flat or curvrd to curved surfaces )
as there is bound to be alteration due to:
1) magnification/reduction ( strain of tension or compression),
2) distortion ( angle changes in shear).
It is in other words so stated by Gauss Egregium theorem. After
writing or printing the text on a flat label when you try to stick it
on a torus of suitable size, a tendency to tear on areas outside the
crown (Gauss Curvature > 0) and some folds/frills on the inside ( G.C
< 0) is inevitable. The most faithful reproduction takes place at the
crown ( G.C ~ 0).
Continued...
Simple example below is for a faithful map from a flat label to a
cone in 3D plot 'drape' :
t=0;
umin=1;umax=16;vmin=3;vmax=5;
(* before draping flatstrip on cone ; can be rasterized as suggested
by Fred Klingener *)
Strp={u Cos[t]-v Sin[t],u Sin[t]+v Cos[t],0};
aa=ParametricPlot3D[Strp,{u,umin,umax},
{v,vmin,vmax},PlotPoints=AE{17,4}];
th[u_,v_,gt_]:=ArcTan[u Cos[gt]-v Sin[gt],u Sin[gt]+v Cos[gt]];
gt=Pi/4;
bb=ParametricPlot3D[Sqrt[u^2+v^2] {Cos[th[u,v,gt]],Sin[th[u,v,gt]],0},
{u,umin,umax},{v,vmin,vmax},PlotPoints=AE{17,4}]
Show[aa,bb]
(* PlotPoints=AE4 is partly does not come through, bb is also not Shown
in full*)
al=Pi/12;
cone=ParametricPlot3D[RHO {Sin[al] Cos[t],Sin[al] Sin[t],Cos[al]}
+{0,0,.03},{RHO,2,17},{t,0,2 Pi},PlotPoints=AE{41,55}]
(*after rotating gt in the plane,Drape/Bend/Roll the flat strip into a
cone of semi vertex angle al*)
t=1.4;
rho=Sqrt[u^2+v^2];
STRP=rho*{Sin[al] Cos[th[u,v,t]/Sin[al]],Sin[al] Sin[th[u,v,t]/
Sin[al]],Cos[al]} ;
drape=ParametricPlot3D[STRP,{u,umin,umax},
{v,vmin,vmax},PlotPoints=AE{65,11}]
Show[cone,drape]
Narasimham