Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

Re^2: Code that writes code that writes code: Perl to Lisp to Postscript

by hsmyers (Canon)
on Apr 28, 2008 at 22:12 UTC ( #683384=note: print w/replies, xml ) Need Help??


in reply to Re: Code that writes code that writes code: Perl to Lisp to Postscript
in thread Code that writes code that writes code: Perl to Lisp to Postscript

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."
  • Comment on Re^2: Code that writes code that writes code: Perl to Lisp to Postscript
  • Download Code

Replies are listed 'Best First'.
Re^3: [OT] Code that writes code that writes code: Perl to Lisp to Postscript
by almut (Canon) on Apr 29, 2008 at 07:33 UTC
    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) )

      I bow to the excellence of you code!! Well I would if my back didn't hurt. This is such an advance over my effort that I will with your permission and with suitable credit steal this code for my Lisp package. Theft is the highest praise for someone else's work ;) This comes at a particularly opportune time— I've decided to forgo the use of the figurine fonts in favor of the ordinary fonts; i.e. LinaresFigurine ⇒ Linares. I'm doing this because this lets me mix normal text and figurine in one font. Your block_justify is just the thing to fold into the mix with this change. I'll update this node with the new result.

      Liking Postscript as you do, have you ever tried Forth? My only complaint about Postscript is that Warnock should have copied all of the Forth vocabulary not just some. Cool thing is that, that is easily fixable using the language itself

      --hsm

      "Never try to teach a pig to sing...it wastes your time and it annoys the pig."
        Theft is the highest praise for someone else's work ;)

        True words :)  Thanks! — feel free to use it in whatever way you like.

        BTW, under these new circumstances I should mention there is a little peculiarity. That is, you need a trailing space at the end of the text (noticed the space in "laborum. ) def"? - that's there on purpose). The space itself will not be visible, but without it, the last line might not wrap properly in some cases. (I've always wanted to fix this bug, but then again, making sure there is that space has always been easier... ;)

        As to Forth, yes I've tried it and generally liked it. Though, due to largely missing library functionality in the environment I used at the time, it has always been somewhat tedious to get any real world problem solved with it... That definitely is a plus of PS, its powerful builtin typesetting and graphics facilities.

      I always wondered whether we could translate TeX and Metafont to postscript, and embed these and all required source files to a large postscript so it does all typesetting work on the viewer's computer.

        I think it should be doable (though performance might still be an issue for huge documents) — whether there is a real need for it is another question ;)

        Anyhow, I'd probably try to leave out Metafont to begin with (IMHO, PostScript has rather superb font handling capabilities on its own). Also, I guess I wouldn't attempt a direct 1:1 reimplementation in PS (except for maybe the TeX parser), but rather a loose mapping of good ideas and features onto the specific functionality that PS has to offer, but with the net effect of generating comparable output. But that's all mere theory at the moment (and probably not even a good one :)

        (Actually, I did play with the idea on and off... But then, with life being so short and so many other things being more rewarding in the short run, I never got started (yeah, lame excuse, I know). Actually, I haven't even gotten as far as doing a thorough search on whether other people might already be working on it.  And now, I don't really have a personal need for it any longer — which might keep me focused beyond the fun playing around phase...)

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://683384]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (5)
As of 2019-12-05 19:30 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Strict and warnings: which comes first?



    Results (151 votes). Check out past polls.

    Notices?