Return to grabit.ps CVS log

Up to [Research Unix] / researchv10dc / cmd / postscript / grabit

Annotation of researchv10dc/cmd/postscript/grabit/grabit.ps, revision 1.1

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.