%!PS-Adobe-3.0  EPSF-3.0
%%BoundingBox:  0 0 340 340
%%Creator:      Gernot Hoffmann
%%Title:        MatchRGB
%%CreationDate: June 24 2004
%%DocumentNeededResources: font Helvetica
%%+ Symbol

% Disable setpagedevice
/setpagedevice {pop} bind def

%-Variables

/mm {2.834646 mul} def % points per mm

%     lam   r        g        b
 
/ci [ 380 +0.00003 -0.00001 +0.00117
      385 +0.00005 -0.00002 +0.00189 
      390 +0.00010 -0.00004 +0.00359 
      395 +0.00017 -0.00007 +0.00647
      400 +0.00030 -0.00014 +0.01214
      405 +0.00047 -0.00022 +0.01969
      410 +0.00084 -0.00041 +0.03707
      415 +0.00139 -0.00070 +0.06637
      420 +0.00211 -0.00110 +0.11541
      425 +0.00266 -0.00143 +0.18575
      430 +0.00218 -0.00119 +0.24769
      435 +0.00036 -0.00021 +0.29012
      440 -0.00261 +0.00149 +0.31228
      445 -0.00673 +0.00379 +0.31860
      450 -0.01213 +0.00678 +0.31670  
      455 -0.01874 +0.01046 +0.31166
      460 -0.02608 +0.01485 +0.29821 
      465 -0.03324 +0.01977 +0.27295
      470 -0.03933 +0.02538 +0.22991
      475 -0.04471 +0.03183 +0.18592
      480 -0.04939 +0.03914 +0.14494
      485 -0.05364 +0.04713 +0.10968
      490 -0.05814 +0.05689 +0.08257
      495 -0.06414 +0.06948 +0.06246
      500 -0.07173 +0.08536 +0.04776
      505 -0.08120 +0.10593 +0.03688
      510 -0.08901 +0.12860 +0.02698
      515 -0.09356 +0.15262 +0.01842  
      520 -0.09264 +0.17468 +0.01221
      525 -0.08473 +0.19113 +0.00830
      530 -0.07101 +0.20317 +0.00549
      535 -0.05316 +0.21083 +0.00320
      540 -0.03152 +0.21466 +0.00146
      545 -0.00613 +0.21487 +0.00023
      550 +0.02279 +0.21178 -0.00058
      555 +0.05514 +0.20588 -0.00105 
      560 +0.09060 +0.19702 -0.00130
      565 +0.12840 +0.18522 -0.00138 
      570 +0.16768 +0.17087 -0.00135
      575 +0.20715 +0.15429 -0.00123
      580 +0.24526 +0.13610 -0.00108
      585 +0.27989 +0.11686 -0.00093
      590 +0.30928 +0.09754 -0.00079
      595 +0.33184 +0.07909 -0.00063
      600 +0.34429 +0.06246 -0.00049
      605 +0.34756 +0.04776 -0.00038      
      610 +0.33971 +0.03557 -0.00030
      615 +0.32265 +0.02583 -0.00022
      620 +0.29708 +0.01828 -0.00015
      625 +0.26348 +0.01253 -0.00011
      630 +0.22677 +0.00833 -0.00008
      635 +0.19233 +0.00537 -0.00005
      640 +0.15968 +0.00334 -0.00003
      645 +0.12905 +0.00199 -0.00002
      650 +0.10167 +0.00116 -0.00001
      655 +0.07857 +0.00066 -0.00001 
      660 +0.05932 +0.00037 +0.00000
      665 +0.04366 +0.00021 +0.00000
      670 +0.03149 +0.00011 +0.00000
      675 +0.02294 +0.00006 +0.00000
      680 +0.01687 +0.00003 +0.00000
      685 +0.01187 +0.00001 +0.00000
      690 +0.00819 +0.00000 +0.00000
      695 +0.00572 +0.00000 +0.00000 
      700 +0.00410 +0.00000 +0.00000 ] def


/sx 100 mm def 
/sy 100 mm def

/x0  10 mm def 
/y0  10 mm def

