% Copyright (C) 1995 Aladdin Enterprises.  All rights reserved
%
% This file is part of Aladdin Ghostscript.
%
% Aladdin Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author
% or distributor accepts any responsibility for the consequences of using it,
% or for whether it serves any particular purpose or works at all, unless he
% or she says so in writing.  Refer to the Aladdin Ghostscript Free Public
% License (the "License") for full details.
%
% Every copy of Aladdin Ghostscript must include a copy of the License,
% normally in a plain ASCII text file named PUBLIC.  The License grants you
% the right to copy, modify and redistribute Aladdin Ghostscript, but only
% under certain conditions described in the License.  Among other things, the
% License requires that the copyright notice and this notice be preserved on
% all copies.

% 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 exch (Aladdin 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