1
0

grabit.ps 12 KB

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