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.)
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]]]
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"]]
For me, this area of Mathematica (Manipulate/Dynamic) is gradually becoming less confusing (but only gradually).