/bb 0 def
/u 0 def /v 0 def
/lamin 0 def /lamax 0 def /la 0 def
/km 0 def /k 0 def /j 0 def
/fh 0 def

/gx 0 def /gy 0 def
/fu 0 def /mi 0 def /re 0 def /yy 0 def /xx 0 def
/n 0 def /hd6 0 def /hm6 0 def /h6h 0 def
/R 0 def /G 0 def /B 0 def 
/x 0 def /y 0 def /z 0 def 
/X 0 def /Y 0 def /Z 0 def /max 0 def
/mult 0 def /fp 0 def /spl 0 def /spa 0 def /vecx 0 def /vecy 0 def   
/t 0 def /r 0 def /s 0 def /c 0 def
/e 0 def /ra 0 def /lam 0 def /clm 0 def
/tx0 0 def /ty0 0 def /tfw 0 def /tna 0 def /tdec 0 def /tchr 0 def
/tk 0 def /tmm 0 def
/num 0 def /tx 0 def /fh 0 def /xtxt 0 def /ytxt 0 def 
/i 0 def /j 0 def /k 0 def

/n 0 def 
/h 0 def /dh 0 def 
/x 0 def /dx 0 def
/y 0 def /dy 0 def 

/setgray
{/g exch def
  0 0 0 1 setcmykcolor 
} bind def 


/Bbox
{/bb 340 def 
  newpath 
  0 0 moveto bb 0 rlineto 0 bb rlineto bb neg  0 rlineto 
  closepath stroke
} def  


/Grid
{ 0 setlinecap
  0 setgray
 /v 0.2 def
  0.2 mm sx div setlinewidth
  newpath
 5 
 { 0 v moveto
   1 0 rlineto
  /v v 0.2 add def 
 } repeat
 stroke
 /km ci length def
 /lamin ci 0 get def
 /lamax ci km clm sub get def
 /la lamin def
 newpath
 { /u la lamin sub lamax lamin sub div def
    u 0 moveto 
    u 1 lineto
   /la la 20 add def    
    la lamax gt {exit} if
  } loop  
 stroke
 
 /fh 10 sx div def
 /Helvetica findfont fh scalefont setfont
 /tms 1 def
 
 /v  0 def
 /u -0.05 def
 -1 1 4 
 {/k exch def 
   u v 0.01 sub k 0.1 mul Shownum
  /v v 0.2 add def 
 } for
 
 /tms 0 def
 /v -0.05 def
 /la lamin def
 { /u la lamin sub lamax lamin sub div def
    u 0.03 add v la Shownum
   /la la 40 add def    
    la lamax gt {exit} if
  } loop  
 
  0.913 v moveto (nm) show  
 
 /fh 12 sx div def
 /Helvetica findfont fh scalefont setfont
  /u 0.710 def 
  /v 0.650 def 
   u v moveto (r) show u v fh 0.8 mul add moveto (_) show
  /u 0.517 def 
   u v moveto (g) show u v fh 0.8 mul add moveto (_) show
  /u 0.207 def 
   u v moveto (b) show u v fh 0.95 mul add moveto (_) show  

 /fh 11 sx div def
 /Symbol findfont fh scalefont setfont
  0.80 -0.05 moveto (l) show
} bind def

/Shownum  
% Draw number by string
% Version May 15 2004 / uses rounding  
%
%  tx0 ty0 nu :on stack
%
%  tx0    Position        not overwritten
%  ty0                    
%  nu     Input number    not overwritten  nu =+-999999
%  fh     Font height     not overwritten
%  tms    Mantissa number of characters    tms=0...6 Global
%  tms=3  Example
%  input  -23.56789  -999.99    0.4567  9999.123456
%  result -23.568    -999.990   0.467   9999.123
%  Postscript number to string is not well defined
%  e.g. 1E-5 instead of 0.00001
%  We use a straightforward BCD conversion. 
%  This is always affected by round-off errors 
%  because of 32-bit arithmetic
%  Results are different, depending on the interpreter
 
