Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

Re: Mathematica 6.0.1 nb working, but not on Mathematica 8.0.1.

• To: mathgroup at smc.vnet.net
• Subject: [mg117792] Re: Mathematica 6.0.1 nb working, but not on Mathematica 8.0.1.
• From: Fred Klingener <jfklingener at gmail.com>
• Date: Thu, 31 Mar 2011 04:04:19 -0500 (EST)
• References: <imshi3$5tr$1@smc.vnet.net>

On Mar 29, 7:58 am, Bill <WDWNORW... at aol.com> wrote:
> Hi:
>
> Ref:http://mathforum.org/kb/message.jspa?messageID=7144121&tstart=15
>
> and
>
> http://en.wikipedia.org/wiki/Star_Wars_opening_crawl
>
> (Fred Klingener and David Reiss posts)
>
> I can run the code fine in Mathematica 6.0.1., but I get error messages and
> no graphic output when I run the same notebook in Mathematica 8.0.1.
> Can someone give me a workaround for Mathematica 8.0.1.?
>
> Thanks,
>
> Bill

There were two accidents that converged to enable that hack:
1.) Mma rendered PDF text as Polygons that linked nodes on the
perimeter of each character, and
2.) the Polygon primitive could be made to work in either Graphics or
Graphics3D.

In either version, you can inspect a sample form with

hfgx = First@
  ImportString[
   ExportString[
    Style["Hfgx"
     , FontFamily -> "Helvetica"
     , Bold
     , 72
     , ShowStringCharacters -> False
     ]
    , "PDF"
    ] (*ExportString*)
   , "PDF"
   ];
Pane[
 hfgx // FullForm
 , ImageSize -> {300, 200}
 , Scrollbars -> {False, True}
 ]

If you're running in a version prior to 8, you'll see that the basic
primitive is Polygon. So it's open to a hack like:

Graphics[p2d = First@Cases[hfgx, _Polygon, Infinity]]

Manipulate[
 Graphics3D[
  {FaceForm[Black]
   , p2d /. {x_, y_} :> {s x Cos[t], s y, s x Sin[t]}
   }
  , PlotRange -> {{0, 150}, {0, 90}, {-150, 150}}
  ]
 , {{t, 0}, -Pi/2, Pi/2}
 , {{s, 1}, 0.5, 2}
 ]

but in 8, it's something called FilledCurve. This is kind of sketchily
documented, and the forms generated by the Import/Export business
produce forms that bear no relationship to those documented. Someday,
I suppose, it'll get documented or one of us will figure out how it
works, but in the meantime, perimeter nodes can be extracted, fed to
Polygons, and recognizable but not ready for prime-time shapes. The
perimeter nodes can be obtained by some combination of deft
application of Cases and brute force search.

nodes = Cases[
    hfgx
    , _FilledCurve
    , Infinity
    ][[1, 2]];

and the patterns can be inspected with

Graphics[Arrow /@ nodes, Axes -> True, AxesOrigin -> 0]

I suppose because that node set is used to construct curves, they're
more granular than the set used for Polygons, but the shapes are
probably good enough for informal use.

It's no big surprise that the winding doesn't quite work out

Graphics[{Opacity[0.3], FaceForm[Red, White], Polygon /@ nodes},
 Axes -> True, AxesOrigin -> 0]

There is probably an elegant way to get it right, but for the example
I fiddled with the winding by hand until it worked. The 'g' becomes

Graphics[Polygon[Join[nodes[[3]], nodes[[4]]]]]

and the assembly becomes:

newnodes = {nodes[[1]], nodes[[2]], Join[nodes[[3]], nodes[[4]]],
  nodes[[6]]};
Graphics[Polygon[newnodes]]

Manipulate[
 Graphics3D[{
  FaceForm[Black],
   Polygon[newnodes /. {x_, y_} :> {s x Cos[t], s y, s x Sin[t]}]}
  ,PlotRange -> {{0, 150}, {0, 90}, {-150, 150}}]
   ,{{t, 0}, -Pi/2, Pi/2}
   , {{s, 1}, 0.5, 2}
]

There are still problems with winding and closure. maybe those can be
fixed with some validation code that assures the nodes remain in a
plane.

Anyway, it's not as slick as the prior version, and the characters are
rougher.

Mathematica taketh away, but Mathematica also giveth. Post-8, probably
the way to generate high quality 3D text is with Texture.

img = Image[hfgx, ImageResolution -> 300]
ImageDimensions[img]

p2d = Polygon[{{0, 0}, {#[[1]], 0}, #, {0, #[[2]]}} &@
    ImageDimensions[img]
   , VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0, 1}}];

Graphics[{Texture[img], p2d}]

Manipulate[
 Graphics3D[
  {Texture[img], Scale[
    {
     p2d /. {x_, y_} :> {x, y, rotationy x + rotationx y + warp x y}
     }
    , scale
    ]
   }
  , PlotRange -> {{0, 600}, {-100, 400}, {-400, 400}}
  ]
 , {{scale, 1}, 0.5, 2}
 , {{rotationy, 0}, -0.5, 0.5}
 , {{rotationx, 0}, -0.5, 0.5}
 , {{warp, 0}, -0.005, 0.005}
 ]

The texture method has the undeniable advantage that it'll fit text
onto curved and warped surfaces.

Hth,
Fred Klingener