summaryrefslogtreecommitdiff
path: root/support/aurora/aurora.pro
blob: 03e9ef435f6f9c9fb26e5a935082c235ed26e891 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
%!
% Aurora: Colour Separation for Level 1 PostScript.
% Copyright: Graham Freeman, 1994.
%  gfreeman@cs.adfa.oz.au
% All Rights Reserved.
% This program may not be used for commercial purposes without
%  the consent of the author.  It may be freely transmitted 
%  provided this authorship and copyright notice is retained 
%  unmodified.
   systemdict /setpacking known 
      {/SavePacking currentpacking def true setpacking}if
/_c+stat 29 dict def
_c+stat begin
/Colour [0 0 0 1] def
/RGB [0 0 0] def
/AllColour [1 1 1 1] def
/setcolour {this type /arraytype eq
   {true 0 1 3 {dup Colour exch get AllColour 3 -1 roll get eq and 
    dup not {exit}if} for  % Is current colour == 1,1,1,1 ?
      {1}
      {0 0 1 3{this exch get dup mul add}for 
       0 0 1 3{Colour exch get dup mul add}for 
       0 0 1 3{dup Colour exch get this 3 -1 roll get mul add}for
       3 copy 3 1 roll mul sqrt dup 0 gt 
        {div 0.98 lt 
          {3{pop}repeat 0}
          {exch pop exch div dup 1 gt {pop 1}if} ifelse}
        {5{pop}repeat 0} ifelse
       }ifelse }
   {Colour this get}ifelse 
   1 exch sub setgray} bind def
/this 3 def
/transfer [{} dup dup dup] def
/screen [4 {currentscreen 3 array astore}repeat ] def    
% {dup mul exch dup mul add 1 exch sub}
/blackgenerate {1 exch sub dup .25 gt {pop 0}{4 mul 1 exch sub}ifelse} def
/undercolourremove {pop 0} def
/bound {dup 0 lt{pop 0}if dup 1 gt{pop 1}if} def
/_c+image [/image load dup type /operatortype ne {/exec cvx}if] cvx def
/I 0 def
/J 0 def
/mask 255 def
/nbit 8 def
/buffer 1 string def
/gsavestack 31 array def
/gsavepointer -1 def
/bitandchpos {I nbit mul dup 8 mod nbit add 8 exch sub  exch 8 idiv}def
/storebitval {
   mask and bitandchpos  % val bitpos chpos
   buffer 1 index get mask 3 index bitshift not and  %val bitpos chpos otherbits
   4 -2 roll bitshift or buffer 3 1 roll put }def
/buffercheck {dup length buffer length gt
   {dup length string /buffer exch def}if }def
/cmyk2blackvalue {
   this 1 eq {4 -1 roll} if  
   this 2 eq {4 -2 roll} if
   this 3 eq {4 1 roll} if
   pop pop pop} def
/compl {
   dup type dup /integertype eq exch /booleantype eq or {not}{
   dup type /stringtype eq {dup dup length 1 sub 0 1 3 -1 roll 
      {/J exch def dup J get not 255 and J exch put dup}for pop }if 
   }ifelse  }def
/rgb2cmyk {3 {1 exch sub 3 1 roll}repeat 
   min3 dup undercolourremove exch blackgenerate 5 1 roll
   3{dup 3 1 roll sub bound 5 1 roll}repeat pop} def
/max3 {2 index 2 index lt{1 index}{2 index}ifelse dup 2 index lt{pop dup}if} def
/min3 {2 index 2 index lt{2 index}{1 index}ifelse dup 2 index gt{pop dup}if} def
/hsb2rgb {3 -1 roll 6 mul dup 6 eq {pop 0}if dup floor cvi
   2 index 4 index 1 exch sub mul exch dup 2 mod 0 eq 
   {dup 4 -1 roll sub 1 add 5 -1 roll mul 1 exch sub 3 index mul 3 1 roll
      dup 0 eq{pop}{2 eq {3 1 roll}{3 -1 roll}ifelse}ifelse }
   {dup 4 -1 roll exch sub 5 -1 roll mul 1 exch sub 3 index mul exch
      dup 1 eq{pop 3 1 roll}{3 eq {3 -1 roll}if}ifelse }
   ifelse} def
