path: root/Master/texmf-dist/dvips/pst-cie/pst-cie.pro

%% version 1.04 2016-05-15
/tx@CIEdict 50 dict def
 tx@CIEdict begin
%
%
(pst-cie-data.pro) run
%
%% Adobe RGB (1998) D65
/Adobe{
  /xy2RGB{
    /R 2.0413690  X mul -0.5649464  Y mul add  -0.3446944 Z mul add def
    /G -0.9692660 X mul 1.8760108   Y mul add 0.0415560   Z mul add def
    /B 0.0134474  X mul  -0.1183897 Y mul add 1.0154096   Z mul add def
  } def
  /primaryIlluminants  {
       /xR 0.6400 def /yR 0.3300 def
       /xG 0.2100 def /yG 0.7150 def
       /xB 0.1500 def /yB 0.0600 def
       D65
  } def
} def
%% CIE RGB
/CIE{
/xy2RGB{
/R 2.3706743  X mul -0.9000405 Y mul add  -0.4706338 Z mul add def
/G -0.5138850 X mul 1.4253036  Y mul add 0.0885814   Z mul add def
/B 0.0052982  X mul -0.0146949 Y mul add 1.0093968   Z mul add def
     } def
/primaryIlluminants  {
       /xR 0.7355 def /yR 0.2645 def
       /xG 0.2658 def /yG 0.7243 def
       /xB 0.1669 def /yB 0.0085 def
       E_
       } def
} def
%% SMPTE-C RGB
/SMPTE{
/xy2RGB{
/R 3.5053960  X mul -1.7394894  Y mul add  -0.5439640 Z mul add def
/G -1.0690722 X mul 1.9778245   Y mul add 0.0351722   Z mul add def
/B 0.0563200  X mul  -0.1970226 Y mul add 1.0502026   Z mul add def
     } def
/primaryIlluminants  {
       /xR 0.6300 def /yR 0.3400 def
       /xG 0.3100 def /yG 0.5950 def
       /xB 0.1550 def /yB 0.0700 def
       D65
       } def
} def
%% NTSC RGB
/NTSC{
/xy2RGB{
/R 1.9099961  X mul -0.5324542  Y mul add -0.2882091   Z mul add def
/G -0.9846663 X mul 1.9991710   Y mul add -0.0283082   Z mul add def
/B 0.0583056  X mul  -0.1183781 Y mul add 0.8975535    Z mul add def
     } def
/primaryIlluminants  {
       /xR 0.6700 def /yR 0.3300 def
       /xG 0.2100 def /yG 0.7100 def
       /xB 0.1400 def /yB 0.0800 def
       C_
       } def
} def
%%SRGB
/sRGB{
/xy2RGB{
/R 3.2404542  X mul -1.5371385  Y mul add  -0.4985314 Z mul add def
/G -0.9692660 X mul 1.8760108   Y mul add 0.0415560   Z mul add def
/B 0.0556434  X mul  -0.2040259 Y mul add 1.0572252   Z mul add def
    R 0.00304 le {/R R 12.92 mul def}{/R 1.055 R 1 2.4 div exp mul 0.055 sub def} ifelse
    G 0.00304 le {/G G 12.92 mul def}{/G 1.055 G 1 2.4 div exp mul 0.055 sub def} ifelse
    B 0.00304 le {/B B 12.92 mul def}{/B 1.055 B 1 2.4 div exp mul 0.055 sub def} ifelse
    } def
/GAM 1 def
/primaryIlluminants  {
       /xR 0.6400 def /yR 0.3300 def
       /xG 0.3000 def /yG 0.6000 def
       /xB 0.1500 def /yB 0.0600 def
       D65
       } def
} def
%% Pal/Secam
/Pal-Secam{
/xy2RGB{
/R 3.0628971  X mul -1.3931791 Y mul add -0.4757517 Z mul add def
/G -0.9692660 X mul 1.8760108  Y mul add 0.0415560  Z mul add def
/B 0.0678775  X mul -0.2288548 Y mul add 1.0693490  Z mul add def
  } def
/primaryIlluminants  {
       /xR 0.6400 def /yR 0.3300 def
       /xG 0.2900 def /yG 0.6000 def
       /xB 0.1500 def /yB 0.0600 def
       D65
       } def
} def
/ProPhoto{
/xy2RGB{
/R 1.3459433   X mul -0.2556075 Y mul add  -0.0511118 Z mul add def
/G -0.5445989  X mul 1.5081673  Y mul add 0.0205351   Z mul add def
/B 0.0000000   X mul 0.0000000  Y mul add 1.2118128   Z mul add def
 } def
/primaryIlluminants  {
       /xR 0.7347 def /yR 0.2653 def
       /xG 0.1596 def /yG 0.8404 def
       /xB 0.0366 def /yB 0.0001 def
       D50
       } def
} def
/ColorMatch{
/xy2RGB{
/R 2.6422874  X mul -1.2234270 Y mul add -0.3930143 Z mul add def
/G -1.1119763 X mul 2.0590183  Y mul add 0.0159614  Z mul add def
/B 0.0821699  X mul -0.2807254 Y mul add 1.4559877  Z mul add def
      } def
/primaryIlluminants  {
       /xR 0.6300 def /yR 0.3400 def
       /xG 0.2950 def /yG 0.6050 def
       /xB 0.1500 def /yB 0.0750 def
       D50
       } def      
} def
%      
% WhitePoints
/E_ {/xW 0.33333 def /yW 0.33333 def} def
/D65 {/xW 0.3127 def /yW 0.3290 def} def
/D50 {/xW 0.3457 def /yW 0.3585 def} def
/C_ {/xW 0.3101 def /yW 0.3162 def} def
%%%%% ### max ###
/max {
   2 {2 copy
   lt {exch} if
   pop }
   repeat
} def
% 
% x y => u' v' % u v 
/xy2uv{
2 dict begin
% /Z exch def 
/Y exch def /X exch def
% 4 X mul X 15 Y mul add 3 Z mul add div % u
% 6 Y mul X 15 Y mul add 3 Z mul add div % v
%u'=4x/(-2x+12y+3) v'=9y/(-2x+12y+3)
 4 X mul X -2 mul 12 Y mul add 3 add div % u'
 9 Y mul X -2 mul 12 Y mul add 3 add div % v' 
end
}def 
%     
/BLKBOD {
  /tablename ED
  /T exch def
  /XX 0 def /YY 0 def /ZZ 0 def
  0 1 tablename length 1 sub {
    /K exch def
    /WL 360 K add 1e-9 mul def
    /CON 1240 8.617e-5 div def
    /DIS 3.74183e-16 WL 5 exp div 2.71828 1.4388e-2 WL T mul div exp 1 sub div def
    /XX XX DIS tablename K get 0 get mul add def
    /YY YY DIS tablename K get 1 get mul add def
    /ZZ ZZ DIS tablename K get 2 get mul add def
  }  for
  /XYZ XX YY ZZ add add def
  /X XX XYZ div def
  /Y YY XYZ div def
  /Z ZZ XYZ div def
} def
%
/normalisation {
	/maxRGB R G B max def
	/R R maxRGB div def
	/G G maxRGB div def
	/B B maxRGB div def
        R 0 lt {/R 0 def} if
        G 0 lt {/G 0 def} if
        B 0 lt {/B 0 def} if
        R 1 gt {/R 1 def} if
        G 1 gt {/G 1 def} if
        B 1 gt {/B 1 def} if
} def
%
/CouleursPrimaires {
   gsave
   0.2 setlinewidth
   primaryIlluminants
chromaticityCoordinates (xy) ne {
   xR yR xy2uv /yR' exch def /xR' exch def
   xG yG xy2uv /yG' exch def /xG' exch def
   xB yB xy2uv /yB' exch def /xB' exch def
   xW yW xy2uv /yW' exch def /xW' exch def
   /X xR def /Y yR def /Z 1 X sub Y sub def
   xy2RGB normalisation
   xR' unit yR' unit pixelSquareColor
   R GAM exp G GAM exp B GAM exp setrgbcolor fill
   xR' unit yR' unit pixelSquareColor
   cie-bgcolor 
   stroke
   /X xG def /Y yG def /Z 1 X sub Y sub def
   xy2RGB normalisation
   xG' unit yG' unit pixelSquareColor
   R GAM exp G GAM exp B GAM exp setrgbcolor fill
  xG' unit yG' unit pixelSquareColor
   cie-bgcolor 
   stroke
    /X xB def /Y yB def /Z 1 X sub Y sub def
   xy2RGB normalisation
   xB' unit yB' unit pixelSquareColor
   R GAM exp G GAM exp B GAM exp setrgbcolor fill
   xB' unit yB' unit pixelSquareColor
   cie-bgcolor 
   stroke
   xW' unit yW' unit pixelSquareColor
   cie-bgcolor 
   stroke
   grestore
   }{
   /X xR def /Y yR def /Z 1 X sub Y sub def
   xy2RGB normalisation
   xR unit yR unit pixelSquareColor
   R GAM exp G GAM exp B GAM exp setrgbcolor fill
   xR unit yR unit pixelSquareColor
   cie-bgcolor 
   stroke
   /X xG def /Y yG def /Z 1 X sub Y sub def
   xy2RGB normalisation
   xG unit yG unit pixelSquareColor
   R GAM exp G GAM exp B GAM exp setrgbcolor fill
  xG unit yG unit pixelSquareColor
   cie-bgcolor 
   stroke
    /X xB def /Y yB def /Z 1 X sub Y sub def
   xy2RGB normalisation
   xB unit yB unit pixelSquareColor
   R GAM exp G GAM exp B GAM exp setrgbcolor fill
   xB unit yB unit pixelSquareColor
   cie-bgcolor 
   stroke
   xW unit yW unit pixelSquareColor
   cie-bgcolor 
   stroke
   grestore
   }ifelse
   } def
