![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to grabit.ps CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10dc / cmd / postscript / grabit|
Return to grabit.ps CVS log | Up to [Research Unix] / researchv10dc / cmd / postscript / grabit |
1.1 root 1: %
2: % Dump a PostScript object, occasionally in a form that can be sent back
3: % through the interpreter. Similiar to Adobe's == procedure, but output
4: % is usually easier to read. No binding so operators like rcheck and exec
5: % can be conviently redefined.
6: %
7:
8: /GrabitDict 100 dict dup begin
9:
10: /recursive true def
11: /scratchstring 200 string def
12: /slowdown 100 def
13:
14: /column 0 def
15: /lastcolumn 80 def
16: /level 0 def
17: /multiline 100 array def
18: /nextname 0 def
19: /arraylength 0 def
20: /lengthonly false def
21:
22: /GrabitSetup {
23: counttomark {OmitNames exch true put} repeat pop
24: 0 0 moveto % for hardcopy output
25: } def
26:
27: /OmitNames 30 dict def % ignore these names
28: /OtherDicts 200 dict def % unrecognized dictionaries
29:
30: %
31: % All strings returned to the host go through Print. First pass through an
32: % array has lengthonly set to true.
33: %
34:
35: /Print {
36: dup type /stringtype ne {scratchstring cvs} if
37: lengthonly {
38: length arraylength add /arraylength exch def
39: }{
40: dup length column add /column exch def
41: print flush
42: slowdown {1 pop} repeat
43: } ifelse
44: } def
45:
46: /Indent {level {( ) Print} repeat} def
47: /Newline {(\n) Print lengthonly not {/column 0 def} if} def
48:
49: /NextLevel {/level level 1 add def multiline level 0 put} def
50: /LastLevel {/level level 1 sub def} def
51:
52: %
53: % Make a unique name for each unrecognized dictionary and remember the name
54: % and dictionary in OtherDicts.
55: %
56:
57: /Register {
58: dup type /dicttype eq {
59: /nextname nextname 1 add def
60: dup (UnknownDict ) dup
61: (UnknownDict) length nextname ( ) cvs putinterval
62: 0 (UnknownDict) length nextname ( ) cvs length add getinterval cvn
63: exch OtherDicts 3 1 roll put
64: } if
65: } def
66:
67: %
68: % Replace array or dictionary values by known names. Lookups are in the
69: % standard PostScript dictionaries and in OtherDicts. If found replace
70: % the value by the name and make it executable so nametype omits the
71: % leading /.
72: %
73:
74: /Replace {
75: false
76: 1 index type /dicttype eq {pop true} if
77: 1 index type /arraytype eq 2 index xcheck not and {pop true} if
78: {
79: false
80: [userdict systemdict statusdict serverdict OtherDicts] {
81: {
82: 3 index eq
83: {exch pop exch pop cvx true exit}
84: {pop}
85: ifelse
86: } forall
87: dup {exit} if
88: } forall
89: pop
90: } if
91: } def
92:
93: %
94: % Simple type handlers. In some cases (e.g. savetype) what's returned can't
95: % be sent back through the interpreter.
96: %
97:
98: /booleantype {{(true )}{(false )} ifelse Print} def
99: /marktype {pop (mark ) Print} def
100: /nulltype {pop (null ) Print} def
101: /integertype {Print ( ) Print} def
102: /realtype {Print ( ) Print} def
103: /filetype {pop (-file- ) Print} def
104: /fonttype {pop (-fontID- ) Print} def
105: /savetype {pop (-saveobj- ) Print} def
106:
107: %
108: % Special formatting for operators is enabled if the flag in multiline
109: % (for the current level) is set to 1. In that case each operator, after
110: % being printed, is looked up in OperatorDict. If found the value is used
111: % as an index into the OperatorProcs array and the object at that index
112: % is retrieved and executed. Currently only used to choose the operators
113: % that end a line.
114: %
115:
116: /operatortype {
117: dup Print ( ) Print
118: multiline level get 1 eq {
119: scratchstring cvs cvn dup OperatorDict exch known {
120: OperatorDict exch get
121: OperatorProcs exch get exec
122: }{
123: pop
124: column lastcolumn gt {Newline Indent} if
125: } ifelse
126: }{pop} ifelse
127: } def
128:
129: %
130: % Executable names are passed to operatortype. Non-executable names get a
131: % leading /.
132: %
133:
134: /nametype {
135: dup xcheck {
136: operatortype
137: }{
138: (/) Print Print ( ) Print
139: } ifelse
140: } def
141:
142: %
143: % Arrays are processed in two passes. The first computes the length of the
144: % string returned to the host without any special formatting. If it extends
145: % past the last column special formatting is enabled by setting a flag in
146: % array multiline. Arrays are processed in a for loop so the last element
147: % easily recognized. At that point special fortmatting is disabled.
148: %
149:
150: /packedarraytype {arraytype} def
151:
152: /arraytype {
153: NextLevel
154: lengthonly not {
155: /lengthonly true def
156: /arraylength 0 def
157: dup dup type exec
158: arraylength 20 gt arraylength column add lastcolumn gt and {
159: multiline level 1 put
160: } if
161: /lengthonly false def
162: } if
163:
164: dup rcheck not {
165: (-array- ) Print pop
166: }{
167: dup xcheck {({)}{([)} ifelse Print
168: multiline level get 0 ne {Newline Indent}{( ) Print} ifelse
169: 0 1 2 index length 1 sub {
170: 2 copy exch length 1 sub eq multiline level get 1 eq and {
171: multiline level 2 put
172: } if
173: 2 copy get exch pop
174: dup type /dicttype eq {
175: Replace
176: dup type /dicttype eq {
177: dup Register Replace
178: recursive {
179: 2 copy cvlit
180: /def load 3 1 roll
181: count 3 roll
182: } if
183: exch pop
184: } if
185: } if
186: dup type exec
187: dup xcheck not multiline level get 1 eq and {
188: 0 index type /arraytype eq
189: 1 index type /packedarray eq or
190: 1 index type /stringtype eq or {Newline Indent} if
191: } if
192: } for
193: multiline level get 0 ne {Newline LastLevel Indent NextLevel} if
194: xcheck {(} )}{(] )} ifelse Print
195: } ifelse
196: LastLevel
197: } def
198:
199: %
200: % Dictionary handler. Try to replace the value by a name before processing
201: % the dictionary.
202: %
203:
204: /dicttype {
205: dup
206: rcheck not {
207: (-dictionary- ) Print pop
208: }{
209: dup maxlength Print ( dict dup begin) Print Newline
210: NextLevel
211: {
212: 1 index OmitNames exch known {
213: pop pop
214: }{
215: Indent
216: Replace % arrays and dicts by known names
217: Register % new dictionaries in OtherDicts
218: exch
219: cvlit dup type exec % key first - force a /
220: dup type exec % then the value
221: (def) Print Newline
222: } ifelse
223: } forall
224: LastLevel
225: Indent
226: (end ) Print
227: } ifelse
228: } def
229:
230: %
231: % Strings containing characters not in AsciiDict are returned in hex. All
232: % others are ASCII strings and use AsciiDict for character mapping.
233: %
234:
235: /onecharstring ( ) def
236: /twocharstring ( ) def
237:
238: /stringtype {
239: dup
240: rcheck not {
241: (-string- ) Print
242: }{
243: /hexit false def
244: dup {
245: onecharstring 0 3 -1 roll put
246: AsciiDict onecharstring cvn known not {
247: /hexit true def exit
248: } if
249: } forall
250:
251: hexit {(<)}{(\()} ifelse Print
252: 0 1 2 index length 1 sub {
253: 2 copy 1 getinterval exch pop
254: hexit {
255: 0 get /n exch def
256: n -4 bitshift 16#F and 16 twocharstring cvrs pop
257: n 16#F and twocharstring 1 1 getinterval 16 exch cvrs pop
258: twocharstring
259: }{cvn AsciiDict exch get} ifelse
260: Print
261: column lastcolumn gt {
262: hexit not {(\\) Print} if
263: Newline
264: } if
265: } for
266: hexit {(> )}{(\) )} ifelse Print
267: } ifelse
268: pop
269: } def
270:
271: %
272: % ASCII characters and replacement strings. Ensures the returned string will
273: % reproduce the original when passed through the scanner. Strings containing
274: % characters not in this list should be returned as hex strings.
275: %
276:
277: /AsciiDict 128 dict dup begin
278: (\n) cvn (\\n) def
279: (\r) cvn (\\r) def
280: (\t) cvn (\\t) def
281: (\b) cvn (\\b) def
282: (\f) cvn (\\f) def
283: ( ) cvn ( ) def
284: (!) cvn (!) def
285: (") cvn (") def
286: (#) cvn (#) def
287: ($) cvn ($) def
288: (%) cvn (\\%) def
289: (&) cvn (&) def
290: (') cvn (') def
291: (\() cvn (\\\() def
292: (\)) cvn (\\\)) def
293: (*) cvn (*) def
294: (+) cvn (+) def
295: (,) cvn (,) def
296: (-) cvn (-) def
297: (.) cvn (.) def
298: (/) cvn (/) def
299: (0) cvn (0) def
300: (1) cvn (1) def
301: (2) cvn (2) def
302: (3) cvn (3) def
303: (4) cvn (4) def
304: (5) cvn (5) def
305: (6) cvn (6) def
306: (7) cvn (7) def
307: (8) cvn (8) def
308: (9) cvn (9) def
309: (:) cvn (:) def
310: (;) cvn (;) def
311: (<) cvn (<) def
312: (=) cvn (=) def
313: (>) cvn (>) def
314: (?) cvn (?) def
315: (@) cvn (@) def
316: (A) cvn (A) def
317: (B) cvn (B) def
318: (C) cvn (C) def
319: (D) cvn (D) def
320: (E) cvn (E) def
321: (F) cvn (F) def
322: (G) cvn (G) def
323: (H) cvn (H) def
324: (I) cvn (I) def
325: (J) cvn (J) def
326: (K) cvn (K) def
327: (L) cvn (L) def
328: (M) cvn (M) def
329: (N) cvn (N) def
330: (O) cvn (O) def
331: (P) cvn (P) def
332: (Q) cvn (Q) def
333: (R) cvn (R) def
334: (S) cvn (S) def
335: (T) cvn (T) def
336: (U) cvn (U) def
337: (V) cvn (V) def
338: (W) cvn (W) def
339: (X) cvn (X) def
340: (Y) cvn (Y) def
341: (Z) cvn (Z) def
342: ([) cvn ([) def
343: (\\) cvn (\\\\) def
344: (]) cvn (]) def
345: (^) cvn (^) def
346: (_) cvn (_) def
347: (`) cvn (`) def
348: (a) cvn (a) def
349: (b) cvn (b) def
350: (c) cvn (c) def
351: (d) cvn (d) def
352: (e) cvn (e) def
353: (f) cvn (f) def
354: (g) cvn (g) def
355: (h) cvn (h) def
356: (i) cvn (i) def
357: (j) cvn (j) def
358: (k) cvn (k) def
359: (l) cvn (l) def
360: (m) cvn (m) def
361: (n) cvn (n) def
362: (o) cvn (o) def
363: (p) cvn (p) def
364: (q) cvn (q) def
365: (r) cvn (r) def
366: (s) cvn (s) def
367: (t) cvn (t) def
368: (u) cvn (u) def
369: (v) cvn (v) def
370: (w) cvn (w) def
371: (x) cvn (x) def
372: (y) cvn (y) def
373: (z) cvn (z) def
374: ({) cvn ({) def
375: (|) cvn (|) def
376: (}) cvn (}) def
377: (~) cvn (~) def
378: end def
379:
380: %
381: % OperatorDict can help format procedure listings. The value assigned to each
382: % name is used as an index into the OperatorProcs array. The procedure at that
383: % index is fetched and executed after the named operator is printed. What's in
384: % OperatorDict is a matter of taste rather than correctness. The default list
385: % represents our choice of which of Adobe's operators should end a line.
386: %
387:
388: /OperatorProcs [{} {Newline Indent}] def
389:
390: /OperatorDict 250 dict def
391:
392: OperatorDict /arc 1 put
393: OperatorDict /arcn 1 put
394: OperatorDict /ashow 1 put
395: OperatorDict /awidthshow 1 put
396: OperatorDict /banddevice 1 put
397: OperatorDict /begin 1 put
398: OperatorDict /charpath 1 put
399: OperatorDict /clear 1 put
400: OperatorDict /cleardictstack 1 put
401: OperatorDict /cleartomark 1 put
402: OperatorDict /clip 1 put
403: OperatorDict /clippath 1 put
404: OperatorDict /closefile 1 put
405: OperatorDict /closepath 1 put
406: OperatorDict /concat 1 put
407: OperatorDict /copypage 1 put
408: OperatorDict /curveto 1 put
409: OperatorDict /def 1 put
410: OperatorDict /end 1 put
411: OperatorDict /eoclip 1 put
412: OperatorDict /eofill 1 put
413: OperatorDict /erasepage 1 put
414: OperatorDict /exec 1 put
415: OperatorDict /exit 1 put
416: OperatorDict /fill 1 put
417: OperatorDict /flattenpath 1 put
418: OperatorDict /flush 1 put
419: OperatorDict /flushfile 1 put
420: OperatorDict /for 1 put
421: OperatorDict /forall 1 put
422: OperatorDict /framedevice 1 put
423: OperatorDict /grestore 1 put
424: OperatorDict /grestoreall 1 put
425: OperatorDict /gsave 1 put
426: OperatorDict /handleerror 1 put
427: OperatorDict /if 1 put
428: OperatorDict /ifelse 1 put
429: OperatorDict /image 1 put
430: OperatorDict /imagemask 1 put
431: OperatorDict /initclip 1 put
432: OperatorDict /initgraphics 1 put
433: OperatorDict /initmatrix 1 put
434: OperatorDict /kshow 1 put
435: OperatorDict /lineto 1 put
436: OperatorDict /loop 1 put
437: OperatorDict /moveto 1 put
438: OperatorDict /newpath 1 put
439: OperatorDict /nulldevice 1 put
440: OperatorDict /pathforall 1 put
441: OperatorDict /print 1 put
442: OperatorDict /prompt 1 put
443: OperatorDict /put 1 put
444: OperatorDict /putinterval 1 put
445: OperatorDict /quit 1 put
446: OperatorDict /rcurveto 1 put
447: OperatorDict /renderbands 1 put
448: OperatorDict /repeat 1 put
449: OperatorDict /resetfile 1 put
450: OperatorDict /restore 1 put
451: OperatorDict /reversepath 1 put
452: OperatorDict /rlineto 1 put
453: OperatorDict /rmoveto 1 put
454: OperatorDict /rotate 1 put
455: OperatorDict /run 1 put
456: OperatorDict /scale 1 put
457: OperatorDict /setcachedevice 1 put
458: OperatorDict /setcachelimit 1 put
459: OperatorDict /setcacheparams 1 put
460: OperatorDict /setcharwidth 1 put
461: OperatorDict /setdash 1 put
462: OperatorDict /setdefaulttimeouts 1 put
463: OperatorDict /setdostartpage 1 put
464: OperatorDict /seteescratch 1 put
465: OperatorDict /setflat 1 put
466: OperatorDict /setfont 1 put
467: OperatorDict /setgray 1 put
468: OperatorDict /sethsbcolor 1 put
469: OperatorDict /setidlefonts 1 put
470: OperatorDict /setjobtimeout 1 put
471: OperatorDict /setlinecap 1 put
472: OperatorDict /setlinejoin 1 put
473: OperatorDict /setlinewidth 1 put
474: OperatorDict /setmargins 1 put
475: OperatorDict /setmatrix 1 put
476: OperatorDict /setmiterlimit 1 put
477: OperatorDict /setpacking 1 put
478: OperatorDict /setpagetype 1 put
479: OperatorDict /setprintname 1 put
480: OperatorDict /setrgbcolor 1 put
481: OperatorDict /setsccbatch 1 put
482: OperatorDict /setsccinteractive 1 put
483: OperatorDict /setscreen 1 put
484: OperatorDict /settransfer 1 put
485: OperatorDict /show 1 put
486: OperatorDict /showpage 1 put
487: OperatorDict /start 1 put
488: OperatorDict /stop 1 put
489: OperatorDict /store 1 put
490: OperatorDict /stroke 1 put
491: OperatorDict /strokepath 1 put
492: OperatorDict /translate 1 put
493: OperatorDict /widthshow 1 put
494: OperatorDict /write 1 put
495: OperatorDict /writehexstring 1 put
496: OperatorDict /writestring 1 put
497:
498: end def
499:
500: %
501: % Put an object on the stack and call Grabit. Output continues until stack
502: % is empty. For example,
503: %
504: % /letter load Grabit
505: %
506: % prints a listing of the letter procedure.
507: %
508:
509: /Grabit {
510: /saveobj save def
511: GrabitDict begin
512: {
513: count 0 eq {exit} if
514: count {dup type exec} repeat
515: (\n) print flush
516: } loop
517: end
518: currentpoint % for hardcopy output
519: saveobj restore
520: moveto
521: } def
522:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.