declare smobs in alloc.c
[bpt/emacs.git] / etc / ps-prin1.ps
1 % === BEGIN ps-print prologue 1
2 % version: 6.1
3
4 % Copyright (C) 2000-2014 Free Software Foundation, Inc.
5
6 % This file is part of GNU Emacs.
7
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.
12
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.
17
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/>.
20
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.
30
31
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
78
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.
83
84 begin % Make the new font the current dictionary.
85
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
89
90 % Override the encoding with the ISOLatin1 encoding.
91 currentdict/FontType get 0 ne{/Encoding ISOLatin1Encoding def}if
92
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.
96
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) --> +----+ - -
108
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
117
118 /FontHeight Ascent Descent sub def % use `sub' because descent < 0
119
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
131
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
137
138 % Font definition
139 /DefFont{findfont exch scalefont reencodeFontISO}def
140
141 % Font selection
142 /F{
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
158
159 /FG/setrgbcolor load def
160
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
169
170 % B width C
171 % +-----------+
172 % | Ascent (usually > 0)
173 % A + +
174 % | Descent (usually < 0)
175 % +-----------+
176 % E width D
177
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
191
192 /eolbg{ % dobackground until right margin
193 PrintWidth % -- x-eol
194 currentpoint pop % -- cur-x
195 sub % -- width until eol
196 dobackground
197 }def
198
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
203
204 /SL{LineHS PSL isLineStep pop}def % Soft Linefeed
205
206 /PHL{ParagraphHS PSL PLN}def % Paragraph Hard Linefeed
207 /LHL{LineHS PSL PLN}def % Hard Linefeed
208
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
212
213 /W{
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
221
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
229
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
241
242 % stack: string |- --
243 /S{
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
268
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
280
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
288
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
307
308 % stack: string |- --
309 /doShadow{
310 gsave
311 Xshadow Yshadow rmoveto
312 false doOutline
313 grestore
314 }bind def
315
316 /st 1 string def
317
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
335
336 % stack: --
337 /FillBgColor{bgcolor aload pop setrgbcolor fill}bind def
338
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
351
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
372
373 % stack: color-specifier |- --
374 /SetColor{dup type/realtype eq{setgray}{aload pop setrgbcolor}ifelse}def
375
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
387
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
413
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
426
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
447
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
457
458 /EndBackImage{-save-image- restore}def
459
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
474
475 /SetPageSize{
476 BMark/PageSize[PageWidth LandscapePageHeight LandscapeMode{exch}if]EMark setpagedevice
477 }def
478
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
496
497 /EndDoc{
498 % ---- restore the state of the document (useful for ghostscript!)
499 docState restore
500 }def
501
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
508
509 /PrintHeaderWidth PrintOnlyOneHeader{PrintPageWidth}{PrintWidth}ifelse def
510
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
540
541 /EndPage{bg{eolbg}if}def
542
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
567
568 /TextStart{
569 LeftMargin BottomMargin
570 PrintFooter{
571 FooterPad add
572 FooterLines FooterLineHeight mul add
573 FooterPad add
574 FooterOffset add}if
575 }def
576
577 % stack: number-of-pages-per-sheet |- --
578 /BeginSheet{
579 /sheetState save def
580 /pages-per-sheet exch def
581
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
632
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
657
658 /EndSheet{
659 showpage
660 sheetState restore
661 }def
662
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
672
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
681
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 % |---------|
697
698 % -- |- x y
699 /HeaderFrameStart{0 PrintHeight HeaderOffset add}def
700 /FooterFrameStart{0 FooterHeight FooterOffset add neg}def
701
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
709
710 /HeaderFramePath{HeaderHeight doFramePath}def
711 /FooterFramePath{FooterHeight doFramePath}def
712
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
732
733 /HeaderFrame{/HeaderFramePath /HeaderFrameStart HeaderFrameProperties doFrame}def
734 /FooterFrame{/FooterFramePath /FooterFrameStart FooterFrameProperties doFrame}def
735
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
744
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
753
754 /HeaderClip{HeaderFrameStart moveto HeaderFramePath clip}def
755 /FooterClip{FooterFrameStart moveto FooterFramePath clip}def
756
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
762
763 /pagenumberstring{
764 PageNumber 32 string cvs
765 ShowNofN{(/)strcat PageCount 32 string cvs strcat}if
766 }def
767
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
787
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
794
795 % -- rightLines leftLines -- at stack
796
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
800
801 % ---- process the left lines
802 false HeaderOrFooterTextLines
803
804 % ---- process the right lines
805 true HeaderOrFooterTextLines
806 }def
807
808 /HeaderText{
809 gsave HeaderClip
810 HeaderLinesRight HeaderLinesLeft
811 /HeaderStart HeaderLineHeight HeaderPad
812 HeaderFrameProperties 0 get
813 HeaderOrFooterText
814 grestore
815 }def
816
817 /FooterText{
818 gsave FooterClip
819 FooterLinesRight FooterLinesLeft
820 /FooterStart FooterLineHeight FooterPad
821 FooterFrameProperties 0 get
822 HeaderOrFooterText
823 grestore
824 }def
825
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
860
861 % cm to point
862 /cm{72 mul 2.54 div}def
863
864 /ReportAllFontInfo{
865 % key = font name value = font dictionary
866 FontDirectory{pop 10 exch ReportFontInfo}forall
867 }def
868
869 % 3 cm 20 cm moveto 10/Courier ReportFontInfo showpage
870 % 3 cm 20 cm moveto ReportAllFontInfo showpage
871
872 % === END ps-print prologue 1