Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

Code that writes code that writes code: Perl to Lisp to Postscript

by hsmyers (Canon)
on Apr 27, 2008 at 22:42 UTC ( #683209=CUFP: print w/replies, xml ) Need Help??

I've always been a fan-boy for code generation so when I needed a strong solution to a typesetting problem I didn't hesitate to use as many tools as needed.

The problem? Accurate justification of Figurine Notation for Chess games. I'm in the process of porting my CPAN code to Lisp as a way of comparing the available variety of Lisps out there. As usual this make a fine excuse to embrace and extend my own code. In particular I added code to output Postscript as well as LaTeX and the rest in the current module (Chess::PGN::EPD etc.) Following advice from one of the industry pioneers, Don Lancaster, I have been writing Postscript code right and left (likewise center) with most of the problem coming down to the arcane art of justification. Whoops! Babbling again!!

Long story short, you need font metric information in order to do a decent job of justification. In order to get the necessary tables in my Lisp code, I used Perl to parse .afm files I generated with Ghostscript.

Herewith:

#!/usr/bin/perl # afm.pl # use strict; use warnings; use Font::AFM; my $h = new Font::AFM $ARGV[0]; print "(setq $ARGV[0]afm12 '(\n"; metric($h,"R",12); metric($h,"N",12); metric($h,"B",12); metric($h,"Q",12); metric($h,"K",12); metric($h,"O",12); metric($h,"-",12); metric($h,"x",12); metric($h,"+",12); metric($h,".",12); metric($h,"a",12); metric($h,"b",12); metric($h,"c",12); metric($h,"d",12); metric($h,"e",12); metric($h,"f",12); metric($h,"g",12); metric($h,"h",12); metric($h,"1",12); metric($h,"2",12); metric($h,"3",12); metric($h,"4",12); metric($h,"5",12); metric($h,"6",12); metric($h,"7",12); metric($h,"8",12); metric($h,"9",12); print " (\"0\" ", $h->stringwidth("0",12), ")))\n"; sub metric { my $afm = shift; my $s = shift; my $p = shift; my $w = $afm->stringwidth($s,$p); print " (\"$s\" $w)\n"; }
Which produces (given a font name [.pfb name] on the command line):
(setq ZURIFB__afm12 '( ("R" 10.392) ("N" 11.676) ("B" 11.676) ("Q" 12) ("K" 11.52) ("O" 9.168) ("-" 10.548) ("x" 6.696) ("+" 6.708) ("." 3.396) ("a" 6.672) ("b" 7.488) ("c" 6.048) ("d" 7.62) ("e" 6.24) ("f" 5.28) ("g" 6.696) ("h" 8.268) ("1" 6.708) ("2" 6.708) ("3" 6.708) ("4" 6.708) ("5" 6.708) ("6" 6.888) ("7" 6.708) ("8" 6.708) ("9" 6.708) ("0" 6.708)))
Which eventually produces:
/ZurichFigurine-Bold 12 sf (1.d4 f5 2.c4 Nf6 3.Nc3 g6 4.Nf3 Bg7) justify (5.e3 d6 6.Bd3 O-O 7.O-O Qe8 8.e4) justify (fxe4 9.Nxe4 Bg4 10.Be3 Nbd7 11.Nxf6) justify (Nxf6 12.Be2 h6 13.d5 Ne4 14.Nd4) justify (Bd7 15.Bg4 Bxd4 16.Bxd4 Nf6) justify (17.Bxd7 Qxd7 18.Qd3 Qg4 19.Rae1) justify (Rf7 20.Re6 Raf8 21.h3 Qg5 22.g4) justify (Kh7 23.f4 Nh5 24.fxg5 Rxf1 25.Qxf1) justify (Rxf1 26.Kxf1 Nf4 27.Rxe7 1-0) left-justify newline
So, are we having fun yet?

--hsm

"Never try to teach a pig to sing...it wastes your time and it annoys the pig."

Replies are listed 'Best First'.
Re: Code that writes code that writes code: Perl to Lisp to Postscript
by almut (Canon) on Apr 28, 2008 at 19:03 UTC

    You also could've generated the Lisp code directly using PostScript :)

    %!PS % load font file % (you don't need this, if you have a .pfa file, in which case % you can directly specify it on the gs command line: % $ gs -q -dNODISPLAY ZURIFB__.pfa 683209.ps ) (./ZURIFB__.pfb) % or whatever your .pfb file is (r) file true /PFBDecode filter cvx mark exch exec cleartomark /ZurichFigurine-Bold findfont 12 scalefont setfont /print_width { dup ( \(" " ) dup 4 4 -1 roll putinterval print % '("X" ' stringwidth pop 20 string cvs print % width (\)) print % ')' } bind def /i2s { % int/char to string ( ) dup 0 4 -1 roll put } bind def (\(setq ZURIFB__afm12 '\() = % 1st line (RNBQKO-x+.abcdefgh1234567890) { % char list i2s dup print_width (0) ne {()=} if % "\n", unless last char } forall (\)\)) = % "))\n" quit

    Running this with Ghostscript

    $ gs -q -dNODISPLAY 683209.ps

    would've produced something like (note that I don't have the (apparently commercial) ZurichFigurine font, so I substituted Helvetica for demo purposes — you should get the proper widths with the real font...)

    (setq ZURIFB__afm12 '( ("R" 8.66016) ("N" 8.66016) ("B" 8.00391) ("Q" 9.33594) ("K" 8.00391) ("O" 9.33594) ("-" 3.99219) ("x" 6.0) ("+" 7.00781) ("." 3.33594) ("a" 6.67188) ("b" 6.67188) ("c" 6.0) ("d" 6.67188) ("e" 6.67188) ("f" 3.33594) ("g" 6.67188) ("h" 6.67188) ("1" 6.67188) ("2" 6.67188) ("3" 6.67188) ("4" 6.67188) ("5" 6.67188) ("6" 6.67188) ("7" 6.67188) ("8" 6.67188) ("9" 6.67188) ("0" 6.67188)))

    BTW, as you might have inferred from the above snippet, PostScript has a native stringwidth function which determines the actual display width of a string (for a given font and fontsize). IOW, for the PS output of your module, you wouldn't necessarily even need the explicit font metrics. You could simply define a center routine in PS like this

    %!PS /center { % move cursor position to the left by half the width dup stringwidth pop 2 div neg 0 rmoveto } bind def /Helvetica findfont 12 scalefont setfont % draw "ABC" left-aligned (as normal) at (100,100) 100 100 moveto (ABC) show % draw "ABC" horizontally centered around (100,100) 100 100 moveto (ABC) center show

    Of course, this wouldn't help with the LaTeX and other backends...  (but as you mentioned having fun :)

      Nice code! I disagree on one remark however. If you really want to do good justification by hand, you do need metrics. Yes, there are justification routines that will make do, and give you a usable result, but I don't want usable, I want good! Have you ever read Lancaster? His remarks on Postscript are the ones I've followed since the late 80's. I particularly recommend his gonzo.ps as a source to dive into.

      Here is the actual output of the Lisp code in question:
      %!PS-Adobe-2.0 %%Creator: newBoard.lsp %%Title: .ps %%CreationDate: %%Pages: 1 %%DocumentFonts: Zurich ZurichFigurine-Bold ZurichDiagram Helvetica-Bo +ldOblique %%PageOrder: Ascend %%BoundingBox: 0 0 612 792 %%DocumentPaperSizes: Letter %%EndComments /gamenumber 1 def /pagenumber 1 def /leading 12 def /pagetop 720 def /nextline 720 def /left-margin 72 def /column-width 216 def /right-margin left-margin column-width add def /hrule { gsave newpath setlinewidth 1 index 4 2 roll moveto lineto stroke grestore } def /vrule { gsave newpath setlinewidth 2 index 4 2 roll moveto exch lineto stroke grestore } def /circle { newpath 0 360 arc setlinewidth stroke } bind def /top-of-page { left-margin pagetop moveto newline } def /sf { /leading exch def /fontkey exch def fontkey findfont leading scalefont setfont } bind def /countblanks { /blankctr 0 def { ( ) search { /blankctr blankctr 1 add def pop pop } { pop exit } ifelse } loop } bind def /justifytext { dup countblanks /linesize right-margin left-margin sub def dup /stringsize exch stringwidth pop def /space linesize stringsize sub def /blankctr 0 ne { /space space blankctr div def } if space 0 8#040 4 -1 roll widthshow } bind def /black { 0 setgray } bind def /vdecoration { /page-number exch def gsave .4 setgray 1 306 756 13 circle 1 306 49 13 circle 1 306 49 16 circle 306 743 65 1 vrule grestore black /ZurichDiagram 20 sf 306 10 sub 756 5 sub moveto (k) show /Zurich-Bold 12 sf 303 46 moveto page-number show } bind def /center { dup stringwidth pop 2 div right-margin left-margin sub 2 div exch sub left-margin add nextline moveto show newline } bind def /newline { /nextline nextline leading sub def } def /nl { left-margin nextline moveto } def /justify { nl justifytext newline } def /left-justify { nl show newline } def /trace { pstack (-----) = } bind def /nlength { /nilcount 0 def { 0 gt {/nilcount nilcount 1 add def} if } forall nilcount } def /nulltrim { trace /str exch def nlength /count exch def /tstr count string def /n 0 def str { count 0 gt { /count count 1 sub def /chr exch def tstr n chr put /n n 1 add def } if } forall tstr trace } def /cat { exch dup length 2 index length add string dup dup 4 2 roll copy length 4 -1 roll putinterval } bind def /right-justify { dup stringwidth pop right-margin exch sub nextline moveto show } def /number-game { /str 5 string def gamenumber str cvs str nulltrim (G) exch cat /nextline pagetop def /Helvetica-BoldOblique 20 sf .75 setgray right-justify /gamenumber gamenumber 1 add def } def /number-page { /str 5 string def pagenumber str cvs str nulltrim vdecoration /pagenumber pagenumber 1 add def } def /label-game { /Zurich-Bold 12 sf (Position at:) center /ZurichFigurine-Bold 12 sf center } def %%EndProlog %%Page: 1 1 /Zurich 12 sf top-of-page (["Event" "Northern Idaho Open"]) left-justify (["Site" "Moscow (ID)"]) left-justify (["Date" "2004.07.17"]) left-justify (["Round" "1.5"]) left-justify (["White" "Eacker David J (ID)"]) left-justify (["Black" "Looney Daniel (ID)"]) left-justify (["Result" "1-0"]) left-justify newline /ZurichFigurine-Bold 12 sf (1.d4 f5 2.c4 Nf6 3.Nc3 g6 4.Nf3 Bg7) justify (5.e3 d6 6.Bd3 O-O 7.O-O Qe8 8.e4) justify (fxe4 9.Nxe4 Bg4 10.Be3 Nbd7 11.Nxf6) justify (Nxf6 12.Be2 h6 13.d5 Ne4 14.Nd4) justify (Bd7 15.Bg4 Bxd4 16.Bxd4 Nf6) justify (17.Bxd7 Qxd7 18.Qd3 Qg4 19.Rae1) justify (Rf7 20.Re6 Raf8 21.h3 Qg5 22.g4) justify (Kh7 23.f4 Nh5 24.fxg5 Rxf1 25.Qxf1) justify (Rxf1 26.Kxf1 Nf4 27.Rxe7 1-0) left-justify newline /ZurichDiagram 20 sf (cuuuuuuuuC) center (\(wdwdwdwd}) center (70p0w$wdk}) center (6wdw0wdp0}) center (5dwdPdw\)w}) center (&wdPGwhPd}) center (3dwdwdwdP}) center (2P\)wdwdwd}) center (%dwdwdKdw}) center (v,./9EFJMV) center (27.Rxe7) label-game number-game number-page showpage %%Trailer %%EOF
      BTW, I'm so rusty writing Postscript, that if you see anything, please sing out! Ignore the debugging code if you will— I've been using it to scale off some of the rust!

      --hsm

      "Never try to teach a pig to sing...it wastes your time and it annoys the pig."
        If you really want to do good justification by hand, you do need metrics.

        Yes... All I wanted to point out was that all the same font metrics info is readily available on the PS side, so it's no big issue to center or otherwise justify short strings.

        My initial understanding was that you maybe wanted to position individual chess pieces/glyphs across the board, or something like that... But upon closer inspection it seems you actually want to do block justification of a whole paragraph of figurine notation (similar to what's shown on the Alpine Fonts sample page). In that case - and as you're outputting individual lines to be justified separately on the PS side - you're of course right in that you need to know the font metrics to pre-compute the proper line breaks in your program.

        An alternative approach would be (in theory - not trying to talk you into doing it) to pass the entire paragraph as a single string to the PS code to let it handle the line wrapping all by itself. In which case you wouldn't need to know the font metrics in your program.

        For illustration purposes I digged out a sample PostScript block justification routine (see below) which I had written a couple of years ago. It computes the line wrapping depending on the font used, and adjusts the inter-word spacings to block justify the lines. Optionally, it can also slightly condense or stretch the distances between the glyphs (intra-word) to compensate for big gaps between words which might otherwise result. (As some people don't like the appearance produced by the latter approach, you can fine-tune it or disable it altogether — see the respective note in the code.) Otherwise, it uses a simple one-pass algorithm...  (I'm explicitly mentioning the latter, as you seem to be doing this at a level of sophistication that I'm not sure if my code is of any interest to you at all... Anyhow, FWIW, maybe someone else will find some use for it some day.)

        The sample code uses standard text with standard fonts, but there's no reason that it couldn't equally work with figurine notation fonts...

        And no, I haven't yet written the PS code that implements the more advanced algorithm (whole-paragraph optimised line breaks) that D. Knuth uses in TeX (though this might be a little fun project for some rainy weekend...;)

        BTW, I'm so rusty writing Postscript, ...

        Same here... Kind of a pity that I don't really find much use for it at work any longer. Actually, PostScript was - as Perl (!) - one of those few languages which was "love at first sight" with me (the only other one in this category being Lisp). Powerful, flexible, and fun to play around with. Unfortunately, these days people mostly want PDF (without having to go via Distiller or Ghostscript), which is not quite as much fun, as it lacks PostScript's programming language features...

        ___

        %!PS /nextline { y linedist sub /y exch def % (page wrap handling could go here...) } bind def /block_justify { % expected args: x, y, string, width of block, line distance % e.g.: 20 100 (...) 400 15 block_justify 30 dict begin % configurable params % (set those values to zero if you want to adjust % nothing but inter-word spacings) /maxcondense 0.1 def % max condense per glyph /maxstretch 0.3 def % max stretch per glyph % args /linedist exch def /blockwidth exch def dup length /txtlen exch def /txt exch def /y exch def /x exch def /j 0 def /_i 0 def /_w 0 def /_len 0 def /nspaces 0 def 0 1 txtlen 1 sub { % for each char/index of strin +g /i exch def txt i get 32 eq { % word boundary? txt j i j sub getinterval % substring to evaluate dup length /len exch def % length of substring stringwidth pop /w exch def % width of substring w blockwidth ge { % would exceed box border? /dleft blockwidth _w sub def % distance to border from left + side /dright w blockwidth sub def % distance to border from righ +t side /maxcondense_tot maxcondense len mul def /maxstretch_tot maxstretch _len mul def dright maxcondense_tot le { /aw dright len div neg def % neg value to apply to 'ashow +' /cw 0 def txt j i j sub getinterval /j i 1 add def } { dleft maxstretch_tot le { /aw dleft _len div def % pos value to apply to 'ashow +' /cw 0 def } { /aw maxstretch def nspaces 1 gt { /cw dleft maxstretch_tot sub nspaces 1 sub div def % value to apply to 'widthshow +' } { /cw 0 def } ifelse } ifelse txt j _i j sub getinterval /j _i 1 add def } ifelse x y moveto cw 0 32 aw 0 6 -1 roll awidthshow nextline /_i j def /_w 0 def /nspaces 0 def } { % doesn't yet exceed... /_w w def /_i i def /_len len def } ifelse /nspaces nspaces 1 add def } if } for txtlen j sub 0 gt { % remainder / last line -- left-justified x y moveto txt j txtlen j sub getinterval show nextline } if end } bind def % ----- /text (Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed d +o \ eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad + \ minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliqui +p \ ex ea commodo consequat. Duis aute irure dolor in reprehenderit in \ voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur + \ sint occaecat cupidatat non proident, sunt in culpa qui officia \ deserunt mollit anim id est laborum. ) def /Helvetica findfont 15 scalefont setfont 50 700 text 500 20 block_justify /Helvetica-BoldOblique findfont 12 scalefont setfont 50 550 text 450 17 block_justify /Times-Roman findfont 15 scalefont setfont 50 400 text 450 18 block_justify /Times-Italic findfont 15 scalefont setfont 50 250 text 400 18 block_justify showpage

        (View with gs -sDEVICE=x11alpha 683424.ps — (device "x11alpha" for nice anti-aliased display) )

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://683209]
Approved by GrandFather
Front-paged by grinder
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (7)
As of 2019-12-05 19:58 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Strict and warnings: which comes first?



    Results (151 votes). Check out past polls.

    Notices?