/rgb2hsb {max3 4 1 roll min3 4 index exch sub 
   dup 5 index 0 eq {pop 0}{5 index div}ifelse 6 1 roll  dup 0 eq 
   {6 1 roll pop pop pop}
   {3 index 1 index eq {2 index 2 index sub exch div}
      {2 index 1 index eq {1 index 4 index sub exch div 2 add}
         {3 index 3 index sub exch div 4 add}ifelse}ifelse}
   ifelse  6 div 6 1 roll pop pop pop} def
/saveproc {_c+stat begin 
   /gsavepointer gsavepointer 1 add def 
   gsavepointer gsavestack length ge 
    {/gsavestack gsavestack gsavepointer 2 mul array dup 3 1 roll copy pop def}
    if    gsavestack gsavepointer get
   type /arraytype ne {gsavestack gsavepointer 7 array dup 0 4 array put
   dup 1 3 array put dup 2 4 array put dup 3 4 array put put} if 
   gsavestack gsavepointer get 
   dup 0 get Colour exch copy pop  dup 1 get RGB exch copy pop 
   dup 2 get screen exch copy pop  dup 3 get transfer exch copy pop
   dup 4 /undercolourremove load put  dup 5 /blackgenerate load put
   6 false put  end } def
end

/currentgray {_c+stat /Colour get aload pop
      4 1 roll .11 mul 4 1 roll .59 mul 4 1 roll .3 mul add add add
      1 exch sub dup 0 lt {pop 0}if} bind def
/currentcmykcolor {_c+stat /Colour get aload pop} bind def
/setcmykcolor {_c+stat begin Colour astore 
   aload pop 4 1 roll 3{3 index add dup 1 gt{pop 1}if 1 exch sub 3 1 roll}repeat
   4 -1 roll pop RGB astore pop  setcolour end} bind def
/setrgbcolor {_c+stat begin 3{2 index}repeat RGB astore pop 
   rgb2cmyk Colour astore pop setcolour end} def
/currentrgbcolor {_c+stat /RGB get aload pop} bind def
/sethsbcolor {_c+stat begin hsb2rgb setrgbcolor end} def
/currenthsbcolor {_c+stat begin RGB aload pop rgb2hsb end} def
/setcolorscreen {_c+stat begin 3 -1 0{screen exch get astore pop}for 
   this type /arraytype ne 
   {screen this get aload pop setscreen}if end} bind def
/currentcolorscreen {_c+stat begin 0 1 3 {screen exch get aload pop}for end} 
   bind def
/setcolortransfer [{_c+stat begin transfer astore pop this type /arraytype ne}
   /exec load
   [{transfer this get} /exec load 
      /settransfer load dup type /operatortype ne {/exec cvx}if] cvx 
   /if load /end load] 
   cvx def
/settransfer [{ _c+stat begin 0 1 3 {transfer exch 2 index put}for end} 
   /exec load 
   [ /settransfer load dup type /operatortype ne {/exec cvx}if ] cvx 
   /exec load ] cvx   def
