* lisp/emacs-lisp/map.el (map--elt-list): Minor refactoring.
[emacs.git] / etc / ps-prin1.ps
blob0cd339663c409dec0ff523239ffb7ebb1a32039c
1 % === BEGIN ps-print prologue 1
2 % version: 6.1
4 % Copyright (C) 2000-2015 Free Software Foundation, Inc.
6 % This file is part of GNU Emacs.
8 % GNU Emacs is free software: you can redistribute it and/or modify
9 % it under the terms of the GNU General Public License as published by
10 % the Free Software Foundation, either version 3 of the License, or
11 % (at your option) any later version.
13 % GNU Emacs is distributed in the hope that it will be useful,
14 % but WITHOUT ANY WARRANTY; without even the implied warranty of
15 % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16 % GNU General Public License for more details.
18 % You should have received a copy of the GNU General Public License
19 % along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
21 % As a special exception, the copyright holders of this module give
22 % you permission to include the module in a Postscript file generated
23 % by Emacs or other free software together with the result of
24 % converting text to be printed, regardless of the license terms of
25 % that text, and to use under terms of your choice the page images
26 % resulting from formatting said combination.  If you modify this
27 % module, you may extend this exception to your version of the module
28 % but you are not obligated to do so.  If you do not wish to do so,
29 % delete this exception statement from your version.
32 % ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4:
33 /ISOLatin1Encoding where{pop}{
34 % -- The ISO Latin-1 encoding vector isn't known, so define it.
35 % -- The first half is the same as the standard encoding,
36 % -- except for minus instead of hyphen at code 055.
37 /ISOLatin1Encoding
38 StandardEncoding 0 45 getinterval aload pop
39     /minus
40 StandardEncoding 46 82 getinterval aload pop
41 %*** NOTE: the following are missing in the Adobe documentation,
42 %*** but appear in the displayed table:
43 %*** macron at 0225, dieresis at 0230, cedilla at 0233, space at 0240.
44 % 0200 (128)
45     /.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef
46     /.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef
47     /dotlessi/grave/acute/circumflex/tilde/macron/breve/dotaccent
48     /dieresis/.notdef/ring/cedilla/.notdef/hungarumlaut/ogonek/caron
49 % 0240 (160)
50     /space/exclamdown/cent/sterling
51         /currency/yen/brokenbar/section
52     /dieresis/copyright/ordfeminine/guillemotleft
53         /logicalnot/hyphen/registered/macron
54     /degree/plusminus/twosuperior/threesuperior
55         /acute/mu/paragraph/periodcentered
56     /cedilla/onesuperior/ordmasculine/guillemotright
57         /onequarter/onehalf/threequarters/questiondown
58 % 0300 (192)
59     /Agrave/Aacute/Acircumflex/Atilde
60         /Adieresis/Aring/AE/Ccedilla
61     /Egrave/Eacute/Ecircumflex/Edieresis
62         /Igrave/Iacute/Icircumflex/Idieresis
63     /Eth/Ntilde/Ograve/Oacute
64         /Ocircumflex/Otilde/Odieresis/multiply
65     /Oslash/Ugrave/Uacute/Ucircumflex
66         /Udieresis/Yacute/Thorn/germandbls
67 % 0340 (224)
68     /agrave/aacute/acircumflex/atilde
69         /adieresis/aring/ae/ccedilla
70     /egrave/eacute/ecircumflex/edieresis
71         /igrave/iacute/icircumflex/idieresis
72     /eth/ntilde/ograve/oacute
73         /ocircumflex/otilde/odieresis/divide
74     /oslash/ugrave/uacute/ucircumflex
75         /udieresis/yacute/thorn/ydieresis
76 256 packedarray def
77 }ifelse
79 /reencodeFontISO{ %def
80   dup
81   length 12 add dict    % Make a new font (a new dict the same size
82                         % as the old one) with room for our new symbols.
84   begin                 % Make the new font the current dictionary.
86     % Copy each of the symbols from the old dictionary
87     % to the new one except for the font ID.
88     {1 index/FID ne{def}{pop pop}ifelse}forall
90     % Override the encoding with the ISOLatin1 encoding.
91     currentdict/FontType get 0 ne{/Encoding ISOLatin1Encoding def}if
93     % Use the font's bounding box to determine the ascent, descent,
94     % and overall height; don't forget that these values have to be
95     % transformed using the font's matrix.
97 %          ^    (x2 y2)
98 %          |       |
99 %          |       v
100 %          |  +----+ - -
101 %          |  |    |   ^
102 %          |  |    |   | Ascent (usually > 0)
103 %          |  |    |   |
104 % (0 0) -> +--+----+-------->
105 %             |    |   |
106 %             |    |   v Descent (usually < 0)
107 % (x1 y1) --> +----+ - -
109     currentdict/FontType get 0 ne
110     {/FontBBox load aload pop                   % -- x1 y1 x2 y2
111      FontMatrix transform/Ascent  exch def pop
112      FontMatrix transform/Descent exch def pop}
113     {/PrimaryFont FDepVector 0 get def
114      PrimaryFont/FontBBox get aload pop
115      PrimaryFont/FontMatrix get transform/Ascent exch def pop
116      PrimaryFont/FontMatrix get transform/Descent exch def pop}ifelse
118     /FontHeight Ascent Descent sub def  % use `sub' because descent < 0
120     % Define these in case they're not in the FontInfo
121     % (also, here they're easier to get to).
122     /UnderlinePosition  Descent 0.70 mul def
123     /OverlinePosition   Descent UnderlinePosition sub Ascent add def
124     /StrikeoutPosition  Ascent 0.30 mul def
125     /LineThickness      FontHeight 0.05 mul def
126     /Xshadow            FontHeight  0.08 mul def
127     /Yshadow            FontHeight -0.09 mul def
128     /SpaceBackground    Descent neg UnderlinePosition add def
129     /XBox               Descent neg def
130     /YBox               LineThickness 0.7 mul def
132     currentdict         % Leave the new font on the stack
133     end                 % Stop using the font as the current dictionary.
134     definefont          % Put the font into the font dictionary
135     pop                 % Discard the returned font.
136 }bind def
138 % Font definition
139 /DefFont{findfont exch scalefont reencodeFontISO}def
141 % Font selection
143   findfont
144   dup/Ascent            get/Ascent            exch def
145   dup/Descent           get/Descent           exch def
146   dup/FontHeight        get/FontHeight        exch def
147   dup/UnderlinePosition get/UnderlinePosition exch def
148   dup/OverlinePosition  get/OverlinePosition  exch def
149   dup/StrikeoutPosition get/StrikeoutPosition exch def
150   dup/LineThickness     get/LineThickness     exch def
151   dup/Xshadow           get/Xshadow           exch def
152   dup/Yshadow           get/Yshadow           exch def
153   dup/SpaceBackground   get/SpaceBackground   exch def
154   dup/XBox              get/XBox              exch def
155   dup/YBox              get/YBox              exch def
156   setfont
157 }def
159 /FG/setrgbcolor load def
161 /bg false def
162 /BG{
163   dup/bg exch def
164   {[4 1 roll]}
165   {[1.0 1.0 1.0]}
166   ifelse
167   /bgcolor exch def
168 }def
170 %  B    width    C
171 %   +-----------+
172 %               | Ascent  (usually > 0)
173 % A +           +
174 %               | Descent (usually < 0)
175 %   +-----------+
176 %  E    width    D
178 /dobackground{                          % width --
179   currentpoint                          % -- width x y
180   gsave
181     newpath
182     moveto                              % A (x y)
183     0 Ascent rmoveto                    % B
184     dup 0 rlineto                       % C
185     0 Descent Ascent sub rlineto        % D
186     neg 0 rlineto                       % E
187     closepath
188     FillBgColor
189   grestore
190 }def
192 /eolbg{                                 % dobackground until right margin
193   PrintWidth                            % -- x-eol
194   currentpoint pop                      % -- cur-x
195   sub                                   % -- width until eol
196   dobackground
197 }def
199 /LineHS LineHeight LineSpacing add def
200 /ParagraphHS LineHeight ParagraphSpacing add def
201 /PSL{/h exch def bg{eolbg}if  0  currentpoint exch pop h sub  moveto}def
202 /PLN{PrintLineNumber{doLineNumber}if}def
204 /SL{LineHS PSL isLineStep pop}def       % Soft Linefeed
206 /PHL{ParagraphHS PSL PLN}def            % Paragraph Hard Linefeed
207 /LHL{LineHS PSL PLN}def                 % Hard Linefeed
209 % Some debug
210 /dcp{currentpoint exch 40 string cvs print(, )print =}def
211 /dp{print 2 copy  exch 40 string cvs print(, )print =}def
214   ( )stringwidth        % Get the width of a space in the current font.
215   pop                   % Discard the Y component.
216   mul                   % Multiply the width of a space
217                         % by the number of spaces to plot
218   bg{dup dobackground}if
219   0 rmoveto
220 }def
222 /Effect          0 def
223 /EffectUnderline false def
224 /EffectStrikeout false def
225 /EffectOverline  false def
226 /EffectShadow    false def
227 /EffectBox       false def
228 /EffectOutline   false def
230 % effect: 1  - underline  2   - strikeout  4  - overline
231 %         8  - shadow     16  - box        32 - outline
232 /EF{
233   /Effect exch def
234   /EffectUnderline Effect 1  and 0 ne def
235   /EffectStrikeout Effect 2  and 0 ne def
236   /EffectOverline  Effect 4  and 0 ne def
237   /EffectShadow    Effect 8  and 0 ne def
238   /EffectBox       Effect 16 and 0 ne def
239   /EffectOutline   Effect 32 and 0 ne def
240 }def
242 % stack:  string  |-  --
244   /xx currentpoint dup Descent add/yy exch def
245   Ascent add/YY exch def def
246   dup stringwidth pop xx add/XX exch def
247   EffectShadow{
248     /yy yy Yshadow add def
249     /XX XX Xshadow add def
250   }if
251   bg{
252     true
253     EffectBox
254       {SpaceBackground doBox}
255       {xx yy XX YY doRect}
256     ifelse
257   }if                                           % background
258   EffectBox      {false 0 doBox}if              % box
259   EffectShadow   {dup doShadow}if               % shadow
260   EffectOutline
261     {true doOutline}                            % outline
262     {show}                                      % normal text
263   ifelse
264   EffectUnderline{UnderlinePosition Hline}if    % underline
265   EffectStrikeout{StrikeoutPosition Hline}if    % strikeout
266   EffectOverline {OverlinePosition  Hline}if    % overline
267 }bind def
269 % stack:  position  |-  --
270 /Hline{
271   currentpoint exch pop add dup
272   gsave
273   newpath
274   xx exch moveto
275   XX exch lineto
276   closepath
277   LineThickness setlinewidth stroke
278   grestore
279 }bind def
281 % stack:  fill-or-not delta  |-  --
282 /doBox{
283   /dd exch def
284   xx XBox sub dd sub yy YBox sub dd sub
285   XX XBox add dd add YY YBox add dd add
286   doRect
287 }bind def
289 % stack:  fill-or-not lower-x lower-y upper-x upper-y  |-  --
290 /doRect{
291   /rYY exch def
292   /rXX exch def
293   /ryy exch def
294   /rxx exch def
295   gsave
296   newpath
297   rXX rYY moveto
298   rxx rYY lineto
299   rxx ryy lineto
300   rXX ryy lineto
301   closepath
302   % top of stack: fill-or-not
303   {FillBgColor}
304   {LineThickness setlinewidth stroke}ifelse
305   grestore
306 }bind def
308 % stack:  string  |-  --
309 /doShadow{
310   gsave
311   Xshadow Yshadow rmoveto
312   false doOutline
313   grestore
314 }bind def
316 /st 1 string def
318 % stack:  string fill-or-not  |-  --
319 /doOutline{
320   /-fillp- exch def
321   /-ox- currentpoint/-oy- exch def def
322   gsave
323   LineThickness setlinewidth
324   {st 0 3 -1 roll put
325    st dup true charpath
326    -fillp- {gsave FillBgColor grestore}if
327    stroke stringwidth
328    -oy- add/-oy- exch def
329    -ox- add/-ox- exch def
330    -ox- -oy- moveto
331   }forall
332   grestore
333   -ox- -oy- moveto
334 }bind def
336 % stack:  --
337 /FillBgColor{bgcolor aload pop setrgbcolor fill}bind def
339 % stack:  -- |- boolean
340 /isLineStep{
341   SyncLineZebra
342   {PLScounter 0 gt                                              % or zebra
343    {/PLScounter PLScounter 1 sub def PLScounter 0 eq}
344    {false}ifelse
345    PrintLineStep 1 gt
346    {/PrintLineStep PrintLineStep 1 sub def}
347    {/PrintLineStep ZebraHeight def
348     /PLScounter PrintLineStart def}ifelse}
349   {LineNumber PrintLineStart sub PrintLineStep mod 0 eq}ifelse  % or line step
350 }def
352 % stack:  --
353 /doLineNumber{
354   /LineNumber where
355   {pop
356    isLineStep                   % or line step
357    LineNumber Lines ge or       % or last line
358    {currentfont
359     gsave
360     LineNumberColor SetColor
361     /L0 findfont setfont
362     LineNumber Lines ge
363     {(end      )}
364     {LineNumber 6 string cvs(      )strcat}ifelse
365     dup stringwidth pop neg 0 rmoveto
366     show
367     grestore
368     setfont}if
369     /LineNumber LineNumber 1 add def
370   }if
371 }def
373 % stack: color-specifier |- --
374 /SetColor{dup type/realtype eq{setgray}{aload pop setrgbcolor}ifelse}def
376 % stack: --
377 /printZebra{
378   gsave
379   ZebraColor SetColor
380   /double-zebra ZebraHeight ZebraHeight add def
381   /yiter double-zebra LineHS mul neg def
382   /xiter PrintWidth InterColumn add def
383   /zebra-line LinesPrinted def
384   NumberOfColumns{LinesPerColumn doColumnZebra xiter 0 rmoveto}repeat
385   grestore
386 }def
388 % stack:  lines-per-column |- --
389 /doColumnZebra{
390   /lpc exch def
391   gsave
392   ZebraFollow 1 and 0 ne{
393     /H ZebraHeight zebra-line ZebraHeight mod sub def
394     /lpc lpc H sub def
395     zebra-line double-zebra mod ZebraHeight lt
396     {H doZebra  % "black" stripe followed by a "white" stripe
397      /lpc lpc ZebraHeight sub def
398      H ZebraHeight add}
399     {H}ifelse   % "white" stripe
400     LineHS mul neg 0 exch rmoveto
401     /zebra-line zebra-line LinesPerColumn add def
402   }if
403   /zspacing 0 def
404   lpc dup double-zebra idiv{ZebraHeight doZebra 0 yiter rmoveto}repeat
405   double-zebra mod dup 0 le{pop}
406   {dup ZebraHeight gt
407    {pop ZebraHeight}
408    {/zspacing LineSpacing def
409     ZebraFollow 2 and 0 ne{pop ZebraHeight}if}ifelse
410    doZebra}ifelse
411   grestore
412 }def
414 % stack:  zebra-height (in lines) |- --
415 /doZebra{
416   /zh exch 0.05 sub LineHS mul zspacing sub def
417   gsave
418   0 LineHeight 0.65 mul rmoveto
419   PrintWidth 0 rlineto
420   0 zh neg rlineto
421   PrintWidth neg 0 rlineto
422   0 zh rlineto
423   fill
424   grestore
425 }def
427 % stack: --
428 /printBackground{
429   /BackgroundColor where{
430     /LHg LineHeight 0.65 mul def
431     /PHg PrintHeight LHg add def
432     pop gsave BackgroundColor SetColor
433     NumberOfColumns{
434      gsave
435      0 LHg rmoveto
436      PrintWidth 0 rlineto
437      0 PHg neg rlineto
438      PrintWidth neg 0 rlineto
439      0 PHg rlineto
440      fill
441      grestore
442      PrintWidth InterColumn add 0 rmoveto
443     }repeat
444     grestore
445   }if
446 }def
448 % tx ty rotation xscale yscale xpos ypos BeginBackImage
449 /BeginBackImage{
450   /-save-image- save def
451   /showpage{}def
452   translate
453   scale
454   rotate
455   translate
456 }def
458 /EndBackImage{-save-image- restore}def
460 % string fontsize fontname rotation gray xpos ypos ShowBackText
461 /ShowBackText{
462   gsave
463   translate
464   setgray
465   rotate
466   findfont exch dup/-offset- exch -0.25 mul def scalefont setfont
467   0 -offset- moveto
468   /-saveLineThickness- LineThickness def
469   /LineThickness 1 def
470   false doOutline
471   /LineThickness -saveLineThickness- def
472   grestore
473 }def
475 /SetPageSize{
476   BMark/PageSize[PageWidth LandscapePageHeight LandscapeMode{exch}if]EMark setpagedevice
477 }def
479 /BeginDoc{
480   % ---- Remember space width of the normal text font `f0'.
481   /SpaceWidth/f0 findfont setfont( )stringwidth pop def
482   % ---- save the state of the document (useful for ghostscript!)
483   /docState save def
484   % ---- [andrewi] set PageSize based on chosen dimensions
485   UseSetpagedevice{
486    WarnPaperSize{SetPageSize}{mark{SetPageSize}stopped cleartomark}ifelse
487   }if
488   /ColumnWidth PrintWidth InterColumn add def
489   % ---- define where  printing will start
490   /f0 F                                 % this installs Ascent
491   /PrintStartY PrintHeight Ascent sub def
492   /ColumnIndex 1 def
493   /N-Up-Counter N-Up-End 1 sub def
494   /PLScounter PrintLineStart def
495 }def
497 /EndDoc{
498   % ---- restore the state of the document (useful for ghostscript!)
499   docState restore
500 }def
502 /BeginDSCPage{
503   % ---- when 1st column, save the state of the page
504   ColumnIndex 1 eq{/pageState save def}if
505   % ---- save the state of the column
506   /columnState save def
507 }def
509 /PrintHeaderWidth PrintOnlyOneHeader{PrintPageWidth}{PrintWidth}ifelse def
511 /BeginPage{
512   /LinesPrinted exch def
513   % ---- when 1st column, print all background effects
514   ColumnIndex 1 eq{
515     0 PrintStartY moveto                % move to where printing will start
516     printBackground
517     Zebra{printZebra}if
518     printGlobalBackground
519     printLocalBackground
520   }if
521   PrintOnlyOneHeader{ColumnIndex 1 eq}{true}ifelse
522   dup PrintHeader and{
523     PrintHeaderFrame{HeaderFrame}if
524     HeaderText
525   }if
526   PrintFooter and{
527     PrintFooterFrame{FooterFrame}if
528     FooterText
529   }if
530   0 PrintStartY moveto                  % move to where printing will start
531   /LineNumber where
532   {pop
533    SyncLineZebra
534    {/H PageNumber 1 sub NumberOfColumns mul ColumnIndex 1 sub add
535        LinesPerColumn mul ZebraHeight mod def
536     /PLScounter H PrintLineStart ge{0}{PrintLineStart H sub}ifelse def
537     /PrintLineStep ZebraHeight H sub def}if}if
538   PLN
539 }def
541 /EndPage{bg{eolbg}if}def
543 /EndDSCPage{
544   ColumnIndex NumberOfColumns eq{
545     % ---- restore the state of the page
546     pageState restore
547     /ColumnIndex 1 def
548     % ---- N-up printing
549     N-Up 1 gt{
550       N-Up-Counter 0 gt
551       {% ---- Next page on same row
552         /N-Up-Counter N-Up-Counter 1 sub def
553         N-Up-XColumn N-Up-YColumn}
554       {% ---- Next page on next line
555         /N-Up-Counter N-Up-End 1 sub def
556         N-Up-XLine N-Up-YLine}ifelse
557       translate
558     }if
559   }{ % else
560     % ---- restore the state of the current column
561     columnState restore
562     % ---- and translate to the next column
563     ColumnWidth 0 translate
564     /ColumnIndex ColumnIndex 1 add def
565   }ifelse
566 }def
568 /TextStart{
569   LeftMargin BottomMargin
570   PrintFooter{
571     FooterPad add
572     FooterLines FooterLineHeight mul add
573     FooterPad add
574     FooterOffset add}if
575 }def
577 % stack: number-of-pages-per-sheet |- --
578 /BeginSheet{
579   /sheetState save def
580   /pages-per-sheet exch def
582   % ---- translate to bottom-right corner of Portrait page
583   LandscapeMode{
584     LandscapePageHeight 0 translate
585     90 rotate
586   }if
587   % ---- [jack] Kludge: my ghostscript window is 21x27.7 instead of 21x29.7
588   /JackGhostscript where{pop 1 27.7 29.7 div scale}if
589   UpsideDown{PageWidth LandscapePageHeight translate 180 rotate}if
590   % ---- N-Up printing
591   N-Up 1 gt{
592     % ---- landscape
593     N-Up-Landscape{
594       PageWidth 0 translate
595       90 rotate
596     }if
597     N-Up-Margin dup translate
598     % ---- scale
599     LandscapeMode{
600       /HH PageWidth def
601       /WW LandscapePageHeight def
602     }{
603       /HH LandscapePageHeight def
604       /WW PageWidth def
605     }ifelse
606     /xx 0 def
607     N-Up-Landscape{
608       /ww WW WW mul N-Up-Lines HH mul div def
609       /cc HH N-Up-Columns N-Up-Missing add div def
610       ww cc gt{/xx WW def/WW cc ww div WW mul def/xx xx WW sub def}if
611     }{
612       /hh HH N-Up-Columns N-Up-Missing add div def
613       /cc HH N-Up-Lines div def
614       hh cc gt{/xx WW def/WW cc hh div WW mul def/xx xx WW sub def}if
615     }ifelse
616     WW N-Up-Margin sub N-Up-Margin sub
617     N-Up-Landscape
618     {N-Up-Lines div HH}
619     {N-Up-Columns N-Up-Missing add div WW}ifelse
620     div dup scale
621     LandscapeMode{/yy 0 def}{/yy xx def/xx 0 def}ifelse
622     xx N-Up-Repeat 1 sub LandscapePageHeight mul yy add translate
623     % ---- go to start position in page matrix
624     N-Up-XStart N-Up-Missing 0.5 mul
625     LandscapeMode
626     {LandscapePageHeight mul N-Up-YStart add}
627     {PageWidth mul add N-Up-YStart}ifelse
628     translate
629   }if
630   % ---- translate to lower left corner of TEXT
631   TextStart translate
633   % ---- N-up printing
634   N-Up 1 gt N-Up-Border and pages-per-sheet 0 gt and{
635     % ---- page border
636     gsave
637     0 setgray
638     TextStart exch neg exch neg moveto
639     N-Up-Repeat
640     {N-Up-End
641      {gsave
642       PageWidth 0 rlineto
643       0 LandscapePageHeight rlineto
644       PageWidth neg 0 rlineto
645       closepath stroke
646       grestore
647       /pages-per-sheet pages-per-sheet 1 sub def
648       pages-per-sheet 0 le{exit}if
649       N-Up-XColumn N-Up-YColumn rmoveto
650      }repeat
651      pages-per-sheet 0 le{exit}if
652      N-Up-XLine N-Up-XColumn sub N-Up-YLine rmoveto
653     }repeat
654     grestore
655   }if
656 }def
658 /EndSheet{
659   showpage
660   sheetState restore
661 }def
663 /SetHeaderLines{                        % nb-lines --
664   /HeaderLines exch def
665   % ---- bottom up
666   HeaderPad
667   HeaderLines 1 sub HeaderLineHeight mul add
668   HeaderTitleLineHeight add
669   HeaderPad add
670   /HeaderHeight exch def
671 }def
673 /SetFooterLines{                        % nb-lines --
674   /FooterLines exch def
675   % ---- bottom up
676   FooterPad
677   FooterLines FooterLineHeight mul add
678   FooterPad add
679   /FooterHeight exch def
680 }def
682 % |---------|
683 % |  tm     |
684 % |---------|
685 % |  header |
686 % |-+-------| <-- (x y)
687 % |  ho     |
688 % |---------|
689 % |  text   |
690 % |---------|
691 % |  fo     |
692 % |---------|
693 % |  footer |
694 % |-+-------| <-- (0 0)
695 % |  bm     |
696 % |---------|
698 % -- |- x y
699 /HeaderFrameStart{0  PrintHeight HeaderOffset add}def
700 /FooterFrameStart{0  FooterHeight FooterOffset add neg}def
702 /doFramePath{
703   /h exch def
704   PrintHeaderWidth      0       rlineto
705   0                     h       rlineto
706   PrintHeaderWidth neg  0       rlineto
707   0                     h neg   rlineto
708 }def
710 /HeaderFramePath{HeaderHeight doFramePath}def
711 /FooterFramePath{FooterHeight doFramePath}def
713 % /path-fun /start-fun vector-property doFrame
714 /doFrame{
715   /vecFrame exch def
716   /startFrame exch load def
717   /pathFrame exch load def
718   gsave
719     vecFrame 2 get setlinewidth                         % frame border width
720     % ---- do the shadow of the next rectangle
721     startFrame moveto
722     1 -1 rmoveto
723     pathFrame
724     vecFrame 4 get SetColor fill                        % frame shadow color
725     % ---- do the next rectangle ...
726     startFrame moveto
727     pathFrame
728     gsave vecFrame 1 get SetColor fill grestore         % frame background
729     gsave vecFrame 3 get SetColor stroke grestore       % frame border color
730   grestore
731 }def
733 /HeaderFrame{/HeaderFramePath /HeaderFrameStart HeaderFrameProperties doFrame}def
734 /FooterFrame{/FooterFramePath /FooterFrameStart FooterFrameProperties doFrame}def
736 /HeaderStart{
737   HeaderFrameStart
738   exch HeaderPad add exch       % horizontal pad
739   % ---- bottom up
740   HeaderPad add                 % vertical   pad
741   HeaderDescent sub
742   HeaderLineHeight HeaderLines 1 sub mul add
743 }def
745 /FooterStart{
746   FooterFrameStart
747   exch FooterPad add exch       % horizontal pad
748   % ---- bottom up
749   FooterPad add                 % vertical   pad
750   FooterDescent sub
751   FooterLineHeight FooterLines 1 sub mul add
752 }def
754 /HeaderClip{HeaderFrameStart moveto HeaderFramePath clip}def
755 /FooterClip{FooterFrameStart moveto FooterFramePath clip}def
757 /strcat{
758   dup length 3 -1 roll dup length dup 4 -1 roll add string dup
759   0 5 -1 roll putinterval
760   dup 4 2 roll exch putinterval
761 }def
763 /pagenumberstring{
764   PageNumber 32 string cvs
765   ShowNofN{(/)strcat PageCount 32 string cvs strcat}if
766 }def
768 % lines is-right HeaderOrFooterTextLines
769 /HeaderOrFooterTextLines{
770   /is_right exch def
771   HFStart moveto
772   { % ---- process the lines
773    aload pop
774    exch F
775    gsave
776     dup xcheck{exec}if
777     is_right{
778      dup stringwidth pop
779      PrintHeaderWidth exch sub HFPad HFPad add sub 0 rmoveto
780     }if
781     HFColor SetColor
782     show
783    grestore
784    0 HFLineHeight neg rmoveto
785   }forall
786 }def
788 % right-lines left-lines /start lineheight pad fore-color HeaderOrFooterText
789 /HeaderOrFooterText{
790   /HFColor exch def
791   /HFPad exch def
792   /HFLineHeight exch def
793   /HFStart exch load def
795   % -- rightLines leftLines -- at stack
797   % ---- hack: `PN 1 and'  ==  `PN 2 modulo'
798   % ---- if even page number and duplex, then exchange left and right
799   PageNumber 1 and 0 eq SwitchHeader and{exch}if
801   % ---- process the left lines
802   false HeaderOrFooterTextLines
804   % ---- process the right lines
805   true HeaderOrFooterTextLines
806 }def
808 /HeaderText{
809   gsave HeaderClip
810   HeaderLinesRight HeaderLinesLeft
811   /HeaderStart HeaderLineHeight HeaderPad
812   HeaderFrameProperties 0 get
813   HeaderOrFooterText
814   grestore
815 }def
817 /FooterText{
818   gsave FooterClip
819   FooterLinesRight FooterLinesLeft
820   /FooterStart FooterLineHeight FooterPad
821   FooterFrameProperties 0 get
822   HeaderOrFooterText
823   grestore
824 }def
826 /ReportFontInfo{
827   2 copy
828   /t0 3 1 roll DefFont
829   /t0 F
830   /lh FontHeight def
831   /sw( )stringwidth pop def
832   /aw(01234567890abcdefghijklmnopqrstuvwxyz)dup length exch
833   stringwidth pop exch div def
834   /t1 12/Helvetica-Oblique DefFont
835   /t1 F
836   gsave
837     (languagelevel = )show
838     languagelevel 32 string cvs show
839   grestore
840   0 FontHeight neg rmoveto
841   gsave
842     (For )show
843     128 string cvs show
844     ( )show
845     32 string cvs show
846     ( point, the line height is )show
847     lh 32 string cvs show
848     (, the space width is )show
849     sw 32 string cvs show
850     (,)show
851   grestore
852   0 FontHeight neg rmoveto
853   gsave
854     (and a crude estimate of average character width is )show
855     aw 32 string cvs show
856     (.)show
857   grestore
858   0 FontHeight neg rmoveto
859 }def
861 % cm to point
862 /cm{72 mul 2.54 div}def
864 /ReportAllFontInfo{
865   % key = font name   value = font dictionary
866   FontDirectory{pop 10 exch ReportFontInfo}forall
867 }def
869 % 3 cm 20 cm moveto  10/Courier ReportFontInfo  showpage
870 % 3 cm 20 cm moveto  ReportAllFontInfo          showpage
872 % === END ps-print prologue 1