(Reverting): Add anchor.
[emacs.git] / etc / ps-prin1.ps
blobdd922b9338d70ff6d398f9bab4f4e4df5c55fe03
1 % === BEGIN ps-print prologue 1
2 % version: 6.0
4 % Copyright (C) 2000, 2001, 2002, 2003, 2004  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 2, or (at your option)
11 % 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; see the file COPYING.  If not, write to the
20 % Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21 % Boston, MA 02111-1307, USA.
23 % As a special exception, the copyright holders of this module give
24 % you permission to include the module in a Postscript file generated
25 % by Emacs or other free software together with the result of
26 % converting text to be printed, regardless of the license terms of
27 % that text, and to use under terms of your choice the page images
28 % resulting from formatting said combination.  If you modify this
29 % module, you may extend this exception to your version of the module
30 % but you are not obligated to do so.  If you do not wish to do so,
31 % delete this exception statement from your version.
34 % ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4:
35 /ISOLatin1Encoding where{pop}{
36 % -- The ISO Latin-1 encoding vector isn't known, so define it.
37 % -- The first half is the same as the standard encoding,
38 % -- except for minus instead of hyphen at code 055.
39 /ISOLatin1Encoding
40 StandardEncoding 0 45 getinterval aload pop
41     /minus
42 StandardEncoding 46 82 getinterval aload pop
43 %*** NOTE: the following are missing in the Adobe documentation,
44 %*** but appear in the displayed table:
45 %*** macron at 0225, dieresis at 0230, cedilla at 0233, space at 0240.
46 % 0200 (128)
47     /.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef
48     /.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef
49     /dotlessi/grave/acute/circumflex/tilde/macron/breve/dotaccent
50     /dieresis/.notdef/ring/cedilla/.notdef/hungarumlaut/ogonek/caron
51 % 0240 (160)
52     /space/exclamdown/cent/sterling
53         /currency/yen/brokenbar/section
54     /dieresis/copyright/ordfeminine/guillemotleft
55         /logicalnot/hyphen/registered/macron
56     /degree/plusminus/twosuperior/threesuperior
57         /acute/mu/paragraph/periodcentered
58     /cedilla/onesuperior/ordmasculine/guillemotright
59         /onequarter/onehalf/threequarters/questiondown
60 % 0300 (192)
61     /Agrave/Aacute/Acircumflex/Atilde
62         /Adieresis/Aring/AE/Ccedilla
63     /Egrave/Eacute/Ecircumflex/Edieresis
64         /Igrave/Iacute/Icircumflex/Idieresis
65     /Eth/Ntilde/Ograve/Oacute
66         /Ocircumflex/Otilde/Odieresis/multiply
67     /Oslash/Ugrave/Uacute/Ucircumflex
68         /Udieresis/Yacute/Thorn/germandbls
69 % 0340 (224)
70     /agrave/aacute/acircumflex/atilde
71         /adieresis/aring/ae/ccedilla
72     /egrave/eacute/ecircumflex/edieresis
73         /igrave/iacute/icircumflex/idieresis
74     /eth/ntilde/ograve/oacute
75         /ocircumflex/otilde/odieresis/divide
76     /oslash/ugrave/uacute/ucircumflex
77         /udieresis/yacute/thorn/ydieresis
78 256 packedarray def
79 }ifelse
81 /reencodeFontISO{ %def
82   dup
83   length 12 add dict    % Make a new font (a new dict the same size
84                         % as the old one) with room for our new symbols.
86   begin                 % Make the new font the current dictionary.
88     % Copy each of the symbols from the old dictionary
89     % to the new one except for the font ID.
90     {1 index/FID ne{def}{pop pop}ifelse}forall
92     % Override the encoding with the ISOLatin1 encoding.
93     currentdict/FontType get 0 ne{/Encoding ISOLatin1Encoding def}if
95     % Use the font's bounding box to determine the ascent, descent,
96     % and overall height; don't forget that these values have to be
97     % transformed using the font's matrix.
99 %          ^    (x2 y2)
100 %          |       |
101 %          |       v
102 %          |  +----+ - -
103 %          |  |    |   ^
104 %          |  |    |   | Ascent (usually > 0)
105 %          |  |    |   |
106 % (0 0) -> +--+----+-------->
107 %             |    |   |
108 %             |    |   v Descent (usually < 0)
109 % (x1 y1) --> +----+ - -
111     currentdict/FontType get 0 ne
112     {/FontBBox load aload pop                   % -- x1 y1 x2 y2
113      FontMatrix transform/Ascent  exch def pop
114      FontMatrix transform/Descent exch def pop}
115     {/PrimaryFont FDepVector 0 get def
116      PrimaryFont/FontBBox get aload pop
117      PrimaryFont/FontMatrix get transform/Ascent exch def pop
118      PrimaryFont/FontMatrix get transform/Descent exch def pop}ifelse
120     /FontHeight Ascent Descent sub def  % use `sub' because descent < 0
122     % Define these in case they're not in the FontInfo
123     % (also, here they're easier to get to).
124     /UnderlinePosition  Descent 0.70 mul def
125     /OverlinePosition   Descent UnderlinePosition sub Ascent add def
126     /StrikeoutPosition  Ascent 0.30 mul def
127     /LineThickness      FontHeight 0.05 mul def
128     /Xshadow            FontHeight  0.08 mul def
129     /Yshadow            FontHeight -0.09 mul def
130     /SpaceBackground    Descent neg UnderlinePosition add def
131     /XBox               Descent neg def
132     /YBox               LineThickness 0.7 mul def
134     currentdict         % Leave the new font on the stack
135     end                 % Stop using the font as the current dictionary.
136     definefont          % Put the font into the font dictionary
137     pop                 % Discard the returned font.
138 }bind def
140 % Font definition
141 /DefFont{findfont exch scalefont reencodeFontISO}def
143 % Font selection
145   findfont
146   dup/Ascent            get/Ascent            exch def
147   dup/Descent           get/Descent           exch def
148   dup/FontHeight        get/FontHeight        exch def
149   dup/UnderlinePosition get/UnderlinePosition exch def
150   dup/OverlinePosition  get/OverlinePosition  exch def
151   dup/StrikeoutPosition get/StrikeoutPosition exch def
152   dup/LineThickness     get/LineThickness     exch def
153   dup/Xshadow           get/Xshadow           exch def
154   dup/Yshadow           get/Yshadow           exch def
155   dup/SpaceBackground   get/SpaceBackground   exch def
156   dup/XBox              get/XBox              exch def
157   dup/YBox              get/YBox              exch def
158   setfont
159 }def
161 /FG/setrgbcolor load def
163 /bg false def
164 /BG{
165   dup/bg exch def
166   {[4 1 roll]}
167   {[1.0 1.0 1.0]}
168   ifelse
169   /bgcolor exch def
170 }def
172 %  B    width    C
173 %   +-----------+
174 %               | Ascent  (usually > 0)
175 % A +           +
176 %               | Descent (usually < 0)
177 %   +-----------+
178 %  E    width    D
180 /dobackground{                          % width --
181   currentpoint                          % -- width x y
182   gsave
183     newpath
184     moveto                              % A (x y)
185     0 Ascent rmoveto                    % B
186     dup 0 rlineto                       % C
187     0 Descent Ascent sub rlineto        % D
188     neg 0 rlineto                       % E
189     closepath
190     FillBgColor
191   grestore
192 }def
194 /eolbg{                                 % dobackground until right margin
195   PrintWidth                            % -- x-eol
196   currentpoint pop                      % -- cur-x
197   sub                                   % -- width until eol
198   dobackground
199 }def
201 /LineHS LineHeight LineSpacing add def
202 /ParagraphHS LineHeight ParagraphSpacing add def
203 /PSL{/h exch def bg{eolbg}if  0  currentpoint exch pop h sub  moveto}def
204 /PLN{PrintLineNumber{doLineNumber}if}def
206 /SL{LineHS PSL isLineStep pop}def       % Soft Linefeed
208 /PHL{ParagraphHS PSL PLN}def            % Paragraph Hard Linefeed
209 /LHL{LineHS PSL PLN}def                 % Hard Linefeed
211 % Some debug
212 /dcp{currentpoint exch 40 string cvs print(, )print =}def
213 /dp{print 2 copy  exch 40 string cvs print(, )print =}def
216   ( )stringwidth        % Get the width of a space in the current font.
217   pop                   % Discard the Y component.
218   mul                   % Multiply the width of a space
219                         % by the number of spaces to plot
220   bg{dup dobackground}if
221   0 rmoveto
222 }def
224 /Effect          0 def
225 /EffectUnderline false def
226 /EffectStrikeout false def
227 /EffectOverline  false def
228 /EffectShadow    false def
229 /EffectBox       false def
230 /EffectOutline   false def
232 % effect: 1  - underline  2   - strikeout  4  - overline
233 %         8  - shadow     16  - box        32 - outline
234 /EF{
235   /Effect exch def
236   /EffectUnderline Effect 1  and 0 ne def
237   /EffectStrikeout Effect 2  and 0 ne def
238   /EffectOverline  Effect 4  and 0 ne def
239   /EffectShadow    Effect 8  and 0 ne def
240   /EffectBox       Effect 16 and 0 ne def
241   /EffectOutline   Effect 32 and 0 ne def
242 }def
244 % stack:  string  |-  --
246   /xx currentpoint dup Descent add/yy exch def
247   Ascent add/YY exch def def
248   dup stringwidth pop xx add/XX exch def
249   EffectShadow{
250     /yy yy Yshadow add def
251     /XX XX Xshadow add def
252   }if
253   bg{
254     true
255     EffectBox
256       {SpaceBackground doBox}
257       {xx yy XX YY doRect}
258     ifelse
259   }if                                           % background
260   EffectBox      {false 0 doBox}if              % box
261   EffectShadow   {dup doShadow}if               % shadow
262   EffectOutline
263     {true doOutline}                            % outline
264     {show}                                      % normal text
265   ifelse
266   EffectUnderline{UnderlinePosition Hline}if    % underline
267   EffectStrikeout{StrikeoutPosition Hline}if    % strikeout
268   EffectOverline {OverlinePosition  Hline}if    % overline
269 }bind def
271 % stack:  position  |-  --
272 /Hline{
273   currentpoint exch pop add dup
274   gsave
275   newpath
276   xx exch moveto
277   XX exch lineto
278   closepath
279   LineThickness setlinewidth stroke
280   grestore
281 }bind def
283 % stack:  fill-or-not delta  |-  --
284 /doBox{
285   /dd exch def
286   xx XBox sub dd sub yy YBox sub dd sub
287   XX XBox add dd add YY YBox add dd add
288   doRect
289 }bind def
291 % stack:  fill-or-not lower-x lower-y upper-x upper-y  |-  --
292 /doRect{
293   /rYY exch def
294   /rXX exch def
295   /ryy exch def
296   /rxx exch def
297   gsave
298   newpath
299   rXX rYY moveto
300   rxx rYY lineto
301   rxx ryy lineto
302   rXX ryy lineto
303   closepath
304   % top of stack: fill-or-not
305   {FillBgColor}
306   {LineThickness setlinewidth stroke}ifelse
307   grestore
308 }bind def
310 % stack:  string  |-  --
311 /doShadow{
312   gsave
313   Xshadow Yshadow rmoveto
314   false doOutline
315   grestore
316 }bind def
318 /st 1 string def
320 % stack:  string fill-or-not  |-  --
321 /doOutline{
322   /-fillp- exch def
323   /-ox- currentpoint/-oy- exch def def
324   gsave
325   LineThickness setlinewidth
326   {st 0 3 -1 roll put
327    st dup true charpath
328    -fillp- {gsave FillBgColor grestore}if
329    stroke stringwidth
330    -oy- add/-oy- exch def
331    -ox- add/-ox- exch def
332    -ox- -oy- moveto
333   }forall
334   grestore
335   -ox- -oy- moveto
336 }bind def
338 % stack:  --
339 /FillBgColor{bgcolor aload pop setrgbcolor fill}bind def
341 % stack:  -- |- boolean
342 /isLineStep{
343   SyncLineZebra
344   {PLScounter 0 gt                                              % or zebra
345    {/PLScounter PLScounter 1 sub def PLScounter 0 eq}
346    {false}ifelse
347    PrintLineStep 1 gt
348    {/PrintLineStep PrintLineStep 1 sub def}
349    {/PrintLineStep ZebraHeight def
350     /PLScounter PrintLineStart def}ifelse}
351   {LineNumber PrintLineStart sub PrintLineStep mod 0 eq}ifelse  % or line step
352 }def
354 % stack:  --
355 /doLineNumber{
356   /LineNumber where
357   {pop
358    isLineStep                   % or line step
359    LineNumber Lines ge or       % or last line
360    {currentfont
361     gsave
362     LineNumberColor SetColor
363     /L0 findfont setfont
364     LineNumber Lines ge
365     {(end      )}
366     {LineNumber 6 string cvs(      )strcat}ifelse
367     dup stringwidth pop neg 0 rmoveto
368     show
369     grestore
370     setfont}if
371     /LineNumber LineNumber 1 add def
372   }if
373 }def
375 % stack: color-specifier |- --
376 /SetColor{dup type/realtype eq{setgray}{aload pop setrgbcolor}ifelse}def
378 % stack: --
379 /printZebra{
380   gsave
381   ZebraColor SetColor
382   /double-zebra ZebraHeight ZebraHeight add def
383   /yiter double-zebra LineHS mul neg def
384   /xiter PrintWidth InterColumn add def
385   /zebra-line LinesPrinted def
386   NumberOfColumns{LinesPerColumn doColumnZebra xiter 0 rmoveto}repeat
387   grestore
388 }def
390 % stack:  lines-per-column |- --
391 /doColumnZebra{
392   /lpc exch def
393   gsave
394   ZebraFollow 1 and 0 ne{
395     /H ZebraHeight zebra-line ZebraHeight mod sub def
396     /lpc lpc H sub def
397     zebra-line double-zebra mod ZebraHeight lt
398     {H doZebra  % "black" stripe followed by a "white" stripe
399      /lpc lpc ZebraHeight sub def
400      H ZebraHeight add}
401     {H}ifelse   % "white" stripe
402     LineHS mul neg 0 exch rmoveto
403     /zebra-line zebra-line LinesPerColumn add def
404   }if
405   /zspacing 0 def
406   lpc dup double-zebra idiv{ZebraHeight doZebra 0 yiter rmoveto}repeat
407   double-zebra mod dup 0 le{pop}
408   {dup ZebraHeight gt
409    {pop ZebraHeight}
410    {/zspacing LineSpacing def
411     ZebraFollow 2 and 0 ne{pop ZebraHeight}if}ifelse
412    doZebra}ifelse
413   grestore
414 }def
416 % stack:  zebra-height (in lines) |- --
417 /doZebra{
418   /zh exch 0.05 sub LineHS mul zspacing sub def
419   gsave
420   0 LineHeight 0.65 mul rmoveto
421   PrintWidth 0 rlineto
422   0 zh neg rlineto
423   PrintWidth neg 0 rlineto
424   0 zh rlineto
425   fill
426   grestore
427 }def
429 % stack: --
430 /printBackground{
431   /BackgroundColor where{
432     pop gsave BackgroundColor SetColor
433     NumberOfColumns{
434      gsave
435      0 LineHeight 0.65 mul rmoveto
436      PrintWidth 0 rlineto
437      0 PrintHeight neg rlineto
438      PrintWidth neg 0 rlineto
439      0 PrintHeight 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