7
$\begingroup$

I thought a simple Mathematica kerning machine (for adjusting the space between characters) would be interesting, but I'm having trouble with the locators. (There are a number of other questions related to this, and I've read the answers, but as yet without finding a solution, or understanding them that well.)

 Manipulate[
  LocatorPane[Dynamic[points],
   text = "Wolfram";
   fonts = FE`Evaluate[FEPrivate`GetPopupList["MenuListFonts"]];
   Column[{
     Button["Export", Export["/tmp/t.png", g]],
     g = Graphics[{
          MapIndexed[
          Text[Style[#1, FontSize -> fontsize, FontFamily -> font], 
            points[[First[#2]]]] &, Characters[text]]}, ImageSize -> 500]
     }]],
  {points, {Table[{ x, 0}, {x, 1, Length[Characters[text]]}]}, 
    ControlType -> None},
  {fontsize , Table[x, {x, 96, 256, 12}]} ,
  {font, fonts}
 ]

(The font menu gets populated once you use it.)

kerning machine

I want to be able to slide the letters right or left (but not up or down), but at the moment they don't move like they're supposed to.

The solution

Thanks to the fine answers, I've got something useful working. There are some kludges and hacks too, and some problems still to be ironed out (string length needs to be dynamic, 'canvas' needs resizing, and so on), but this is excellent for now.

With[{fonts = FE`Evaluate[FEPrivate`GetPopupList["MenuListFonts"]]},
 DynamicModule[{kernedText, points},
  points = Table[{x, 0}, {x, 1, Length[Characters[text]] + 10}];
  Column[{
    (* input *)
    InputField[Dynamic[text], String],
    (* main panel *)
    Panel@LocatorPane[
      Dynamic[
       points, (points = ReplacePart[#, {{_, 2} -> 0}]) &], 
      Dynamic[kernedText = 
        Graphics[{MapIndexed[
           Text[Style[#1, FontSize -> fontsize, FontFamily -> font], 
             points[[First[#2]]]] &, Characters[text]]}, 
         PlotRangePadding -> 0, 
         PlotRange -> {{0, 1 + Length[Characters[text]]}, Automatic}, 
         Background -> None, ImageSize -> 800]], Appearance -> None],
    (* controls *)
    Row[
     {
      PopupMenu[Dynamic[fontsize], Table[x, {x, 72, 416, 12}]],
      PopupMenu[Dynamic[font], fonts],
      Button["Export", 
       Export[FileNameJoin[{$HomeDirectory, "Desktop", 
          "KernedText.png"}], kernedText], 
       ImageSize -> {Full, Automatic}]
      }]
    }, Left]]]

final

I realised that the locator dots didn't need to be showing - just click on the characters. The result can be compared to the unkerned version:

Text[Style[text, 192, FontFamily -> "Palatino"]]

unkerned

For me, this area of Mathematica (Manipulate/Dynamic) is gradually becoming less confusing (but only gradually).

$\endgroup$

3 Answers 3

5
$\begingroup$

This is just an addendum to jVincent's answer. In order to constrain the letters/locators to a horizontal line, you need to use the second argument of Dynamic. The following modified version of jVincent's answer adds the needed constraint:

With[{text = "Wolfram", fontsize = 96, font = "Georgia"},
   DynamicModule[{chars, kernedText, points},
      chars = Length[Characters[text]];
      points = Table[{x, 0}, {x, 1, chars}]; 
      Column[{Panel@
         LocatorPane[
            Dynamic[points, (points = ReplacePart[#, {{_, 2} -> 0}]) &], 
            Dynamic[kernedText = 
               Graphics[
                  {
                  MapIndexed[
                     Text[Style[#1, FontSize -> fontsize,
                        FontFamily -> font], points[[First[#2]]]]&,
                     Characters[text]]
                  }, 
                  PlotRange -> {{0, 1 + chars}, Automatic},
                  ImageSize -> 450]]],
         Button["Export", 
            Export[FileNameJoin[
               {
               $HomeDirectory, "Desktop", "KernedText.png"
               }],
            kernedText],
            ImageSize -> {Full, Automatic}]},
         Right]]]

Edit

I've cleaned up my code and incorporated kguler's fix. The resulting kerned letters look pretty and export nicely.

kerned text

$\endgroup$
1
  • $\begingroup$ You can use PlotRange->{{0,10},Automatic} to fix the issue with the right-most locator. (+1) $\endgroup$
    – kglr
    Nov 18, 2012 at 22:55
7
$\begingroup$

First off, Dynamic[exp]] redraws whenever anything that appears in expression changes. Think of Manipulate as being just a Dynamic[code] with some nice shortcuts to build controllers that can change things that appear in code. In your case, you have a Dynamic[LocatorPane[(* some expression depending on points*)]]. So whenever someone changes points a new locatorpane will be created and displayed right where the old one was, so you won't notice... except that the active controller loses focus, so you stop dragging the controller. Here is a very short demonstration of the problem:

points = {{0, 0}};
Dynamic@LocatorPane[Dynamic[points], Graphics[Point /@ points, PlotRange -> 2]]

While just moving the Dynamic will cause only the graphic to be updated and solve the issue:

LocatorPane[Dynamic[points], Dynamic@Graphics[Point /@ points, PlotRange -> 2]]

So how to get around this problem In your case. I would suggest not using LocatorPane inside manipulate, and either fully using only manipulate, or going completely without it. Here is a possible solution without using Manipulate:

text = "Wolfram";
fontsize = 96;
font = "BankGothic";

 DynamicModule[{points = Table[{x, 0}, {x, 1, Length[Characters[text]]}]},
  LocatorPane[Dynamic[points],
   Column[{
     Button["Export", Export["/tmp/t.png", g]], 
     Dynamic[g = Graphics[{MapIndexed[
     Text[Style[#1, FontSize -> fontsize], points[[First[#2]]]] &,
      Characters[text]]}, ImageSize -> 500]]}]]
  ]
$\endgroup$
2
  • $\begingroup$ Thanks, a good solution. So you don't use LocatorPane in Manipulate, because it doesn't need to create new panes all the time... $\endgroup$
    – cormullion
    Nov 19, 2012 at 10:58
  • $\begingroup$ @cormullion Correct, when it creates a new locator pane, the old locators stop working, so what you where moving stops moving and it redraws.You could possibly also make it all work by using ControlType->Locator inside the Manipulate and displaying a Graphics. $\endgroup$
    – jVincent
    Nov 19, 2012 at 11:21
2
$\begingroup$

I'm sure the OP has figured the problem out already, so I don't know why I'm bothering except that I think future users might appreciate a good Manipulate-based solution as an alternative, especially as an example of how to work with Locators.

A few changes: The most important thing is that the Locators are constrained by making the minimum and maximum y coordinate the same (0). I used BaseStyle instead of styling each character. For a smoother start-up, I put the font list into the specification for fonts; wrapping it in Dynamic means that the list of fonts will not be stored in the Manipulate output cell, only the code for loading it; since Manipulate can't interpret code, I needed to specify the control type. I changed some of the sizes to scale with fontsize. I also made text and g local variables. The important thing about making text local is that points needs to be initialized after text is initialized by the front end, unless it already has been set. The way points might be already initialized is if the cell is copied and pasted, or the notebook reopened.

text0 = "Wolfram";
Manipulate[
 g = Graphics[{MapIndexed[Text[#1, points[[First[#2]]]] &, Characters[text]]}, 
   ImageSize -> 0.75 fontsize * (StringLength @ text + 1), 
   PlotRange -> {{0, StringLength @ text + 1}, {-0.7, 1.}},
   BaseStyle -> {FontSize -> fontsize, FontFamily -> font}],

 {{text, text0}, ControlType -> None}, {g, ControlType -> None},
 {{points, Table[{x, 0}, {x, 1, StringLength @ text0}]},
  {0, 0}, {StringLength @ text + 1, 0}, Locator},
 {fontsize, Table[x, {x, 96, 256, 12}]},
 {{font, "Times"}, 
  Dynamic@FE`Evaluate[FEPrivate`GetPopupList["MenuListFonts"]], 
  PopupMenu},

 Button["Export", Export["/tmp/t.png", g]]
 ]

Here's a variation in which the characters themselves are the locators. Wrapping the characters in Pane aligns the text.

text0 = "Wolfram";
Manipulate[
 g = LocatorPane[Dynamic@points,
   Dynamic[
    Graphics[{}, ImageSize -> 0.75 fontsize * (StringLength @ text + 1), 
     PlotRange -> {{0, StringLength@text + 1}, {-0.7, 1.}}]
    ],
   {{0, 0}, {StringLength @ text + 1, 0}},
   Appearance -> Pane /@ Characters[text],
   BaseStyle -> {FontSize -> fontsize, FontFamily -> font}
   ],

 {{text, text0}, ControlType -> None}, {g, ControlType -> None},
 {{points, Table[{x, 0}, {x, 1, StringLength @ text0}]}, None},
 {fontsize, Table[x, {x, 96, 256, 12}]},
 {{font, "Times"}, 
  Dynamic@FE`Evaluate[FEPrivate`GetPopupList["MenuListFonts"]], 
  PopupMenu},

 Button["Export", Export["/tmp/t.png", g]]
 ]

Mathematica graphics


Edit summary: Apparently I had a definition hanging around that made it seem that the initialization of points was working properly in the previous, simpler version. I've fixed it. An alternative fix is to initialize points in the Initialization option, after text has been initialized in the front end as follows. Set points to be an empty list in its variable specification, and conditionally initialize it later in Initialization. If it's not conditional, the points will be reset to the beginning whenever the notebook is opened or a copy of the cell is pasted into a notebook (when the Initialization code will be executed).

{{points, {}}, ...},
...
Initialization :> (If[Length[points] == 0, 
   points = Table[{x, 0}, {x, 1, StringLength @ text}]])

(For the ellipsis after points, fill in the locator code or None in each of the two Manipulates above, as appropriate.)

One could also dispense with the local variable text altogether, but I was playing with as an InputField, in which case it is convenient for it to be local.

$\endgroup$
2
  • $\begingroup$ Cool - this was some time ago! Some interesting additions which I'll check out later. (Necromancer badge for you perhaps?!) $\endgroup$
    – cormullion
    Aug 13, 2013 at 15:27
  • $\begingroup$ @cormullion We'll have to see if more than one person thinks it's cool. But thanks! $\endgroup$
    – Michael E2
    Aug 13, 2013 at 15:37

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.