Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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).

share|improve this question
add comment

3 Answers

up vote 5 down vote accepted

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

share|improve this answer
    
You can use PlotRange->{{0,10},Automatic} to fix the issue with the right-most locator. (+1) –  kguler Nov 18 '12 at 22:55
    
Thanks. Playing with it now. –  cormullion Nov 19 '12 at 11:01
add comment

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]]}]]
  ]
share|improve this answer
    
Thanks, a good solution. So you don't use LocatorPane in Manipulate, because it doesn't need to create new panes all the time... –  cormullion Nov 19 '12 at 10:58
    
@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. –  jVincent Nov 19 '12 at 11:21
add comment

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.

share|improve this answer
    
Cool - this was some time ago! Some interesting additions which I'll check out later. (Necromancer badge for you perhaps?!) –  cormullion Aug 13 '13 at 15:27
    
@cormullion We'll have to see if more than one person thinks it's cool. But thanks! –  Michael E2 Aug 13 '13 at 15:37
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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