%
/unitPixel {0.005 cie-unit mul} def

/pixelSquare {
/y0 exch def /x0 exch def
newpath				
x0 1 sub y0 1 sub moveto	
2 0 rlineto		
0 2 rlineto		
-2 0 rlineto	
closepath			
} def

/pixelSquareColor{
/y0 exch def /x0 exch def
newpath				
x0 unitPixel sub y0 unitPixel sub moveto	
unitPixel 2 mul 0 rlineto		
0 unitPixel 2 mul rlineto		
unitPixel -2 mul 0 rlineto	
closepath			
} def
%
/pixelDisk {
1 0 360 arc
} def
%
/contourTriangle{
  primaryIlluminants
 chromaticityCoordinates (xy) ne {
  /zR 1 xR sub yR sub def
  /zG 1 xG sub yG sub def
  /zB 1 xB sub yB sub def
 xR yR xy2uv /yR exch def /xR exch def
 xG yG xy2uv /yG exch def /xG exch def
 xB yB xy2uv /yB exch def /xB exch def
     } if
   newpath
   xR unit yR unit moveto
   xG unit yG unit lineto
   xB unit yB unit lineto
   closepath
   } def
%
/unit {cie-unit mul} bind def
%
/contour {% /TAB exch def
newpath
TAB 0 get aload pop unit exch unit exch moveto
0 1 TAB length 1 sub {/i exch def
  TAB i get aload pop unit exch unit exch
  lineto } for
closepath
} def
%
/stepXY  {1 285 cie-U mul div 1.5 div} def
/gamutTriangle {
newpath
% 400 pixels
0 stepXY 1 {/X exch def
0 stepXY 1 {/Y exch def
    /Z 1 X sub Y sub def
 /xPos X cie-unit mul def
 /yPos Y cie-unit mul def
 chromaticityCoordinates (xy) ne {
X Y xy2uv
  /yPos exch cie-unit mul def
  /xPos exch cie-unit mul def
     } if
%    Z 0 ge {
    xy2RGB
    normalisation
     xPos yPos pixelSquare 
     R GAM exp G GAM exp B GAM exp setrgbcolor
     fill
%    } if
    } for
    } for
    }
    def