/currentcolortransfer {_c+stat /transfer get aload pop} bind def
/setblackgeneration {_c+stat /blackgenerate 3 -1 roll put} bind def
/currentblackgeneration {_c+stat /blackgenerate get} bind def
/setundercolorremoval {_c+stat /undercolourremove 3 -1 roll put} bind def
/currentundercolorremoval {_c+stat /undercolourremove get} bind def
/colorimage {_c+stat begin dup 1 eq 
                                             % 1
   {pop pop this type /arraytype eq
      {(Compound colour cannot be handled with "colorimage"\n)print stop}if 
      this 3 ne 
      {4 array dup 0 4 -1 roll put dup 1 /exec load put dup
         2 {_c+stat begin buffercheck dup length 1 sub 0 1 3 -1 roll
            {buffer exch 255 put}for length buffer exch 0 exch getinterval end} 
         bind put 
         dup 3 /exec load put cvx} if
   }{3 eq
                                             % 3
   {{this type /arraytype eq                 % true 3
      {(Compound colour cannot be handled with "colorimage"\n)print stop}if 
      4 index 8 ne                                    % not 8 bits
      {4 index {dup 1 eq {exit}if dup 2 mod 0 ne 
          {(Only 1,2,4 or 8-bit images can be handled\n)print stop}if 2 idiv}
        loop pop
       4 index 1 sub 1 exch {1 bitshift 1 or}repeat _c+stat /mask 3 -1 roll put
       4 index _c+stat /nbit 3 -1 roll put
       8 array dup 
       2 -1 0 {2 mul dup 2 index exch 6 -1 roll put 1 add /exec load put dup}for
       6 {_c+stat begin buffercheck 0 1 2 index length 8 mul nbit idiv 1 sub 
          {/I exch def I nbit mul dup 8 mod nbit add 8 sub exch 8 idiv 
           3{4 index 1 index get 2 index bitshift mask and mask div 3 1 roll}
           repeat                                          % RGB values found
           pop pop rgb2cmyk cmyk2blackvalue mask mul round cvi not mask and
           storebitval}for 
          pop pop pop buffer 0 I 1 add nbit mul 8 idiv getinterval end} bind put
       dup 7 /exec load put cvx}
      {8 array dup                                    % 8 bits
       2 -1 0 {2 mul dup 2 index exch 6 -1 roll put 1 add /exec load put dup}for
       6 {_c+stat begin buffercheck 0 1 2 index length 1 sub 
         {/I exch def 3{2 index I get 255 div}repeat 
          rgb2cmyk  cmyk2blackvalue 255 mul round cvi not 255 and
          buffer I 3 -1 roll put}for 
         pop pop pop buffer 0 I 1 add getinterval end} bind put 
      dup 7 /exec load put cvx}ifelse}
                                             % false 3
    {this type /arraytype eq
      {(Compound colour cannot be handled with "colorimage"\n)print stop}if 
      2 index 8 ne                                    % not 8 bits
      {2 index {dup 1 eq {exit}if dup 2 mod 0 ne 
          {(Only 1,2,4 or 8-bit images can be handled\n)print stop}if 2 idiv}
        loop pop
       2 index 1 sub 1 exch {1 bitshift 1 or}repeat _c+stat /mask 3 -1 roll put
       2 index _c+stat /nbit 3 -1 roll put
       4 array dup 0 4 -1 roll put dup 1 /exec load put dup
       2 {_c+stat begin buffercheck dup length 8 mul nbit idiv 3 idiv  /I 0 def 
          {dup 0 1 2{I 3 mul add nbit mul dup 8 mod nbit add 8 sub 
           exch 8 idiv 2 index exch get exch bitshift mask and mask div exch}for 
                                                           % RGB values found
           pop rgb2cmyk cmyk2blackvalue mask mul round cvi not mask and storebitval 
           /I I 1 add def}repeat 
          pop buffer 0 I nbit mul 8 idiv getinterval end} bind put 
       dup 3 /exec load put cvx}
      {4 array dup 0 4 -1 roll put dup 1 /exec load put dup  % 8 bits
       2 {_c+stat begin buffercheck dup length 3 idiv  /I 0 def /J 0 def
         {dup J get 255 div 1 index J 1 add get 255 div 
          2 index J 2 add get 255 div rgb2cmyk cmyk2blackvalue 255 mul round cvi
          not 255 and buffer I 3 -1 roll put    /I I 1 add def /J J 3 add def}repeat
         pop buffer 0 I getinterval end} 
       bind put dup 3 /exec load put cvx}ifelse}ifelse}
                                             % 4
   {{this type /arraytype eq                 % true 4
      {(Compound colour cannot be handled with "colorimage"\n)print stop}if 
       5 index {dup 1 eq {exit}if dup 2 mod 0 ne 
          {(Only 1,2,4 or 8-bit images can be handled\n)print stop}if 2 idiv}
        loop pop
       10 array dup 0 7 -1 roll put dup 1 /exec load put
       dup 2 6 -1 roll put dup 3 /exec load put dup 4 5 -1 roll put
       dup 5 /exec load put dup 6 4 -1 roll put dup 7 /exec load put
       dup 8 {_c+stat begin cmyk2blackvalue buffercheck buffer copy compl end} 
          bind put 
       dup 9 /exec load put cvx}
                                             % false 4
    {this type /arraytype eq 
      {(Compound colour cannot be handled with "colorimage"\n)print stop}if 
      2 index 8 ne                                    % not 8 bits
      {2 index {dup 1 eq {exit}if dup 2 mod 0 ne 
          {(Only 1,2,4 or 8-bit images can be handled\n)print stop}if 2 idiv}
        loop pop
       2 index 1 sub 1 exch {1 bitshift 1 or}repeat _c+stat /mask 3 -1 roll put
       2 index _c+stat /nbit 3 -1 roll put
       4 array dup 0 4 -1 roll put dup 1 /exec load put dup
       2 {_c+stat begin buffercheck dup length 8 mul nbit idiv 4 idiv  /I 0 def 
          {dup 0 1 3{I 4 mul add nbit mul dup 8 mod nbit add 8 sub 
           exch 8 idiv 2 index exch get exch bitshift mask and exch}for 
          pop cmyk2blackvalue not  storebitval    /I I 1 add def}repeat
          pop buffer 0 I nbit mul 8 idiv getinterval end} bind put 
       dup 3 /exec load put cvx}
      {4 array dup 0 4 -1 roll put dup 1 /exec load put dup  % 8 bits
       2 {_c+stat begin buffercheck dup length 4 idiv  /I this def /J 0 def
         {dup I get not 255 and buffer J 3 -1 roll put /I I 4 add def /J J 1 add def}repeat
         pop buffer 0 J getinterval end} bind put 
       dup 3 /exec load put cvx}ifelse}
    ifelse}ifelse}ifelse           
   end _c+stat /_c+image get exec} def
