diff options
Diffstat (limited to 'Master/tlpkg')
| -rw-r--r-- | Master/tlpkg/tlgs/Resource/Init/gs_init.ps | 11 | ||||
| -rw-r--r-- | Master/tlpkg/tlgs/lib/cat.ps | 74 | ||||
| -rw-r--r-- | Master/tlpkg/tlgs/lib/font2pcl.ps | 604 | ||||
| -rw-r--r-- | Master/tlpkg/tlgs/lib/jobseparator.ps | 3 | ||||
| -rw-r--r-- | Master/tlpkg/tlgs/lib/stcinfo.ps | 794 | ||||
| -rw-r--r-- | Master/tlpkg/tlgs/lib/stcolor.ps | 169 |
6 files changed, 0 insertions, 1655 deletions
diff --git a/Master/tlpkg/tlgs/Resource/Init/gs_init.ps b/Master/tlpkg/tlgs/Resource/Init/gs_init.ps index f6a89521bae..0596e5e28c4 100644 --- a/Master/tlpkg/tlgs/Resource/Init/gs_init.ps +++ b/Master/tlpkg/tlgs/Resource/Init/gs_init.ps @@ -173,8 +173,6 @@ currentdict /OUTPUTFILE known % obsolete currentdict /OUTPUTFILE .undef } if currentdict /QUIET known /QUIET exch def -currentdict /WINKANJI known /WINKANJI exch def -currentdict /NOWINKANJI known /NOWINKANJI exch def % DELAYSAFER is effectively the same as newer NOSAFER currentdict /DELAYSAFER known { /DELAYSAFER //true def /NOSAFER //true def } if /SAFER currentdict /NOSAFER known { @@ -2255,15 +2253,6 @@ SAFER { .setsafeglobal } if % procedures are writable. //false setpacking -% Load the kanji font environment. -NOWINKANJI not { - WINKANJI { - (metrics2.ps) runlibfile - (kinit.ps) runlibfile - 1048576 setcachelimit - } if -} if - (END INIT) VMDEBUG /.currentuserparams where { diff --git a/Master/tlpkg/tlgs/lib/cat.ps b/Master/tlpkg/tlgs/lib/cat.ps deleted file mode 100644 index 1dec040db76..00000000000 --- a/Master/tlpkg/tlgs/lib/cat.ps +++ /dev/null @@ -1,74 +0,0 @@ -% Copyright (C) 2001-2012 Artifex Software, Inc. -% All Rights Reserved. -% -% This software is provided AS-IS with no warranty, either express or -% implied. -% -% This software is distributed under license and may not be copied, -% modified or distributed except as expressly authorized under the terms -% of the license contained in the file LICENSE in this distribution. -% -% Refer to licensing information at http://www.artifex.com or contact -% Artifex Software, Inc., 7 Mt. Lassen Drive - Suite A-134, San Rafael, -% CA 94903, U.S.A., +1(415)492-9861, for further information. -% -% -% $Id: cat.ps 8331 2008-02-05 11:07:00Z kens $ -% -% Appends one file to another. Primarily used to overcome the -% 'copy' limitation of Windows command shell for ps2epsi -% -% the files to be appended are given by the environament -% variables %infile% and %outfile%. %infile% is appended to -% %outfile% -% - -/datastring 1024 string def - -{ - (outfile) getenv - { - /outfilename exch def - (infile) getenv - { - /infilename exch def - - infilename status - { - pop pop pop pop outfilename status - { - pop pop pop pop - infilename (r) file /infile exch def - outfilename (a+) file /outfile exch def - { - infile datastring readstring - { - outfile exch writestring - } - { - dup length 0 gt - {outfile exch writestring} {pop} ifelse - exit - } ifelse - } loop - infile closefile - outfile closefile - } - { - (Failed to find file ) print outfilename == - } ifelse - } - { - (Failed to find file ) print infilename == - } ifelse - } - { - (Couldn't find %infile% environment variable) == - } ifelse - } - { - (Couldn't find %outfile% environment variable) == - } - ifelse -} bind -exec diff --git a/Master/tlpkg/tlgs/lib/font2pcl.ps b/Master/tlpkg/tlgs/lib/font2pcl.ps deleted file mode 100644 index bf0c903d6b1..00000000000 --- a/Master/tlpkg/tlgs/lib/font2pcl.ps +++ /dev/null @@ -1,604 +0,0 @@ -% Copyright (C) 2001-2012 Artifex Software, Inc. -% All Rights Reserved. -% -% This software is provided AS-IS with no warranty, either express or -% implied. -% -% This software is distributed under license and may not be copied, -% modified or distributed except as expressly authorized under the terms -% of the license contained in the file LICENSE in this distribution. -% -% Refer to licensing information at http://www.artifex.com or contact -% Artifex Software, Inc., 7 Mt. Lassen Drive - Suite A-134, San Rafael, -% CA 94903, U.S.A., +1(415)492-9861, for further information. -% - -% font2pcl.ps -% Write out a font as a PCL bitmap font. - -/pcldict 60 dict def - -% Write out the current font as a PCL bitmap font. -% The current transformation matrix defines the font size and orientation. - -/WriteResolution? false def % true=use "resolution bound font" format, - % false=use older format - -/LJ4 false def % true=use LJ4 Typeface code - % false=use LJIIP/IID/IIIx Typeface code - -pcldict begin % internal procedures - -/findstring % <string> <substring> findstring <bool> - { search { pop pop pop true } { pop false } ifelse - } def - - % Determine which set of keywords is present in a string. - % The last keyword set must be empty. - -/keysearch % <string> <array of arrays of keywords> keysearch <index> - { 0 1 2 index length 1 sub - { 2 copy get true exch - { % Stack: <string> <a.a.k.> <index> <bool> <keyword> - 4 index exch findstring and - } - forall - { 0 exch getinterval exit - } - if pop - } - for - exch pop length % invalid index if missing - } def - - % Determine the device height of a string in quarter-dots. - -/charheight % <string> charheight <int> - { gsave newpath 0 0 moveto false charpath - pathbbox exch pop exch sub exch pop 0 exch grestore - dtransform add abs 4 mul cvi - } def - - % Compute an integer version of the transformed FontBBox. - -/inflate % <num> inflate <num> - { dup 0 gt { ceiling } { floor } ifelse - } def -/ixbbox % - ixbbox <llx> <lly> <urx> <ury> - { /FontBBox load aload pop % might be executable or literal - 4 2 roll transform exch truncate cvi exch truncate cvi - 4 2 roll transform exch inflate cvi exch inflate cvi - } def - - % Determine the original font of a possibly transformed font. - % Since some badly behaved PostScript files construct transformed - % fonts "by hand", we can't just rely on the OrigFont pointers. - % Instead, if a font with the given name exists, and if its - % entries for FontType and UniqueID match those of the font we - % obtain by following the OrigFont chain, we use that font. - -/origfont - { { dup /OrigFont known not { exit } if /OrigFont get } loop - FontDirectory 1 index /FontName get .knownget - { % Stack: origfont namedfont - 1 index /FontType get 1 index /FontType get eq - { 1 index /UniqueID .knownget - { 1 index /UniqueID .knownget - { eq { exch } if } - { pop } - ifelse - } - if - } - if pop - } - if - } def - - % Determine the bounding box of the current device's image. - % Free variables: row, zerow. - -/devbbox % <rw> <rh> devbbox <ymin> <ymax1> <xmin> <xmax1> - { % Find top and bottom whitespace. - dup - { dup 0 eq { exit } if 1 sub - dup currentdevice exch row copyscanlines - zerow ne { 1 add exit } if - } - loop % ymax1 - 0 - { 2 copy eq { exit } if - dup currentdevice exch row copyscanlines - zerow ne { exit } if - 1 add - } - loop % ymin - exch - % Find left and right whitespace. - 3 index 0 - % Stack: rw rh ymin ymax1 xmin xmax1 - 3 index 1 4 index 1 sub - { currentdevice exch row copyscanlines .findzeros - exch 4 1 roll .max 3 1 roll .min exch - } - for % xmin xmax1 - % Special check: xmin > xmax1 if height = 0 - 2 copy gt { exch pop dup } if - 6 -2 roll pop pop - - } def - - % Write values on outfile. - - /w1 { 255 and outfile exch write } def - /w2 { dup -8 bitshift w1 w1 } def - /wbyte % <byte> <label> wbyte - { VDEBUG { print ( =byte= ) print dup == flush } { pop } ifelse w1 - } def - /wword % <word16> <label> wword - { VDEBUG { print ( =word= ) print dup == flush } { pop } ifelse w2 - } def - /wdword % <word32> <label> wdword - { VDEBUG { print ( =dword= ) print dup == flush } { pop } ifelse - dup -16 bitshift w2 w2 - } def - -/style.posture.keys - [ { (Italic) } { (Oblique) } - { } - ] def -/style.posture.values <010100> def - -/style.appearance.width.keys - [ { (Ultra) (Compressed) } - { (Extra) (Compressed) } - { (Extra) (Condensed) } - { (Extra) (Extended) } - { (Extra) (Expanded) } - { (Compressed) } - { (Condensed) } - { (Extended) } - { (Expanded) } - { } - ] def -/style.appearance.width.values <04030207070201060600> def - -/width.type.keys - [ { (Ultra) (Compressed) } - { (Extra) (Compressed) } - { (Extra) (Condensed) } - { (Extra) (Expanded) } - { (Compressed) } - { (Condensed) } - { (Expanded) } - { } - ] def -/width.type.values <fbfcfd03fdfe0200> def - -/stroke.weight.keys - [ { (Ultra) (Thin) } - { (Ultra) (Black) } - { (Extra) (Thin) } - { (Extra) (Light) } - { (Extra) (Bold) } - { (Extra) (Black) } - { (Demi) (Light) } - { (Demi) (Bold) } - { (Semi) (Light) } - { (Semi) (Bold) } - { (Thin) } - { (Light) } - { (Bold) } - { (Black) } - { } - ] def -/stroke.weight.values <f907fafc0406fe02ff01fbfd030500> def - -/vendor.keys - [ { (Agfa) } - { (Bitstream) } - { (Linotype) } - { (Monotype) } - { (Adobe) } - { } - ] def -/vendor.default.index 4 def % might as well be Adobe -/old.vendor.values <020406080a00> def -/new.vendor.values <010203040500> def -/vendor.initials (CBLMA\000) def - -currentdict readonly end pop % pcldict - -% Convert and write a PCL font for the current font and transformation. - -% Write the font header. We split this off only to avoid overflowing -% the limit on the maximum size of a procedure. -% Free variables: outfile uury u0y rw rh orientation uh ully -/writefontheader - { outfile (\033\)s) writestring - outfile 64 WriteResolution? { 4 add } if - Copyright length add write==only - outfile (W) writestring - WriteResolution? { 20 68 } { 0 64 } ifelse - (Font Descriptor Size) wword - (Header Format) wbyte - 1 (Font Type) wbyte - FullName style.posture.keys keysearch style.posture.values exch get - FullName style.appearance.width.keys keysearch - style.appearance.width.values exch get 4 mul add - PaintType 2 eq { 32 add } if - /style exch def - style -8 bitshift (Style MSB) wbyte - 0 (Reserved) wbyte - /baseline uury 1 sub u0y sub def - baseline (Baseline Position) wword - rw (Cell Width) wword - rh (Cell Height) wword - orientation (Orientation) wbyte - FontInfo /isFixedPitch .knownget not { false } if - { 0 } { 1 } ifelse (Spacing) wbyte - % Use loop/exit to fake a multiple-exit block. - { Encoding StandardEncoding eq { 10 (J) exit } if - Encoding ISOLatin1Encoding eq { 11 (J) exit } if - Encoding SymbolEncoding eq { 19 (M) exit } if - Encoding DingbatsEncoding eq { 10 (L) exit } if -% (Warning: unknown Encoding, using ISOLatin1.\n) print flush - 11 (J) exit - } - loop - 0 get 64 sub exch 32 mul add (Symbol Set) wword - ( ) stringwidth pop 0 dtransform add abs 4 mul - /pitch exch def - pitch cvi (Pitch) wword - uh 4 mul (Height) wword % Height - (x) charheight (x-Height) wword - FullName width.type.keys keysearch - width.type.values exch get (Width Type) wbyte - style 255 and (Style LSB) wbyte - FullName stroke.weight.keys keysearch - stroke.weight.values exch get (Stroke Weight) wbyte - FullName vendor.keys keysearch - dup vendor.initials exch get 0 eq - { % No vendor in FullName, try Notice - pop Copyright vendor.keys keysearch - dup vendor.initials exch get 0 eq { pop vendor.default.index } if - } - if - /vendor.index exch def - 0 (Typeface LSB) wbyte % punt - 0 (Typeface MSB) wbyte % punt - 0 (Serif Style) wbyte % punt - 2 (Quality) wbyte - 0 (Placement) wbyte - gsave FontMatrix concat rot neg rotate - /ulwidth - FontInfo /UnderlineThickness .knownget - { 0 exch dtransform exch pop abs } - { resolution 100 div } - ifelse def - FontInfo /UnderlinePosition .knownget - { 0 exch transform exch pop negY ulwidth 2 div add } - { ully ulwidth add } - ifelse u0y sub - round cvi 1 .max 255 .min (Underline Position) wbyte - ulwidth round cvi 1 .max 255 .min (Underline Thickness) wbyte - grestore - uh 1.2 mul 4 mul cvi (Text Height) wword - (average lowercase character) dup stringwidth - pop 0 dtransform add abs - exch length div 4 mul cvi (Text Width) wword - 0 - { dup Encoding exch get /.notdef ne { exit } if - 1 add - } - loop (First Code) wword - 255 - { dup Encoding exch get /.notdef ne { exit } if - 1 sub - } - loop (Last Code) wword - pitch dup cvi sub 256 mul cvi (Pitch Extended) wbyte - 0 (Height Extended) wbyte - 0 (Cap Height) wword % (default) - currentfont /UniqueID known { UniqueID } { 0 } ifelse - 16#c1000000 add (Font Number (Adobe UniqueID)) wdword - FontName length 16 .max string - dup FontName exch cvs pop - outfile exch 0 16 getinterval writestring % Font Name - WriteResolution? - { resolution dup (X Resolution) wword (Y Resolution) wword - } - if - outfile Copyright writestring % Copyright - } def - -/writePCL % <fontfile> <resolution> writePCL - - { - save - currentfont begin - pcldict begin - 80 dict begin % allow for recursion - /saved exch def - /resolution exch def - /outfile exch def - matrix currentmatrix dup 4 0 put dup 5 0 put setmatrix - - % Supply some default values so we don't have to check later. - - currentfont /FontInfo known not { /FontInfo 1 dict def } if - currentfont /FontName known not { /FontName () def } if - /Copyright FontInfo /Notice .knownget not { () } if def - /FullName - FontInfo /FullName .knownget not - { FontName dup length string cvs } - if def - - % Determine the original font, and its relationship to this one. - - /OrigFont currentfont origfont def - /OrigMatrix OrigFont /FontMatrix get def - /OrigMatrixInverse OrigMatrix matrix invertmatrix def - /ScaleMatrix matrix currentfont OrigFont ne - { FontMatrix exch OrigMatrixInverse exch concatmatrix - } if - def - /CurrentScaleMatrix - matrix currentmatrix - matrix defaultmatrix - dup 0 get 1 index 3 get mul 0 lt - 1 index dup 1 get exch 2 get mul 0 gt or - /flipY exch def - dup invertmatrix - dup concatmatrix - def - /negY flipY { {neg} } { {} } ifelse def - - % Print debugging information. - - /CDEBUG where { pop } { /CDEBUG false def } ifelse - /VDEBUG where { pop } { /VDEBUG false def } ifelse - CDEBUG { /VDEBUG true def } if - DEBUG - { (currentmatrix: ) print matrix currentmatrix == - (defaultmatrix: ) print matrix defaultmatrix == - (flipY: ) print flipY == - (scaling matrix: ) print CurrentScaleMatrix == - (FontMatrix: ) print FontMatrix == - (FontBBox: ) print /FontBBox load == - currentfont OrigFont ne - { OrigFont /FontName .knownget { (orig FontName: ) print == } if - (orig FontMatrix: ) print OrigMatrix == - } if - currentfont /ScaleMatrix .knownget { (ScaleMatrix: ) print == } if - gsave - FontMatrix concat - (combined matrix: ) print matrix currentmatrix == - grestore - flush - } if - - % Determine the orientation. - - ScaleMatrix matrix currentmatrix dup concatmatrix - 0 1 3 - { 1 index 1 get 0 eq 2 index 2 get 0 eq and 2 index 0 get 0 gt and - { exit } if - pop -90 matrix rotate exch dup concatmatrix - } - for - dup type /integertype ne - { (Only rotations by multiples of 90 degrees are supported:\n) print - == flush - saved end end end restore stop - } - if - /orientation exch def - /rot orientation 90 mul def - DEBUG { (orientation: ) print orientation == flush } if - - dup dup 0 get exch 3 get negY sub abs 0.5 ge - { (Only identical scaling in X and Y is supported:\n) print - exch flipY 3 array astore == -% -% .devicename has been deprecated -% currentdevice .devicename == -% - currentpagedevice /Name get == - matrix defaultmatrix == flush - saved end end end restore stop - } - if pop - - % Determine the font metrics, in the PCL character coordinate system, - % which has +Y going towards the top of the page. - - gsave - FontMatrix concat - 0 0 transform - negY round cvi /r0y exch def - round cvi /r0x exch def - ixbbox - negY /rury exch def /rurx exch def - negY /rlly exch def /rllx exch def - /rminx rllx rurx .min def - /rminy rlly negY rury negY .min def - /rw rurx rllx sub abs def - /rh rury rlly sub abs def - gsave rot neg rotate - 0 0 transform - negY round cvi /u0y exch def - round cvi /u0x exch def - ixbbox - negY /uury exch def /uurx exch def - negY /ully exch def /ullx exch def - /uw uurx ullx sub def - /uh uury ully sub def - grestore - DEBUG - { (rmatrix: ) print matrix currentmatrix == - (rFontBBox: ) print [rllx rlly rurx rury] == - (uFontBBox: ) print [ullx ully uurx uury] == - flush - } if - grestore - - % Disable the character cache, to avoid excessive allocation - % and memory sandbars. - - mark cachestatus /upper exch def - cleartomark 0 setcachelimit - - % Write the font header. - - writefontheader - - % Establish an image device for rasterizing characters. - - matrix currentmatrix - dup 4 rminx neg put - dup 5 rminy neg put - % Round the width up to a multiple of 8 - % so we don't get garbage bits in the last byte of each row. - rw 7 add -8 and rh <ff 00> makeimagedevice - /cdevice exch def - nulldevice % prevent page device switching - cdevice setdevice - - % Rasterize each character in turn. - - /raster rw 7 add 8 idiv def - /row raster string def - /zerow row length string def - 0 1 Encoding length 1 sub - { /cindex exch def - Encoding cindex get /.notdef ne - { VDEBUG { Encoding cindex get == flush } if - erasepage initgraphics - 0 0 moveto currentpoint transform add - ( ) dup 0 cindex put show - currentpoint transform add exch sub round cvi - /cwidth exch abs def - rw rh devbbox - VDEBUG - { (image bbox: ) print 4 copy 4 2 roll 4 array astore == flush - } if - % Save the device bounding box. - % Note that this is in current device coordinates, - % not PCL (right-handed) coordinates. - /bqx exch def /bpx exch def /bqy exch def /bpy exch def - % Re-render with the character justified to (0,0). - % This may be either the lower left or the upper left corner. - bpx neg bpy neg idtransform moveto - erasepage - VDEBUG { (show point: ) print [ currentpoint transform ] == flush } if - ( ) dup 0 cindex put show - % Find the bounding box. Note that xmin and ymin are now 0, - % xmax1 = xw, and ymax1 = yh. - rw rh devbbox - /xw exch def - % xmin or ymin can be non-zero only if the character is blank. - xw 0 eq - { pop } - { dup 0 ne { (Non-zero xmin! ) print = } { pop } ifelse } - ifelse - /yh exch def - yh 0 eq - { pop } - { dup 0 ne { (Non-zero ymin! ) print = } { pop } ifelse } - ifelse - - /xbw xw 7 add 8 idiv def - /xright raster 8 mul xw sub def - % Write the Character Code command. - outfile (\033*c) writestring - outfile cindex write==only - outfile (E) writestring - % Write the Character Definition command. - outfile (\033\(s) writestring - yh xbw mul 16 add - outfile exch write=only - % Record the character position for the .PCM file. - /cfpos outfile fileposition 1 add def - outfile (W\004\000\016\001) writestring - orientation (Orientation) wbyte 0 (Reserved) wbyte - rminx bpx add r0x sub (Left Offset) wword - flipY { rminy bpy add neg } { rminy bqy add } ifelse r0y sub - (Top Offset) wword - xw (Character Width) wword - yh (Character Height) wword - cwidth orientation 2 ge { neg } if 4 mul (Delta X) wword - % Write the character data. - flipY { 0 1 yh 1 sub } { yh 1 sub -1 0 } ifelse - { cdevice exch row copyscanlines - 0 xbw getinterval - CDEBUG - { dup - { 8 - { dup 128 ge { (+) } { (.) } ifelse print - 127 and 1 bitshift - } - repeat pop - } - forall (\n) print - } - if - outfile exch writestring - } - for - } - { /bpx 0 def /bpy 0 def /bqx 0 def /bqy 0 def - /cwidth 0 def - /cfpos 0 def - } - ifelse - - } - for - - % Wrap up. - - upper setcachelimit - outfile closefile - - nulldevice % prevent page device switching - saved end end end restore - - } def - -% Provide definitions for testing with older or non-custom interpreters. - -/.findzeros where { pop (%END) .skipeof } if -/.findzeros - { userdict begin /zs exch def /zl zs length def - 0 { dup zl ge { exit } if dup zs exch get 0 ne { exit } if 1 add } loop - zl { dup 0 eq { exit } if dup 1 sub zs exch get 0 ne { exit } if 1 sub } loop - exch 3 bitshift exch 3 bitshift - 2 copy lt - { exch zs 1 index -3 bitshift get - { dup 16#80 and 0 ne { exit } if exch 1 add exch 1 bitshift } loop pop - exch zs 1 index -3 bitshift 1 sub get - { dup 1 and 0 ne { exit } if exch 1 sub exch -1 bitshift } loop pop - } - if end - } bind def -%END - -/write=only where { pop (%END) .skipeof } if -/w=s 128 string def -/write=only - { w=s cvs writestring - } bind def -%END - -%**************** Test -/PCLTEST where { - pop - /DEBUG true def - /CDEBUG true def - /VDEBUG true def - /Times-Roman findfont 10 scalefont setfont - (t.pcf) (w) file - 300 72 div dup scale - 300 writePCL - flush quit -} if diff --git a/Master/tlpkg/tlgs/lib/jobseparator.ps b/Master/tlpkg/tlgs/lib/jobseparator.ps deleted file mode 100644 index fbb6920842f..00000000000 --- a/Master/tlpkg/tlgs/lib/jobseparator.ps +++ /dev/null @@ -1,3 +0,0 @@ -% Execute the "real" system version of the ^D to separate jobs -% when -dJOBDSERVER is being used. -<04> cvn .systemvar exec diff --git a/Master/tlpkg/tlgs/lib/stcinfo.ps b/Master/tlpkg/tlgs/lib/stcinfo.ps deleted file mode 100644 index d39b182d4fe..00000000000 --- a/Master/tlpkg/tlgs/lib/stcinfo.ps +++ /dev/null @@ -1,794 +0,0 @@ -% Copyright (C) 2001-2012 Artifex Software, Inc. -% All Rights Reserved. -% -% This software is provided AS-IS with no warranty, either express or -% implied. -% -% This software is distributed under license and may not be copied, -% modified or distributed except as expressly authorized under the terms -% of the license contained in the file LICENSE in this distribution. -% -% Refer to licensing information at http://www.artifex.com or contact -% Artifex Software, Inc., 7 Mt. Lassen Drive - Suite A-134, San Rafael, -% CA 94903, U.S.A., +1(415)492-9861, for further information. -% - -% stcinfo.ps -% Epson Stylus-Color Printer-Driver - -% The purpose of this file is to print & show Parameters of the -% stcolor-driver. If not run on ghostscript/stcolor, it prints -% something like a color-chart. - -% use either existing STCinfo-dictionary, retrieve new one or create dummy - -statusdict begin product end -dup (Ghostscript) eq 1 index (Artifex Ghostscript) eq or -exch (AFPL Ghostscript) eq or{ - - currentdevice getdeviceprops .dicttomark - dup /Name get (stcolor) eq /STCi_onstc exch def - /STCinfo where {/STCinfo get exch pop} if - /STCinfo exch def - -}{ - - /STCinfo 10 dict def - STCinfo begin /Name (unknown) def end - /STCi_onstc false def - -}ifelse - -% Next Block are procedures to generate the color-triangles. -% you may wish to separate them, just look ahead for the name -% given in the next line to achieve that. -% Begin: colortri_procedures - -% Plot the CIE-XY-triangle (or something like that) - -% /colortri_mat Conversion matrix RGB -> XYZ -% /colortri_bg procedure, that takes X/Y-Values and delivers the -% "background color" as RGB-Values, default is: -% {pop pop 0.85 dup dup} - -% The default matrix was taken from: -% Color spaces FAQ - David Bourgin -% Date: 15/6/94 (items 5.3 and 6 updated) -% Last update: 29/6/94 - - /colortri_mat [ % RGB -> CIE XYZitu601-1 (D65) - 0.4306 0.3415 0.1784 - 0.2220 0.7067 0.0713 - 0.0202 0.1295 0.9394 - ] def - - /colortri_bg {pop pop 0.85 dup dup} bind def - -% +---------------------------------------------------------------------+ -% | Besides from fixing bugs, nothing should be changed below this line | -% +---------------------------------------------------------------------+ - -% Arbitrary operation on a pair of vectors, *CHANGES* 1st. -% invoke: Vaccu Vop op vop - /vop { - bind 0 1 3 index length 1 sub { - 3 index 1 index get 3 index 2 index get 3 index exec 4 index 3 1 roll put - } for pop pop - } bind def - - /vsub { {sub} vop } bind def % subtract two vectors - /vmul { {mul} vop } bind def % multiply two vectors - -% Compute sum of vectors elements - /vsum {0.0 exch{add}forall} bind def - -% Sum up products of elements - /veqn { [ 3 -1 roll {} forall ] exch vmul vsum } bind def - -% Find index of |maximum| in array - /imax { - dup 0 get abs 0 exch % array i v[i] - 1 1 4 index length 1 sub { - 3 index 1 index get abs dup 3 index gt {4 2 roll}if pop pop - } for - 3 -1 roll pop - } bind def - -% Procedure to *CHANGE* RGB-Values into XYZ-Values - /rgb2xyz { - 0 3 6 { colortri_mat exch 3 getinterval 1 index veqn exch } for astore - } bind def - -% Procedure to *CHANGE* transform rgb->xy - /rgb2xy { - rgb2xyz - dup 0 get 1 index 1 get 2 index vsum % XYZ X Y sum - dup 0 ne { - exch 1 index div 3 1 roll div % XYZ y x - 2 index exch 0 exch put % xYZ y - 1 index exch 1 exch put % xyZ - }{ - pop pop pop dup 0 0 put dup 0 1 put - } ifelse - 0 2 getinterval - } bind def - -% So here we go with our procedure - -/colortri { %Usage: box #pixels - save - 1 index type /arraytype eq {exch 8}{3 1 roll} ifelse % Default scale - /colortri_scale exch def - /colortri_box exch def - -% Prepare some useful constants for xy -> RGB conversion - - /colsum [ % Array with column-sums - 0 1 2{0 exch 3 1 index 6 add{colortri_mat exch get add}for}for - ] def - - /Xrow colortri_mat 0 3 getinterval def % two rows from colortri_mat - /Yrow colortri_mat 3 3 getinterval def - -% Avoid allocating new arrays - /xcoeff 3 array def - /ycoeff 3 array def - -% Procedure to derive RGB-Values form X,Y - /xy2rgb{ aload pop - dup dup dup ycoeff astore colsum vmul Yrow vsub imax - 3 index dup dup xcoeff astore colsum vmul Xrow vsub imax - 3 -1 roll 1 index 1 index gt{ - xcoeff ycoeff /xcoeff exch def /ycoeff exch def pop 3 -1 roll pop - }{ - 3 1 roll pop pop - } ifelse - 1e-6 lt { % No Pivot ? - pop colortri_bg xcoeff astore pop - }{ % Have a Pivot - dup ycoeff exch get neg - 0 1 2 { dup ycoeff exch get 2 index div ycoeff 3 1 roll put} for - pop ycoeff 1 index 0 put - - xcoeff 1 index get - 0 1 2 { - ycoeff 1 index get 2 index mul xcoeff 2 index get add - xcoeff 3 1 roll put - } for - pop xcoeff 1 index 0 put - xcoeff imax 1e-6 lt { % no Pivot ? - pop pop colortri_bg xcoeff astore pop - }{ - dup 2 index or 3 exch sub - xcoeff 1 index get xcoeff 3 index get div neg - xcoeff exch 3 index exch put - xcoeff 1 index 1 put - ycoeff exch get ycoeff 2 index get xcoeff 4 -1 roll get mul add - xcoeff 3 1 roll put - 0 1 2 { - xcoeff exch get dup -0.0015 lt exch 1.0015 gt or { - colortri_bg xcoeff astore dup exit - } if - } for - pop pop xcoeff - } ifelse - } ifelse - } bind def - -% Compute the displayed range - [ 1 1 1 ] rgb2xy - dup 0 get /colortri_x0 exch def /colortri_dx colortri_x0 def - 1 get /colortri_y0 exch def /colortri_dy colortri_y0 def - [[0 0 1][0 1 0][0 1 1][1 0 0][1 0 1][1 1 0]] { - rgb2xy - dup 0 get - dup colortri_x0 lt {/colortri_x0 1 index def}if - dup colortri_dx gt {/colortri_dx 1 index def}if - pop 1 get - dup colortri_y0 lt {/colortri_y0 1 index def}if - dup colortri_dy gt {/colortri_dy 1 index def}if - pop - } forall - colortri_dx colortri_x0 sub /colortri_dx exch def - colortri_dy colortri_y0 sub /colortri_dy exch def -% - -% determine the scale - colortri_box 2 get colortri_box 0 get sub colortri_dx div % fx - colortri_box 3 get colortri_box 1 get sub colortri_dy div % fx fy - gt { % fy limits - colortri_box 3 get colortri_box 1 get sub - dup colortri_dx mul colortri_dy div exch - }{ % fx limits - colortri_box 2 get colortri_box 0 get sub - dup colortri_dy mul colortri_dx div - } ifelse - dtransform abs colortri_scale div cvi /colortri_ny exch def - abs colortri_scale div cvi /colortri_nx exch def - colortri_nx colortri_scale mul colortri_ny colortri_scale mul - idtransform abs exch abs exch - colortri_box 0 get colortri_box 2 get 1 index sub 3 index sub 2 div add - colortri_box 1 get colortri_box 3 get 1 index sub 3 index sub 2 div add - transform .5 add cvi exch .5 add cvi exch itransform - translate scale - -% String & indices - /colortri_tmp colortri_nx 3 mul string def - /colortri_dx colortri_dx colortri_nx 1 sub div def - /colortri_dy colortri_dy colortri_ny 1 sub div def - /colortri_xy [ colortri_x0 colortri_y0 ] def - /colortri_ie colortri_tmp length 3 sub def - - colortri_nx colortri_ny 8 [ colortri_nx 0 0 colortri_ny 0 0 ] - { - colortri_xy 0 colortri_x0 put - 0 3 colortri_ie { - colortri_tmp exch % buf ir - colortri_xy xy2rgb % buf ir rgb buf ib - 2 index 2 index 2 add 2 index 2 get 255 mul cvi put - 2 index 2 index 1 add 2 index 1 get 255 mul cvi put - 0 get 255 mul cvi put - colortri_xy dup 0 exch 0 get colortri_dx add put - }for - colortri_xy dup 1 exch 1 get colortri_dy add put - colortri_tmp - } bind - false 3 colorimage - restore -} bind def - -% [ newpath clippath pathbbox ] colortri showpage % standalone usage - -% End: colortri_procedures - -% The next section is a group of procedures, that I for myself -% do no more fully understand, but they do the Job. - -% Begin: stcinfo_procedures_1 - -% fetch a parameter from the dictionary -/STCiget { STCinfo exch get } bind def - -% action upon ProcessColorModel -/STCimode { - /ProcessColorModel STCiget dup - /DeviceCMYK eq{pop 2}{/DeviceRGB eq{1}{0}ifelse}ifelse get exec -} bind def - -% print given number of blanks -/STCipspace { - dup 0 gt{ 1 exch 1 exch { pop ( ) print}for }{ pop } ifelse -} bind def - -% print right or left-justified text -/STCiprint { - dup 0 gt { dup 2 index length sub STCipspace } if - 1 index print - dup 0 lt { neg dup 2 index length sub STCipspace } if - pop pop -} bind def - -% floating-point to fixed-length-string conversion - -/STCicvs { % number -> string - -% Prepare the result - 8 string dup 0 ( ) putinterval - exch - -% Make it unsigned - dup 0 lt {neg(-)}{( )}ifelse 0 get exch - - dup 1000 lt 1 index 0 eq 2 index 0.001 ge or and { % floating point - (e+) 0 - }{ % engineering - 0 { - 1 index 1000.0 ge - {3 add exch 1000 div exch} - {1 index 1 lt {3 sub exch 1000 mul exch}{exit}ifelse} - ifelse - }loop - dup 0 lt {neg(e-)}{(e+)}ifelse exch - }ifelse - -% string sign num esig e - -% always up to three Integer Digits plus sign - 2 index cvi 3 { % string sign num esig e int ind - 1 index 10 div cvi dup 10 mul 3 index exch sub cvi - (0123456789) exch get 8 index exch 3 index exch put - 3 -2 roll 1 sub exch pop dup 0 eq 2 index 0 eq or {exit} if - } loop exch pop % string sign num esig e ind - 5 index exch 6 -1 roll put % string num esig e - -% print either fraction or exponent - dup 0 eq { pop pop dup cvi sub % String fraction - - dup 0.0 ne { % Fraction present - 0.0005 add 1 index 4 (.) putinterval - 5 1 7 { % string frac ind - exch 10 mul dup cvi exch 1 index sub % string ind ic nfrac - exch (0123456789) exch get 3 -1 roll % string nfrac chr ind - exch 3 index 3 1 roll put - } for - } if - pop - - }{ 3 -1 roll pop % string esig e - - exch 2 index exch 4 exch putinterval - 7 -1 6 { % string n i - 1 index 10 div cvi dup 10 mul 3 index exch sub cvi % string n i n/10 - (0123456789) exch get 4 index exch 3 index exch put - exch pop exch pop - } for - pop - } ifelse - -} bind def - -% compute colorvalue-steps from transfer & coding -/STCisteps { % xfer, coding => X-values, Y-Values -% 2^nbits - 2 /BitsPerComponent STCiget dup 11 gt { pop 11 } if exp cvi - -% X & Y - Arrays (stack: xv:4 yv:3 xfer:2 coding:1 2^ni:0) - dup 1 add array 1 index array 5 2 roll - -% compute GS-Color-Value according to the coding-array - - 1 index null eq { % no coding present - - 0 1 2 index 1 sub { - dup 6 index exch dup 4 index div put - 4 index exch dup 3 index 1 sub div put - } for - - }{ % coding-array given - - 1.0 1 index 1 sub div % y step - 0 % current index - 0 1 4 index 1 sub { % over indices - dup 3 index mul - { - dup 3 index 1 add dup 8 index length ge {pop pop exit} if % i y - 7 index exch get le {exit} if - 2 index 1 add 3 1 roll 4 -1 roll pop - } loop - 5 index 3 index get sub - 5 index 3 index 1 add get 6 index 4 index get sub div - 2 index add 5 index length 1 sub div - 2 copy exch dup 0 eq { - 10 index exch 0.0 put pop - }{ - dup 10 index exch 1 sub get 3 -1 roll add 2 div - 10 index 3 1 roll put - }ifelse - 7 index 3 1 roll put - } for % over indices - pop pop - } ifelse - 4 index 1 index 1.0 put - -% Replace the raw y-values by those computed from the transfer-array - - 0 1 2 index 1 sub { % over indices, 2nd - dup 5 index exch get - dup 5 index length 1 sub mul cvi % -> iy - 5 index 1 index get - 1 index 1 add 7 index length lt { - dup 7 index 3 index 1 add get exch sub - 3 index 3 index 9 index length 1 sub div sub mul - 7 index length 1 sub mul add - } if - exch pop exch pop 5 index 3 1 roll put - } for % over indices, 2nd - - pop pop pop -} bind def - -/STCibar { % Window X-Values proc => Window - 0 1 3 index length 2 sub { - dup 3 index exch get exch - 1 add 3 index exch get - dup 2 index add 2 div 3 index exec % Color to average - 4 index 2 get 5 index 0 get sub exch 1 index mul 5 index 0 get add 3 1 roll - mul 4 index 0 get add 4 index 3 get 5 index 1 get - newpath - 2 index 1 index moveto - 3 index 1 index lineto - 3 index 2 index lineto - 2 index 2 index lineto - closepath fill - pop pop pop pop - } for - pop pop - 0 setgray - newpath - dup 0 get 1 index 1 get moveto - dup 2 get 1 index 1 get lineto - dup 2 get 1 index 3 get lineto - dup 0 get 1 index 3 get lineto - closepath stroke - pop -} bind def - -% End: stcinfo_procedures_1 - -% Begin: stcinfo_preparation - -% Compute used area from clippath - -/STCi_clip [ - newpath clippath pathbbox - 2 sub 4 1 roll 2 sub 4 1 roll 2 add 4 1 roll 2 add 4 1 roll -] def - -% -% Perpare the texual messages, assume no stcolor if this fails -% -{ - /STCi_stopped % A Special Mark - -% Textual Parameters (an array of pairs of strings) - /STCi_l1 0 def - /STCi_l2 0 def - /STCi_text [ -% Driver-Name & Version - (Parameters of) - /Name STCiget length /Version STCiget length add 1 add string - dup 0 /Name STCiget putinterval dup /Name STCiget length (-)putinterval - dup /Name STCiget length 1 add /Version STCiget putinterval -% Dithering-Algorithm - (Dithering) - /Dithering STCiget - [{( \(Monochrome\))}{( \(RGB\))}{( \(CMYK\))}] STCimode - dup length 2 index length add string exch 1 index exch - 3 index length exch putinterval dup 3 1 roll exch 0 exch putinterval -% Flags for the algorithm - (Flag4-0) 5 string - dup 0 /Flag4 STCiget {(T)}{(f)} ifelse putinterval - dup 1 /Flag3 STCiget {(T)}{(f)} ifelse putinterval - dup 2 /Flag2 STCiget {(T)}{(f)} ifelse putinterval - dup 3 /Flag1 STCiget {(T)}{(f)} ifelse putinterval - dup 4 /Flag0 STCiget {(T)}{(f)} ifelse putinterval - -% Bits Per Pixel & Bits Per Component - (BitsPerPixel) 10 string % (nn -> nxnn) - /BitsPerPixel STCiget 1 index cvs length % string used - dup 2 index exch ( -> ) putinterval 4 add dup 2 add exch 2 index exch - [{(1x)}{(3x)}{(4x)}] STCimode putinterval % String used - /BitsPerComponent STCiget 2 index 2 index 2 getinterval cvs length add - 0 exch getinterval - - () () -% ColorAdjustMatrix - (ColorAdjustMatrix) - /ColorAdjustMatrix STCiget dup null eq { - pop (default) - }{ - { STCicvs } forall - [{ % Monochrome - 26 string - dup 0 6 -1 roll putinterval dup 8 ( ) putinterval - dup 9 5 -1 roll putinterval dup 17 ( ) putinterval - dup 18 4 -1 roll putinterval - }{ % RGB - 26 string - dup 0 12 -1 roll putinterval dup 8 ( ) putinterval - dup 9 11 -1 roll putinterval dup 17 ( ) putinterval - dup 18 10 -1 roll putinterval - - () 26 string - dup 0 11 -1 roll putinterval dup 8 ( ) putinterval - dup 9 10 -1 roll putinterval dup 17 ( ) putinterval - dup 18 9 -1 roll putinterval - - () 26 string - dup 0 10 -1 roll putinterval dup 8 ( ) putinterval - dup 9 9 -1 roll putinterval dup 17 ( ) putinterval - dup 18 8 -1 roll putinterval - }{ - 35 string - dup 0 19 -1 roll putinterval dup 8 ( ) putinterval - dup 9 18 -1 roll putinterval dup 17 ( ) putinterval - dup 18 17 -1 roll putinterval dup 26 ( ) putinterval - dup 27 16 -1 roll putinterval - - () 35 string - dup 0 17 -1 roll putinterval dup 8 ( ) putinterval - dup 9 16 -1 roll putinterval dup 17 ( ) putinterval - dup 18 15 -1 roll putinterval dup 26 ( ) putinterval - dup 27 14 -1 roll putinterval - - () 35 string - dup 0 15 -1 roll putinterval dup 8 ( ) putinterval - dup 9 14 -1 roll putinterval dup 17 ( ) putinterval - dup 18 13 -1 roll putinterval dup 26 ( ) putinterval - dup 27 12 -1 roll putinterval - - () 35 string - dup 0 13 -1 roll putinterval dup 8 ( ) putinterval - dup 9 12 -1 roll putinterval dup 17 ( ) putinterval - dup 18 11 -1 roll putinterval dup 26 ( ) putinterval - dup 27 10 -1 roll putinterval - - } - ] STCimode - } ifelse - () () - -% Printer Model - (Printer-Model) /Model STCiget - -% Resolution - (Resolution) 15 string % (nnnnnxnnnnn DpI) - /HWResolution STCiget 0 get cvi 1 index cvs length - dup 2 index exch (x) putinterval 1 add dup 2 index exch 5 getinterval - /HWResolution STCiget 1 get cvi exch cvs length add dup 2 index - exch ( DpI) putinterval 4 add 0 exch getinterval - -% HWsize holds entire Page in Pixels, -% .HWMargins is [left,bottom,right,top] in Points - (Printed Area) 18 string % (nnnnnxnnnnn Pixel) - /HWSize STCiget 0 get /.HWMargins STCiget dup 0 get exch 2 get add - /HWResolution STCiget 0 get mul 72.0 div sub cvi 1 index cvs length - dup 2 index exch (x) putinterval 1 add dup 2 index exch 5 getinterval - /HWSize STCiget 1 get /.HWMargins STCiget dup 1 get exch 3 get add - /HWResolution STCiget 1 get mul 72.0 div sub cvi exch cvs length add - dup 2 index exch ( Pixel) putinterval 6 add 0 exch getinterval - - () () -% WeaveMode - (Weave-Mode) - /noWeave STCiget { - (noWeave) - }{ - /Microweave STCiget {(Microweave)}{(Softweave)}ifelse - }ifelse -% Unidirectional - (Unidirectional) /Unidirectional STCiget {(ON)}{(off)} ifelse -% Output coding - (OutputCode) /OutputCode STCiget -% number of heads - (escp_Band) /escp_Band STCiget 3 string cvs - (escp_Width) /escp_Width STCiget 5 string cvs - (escp_Height) /escp_Height STCiget 5 string cvs - (escp_Top) /escp_Top STCiget 5 string cvs - (escp_Bottom) /escp_Bottom STCiget 5 string cvs - ] def - -% -% compute the Proper X & Y-Arrays -% - [{ % Monochrome - /Ktransfer STCiget /Kcoding STCiget STCisteps - /STCi_yv [ 3 -1 roll ] def - /STCi_xv [ 3 -1 roll ] def - /STCi_col [[0 0 0]] def - /STCi_set [{1.0 exch sub setgray}] def - }{ % RGB - /Rtransfer STCiget /Rcoding STCiget STCisteps - /Gtransfer STCiget /Gcoding STCiget STCisteps - /Btransfer STCiget /Bcoding STCiget STCisteps - exch 4 -1 roll 6 -1 roll exch 3 -1 roll - /STCi_xv [ 5 2 roll ] def - /STCi_yv [ 5 2 roll ] def - /STCi_col [[1 0 0] [0 1 0] [0 0 1]] def - /STCi_set [ - {1.0 exch sub 1 exch dup setrgbcolor} - {1.0 exch sub dup 1 exch setrgbcolor} - {1.0 exch sub dup 1 setrgbcolor} - ] def - }{ % CMYK - /Ctransfer STCiget /Ccoding STCiget STCisteps - /Mtransfer STCiget /Mcoding STCiget STCisteps exch 3 1 roll - /Ytransfer STCiget /Ycoding STCiget STCisteps exch 4 1 roll - /Ktransfer STCiget /Kcoding STCiget STCisteps exch 5 1 roll - /STCi_yv [ 6 2 roll ] def - /STCi_xv [ 6 2 roll ] def - /STCi_col [[0 1 1] [1 0 1] [1.0 0.5 0.0] [0 0 0]] def - /STCi_set [ - { 0 0 0 setcmykcolor } - { 0 exch 0 0 setcmykcolor } - { 0 exch 0 exch 0 setcmykcolor } - { 0 exch 0 exch 0 exch setcmykcolor } - ] def - } - ]STCimode - -} stopped - -{ {/STCi_stopped eq {exit}if}loop true} -{ {/STCi_stopped eq {exit}if}loop false} ifelse - -% End: stcinfo_preparation - -% The Next section does the real job - -% Begin: stcinfo_execution -{ - (%%[ stcinfo.ps: currentdevice is not supported -> colortri ]%%\n) print - STCi_clip colortri % The default action - -}{ -% -% Print the text -% - 0 2 STCi_text length 2 sub { dup 1 add exch - STCi_text exch get length dup STCi_l1 gt{/STCi_l1 exch def}{pop}ifelse - STCi_text exch get length dup STCi_l2 gt{/STCi_l2 exch def}{pop}ifelse - } for - /STCi_l2 STCi_l2 neg def - 0 2 STCi_text length 2 sub { - dup 1 add STCi_text exch get exch STCi_text exch get - 1 index length 0 gt { - dup STCi_l1 STCiprint length 0 gt {(: )}{( )}ifelse print print - }{ - pop pop - } ifelse - (\n) print - } for -% -% Deactivate a present ColorAdjust Matrix, if any -% - /ColorAdjustMatrix STCiget null ne STCi_onstc and { - mark - /ColorAdjustMatrix null - currentdevice putdeviceprops pop - } if -% -% "Show" the text -% - /Times-Roman findfont 10 scalefont setfont - /STCi_l1 0 def - 0 2 STCi_text length 2 sub { - STCi_text exch get stringwidth pop dup STCi_l1 gt { - /STCi_l1 exch def - }{ - pop - } ifelse - } for - STCi_l1 STCi_clip 0 get add /STCi_l1 exch def - - STCi_clip 3 get 12 sub - 0 2 STCi_text length 2 sub { - STCi_text exch get dup length 0 gt { - dup stringwidth pop STCi_l1 exch sub 2 index moveto show - }{ - pop - } ifelse - 12 sub - } for - pop - - /Courier findfont 10 scalefont setfont - /STCi_l2 0 def - 1 2 STCi_text length 1 sub { - STCi_text exch get stringwidth pop dup STCi_l2 gt { - /STCi_l2 exch def - }{ - pop - } ifelse - } for - - STCi_clip 3 get 12 sub - 1 2 STCi_text length 1 sub { - STCi_text exch get dup length 0 gt { - STCi_l1 12 add 2 index moveto show - }{ - pop - } ifelse - 12 sub - } for - pop - -% -% compute the space for the graph-window -% - STCi_l1 12 add STCi_l2 add 12 add dup STCi_clip 2 get exch sub % Extend - [ 3 -1 roll dup 3 index add STCi_clip 3 get dup 5 index sub 3 1 roll ] - /STCi_win exch def /STCi_l1 exch def - -% The "Axis" - newpath - STCi_win 0 get STCi_win 1 get 14 add moveto - STCi_win 2 get STCi_win 1 get 14 add lineto stroke - - STCi_win 0 get 14 add STCi_win 1 get moveto - STCi_win 0 get 14 add STCi_win 3 get lineto stroke - -% The Labels - /Times-Roman findfont 10 scalefont setfont - (Postscript-color) dup stringwidth pop - STCi_win 2 get STCi_win 0 get sub 14 sub 1 index sub 2 div exch pop - STCi_win 0 get add 14 add STCi_win 1 get 4 add moveto show - - gsave - STCi_win 0 get 10 add STCi_win 1 get 14 add translate 90 rotate - (Device-color) dup stringwidth pop - STCi_win 3 get STCi_win 1 get sub 14 sub 1 index sub 2 div exch pop - 0 moveto show - grestore - -% The Graphs - gsave - STCi_win 0 get 14 add STCi_win 1 get 14 add - STCi_win 2 get 2 index sub STCi_win 3 get 2 index sub - 4 2 roll translate - STCi_col 0 1 2 index length 1 sub { - 1 index 1 index get aload pop setrgbcolor - STCi_xv 1 index get STCi_yv 3 -1 roll get - newpath - 1 index 0 get 5 index mul 1 index 0 get 5 index mul moveto - 1 index 1 get 5 index mul 1 index 0 get 5 index mul lineto - 1 1 2 index length 1 sub { - 2 index 1 index get 6 index mul - 2 index 2 index get 6 index mul lineto - 2 index 1 index 1 add get 6 index mul - 2 index 2 index get 6 index mul lineto - pop - } for - stroke pop pop - } for - pop pop pop - grestore - -% -% Find lowest Y from Text or graph -% - STCi_win 1 get STCi_clip 3 get STCi_text length 2 div 12 mul sub - dup 2 index gt { pop } { exch pop } ifelse 12 sub - -% -% compute the upper bar-window -% - /STCi_win [ - STCi_clip 0 get 4 -1 roll 36 sub STCi_clip 2 get 1 index 36 add - ] def - -% -% Draw the required number of graphs -% - [{ % Monochrome - STCi_win STCi_xv 0 get {setgray} STCibar - }{ % RGB - STCi_win STCi_xv 0 get {0 0 setrgbcolor} STCibar - STCi_win dup 1 exch 1 get 47 sub put - STCi_win dup 3 exch 3 get 47 sub put - STCi_win STCi_xv 1 get {0 0 3 1 roll setrgbcolor} STCibar - STCi_win dup 1 exch 1 get 47 sub put - STCi_win dup 3 exch 3 get 47 sub put - STCi_win STCi_xv 2 get {0 0 3 2 roll setrgbcolor} STCibar - }{ % CMYK - STCi_win STCi_xv 0 get {0 0 0 setcmykcolor} STCibar - STCi_win dup 1 exch 1 get 47 sub put - STCi_win dup 3 exch 3 get 47 sub put - STCi_win STCi_xv 1 get {0 0 0 4 1 roll setcmykcolor} STCibar - STCi_win dup 1 exch 1 get 47 sub put - STCi_win dup 3 exch 3 get 47 sub put - STCi_win STCi_xv 2 get {0 0 0 4 2 roll setcmykcolor} STCibar - STCi_win dup 1 exch 1 get 47 sub put - STCi_win dup 3 exch 3 get 47 sub put - STCi_win STCi_xv 3 get {0 0 0 4 3 roll setcmykcolor} STCibar - } - ] STCimode - - STCi_win 1 STCi_clip 1 get put - STCi_win dup 3 exch 3 get 47 sub put - -% -% Plot either one or two Color-Triangles -% - /ColorAdjustMatrix STCiget null ne STCi_onstc and { - STCi_win 0 get STCi_win 2 get add 2 div - [STCi_win 0 get STCi_win 1 get 3 index STCi_win 3 get ] colortri - mark /ColorAdjustMatrix dup STCiget currentdevice putdeviceprops pop - [1 index STCi_win 1 get STCi_win 2 get STCi_win 3 get ] colortri - pop - }{ - STCi_win colortri - } ifelse - newpath clippath stroke -} ifelse -showpage diff --git a/Master/tlpkg/tlgs/lib/stcolor.ps b/Master/tlpkg/tlgs/lib/stcolor.ps deleted file mode 100644 index 105a6ec3949..00000000000 --- a/Master/tlpkg/tlgs/lib/stcolor.ps +++ /dev/null @@ -1,169 +0,0 @@ -% Copyright (C) 2001-2012 Artifex Software, Inc. -% All Rights Reserved. -% -% This software is provided AS-IS with no warranty, either express or -% implied. -% -% This software is distributed under license and may not be copied, -% modified or distributed except as expressly authorized under the terms -% of the license contained in the file LICENSE in this distribution. -% -% Refer to licensing information at http://www.artifex.com or contact -% Artifex Software, Inc., 7 Mt. Lassen Drive - Suite A-134, San Rafael, -% CA 94903, U.S.A., +1(415)492-9861, for further information. -% - -% stcolor.ps -% Epson Stylus-Color Printer-Driver - -% The purpose of this file is to configure the stcolor-printer driver - -% -% It is useless and dangerous to interpret the following code with anything -% else than Ghostscript, so this condition is verified first. If this fails -% a message is send to the output. If this message bothers you, remove it, -% but I prefer to know why the device-setup failed. - -statusdict begin product end -dup (Ghostscript) eq 1 index (Artifex Ghostscript) eq or -exch (AFPL Ghostscript) eq or{ - -% fetch the current device-parameters this is specific for Ghostscript. - - /STCold currentdevice getdeviceprops .dicttomark def - -% Any Ghostscript-Driver has a Name, verify that the selected device is -% stcolor, otherwise nothing than another message will be produced. - - STCold /Name get (stcolor) eq { - -% -% The main thing this file does, is to establish transfer-functions. -% Here are two predefined arrays for 360x360Dpi and for 720x720DpI. -% If resolution is 360x720 or 720x360 the average is used. You may -% want to define other arrays here. -% - - /STCdeftransfer [ 0.0 1.0 ] def - - /STCKtransfer360 [ - 0.0000 0.0034 0.0185 0.0377 0.0574 0.0769 0.0952 0.1147 - 0.1337 0.1540 0.1759 0.1985 0.2209 0.2457 0.2706 0.2949 - 0.3209 0.3496 0.3820 0.4145 0.4505 0.4907 0.5344 0.5840 - 0.6445 0.7093 0.8154 0.9816 0.9983 0.9988 0.9994 1.0000 - ] def - - /STCKtransfer720 [ - 0.0000 0.0011 0.0079 0.0151 0.0217 0.0287 0.0354 0.0425 - 0.0492 0.0562 0.0633 0.0700 0.0766 0.0835 0.0900 0.0975 - 0.1054 0.1147 0.1243 0.1364 0.1489 0.1641 0.1833 0.2012 - 0.2217 0.2492 0.2814 0.3139 0.3487 0.3996 0.4527 0.5195 - ] def - -% compute the resolution - - STCold /HWResolution get dup - 0 get exch 1 get mul sqrt /STCdpi exch def - -% pick the colormodel - STCold /ProcessColorModel get /STCcolor exch def - - mark % prepare stack for "putdeviceprops" - -% warn for BitsPerPixel=30 with fsrgb - STCcolor /DeviceRGB eq STCold /BitsPerPixel get 32 eq and - { - (%%[ stcolor.ps: inefficient RGB-setup, recommend BitsPerPixel=24 ]%%\n) - print - } if - -% if the Dithering-Method is default (gscmyk), change it to fscmyk -% this is achieved by pushing a name/value-pair onto the stack -% if the selected algorithm uses another ProcessColorModel, it is necessary -% to change the Value of STCcolor according to the new algorithm. - - STCold /Dithering get (gscmyk) eq - { - /Dithering (hscmyk) % preferred dithering-method - } if % might be necessary to change STCcolor too - -% -% select the array according to the resolution -% - STCdpi 359.0 lt - { STCdeftransfer } - { STCdpi 361.0 lt - { STCKtransfer360 } - { STCdpi 719.0 gt - { STCKtransfer720 } - { - STCKtransfer360 length STCKtransfer720 length eq - { - 0 1 STCKtransfer360 length 1 sub - { - dup dup - STCKtransfer360 exch get - exch STCKtransfer720 exch get - add 2.0 div - STCKtransfer360 3 1 roll put - } for - }if - STCKtransfer360 - } ifelse - }ifelse - } ifelse - /STCtransfer exch def - -% -% Add the arrays. With Version 1.17 and above, it seems to be -% a good idea, to use the transfer-arrays as coding-arrays too. -% - -% -% RGB-Model requires inversion of the transfer-arrays -% - STCcolor /DeviceRGB eq - { - /RGBtransfer STCtransfer length array def - 0 1 STCtransfer length 1 sub - { - dup RGBtransfer length 1 sub exch sub exch - STCtransfer exch get 1.0 exch sub - RGBtransfer 3 1 roll put - } for - - /Rtransfer RGBtransfer - /Gtransfer RGBtransfer - /Btransfer RGBtransfer - - /Rcoding RGBtransfer - /Gcoding RGBtransfer - /Bcoding RGBtransfer - - }{ - - /Ctransfer STCtransfer - /Mtransfer STCtransfer - /Ytransfer STCtransfer - /Ktransfer STCtransfer - - /Ccoding STCtransfer - /Mcoding STCtransfer - /Ycoding STCtransfer - /Kcoding STCtransfer - - } ifelse - - counttomark 0 ne - {currentdevice putdeviceprops pop}{cleartomark}ifelse - -% decativate predefined correction - - {} dup dup currenttransfer setcolortransfer - - }{ - (%%[ stcolor.ps: currentdevice is not stcolor - ignored ]%%\n) print - } ifelse -}{ - (%%[ stcolor.ps: not interpreted by AFPL Ghostscript - ignored ]%%\n) print -} ifelse |