/gamut {
newpath
0 stepXY 1 {/X exch def
0 stepXY 1 {/Y exch def
    /Z 1 X sub Y sub def
 /xPos X cie-unit mul def
 /yPos Y cie-unit mul def
 chromaticityCoordinates (xy) ne {
X Y xy2uv
  /yPos exch cie-unit mul def
  /xPos exch cie-unit mul def
     } if
%    Z 0 ge {
    xy2RGB
    normalisation
     xPos yPos pixelSquare 
     R GAM exp contrast mul G GAM exp contrast mul B GAM exp contrast mul setrgbcolor
     fill
%    } if
    } for
    } for
    }
    def
%
/DrawGamut {
  gsave
  TAB contour
  clip
  gamut
  contourTriangle
  clip
  gamutTriangle
  grestore
  % dessin du contour
  contour
  0.5 setlinewidth
  cie-textcolor 
  stroke
  % dessin du contour du triangle des couleurs primaires
  primaries {
    contourTriangle
    closepath
    cie-textcolor 
    stroke 
  } if
  % placement des couleurs primaires et du blanc
  primaries { CouleursPrimaires } if
} def
% dessin du triangle des couleurs plein
% afficher les longieurs d'onde
% /Helvetica-bold  findfont 5 scalefont  setfont
% marquage des longueurs d'onde
gsave
% 460 -> 520 nm
/traceGamut { 
  /contrast exch def /gamma exch def /system exch def /TAB exch def
       chromaticityCoordinates (xy) ne {/Tabuv [
    0 1 TAB length 1 sub {/i exch def
     TAB i get /subarray exch def
     /X subarray 0 get def /Y subarray 1 get def /Z 1 X sub Y sub def
%     [4 X mul -2 X mul 12 Y mul add 3 add div         % u
%      6 Y mul -2 X mul 12 Y mul add 3 add div]        % v
     [4 X mul -2 X mul 12 Y mul add 3 add div         % u'
      9 Y mul -2 X mul 12 Y mul add 3 add div]        % v'
      } for
     ] def
     /TAB Tabuv def
     } if
  /GAM {1 gamma div} bind def
  system
  DrawGamut
  gsave
  /Helvetica-bold  findfont 5 scalefont setfont
  cie-textcolor 
  100 10 270 {
    /i exch def
    TAB i get 0 get /x0 exch def
    TAB i get 1 get /y0 exch def
    TAB i 1 sub get 0 get /x1 exch def
    TAB i 1 sub get 1 get /y1 exch def
    TAB i 1 add get 0 get /x2 exch def
    TAB i 1 add get 1 get /y2 exch def
    /dx x2 x1 sub def
    /dy y2 y1 sub def
    /norme dx dup mul dy dup mul add sqrt def
    % norme 0 eq {/norme 1e-9 def} if
    /ux dy norme div neg 3 mul def
    /uy dx norme div 3 mul def
    /normale {x0 unit ux add y0 unit uy add} def
    x0 unit y0 unit moveto
    normale lineto
    stroke
    i 160 ge {normale moveto 360 i add cvi 15 string cvs show}
             {normale -2 add exch -9 add exch moveto 360 i add cvi 15 string cvs show} ifelse
  } for
  20 300 320 {
    /i exch def
    TAB i get 0 get /x0 exch def
    TAB i get 1 get /y0 exch def
    TAB i 1 sub get 0 get /x1 exch def
    TAB i 1 sub get 1 get /y1 exch def
    TAB i 1 add get 0 get /x2 exch def
    TAB i 1 add get 1 get /y2 exch def
    /dx x2 x1 sub def
    /dy y2 y1 sub def
    /norme dx dup mul dy dup mul add sqrt def
    /ux dy norme div neg 3 mul def
    /uy dx norme div 3 mul def
    /normale {x0 unit ux add y0 unit uy add} def
    x0 unit y0 unit moveto
    normale lineto
    stroke
    i 20 eq { normale -5 add exch -5 add exch moveto 360 i add cvi 15 string cvs show }
            { normale moveto 360 i add cvi 15 string cvs show } ifelse
  } for
  grestore
} def
%
0 0 translate
/SCREEN {
  /cadre {
    newpath
     -0.1  unit -0.1 unit moveto
      0.85 unit -0.1 unit lineto
      0.85 unit  0.9 unit lineto
     -0.1  unit  0.9 unit lineto
    closepath
  } def
  /axes {
    newpath
    -0.05  unit -0.05  unit moveto
     0.825 unit -0.05  unit lineto
     0.825 unit  0.875 unit lineto
    -0.05  unit  0.875 unit lineto
    closepath
    stroke
  } def
% tableau noir
  gsave
  cadre
  cie-bgcolor 
  fill
  cadre cie-textcolor  stroke
  0.5 setlinewidth
  axes
  /Helvetica-bold  findfont 5 scalefont setfont
  0 0.1 0.9 {
    /i exch def
    /M1 {i unit -0.05 unit} def 
    /M2 {i unit -0.06 unit} def
    M1 moveto M2 lineto stroke
    M2 -5 add exch -3.5 add exch moveto i 15 string cvs show
  } for
  0 0.1 0.9 {
    /i exch def
    /M1 {-0.05 unit i unit } def /M2 {-0.06 unit i unit } def
    M1 moveto M2 lineto stroke
    M2 -2 add  exch -8 add exch moveto i 15 string cvs show
  } for
  gsave
  /Helvetica-bold  findfont 8 scalefont  setfont
  cie-textcolor 
chromaticityCoordinates (xy) eq {
  -0.08 unit 0.45 unit moveto (y) 90 rotate show
  }{
  -0.08 unit 0.45 unit moveto (v') 90 rotate show
  }ifelse
  grestore
  gsave
  /Helvetica-bold  findfont 8 scalefont  setfont
  cie-textcolor 
chromaticityCoordinates (xy) eq {
  0.35 unit -0.08 unit moveto (x) show
  }{
   0.35 unit -0.08 unit moveto (u') show
  }ifelse
  grestore
  grestore
} def
% TAB {colorSpace} gamma  contrast traceGamut
%
%  CIE 1931 (2 degree) and 1964 (10 degree) Color Matching Functions   
% Wavelength >= 360 && Wavelength <= 830 
/XYZ_to_RGB {
  system cvx exec
  normalisation
  R G B
} def
%
% on calcule les coordonnées du lieu de Planck
/tablePlanckianLocus {
% {datas cvx exec} 
/TAB exch def %  {ColorSpace cvx exec} /system exch def
/PlanckianLocus[
1000 100 40000 {/T exch def
 /XX 0 def /YY 0 def /ZZ 0 def
  0 1 TAB length 1 sub {
    /K exch def
    /WL 360 K add 1e-9 mul def
    /CON 1240 8.617e-5 div def
    /DIS 3.74183e-16 WL 5 exp div 2.71828 1.4388e-2 WL T mul div exp 1 sub div def
    /XX XX DIS TAB K get 0 get mul add def
    /YY YY DIS TAB K get 1 get mul add def
    /ZZ ZZ DIS TAB K get 2 get mul add def
  }  for
  /XYZ XX YY ZZ add add def
  /X XX XYZ div def
  /Y YY XYZ div def
  /Z ZZ XYZ div def
%   4 X mul deno div % u
%   6 Y mul deno div % v
chromaticityCoordinates (xy) ne {
  /deno -2 X mul 12 Y mul add 3 add def
   4 X mul deno div % u'
   9 Y mul deno div % v'
   /Y exch def /X exch def
   } if
X Y
 }for
 ] def
PlanckianLocus
} def
%
end  % of dictionary
%%