{ /nu  exch def
  /ty0 exch def
  /tx0 exch def
  /tfw fh 0.6 mul def                   % character distance
  /tna nu abs 10 tms neg exp 0.500001 mul add def

  /tdec 1E5 def                          
  /tchr 1 string def
 
   tna 999999.1 lt                      % larger number replaced by #  
  /tmm true def                         % sign 
  {/tx0 tx0 tfw 6 mul sub def
   /tz 0 def  
  1 1 5                                 % first 5 digits, no leading 0 
  { pop
   /tk 0 def  
   { tna tdec gt {/tna tna tdec sub def /tk tk 1 add def}{exit} ifelse 
   } loop
    tk 0 ne {/tz tz 1 add def} if
    tz 0 ne
    { tx0 ty0 moveto tk tchr cvs show
    } if
    tz 1 eq nu 0 lt and                 % minus 
    { tx0 tfw 0.7 mul sub ty0 moveto (-) show
      /tmm false def
    } if 
   /tdec tdec 0.1 mul def
   /tx0 tx0 tfw add def
  } for
  
   /tk 0 def                            % leading 0 
   { tna tdec gt {/tna tna tdec sub def /tk tk 1 add def}{exit} ifelse 
   } loop
     tmm nu 0 lt and                    % minus 
    { tx0 tfw 0.7 mul sub ty0 moveto (-) show
    } if   
    tx0 ty0 moveto tk tchr cvs show
   /tdec tdec 0.1 mul def
   /tx0 tx0 tfw add def
  
  tms 0 gt                              % for float
  { tx0 ty0 moveto (.) show
   /tx0 tx0 tfw 0.5 mul add def 
  1 1 tms 
  { pop
   /tk 0 def  
   { tna tdec gt {/tna tna tdec sub def /tk tk 1 add def}{exit} ifelse 
   } loop
     tx0 ty0 moveto tk tchr cvs show
   /tdec tdec 0.1 mul def
   /tx0 tx0 tfw add def
  } for
  } if
 }{ tx0 tfw sub ty0 moveto (#) show} ifelse
} def  

/MakeSpline % for actual array ci with 4 columns
{/fu  spa array def /mi spa array def /re spa array def /yy spa array def /xx spa array def
 /n fp 1 sub def /hh mult def /hd6 hh 6 div def /hm6 hh 6 mul def /h6h -6 hh dup mul div def 
  pxy 0 eq {0 1 fp {/k exch def fu k hh mul ci k clm mul       get put} for} if 
  pxy 1 eq {0 1 fp {/k exch def fu k hh mul ci k clm mul 1 add get put} for} if 
  pxy 2 eq {0 1 fp {/k exch def fu k hh mul ci k clm mul 2 add get put} for} if 
  pxy 3 eq {0 1 fp {/k exch def fu k hh mul ci k clm mul 3 add get put} for} if 
  mi 1 0.25 put 
  1 1 n 1 sub {/j exch def mi j 1 add 1 4 mi j get sub div put} for    
  1 1 n {/j exch def /jh j hh mul def re j fu jh hh add get fu jh get 2 mul sub fu jh hh sub get add h6h mul put} for
  yy 1 re 1 get put
  2 1 n {/j exch def yy j re j get yy j 1 sub get mi j 1 sub get mul sub put} for
  xx 0 0 put xx n yy n get mi n get mul neg put xx n 1 add 0 put
  n 1 sub -1 1{/j exch def xx j yy j get xx j 1 add get add mi j get mul neg put} for
  /i 0 def
  0 1 n
  {/j exch def /jh j hh mul def 
   /a3 xx j 1 add get xx j get sub hm6 div def /a2 xx j get 0.5 mul def
   /a1 fu jh hh add get fu jh get sub hh div xx j 1 add get xx j get 2 mul add hd6 mul sub def /a0 fu jh get def
    1 1 hh 1 sub {/k exch def /i i 1 add def fu i a3 k mul a2 add k mul a1 add k mul a0 add put} for
   /i i 1 add def} for
  pxy 0 eq {fu vecu copy} if
  pxy 1 eq {fu vecx copy} if 
  pxy 2 eq {fu vecy copy} if 
  pxy 3 eq {fu vecz copy} if      
} bind def

/NormL  
{% Normalize lambda 0..1
 %u = (la-380)/(700-380)
 /km ci length def % number of elements
 /lamin ci 0 get def
 /lamax ci km clm sub get def
 /j 0 def
  km clm idiv 
 {/la ci j get def
  /u  la lamin sub lamax lamin sub div def
   ci j u put
  /j j clm add def 
 } repeat
} bind def

/MakeS  
{% Spline
 /mult 10 def  
 /fp   ci length clm idiv 1 sub def    
 /spl  fp mult mul def   
 /spa  spl 1 add def
 /vecu spa array def
 /vecx spa array def   
 /vecy spa array def 
 /vecz spa array def 
 /pxy 0 def MakeSpline
 /pxy 1 def MakeSpline
 /pxy 2 def MakeSpline
 /pxy 3 def MakeSpline 
} bind def

/DrawX
{ newpath
  vecu 0 get vecx 0 get 0.1 add 2 mul moveto
  1 1 spl 
  {/k exch def
    vecu k get vecx k get 0.1 add 2 mul lineto } for
  stroke
} bind def

/DrawY
{ newpath
  vecu 0 get vecy 0 get 0.1 add 2 mul moveto
  1 1 spl 
  {/k exch def
    vecu k get vecy k get 0.1 add 2 mul lineto } for
  stroke
} bind def


/DrawZ
{ newpath
  vecu 0 get vecz 0 get 0.1 add 2 mul moveto
  1 1 spl 
  {/k exch def
    vecu k get vecz k get 0.1 add 2 mul lineto } for
  stroke
} bind def

/Spectrum
{% Draw spectrum bar
 % lambda - hue fixed points
 % Piecewise linear interpolation 
 % Requires linewidth    
 /Tab 
 [ 380 270
   435 240 
   475 180
   495 170
   545 120
   575  60
   660   0
   700   0 ] def
 /ExecTab
 {/xi exch def
  /tb Tab length 1 sub def 
  /ii 0 def
  { ii tb gt {exit} if  
    xi Tab ii 2 add get le {exit} if
   /ii ii 2 add def
  } loop 
  %     yi=y0 +[(xi-x0)/(x1-x0)]*(y1-y0)
  % ofs     1        0    2  0     3  1
    Tab ii 1 add get xi Tab ii get sub Tab ii 2 add get Tab ii get sub div 
    Tab ii 3 add get Tab ii 1 add get sub mul add 
 } bind def
/n  256 def
/y  1 def
/x  0 def
/dx 1 n div def
/dy 0.05 def
1 1 n
 {/h exch n div 320 mul 380 add ExecTab 360 div def  
   h 0.7 1 sethsbcolor   
   x y moveto dx 0 rlineto 0 dy neg rlineto dx neg 0 rlineto closepath 
   gsave 
   stroke
   grestore
   fill
  /x x dx add def
 } for
} bind def

%-Begin

% Bounding box
% Choose one
/bb 1 def
/bb 0 def 

% Color
% Choose one
/cc 0 def
/cc 1 def 

bb 1 eq {Bbox} if

true setstrokeadjust

x0 y0 translate
sx sy scale 

/clm 4 def 

Grid 
cc 1 eq 
{Spectrum
 0 setgray
 0.2 mm sx div setlinewidth
 newpath 0 0.95 moveto 1 0.95 lineto stroke } if 

0.4 mm sx div setlinewidth % 0.4

NormL

MakeS

0 setgray 

cc 1 eq {1 0.0 0 setrgbcolor} if
DrawX

cc 1 eq {0 0.0 1 setrgbcolor} if
DrawZ

cc 1 eq {0 0.8 0 setrgbcolor} if
DrawY

0.4 mm sx div setlinewidth
0 setgray
newpath
0 0 moveto 1 0 rlineto 0 1 rlineto -1 0 rlineto closepath
stroke

showpage

%%EndDocument