/setgray {_c+stat begin dup dup dup RGB astore pop
   1 exch sub 0 0 0 4 -1 roll Colour astore pop setcolour    end} bind def
/image [{_c+stat begin 
   this type /arraytype eq
    %  {(Compound colour cannot be handled with "image"\n)print stop}if 
   this 3 ne   or
   { 4 array dup 0 4 -1 roll put dup 1 /exec load put dup
      2 {_c+stat begin buffercheck dup length 1 sub 0 1 3 -1 roll
         {buffer exch 255 put}for length buffer exch 0 exch getinterval end} bind put 
      dup 3 /exec load put cvx} if 
   end} /exec load /image load dup type /operatortype ne {/exec cvx}if] cvx def
/gsave [_c+stat /saveproc get  /exec load
   /gsave load dup type /operatortype ne {/exec load}if ] cvx def
/grestore [/grestore load dup type /operatortype ne {/exec cvx}if
   {_c+stat begin   gsavepointer 0 ge 
         dup {gsavestack gsavepointer get 6 get and}if
      {gsavestack gsavepointer get
      dup 0 get Colour copy pop  dup 1 get RGB copy pop  
      dup 2 get screen copy pop  dup 3 get transfer copy pop  
      dup 4 get /undercolourremove exch def  5 get /blackgenerate exch def
      /gsavepointer gsavepointer 1 sub def} if  end} 
   /exec load   ] cvx def
/grestoreall [/grestoreall load dup type /operatortype ne {/exec cvx}if
   {_c+stat begin   gsavepointer -1 0 
      {/gsavepointer exch def gsavestack gsavepointer get 6 get {exit}if}for
      gsavepointer 0 ge 
      { gsavestack gsavepointer get      dup 0 get Colour copy pop  
         dup 1 get RGB copy pop  dup 2 get screen copy pop
         dup 3 get transfer copy pop  dup 4 get /undercolourremove exch def
         dup 5 get /blackgenerate exch def  
         6 get not {/gsavepointer -1 def}if  } if
    end} 
   /exec load   ] cvx def
/save [_c+stat /saveproc get   /exec load
   {_c+stat begin gsavestack gsavepointer get 6 true put end} /exec load
   /save load dup type /operatortype ne {/exec cvx}if] cvx def
/restore [/restore load dup type /operatortype ne {/exec cvx}if 
   {_c+stat begin   gsavepointer 0 ge 
      {gsavestack gsavepointer get
      dup 0 get Colour copy pop  dup 1 get RGB copy pop  
      dup 2 get screen copy pop  dup 3 get transfer copy pop  
      dup 4 get /undercolourremove exch def  5 get /blackgenerate exch def
      /gsavepointer gsavepointer 1 sub def} if  end} /exec load
   ]cvx def
/initgraphics [/initgraphics load dup type /operatortype ne {/exec cvx}if
   {0 setgray} /exec load   ] cvx def

systemdict /setpacking known {SavePacking setpacking}if
% End of Aurora: colour separation prelude