home *** CD-ROM | disk | FTP | other *** search
/ Acorn User 10 / AU_CD10.iso / Updates / GhostScript / !GhostScr / 6_01 / lib / gs_btokn.ps < prev    next >
Text File  |  2000-03-09  |  11KB  |  318 lines
  1. %    Copyright (C) 1994, 2000 Aladdin Enterprises.  All rights reserved.
  2. % 
  3. % This file is part of Aladdin Ghostscript.
  4. % 
  5. % Aladdin Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author
  6. % or distributor accepts any responsibility for the consequences of using it,
  7. % or for whether it serves any particular purpose or works at all, unless he
  8. % or she says so in writing.  Refer to the Aladdin Ghostscript Free Public
  9. % License (the "License") for full details.
  10. % 
  11. % Every copy of Aladdin Ghostscript must include a copy of the License,
  12. % normally in a plain ASCII text file named PUBLIC.  The License grants you
  13. % the right to copy, modify and redistribute Aladdin Ghostscript, but only
  14. % under certain conditions described in the License.  Among other things, the
  15. % License requires that the copyright notice and this notice be preserved on
  16. % all copies.
  17.  
  18. % $Id: gs_btokn.ps,v 1.2 2000/03/10 04:27:31 lpd Exp $
  19. % Initialization file for binary tokens.
  20. % When this is run, systemdict is still writable,
  21. % but everything defined here goes into level2dict.
  22.  
  23. % Define whether or not to allow writing dictionaries.
  24. % This is a non-standard feature!
  25. /WRITEDICTS false def
  26.  
  27. languagelevel 1 .setlanguagelevel
  28. level2dict begin
  29.  
  30. % Initialization for the system name table.
  31.  
  32. mark
  33. % 0
  34.     /abs /add /aload /anchorsearch /and
  35.     /arc /arcn /arct /arcto /array
  36.     /ashow /astore /awidthshow /begin /bind
  37.     /bitshift /ceiling /charpath /clear /cleartomark
  38. % 20
  39.     /clip /clippath /closepath /concat /concatmatrix
  40.     /copy /count /counttomark /currentcmykcolor /currentdash
  41.     /currentdict /currentfile /currentfont /currentgray /currentgstate
  42.     /currenthsbcolor /currentlinecap /currentlinejoin /currentlinewidth /currentmatrix
  43. % 40
  44.     /currentpoint /currentrgbcolor /currentshared /curveto /cvi
  45.     /cvlit /cvn /cvr /cvrs /cvs
  46.     /cvx /def /defineusername /dict /div
  47.     /dtransform /dup /end /eoclip /eofill
  48. % 60
  49.     /eoviewclip /eq /exch /exec /exit
  50.     /file /fill /findfont /flattenpath /floor
  51.     /flush /flushfile /for /forall /ge
  52.     /get /getinterval /grestore /gsave /gstate
  53. % 80
  54.     /gt /identmatrix /idiv /idtransform /if
  55.     /ifelse /image /imagemask /index /ineofill
  56.     /infill /initviewclip /inueofill /inufill /invertmatrix
  57.     /itransform /known /le /length /lineto
  58. % 100
  59.     /load /loop /lt /makefont /matrix
  60.     /maxlength /mod /moveto /mul /ne
  61.     /neg /newpath /not /null /or
  62.     /pathbbox /pathforall /pop /print /printobject
  63. % 120
  64.     /put /putinterval /rcurveto /read /readhexstring
  65.     /readline /readstring /rectclip /rectfill /rectstroke
  66.     /rectviewclip /repeat /restore /rlineto /rmoveto
  67.     /roll /rotate /round /save /scale
  68. % 140
  69.     /scalefont /search /selectfont /setbbox /setcachedevice
  70.     /setcachedevice2 /setcharwidth /setcmykcolor /setdash /setfont
  71.     /setgray /setgstate /sethsbcolor /setlinecap /setlinejoin
  72.     /setlinewidth /setmatrix /setrgbcolor /setshared /shareddict
  73. % 160
  74.     /show /showpage /stop /stopped /store
  75.     /string /stringwidth /stroke /strokepath /sub
  76.     /systemdict /token /transform /translate /truncate
  77.     /type /uappend /ucache /ueofill /ufill
  78. % 180
  79.     /undef /upath /userdict /ustroke /viewclip
  80.     /viewclippath /where /widthshow /write /writehexstring
  81.     /writeobject /writestring /wtranslation /xor /xshow
  82.     /xyshow /yshow /FontDirectory /SharedFontDirectory /Courier
  83. % 200
  84.     /Courier-Bold /Courier-BoldOblique /Courier-Oblique /Helvetica /Helvetica-Bold
  85.     /Helvetica-BoldOblique /Helvetica-Oblique /Symbol /Times-Bold /Times-BoldItalic
  86.     /Times-Italic /Times-Roman /execuserobject /currentcolor /currentcolorspace
  87.     /currentglobal /execform /filter /findresource /globaldict
  88. % 220
  89.     /makepattern /setcolor /setcolorspace /setglobal /setpagedevice
  90.     /setpattern
  91. % pad to 256
  92.     counttomark 256 exch sub { 0 } repeat
  93. % 256
  94.     /= /== /ISOLatin1Encoding /StandardEncoding
  95. % 260
  96.     ([) cvn (]) cvn /atan /banddevice /bytesavailable
  97.     /cachestatus /closefile /colorimage /condition /copypage
  98.     /cos /countdictstack /countexecstack /cshow /currentblackgeneration
  99.     /currentcacheparams /currentcolorscreen /currentcolortransfer /currentcontext /currentflat
  100. % 280
  101.     /currenthalftone /currenthalftonephase /currentmiterlimit /currentobjectformat /currentpacking
  102.     /currentscreen /currentstrokeadjust /currenttransfer /currentundercolorremoval /defaultmatrix
  103.     /definefont /deletefile /detach /deviceinfo /dictstack
  104.     /echo /erasepage /errordict /execstack /executeonly
  105. % 300
  106.     /exp /false /filenameforall /fileposition /fork
  107.     /framedevice /grestoreall /handleerror /initclip /initgraphics
  108.     /initmatrix /instroke /inustroke /join /kshow
  109.     /ln /lock /log /mark /monitor
  110. % 320
  111.     /noaccess /notify /nulldevice /packedarray /quit
  112.     /rand /rcheck /readonly /realtime /renamefile
  113.     /renderbands /resetfile /reversepath /rootfont /rrand
  114.     /run /scheck /setblackgeneration /setcachelimit /setcacheparams
  115. % 340
  116.     /setcolorscreen /setcolortransfer /setfileposition /setflat /sethalftone
  117.     /sethalftonephase /setmiterlimit /setobjectformat /setpacking /setscreen
  118.     /setstrokeadjust /settransfer /setucacheparams /setundercolorremoval /sin
  119.     /sqrt /srand /stack /status /statusdict
  120. % 360
  121.     /true /ucachestatus /undefinefont /usertime /ustrokepath
  122.     /version /vmreclaim /vmstatus /wait /wcheck
  123.     /xcheck /yield /defineuserobject /undefineuserobject /UserObjects
  124.     /cleardictstack
  125. % 376
  126.     /A /B /C /D /E /F /G /H /I /J /K /L /M
  127.     /N /O /P /Q /R /S /T /U /V /W /X /Y /Z
  128.     /a /b /c /d /e /f /g /h /i /j /k /l /m
  129.     /n /o /p /q /r /s /t /u /v /w /x /y /z
  130. % 428
  131.     /setvmthreshold (<<) cvn
  132.     (>>) cvn /currentcolorrendering /currentdevparams /currentoverprint /currentpagedevice
  133.     /currentsystemparams /currentuserparams /defineresource /findencoding /gcheck
  134. % 440
  135.     /glyphshow /languagelevel /product /pstack /resourceforall
  136.     /resourcestatus /revision /serialnumber /setcolorrendering /setdevparams
  137.     /setoverprint /setsystemparams /setuserparams /startjob /undefineresource
  138.     /GlobalFontDirectory /ASCII85Decode /ASCII85Encode /ASCIIHexDecode /ASCIIHexEncode
  139. % 460
  140.     /CCITTFaxDecode /CCITTFaxEncode /DCTDecode /DCTEncode /LZWDecode
  141.     /LZWEncode /NullEncode /RunLengthDecode /RunLengthEncode /SubFileDecode
  142.     /CIEBasedA /CIEBasedABC /DeviceCMYK /DeviceGray /DeviceRGB
  143.     /Indexed /Pattern /Separation /CIEBasedDEF /CIEBasedDEFG
  144. % 480
  145.     /DeviceN
  146. % 481 -- end
  147. .packtomark
  148. dup /SystemNames exch def .installsystemnames
  149.  
  150. % Define printobject and writeobject.
  151. % These are mostly implemented in PostScript, so that we don't have to
  152. % worry about interrupts or callbacks when writing to the output file.
  153.  
  154. % Define procedures for accumulating the space required to represent
  155. % an object in binary form.
  156. /cntdict mark        % <#refs> <#chars> <obj> -proc- <#refs> <#chars>
  157.   /integertype /pop load
  158.   /realtype 1 index
  159.   /marktype 1 index
  160.   /nulltype 1 index
  161.   /booleantype 1 index
  162.   /nametype { length add } bind
  163.   /stringtype 1 index
  164.   /arraytype null
  165.   /dicttype null
  166. .dicttomark def
  167. cntdict /arraytype {
  168.   dup dup length 5 -1 roll add 4 2 roll {
  169.     dup type //cntdict exch get exec
  170.   } forall
  171. } bind put
  172. cntdict /dicttype {
  173.   WRITEDICTS {
  174.     dup dup length 2 mul 5 -1 roll add 4 2 roll {
  175.       4 1 roll dup type //cntdict exch get exec
  176.       3 -1 roll dup type //cntdict exch get exec
  177.     } forall
  178.   } {
  179.     /writeobject load /typecheck signalerror
  180.   } ifelse
  181. } bind put
  182.  
  183. /w2dict mark
  184.   /nametype { 2 copy .writecvs pop } bind
  185.   /stringtype 1 index
  186. .dicttomark def
  187.  
  188. /.bosheader {        % <top_length> <total_length> <string8> .bosheader
  189.             %   <string4|8>
  190.   dup 0 currentobjectformat 127 add put        % object format => BOS tag
  191.   2 index 255 le 2 index 65531 le and {
  192.     % Use the short header format: tag toplen(1) totlen(2)
  193.     exch 4 add exch
  194.     0 4 getinterval
  195.     dup 1 5 -1 roll put
  196.   } {
  197.     % Use the long header format: tag 0(1) toplen(2) totlen(4)
  198.     exch 8 add exch
  199.     0 0 4 2 roll .bosobject exch pop exch pop    % store with byte swapping
  200.   } ifelse        % Stack: shortlen str
  201.   exch dup -8 bitshift exch 255 and    % str hibyte lobyte
  202.   currentobjectformat 1 and 0 eq {    % lsb first
  203.     exch
  204.   } if
  205.   2 index 3 3 -1 roll put
  206.   1 index 2 3 -1 roll put
  207. } .bind def
  208.  
  209. /.writeobjects {    % <file> <tag> <array> .writeobjects -
  210.   mark exch
  211.  
  212.     % Count the space required for refs and strings.
  213.  
  214.   dup length 0 3 -1 roll
  215.     % Stack: file tag -mark- #refs #chars array
  216.   dup 4 1 roll {
  217.     dup type //cntdict exch get exec
  218.    } forall
  219.  
  220.     % Write the header.
  221.  
  222.     % Stack: file tag -mark- array1 ... array|dictN #refs #chars
  223.   counttomark 3 add -2 roll 4 1 roll
  224.     % Stack: -mark- array1 ... array|dictN tag #refs #chars file
  225.   dup counttomark 1 sub index length
  226.   4 index 3 bitshift 4 index add
  227.   (xxxxxxxx) .bosheader writestring
  228.  
  229.     % Write the objects per se.
  230.  
  231.   3 1 roll pop
  232.   counttomark 1 sub index length 3 bitshift exch
  233.   3 bitshift
  234.     % Stack: -mark- array1 ... array|dictN tag file ref# char#
  235.   counttomark 4 sub {
  236.     counttomark -1 roll dup 6 1 roll
  237.     dup type /dicttype eq {        % can't be first object
  238.       { 5 1 roll (xxxxxxxx) .bosobject
  239.     3 index exch writestring
  240.     4 -1 roll (xxxxxxxx) .bosobject
  241.     3 index exch writestring
  242.       } forall
  243.     } {
  244.       { (xxxxxxxx) .bosobject
  245.     dup 1 6 index put
  246.     3 index exch writestring
  247.     4 -1 roll pop 0 4 1 roll    % clear tag
  248.       } forall
  249.     } ifelse
  250.   } repeat
  251.  
  252.     % Write the strings and names.
  253.  
  254.   pop pop exch pop
  255.     % Stack: -mark- array1 ... array|dictN file
  256.   counttomark 1 sub {
  257.     counttomark -1 roll {
  258.         % The counting pass ensured that the keys and values
  259.         % of any dictionary must be writable objects.
  260.         % Hence, we are processing a dictionary iff
  261.         % the next-to-top stack element is not a file.
  262.       1 index type /filetype ne {
  263.     exch 2 index exch dup type //w2dict exch .knownget
  264.      { exec } { pop } ifelse pop
  265.       } if
  266.       dup type //w2dict exch .knownget { exec } { pop } ifelse
  267.     } forall
  268.   } repeat
  269.  
  270.     % Clean up.
  271.  
  272.     % Stack: -mark- file
  273.   pop pop
  274.  
  275. } odef
  276.  
  277. /printobject {        % <obj> <tag> printobject -
  278.   (%stdout) (w) file 2 index 2 index writeobject pop pop
  279. } odef
  280. /writeobject {        % <file> <obj> <tag> writeobject -
  281.   3 copy exch
  282.         % We must allocate the array in local VM
  283.         % to avoid a possible invalidaccess.
  284.   .currentglobal false .setglobal exch 1 array astore exch .setglobal
  285.   .writeobjects pop pop pop
  286. } odef
  287.  
  288. % Implement binary error message output.
  289. /.objectprinttest {        % <obj> .objectprinttest -
  290.         % This is a pseudo-operator so it will restore the stack
  291.         % if it gets an error.
  292.   0 0 2 index dup type //cntdict exch get exec pop pop
  293. } bind odef
  294. /.printerror {
  295.   $error /binary get .languagelevel 2 ge and {
  296.     currentobjectformat 0 ne {
  297.       [ /Error $error /errorname get $error /command get
  298.         % Convert the object with cvs if it isn't printable.
  299.       dup { .objectprinttest } .internalstopped {
  300.     pop 100 string cvs
  301.       } if
  302.       false ] 250 printobject
  303.     }
  304.     //.printerror    % known to be a procedure
  305.     ifelse
  306.   }
  307.   //.printerror        % known to be a procedure
  308.   ifelse
  309. } bind def
  310.  
  311. currentdict /cntdict .undef
  312. currentdict /w2dict .undef
  313.  
  314. % End of level2dict
  315.  
  316. end
  317. .setlanguagelevel
  318.