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