%!PS-Adobe-3.0 EPSF-3.0 http://farbe.li.tu-berlin.de/heo8/heo80-1a
%%BoundingBox: 70 85 246 206

%START PDFDE011.EPS
/pdfmark01 where {pop} {userdict /pdfmark01 /cleartomark load put} ifelse
/languagelevel where {pop languagelevel} {1} ifelse
2 lt { userdict (<<) cvn ([) cvn load put
       userdict (>>) cvn (]) cvn load put} if
[/Title (PostScript pictures: farbe.li.tu-berlin.de/heo8/heo8.HTM)
 /Author (compare K. Richter "Computergrafik ...": ISBN 3-8007-1775-1)
 /Subject (goto: http://farbe.li.tu-berlin.de or http://color.li.tu-berlin.de)
 /Keywords (image reproduction, colour devices)
 /Creator (klaus.richter@mac.com)
 /CreationDate (D:2024100112000)
 /ModDate (D:20241001112000)
/DOCINFO pdfmark01
[ /View [ /Fit ]
/DOCVIEW pdfmark01
%END  PDFDE011

/Times-Roman findfont dup length dict  begin
{1 index /FID ne {def} {pop pop} ifelse }forall
/Encoding ISOLatin1Encoding def
currentdict end

/Times-ISOL1 exch definefont pop

/Times-Italic findfont dup length dict  begin
{1 index /FID ne {def} {pop pop} ifelse }forall
/Encoding ISOLatin1Encoding def
currentdict end

/TimesI-ISOL1 exch definefont pop

/Times-Bold findfont dup length dict  begin
{1 index /FID ne {def} {pop pop} ifelse }forall
/Encoding ISOLatin1Encoding def
currentdict end

/TimesB-ISOL1 exch definefont pop

/Times-BoldItalic findfont dup length dict  begin
{1 index /FID ne {def} {pop pop} ifelse }forall
/Encoding ISOLatin1Encoding def
currentdict end

/TimesBI-ISOL1 exch definefont pop

/FS {findfont exch scalefont setfont} bind def
/MM {72 25.4 div mul} def /str {8 string } bind def

/TS {160 /Times-ISOL1 FS} bind def
/TL {200 /Times-ISOL1 FS} bind def
/TK {250 /Times-ISOL1 FS} bind def
/TM {300 /Times-ISOL1 FS} bind def
/TG {350 /Times-ISOL1 FS} bind def

/TIS {160 /TimesI-ISOL1 FS} bind def
/TIL {200 /TimesI-ISOL1 FS} bind def
/TIK {250 /TimesI-ISOL1 FS} bind def
/TIM {300 /TimesI-ISOL1 FS} bind def
/TIG {350 /TimesI-ISOL1 FS} bind def

/TBS {160 /TimesB-ISOL1 FS} bind def
/TBL {200 /TimesB-ISOL1 FS} bind def
/TBK {250 /TimesB-ISOL1 FS} bind def
/TBM {300 /TimesB-ISOL1 FS} bind def
/TBG {350 /TimesB-ISOL1 FS} bind def

/TBIS {160 /TimesBI-ISOL1 FS} bind def
/TBIL {200 /TimesBI-ISOL1 FS} bind def
/TBIK {250 /TimesBI-ISOL1 FS} bind def
/TBIM {300 /TimesBI-ISOL1 FS} bind def
/TBIG {350 /TimesBI-ISOL1 FS} bind def

/SS {160 /Symbol FS} bind def
/SL {200 /Symbol FS} bind def
/SK {250 /Symbol FS} bind def
/SM {300 /Symbol FS} bind def
/SG {350 /Symbol FS} bind def

/CS {160 /Courier-ISOL1 FS} bind def
/CL {200 /Courier-ISOL1 FS} bind def
/CK {250 /Courier-ISOL1 FS} bind def
/CM {300 /Courier-ISOL1 FS} bind def
/CG {350 /Courier-ISOL1 FS} bind def

/CBS {160 /CourierB-ISOL1 FS} bind def
/CBL {200 /CourierB-ISOL1 FS} bind def
/CBK {250 /CourierB-ISOL1 FS} bind def
/CBM {300 /CourierB-ISOL1 FS} bind def
/CBG {350 /CourierB-ISOL1 FS} bind def

/nGs {350 /Times-ISOL1 FS  show} bind def
/kGs {350 /TimesI-ISOL1 FS  show} bind def
/bGs {350 /TimesB-ISOL1 FS  show} bind def
/jGs {350 /TimesBI-ISOL1 FS  show} bind def
/sGs {350 /Symbol FS  show} bind def
/iGs {300 /Times-ISOL1 FS 0 -80 rmoveto show 0   80 rmoveto} bind def
/eGs {300 /Times-ISOL1 FS 0 200 rmoveto show 0 -200 rmoveto} bind def
/ibGb {300 /TimesB-ISOL1 FS 0 -80 rmoveto show 0   80 rmoveto} bind def
/ebGb {300 /TimesB-ISOL1 FS 0 200 rmoveto show 0 -200 rmoveto} bind def
/ipG {300 /Times-ISOL1 FS 50 50 rmoveto (\267) show 50 -50 rmoveto} bind def

%20% kleiner
/nMs {300 /Times-ISOL1 FS  show TM} bind def
/kMs {300 /TimesI-ISOL1 FS  show TM} bind def
/bMs {300 /TimesB-ISOL1 FS  show TM} bind def
/jMs {300 /TimesBI-ISOL1 FS  show TM} bind def
/sMs {300 /Symbol FS  show TM} bind def
/iMs {250 /Times-ISOL1 FS 0 -60 rmoveto show 0 60 rmoveto TM} bind def
/eMs {250 /Times-ISOL1 FS 0 160 rmoveto show 0 -160 rmoveto TM} bind def
/ibMs {250 /TimesB-ISOL1 FS 0 -60 rmoveto show 0 60 rmoveto TM} bind def
/ebMs {250 /TimesB-ISOL1 FS 0 160 rmoveto show 0 -160 rmoveto TM} bind def
/ipM {250 /Times-ISOL1 FS 40 40 rmoveto (\267) show 40 -40 rmoveto TM} bind def

%40% kleiner
/nKs {250 /Times-ISOL1 FS  show TK} bind def
/kKs {250 /TimesI-ISOL1 FS  show TK} bind def
/bKs {250 /TimesB-ISOL1 FS  show TK} bind def
/jKs {250 /TimesBI-ISOL1 FS  show TK} bind def
/sKs {250 /Symbol FS  show TK} bind def
/iKs {200 /Times-ISOL1 FS 0 -50 rmoveto show 0 50 rmoveto TK} bind def
/eKs {200 /Times-ISOL1 FS 0 130 rmoveto show 0 -130 rmoveto TK} bind def
/ibKs {200 /TimesB-ISOL1 FS 0 -50 rmoveto show 0 50 rmoveto TK} bind def
/ebKs {200 /TimesB-ISOL1 FS 0 130 rmoveto show 0 -130 rmoveto TK} bind def
/ipK {200 /Times-ISOL1 FS 30 30 rmoveto (\267) show 30 -30 rmoveto TK} bind def

%60% kleiner
/nLs {200 /Times-ISOL1 FS  show TL} bind def
/kLs {200 /TimesI-ISOL1 FS  show TL} bind def
/bLs {200 /TimesB-ISOL1 FS  show TL} bind def
/jLs {200 /TimesBI-ISOL1 FS  show TL} bind def
/sLs {200 /Symbol FS  show TL} bind def
/iLs {160 /Times-ISOL1 FS 0 -40 rmoveto show 0 40 rmoveto TL} bind def
/eLs {160 /Times-ISOL1 FS 0 110 rmoveto show 0 -110 rmoveto TL} bind def
/ibLs {160 /TimesB-ISOL1 FS 0 -40 rmoveto show 0 40 rmoveto TL} bind def
/ebLs {160 /TimesB-ISOL1 FS 0 110 rmoveto show 0 -110 rmoveto TL} bind def
/ipL {160 /Times-ISOL1 FS 25 25 rmoveto (\267) show 25 -25 rmoveto TL} bind def
/jbLs {160 /TimesBI-ISOL1 FS 0 110 rmoveto show 0 -110 rmoveto TL} bind def

%80% smaller
/nSs {160 /Times-ISOL1 FS  show TS} bind def
/kSs {160 /TimesI-ISOL1 FS  show TS} bind def
/bSs {160 /TimesB-ISOL1 FS  show TS} bind def
/jSs {160 /TimesBI-ISOL1 FS  show TS} bind def
/sSs {160 /Symbol FS  show TS} bind def
/iSs {130 /Times-ISOL1 FS 0 -30 rmoveto show 0 30 rmoveto TS} bind def
/eSs {130 /Times-ISOL1 FS 0 80 rmoveto show 0 -80 rmoveto TS} bind def
/ibSs {130 /TimesB-ISOL1 FS 0 -30 rmoveto show 0 30 rmoveto TS} bind def
/ebSs {130 /TimesB-ISOL1 FS 0 80 rmoveto show 0 -80 rmoveto TS} bind def
/ipS {130 /Times-ISOL1 FS 20 20 rmoveto (\267) show 20 -20 rmoveto TS} bind def
/jbSs {130 /TimesBI-ISOL1 FS 0 80 rmoveto show 0 -80 rmoveto TS} bind def

/20rm {20 0 rmoveto} def

/cvishow {cvi 10 string cvs show} def
/cvsshow1 {10 mul cvi 0.1 mul 10 string cvs show} def
/cvsshow2 {100 mul cvi 0.01 mul 10 string cvs show} def
/cvsshow3 {1000 mul cvi 0.001 mul 10 string cvs show} def
/cvsshow4 {10000 mul cvi 0.0001 mul 10 string cvs show} def

/cvsshow1x {/nxx exch def                              %example nxx=99.1/99.0
             nxx 0 lt {(-) show}
                      {() show} ifelse
             nxx 10 mul cvi abs /nxi exch def          %nxi=991/990
             nxi 10 idiv /nxa exch def                 %nxa=99
             nxi nxa 10 mul sub /nxb exch def          %nxb=1/0
             nxa cvishow (,) show                      %nxa=99
             nxb cvishow                               %nxb=1/0
           } def
/cvsshow2x {/nxx exch def                              %example nxx=99.12/99,02/99,00
             nxx 0 lt {(-) show}
                      {() show} ifelse
             nxx 100 mul cvi abs /nxi exch def         %nxi=9912/9902/00
             nxi 100 idiv /nxa exch def                %nxa=99
             nxi nxa 100 mul sub /nxb exch def         %nxb=12/02/00
             nxa cvishow (,) show                      %nxb=99,
             nxb 10 ge {nxb cvishow} if                %nxb=12
             nxb  1 ge
             nxb  9 le and {(0) show nxb cvishow} if   %nxb=02
             nxb  0 eq {(00) show} if                  %nxb=00
           } def
/cvsshow3x {/nxx exch def                              %example nxx=99.123/99.012/99.001/99.000
             nxx 0 lt {(-) show}
             {() show} ifelse
             nxx 1000 mul cvi abs /nxi exch def        %nxi=99123/99012/99001/99000
             nxi 1000 idiv /nxa exch def               %nxa=99
             nxi nxa 1000 mul sub /nxb exch def        %nxb=123/012/001/000
             nxa cvishow (,) show                      %nxb=99,
             nxb 100 ge {nxb cvishow} if               %nxb=123/012/001/000
             nxb  10 ge
             nxb  99 le and {(0) show nxb cvishow} if  %nxb=012
             nxb   1 ge
             nxb   9 le and {(00) show nxb cvishow} if %nxb=001
             nxb   0 eq {(000) show} if                %nxb=000
           } def

/cvsshow4x {/nxx exch def                              %example nxx=99.123/99.0
             nxx 0 lt {(-) show}
                      {() show} ifelse
             nxx 10000 mul cvi abs /nxi exch def        %nxi=99123/99012/99001/9
             nxi 10000 idiv /nxa exch def               %nxa=99
             nxi nxa 10000 mul sub /nxb exch def        %nxb=123/012/001/000
             nxa cvishow (,) show                       %nxb=99,
             nxb 1000 ge {nxb cvishow} if               %nxb=123/012/001/000
             nxb  100 ge
             nxb  999 le and {(0) show nxb cvishow} if  %nxb=012
             nxb  10 ge
             nxb  99 le and {(00) show nxb cvishow} if  %nxb=012
             nxb   1 ge
             nxb   9 le and {(000) show nxb cvishow} if %nxb=001
             nxb   0 eq {(0000) show} if                %nxb=000
           } def

/cvsshow4s {/nxx exch def                              %example nxx=-0,1234
             nxx 0 lt {(-0,) show}
                      {(0,) show} ifelse
             /nxi nxx 10000 mul cvi abs def            %nxi=1234
             nxi 1000 ge {nxi cvishow} if              %nxb=123/012/001/000
             nxi 100 ge
             nxi 999 le and {(0) show nxi cvishow} if      %nxb=123/012/001/000
             nxi  10 ge
             nxi  99 le and {(00) show nxi cvishow} if  %nxb=012
             nxi   1 ge
             nxi   9 le and {(000) show nxi cvishow} if %nxb=001
             nxi   0 eq {(0000) show} if                %nxb=000
           } def

%XCHA01.PS BEG
/rec %x, y width heigth
  {/heigth exch def /width exch def
   moveto width 0 rlineto 0 heigth rlineto width neg 0 rlineto
   closepath } bind def

/colrecfi %x y width heigth r g b
  {setrgbcolor rec fill} bind def

/colrecst %x y width heigth r g b
  {setrgbcolor rec stroke} bind def

/rem %x, y width heigth
  {/heigth exch 0.5 mul def /width exch 0.5 mul def
   /yleftb exch heigth 0.5 mul add def
   /xleftb exch width  0.5 mul add def
   xleftb yleftb
   moveto width 0 rlineto 0 heigth rlineto width neg 0 rlineto
   closepath } bind def

/colremfi %x y width heigth r g b
  {setrgbcolor rem fill} bind def

/colremst %x y width heigth r g b
  {setrgbcolor rem stroke} bind def

/tfr {1.0 0.0 0.0 setrgbcolor} bind def %Reproduktionsfarben
/tfg {0.0 1.0 0.0 setrgbcolor} bind def
/tfb {0.0 0.0 1.0 setrgbcolor} bind def
/tfc {0.0 1.0 1.0 setrgbcolor} bind def
/tfm {1.0 0.0 1.0 setrgbcolor} bind def
/tfy {1.0 1.0 0.0 setrgbcolor} bind def

/tfw {1.00 1.00 1.00 setrgbcolor} bind def %Graureihe
/tfh {0.75 0.75 0.75 setrgbcolor} bind def
/tfz {0.50 0.50 0.50 setrgbcolor} bind def
/tfd {0.25 0.25 0.25 setrgbcolor} bind def
/tfn {0.00 0.00 0.00 setrgbcolor} bind def

%**********************************************
/proc_basdef {%BEG proc_basdef
/YnW 100 def %HAULAB, CIELAB
%/Yki   700 array def %101(W)+3*101(R,G,B)
%/dYki  700 array def
%/L*ki  700 array def
%/logL*ki 700 array def
%/X0ki 700 array def %log(Xi)

/Yi     700 array def %101(W)+3*101(R,G,B)
/dYi    700 array def
/L*i    700 array def
/logL*i 700 array def
/X0ki   700 array def %log(Xi)

/X00k 100 array def %x-axis
/Y00k 100 array def %L*i, log(L*i)
/Y0uk 100 array def %L*i/Lu, log(L*i/L*u)
/Y10k 100 array def %dYi, log(dYi)
/Y1uk 100 array def %dYi/dYu, log(dYi/dYu)
/Y20k 100 array def %dYi/Yi, log(dYi/Yi) sensitivity
/Y2uk 100 array def %(dYi/dYu)/(Yi/Yu), log[(dYi/dYu)/(Yi/Yu)]
/Y30k 100 array def %Yi/dYi, log(Yi/dYi) contrast
/Y3uk 100 array def %(Yi/Yu)/(dYi/dYu), log[(Yi/Yu)/(dYi/dYu)]

/Yx0k 100 array def %one of four Y00k, Y10k, Y20k, Y20k
/Yxuk 100 array def %one of four Y0uk, Y1uk, Y2uk, Y2uk

/MULX 1000 def
/MULY 1000 def

%data for HAULAB IECsRGB, TUBsRGB
/c32 3.2258 def %HAULAB n=0.31
/e10D32 1.0 3.2258 div def
/e20D32 2.2258 3.2258 div def

/c24 2.4 def %IECsRGB
/e10D24 1.0 2.4 div def
/e14D24 1.4 2.4 div def

/c30 3.0 def %CIELAB
/e10D30 1.0 3.0 div def
/e20D30 2.0 3.0 div def

/c23 2.3 def %TUBsRGB
/e10D23 1.0 10 ln div def
/e13D23 10 ln 1 sub 10 ln div def

/econst 2.71828182 def
/W2 2 sqrt def
/FL 0.0001 def

/x00t 0400 def %xpos for BEG equations
/x01t 1900 def %xpos for shift equations
/x00e 5250 def %xpos for Num equations

%STOP0A
} bind def %END proc_basdef

%$STOP00

%***************************************************
/proc_funcHAU {%BEG proc_funcHAU function Haubner 4 versions, ifunc-0 to 3
%from 'hnp5'Y10-3n.EPS, line 259:371
/Haubdatj 28 array def %phi, Cr(phi), S0(phi), S1(phi)

%BEG Haubdati Table 1, 7x4 data
%A Unifield Relationship between Brightness an Luminance
%P. Haubner, H.-W. Bodmann and A.W. Marsden
%Siemens Forsch. u. Entwickl.Ber. Bd. 9 (1980), Nr. 6, p.315-318

/phk 7 array def %form above publication, i=ichart=6,0 10,20,..,120
/CTk 7 array def
/S0k 7 array def
/S1k 7 array def
/Ltk 7 array def %t=black threshold, equ. (71), Haubner, PhD-thesis

/phi 7 array def %form above publication, i=ichart=0,6 120,90,..,10
/CTi 7 array def
/S0i 7 array def
/S1i 7 array def
/Lti 7 array def %t=black threshold, equ. (71), Haubner, PhD-thesis

%Lti=[S0i + S1i*(La)^n]^(1/n)

%Table 1 order of Haubner
/phk [010     020     030     060     090     100     120    ] def
/CTk [30.747  27.971  26.235  23.973  23.415  23.128  22.969 ] def
/S0k [0.27308 0.20132 0.17975 0.13133 0.10838 0.07473 0.07186] def
/S1k [0.39842 0.35557 0.31888 0.26578 0.25265 0.24943 0.24481] def

%inverse Table 1 order of Haubner, used as default, index i=ichart=0,6
/phi [120     100     090     060     030     020     010    ] def
/CTi [22.969  23.128  23.415  23.973  26.235  27.971  30.747 ] def
/S0i [0.07186 0.07473 0.10868 0.13133 0.17975 0.20132 0.27308] def
/S1i [0.24481 0.24943 0.25265 0.26578 0.31888 0.35557 0.39842] def

/Haub_Laj 7 array def %300 default, index j=jchart=0,6
%j         0    1    2    3   4  5   6
/Haub_Laj [0300 1000 200  40  08 1.6 0.32] def

/Haub_n     0.31     def %fix
/Haub_1Mn 1 0.31 div def %=3.2268 (1Mn=1-Minus-n)

/Haub_B0ij 49 array def %=7x7 options for ichart=0,6 and jchart=0,6
/Haub_Ltij 49 array def %t=black threshold
/Haub_B*ij 49 array def %brightness - Hellheit

/Laj     Haub_Laj jchart get def %a=Adaptation white La=300, 5000, ..1,6
/Lajen   Laj Haub_n exp def

/Lr      300 def                  %r=reference=La0
/Lren    Lr Haub_n exp def        %e=exponent

/Lrdaj   Lr Laj div def
/Lrdajen Lrdaj Haub_n exp def

/Lajdr   Laj Lr div def
/Lajdren Lajdr Haub_n exp def

/LTj     Laj def              %0.01Laj < Laj < 10Laj
                              %or 0,16 <= Laj <= 5000 cd/m^2
/LTjen   LTj Haub_n exp def

/LTjdaj   LTj Laj div def
/LTjdajen LTjdaj Haub_n exp def

/Lu     Lr 0.18 mul def
/Luen   Lu Haub_n exp def

/B0ij 49 array def
/B*ij 49 array def
/Ltij 49 array def

/sxij 49 array def
/dxij 49 array def
/syij 49 array def
/dyij 49 array def
/szij 49 array def
/dzij 49 array def

0 1 6 {/j exch def %i=0,6
0 1 6 {/i exch def %i=0,6
       /k i 6 mul j add def
       %B0(Lu,p) = Cri(p) [S0i(p) + S1i(p) * Lu^n]
       B0ij k S0i  i get S1i i get Lajen mul add CTi i get mul put
       sxij k CTi  i get put
       dxij k B0ij k get put
       syij k CTi  i get Lren mul put
       dyij k B0ij k get put
       szij k CTi  i get Lren mul 0.18 Haub_n exp mul put
       dzij k B0ij k get put
       Ltij k S0i  i get S1i i get Lajen mul add Haub_1Mn exp put
       %for Y10-3n
       ifunc 0 eq {B*ij k CTi  i get LTjen mul B0ij k get sub put} if
       %for Y10-7n
       ifunc 1 eq {B*ij k sxij k get LTjen mul dxij k get sub put} if
       %for Y11-3n
       ifunc 2 eq {B*ij k syij k get LTjen Lren div mul dyij k get sub put} if
       %for Y11-7n
       ifunc 3 eq {B*ij k szij k get LTjen Lren div mul dzij k get sub put} if
} for %i=0,6
} for %j=0,6

%equations:
%ifunc 0 eq {%func=0 for Y10-3:
%       B*i i CTi i get LTen mul B0i i get sub put
%           } if %func=0 for Y10-3
%
%ifunc 1 eq {%func=1 for Y10-7:
%       B*i i CTi i get LTen mul B0i i get sub put
%       B*i i sxi       LTen mul dxi i get sub put
%        sxi i CTi i get put
%        dxi i B0i i get put
%        B*i i sxi i get LTjen mul dxi i get sub put
%           } if %func=1 for Y10-7
%
%ifunc 2 eq {%func=2 for Y11-3:
%       B*i i CTi i get LTen mul          B0i i get sub put
%       B*i i sxi       LTen mul          dxi i get sub put
%       B*i i CTi i get LTen mul Lren div B0i i get sub put
%       B*i i sYi       LTen Lren div mul dYi i get sub put
%
%        sYi i CTi i get Lren mul put
%        dYi i B0i i get put
%        B*i i sYi i get LTen Lren div mul dYi i get sub put
%           } if %func=2 for Y11-3
%
%ifunc 3 eq {%func=3 for Y11-7:
%       B*i i CTi i get LTen mul          B0i i get sub put
%       B*i i sxi       LTen mul          dxi i get sub put
%       B*i i CTi i get LTen mul Lren div B0i i get sub put
%       B*i i sYi       LTen Lren div mul dYi i get sub put
%       B*i i CTi i get LTen mul Lren div B0i i get sub put
%       B*i i szi       LTen Luen div mul dzi i get sub put
%
%        szi i CTi i get Lren mul 0.18 Haub_n exp mul put
%        dzi i B0i i get put
%        B*i i szi i get LTen Lren div mul dzi i get sub put
%           } if %func=3 for Y11-7

} bind def %END proc_funcHAU function Haubner 7x7 versions, ifunc-0 to 3

%$STOP01

%*************************************************
/proc_Ykij_L*kij_dYkij_H_0 {%BEG proc_Ykij_L*kij_dYkij_H_0 %H=HAULAB
/k10 1 def
/k1 ichart       100 mul k10 add def
/k2 ichart 1 add 100 mul def 
/Yk        100 array def
/Ykij     4900 array def
/L*kij    4900 array def
/dYkij    4900 array def
/logdYkij 4900 array def
/logL*kij 4900 array def

%use either for example syij i=0,6 or j=0,6
0 1 99
 {/k exch def %k=0,99, allways
        Yk k k 1 add put
       } for %k=0,99

0 1 06 {/j exch def %j=0,6
0 1 06 {/i exch def %i=0,6
        /kch i 6 mul j add def %0<=kch<=48    
0 1 99 {/k exch def %k=0,99
        /kij 100 kch mul k add def
        Ykij   kij   Yk k get put
        L*kij  kij   Yk k get YnW div e10D32 exp 
                     syij kch get mul
                     dyij kch get sub put
        dYkij  kij   Yk k get YnW div e20D32 exp c32 mul
                     100 mul syij kch get div put
        L*kij kij get 0 le {logL*kij kij 0 put}
                           {logL*kij kij L*kij kij get log put} ifelse
       } for %k=0,99
       } for %i=0,6
       } for %j=0,6

} bind def %END proc_Ykij_L*kij_dYkij_H_0 %H=HAULAB

%*************************************************
/proc_Yi_L*i_dYi_C_0 {%BEG proc_Yi_L*i_dYi_C_0 %C=CIELAB
i1 1 100 {/i exch def %i=1,100
         Yi  i i YnW mul 100. div put
         L*i i Yi i get YnW div e10D30 exp 116 mul 16 sub put
         dYi i Yi i get YnW div e20D30 exp c30 mul
         100 mul 116 div put
        } for %i=1,100
} bind def %END proc_Yi_L*i_dYi_C_0 %C=CIELAB

%*************************************************
/proc_Yi_L*i_dYi_I_0 {%BEG proc_Yi_L*i_dYi_I_0 %I=IECsRGB
i1 1 100 {/i exch def %i=1,100
         Yi  i i YnW mul 100. div put
         L*i i Yi i get YnW div e10D24 exp 100 mul put
         dYi i Yi i get YnW div e14D24 exp c24 mul
         100 mul 100 div put
        } for %i=1,100
} bind def %END proc_Yi_L*i_dYi_I_0 %I=IECsRGB

%*************************************************
/proc_Yi_L*i_dYi_T_0 {%BEG proc_Yi_L*i_dYi_T_0 %T=TUBsRGB
i1 1 100 {/i exch def %i=1,100
         Yi  i i YnW mul 100. div put
         L*i i Yi i get YnW div e10D23 exp 100 mul put
         dYi i Yi i get YnW div e13D23 exp c23 mul put
        } for %i=1,100
} bind def %END proc_Yi_L*i_dYi_T_0 %T=TUBsRGB

%$STOP02

%**************************************************************
/proc_funcHAU_CIE_IEC_TUB {%BEG proc_funcHAU_CIE_IEC_TUB
%uses proc_funcHAU
%for ifunc=0 (HAULAB), 1 (CIELAB), 2 (IECsRGB), 3(TUBsRGB)

ifunc 0 eq {%ifunc=0 BEG HAULAB
%standard for phi=120 and La=300cd/m^2
%2: 1/3.2258=0.3100
%for phi=120 in he60/he60-3a.eps
%L* =134.60*(Y/Yn)**(1/3.2258)-34.60
%   =134.60*(Yu/Yn)**0.31*(Y/Yu)**0.31-34.60
%   =134.60*(18/100)**0.31*(Y/Yu)**0.31-34.60

%L*u=134.60*0.5876        *(Y/Yu)**0.31-34.60
%   =79.09                             -34.60
%   =45.39
%
%s*(Yu/Yn)**0.31=r*(Yu/Yu)**0.31=1
%r=s*(Yu/Yn)**0.31
% =134.60*(0.18)**0.31
% =134.60.5876
% =79.09
%
%for all versions phi=120 to 10, La=300,1000,200,40,8?
%normalized at least for La=300cd/m^2
%to be checked for La=1000,200,40,8
%
/L*uij 49 array def
/Yuij  49 array def
/dYuij 49 array def
/Yn    100 def
/L*u   50 def
/i ichart def
/j jchart def
/L*uij L*u def
/Yuij  L*u dyij ij get add syij ij get div 3.2258 exp 100 mul def
/dYuij Yn e10D32 exp syij ij get div 3.2258 mul Yuij e20D32 exp mul def
/Yu  Yuij  def
/dYu dYuij def
/iu 18 def

/aCIE 3.2258 syij ij get div Yn e20D32 exp mul def
/bCIE aCIE iu e20D30 exp mul def

/cCIE 3.2258 syij ij get div Yn e10D32 exp mul def
/dCIE cCIE iu e20D30 exp mul def

/eCIE syij ij get 3.2258 div Yn e20D32 exp mul def
/fCIE eCIE iu e20D32 exp mul def

proc_Ykij_L*kij_dYkij_H_0

} if %ifunc=0 END HAULAB

%****
ifunc 1 eq {%ifunc=1 BEG CIELAB
%2: 1/2,4=0.41667
%L*u=116*(Yu/Yn)**(1/3)-16
%   =116*(0.18)**(1/3) -16
%   =116*0.5656-16
%   =65.50-16=49,50
%
%(L*u+16)/116=(Yu/Yn)**(1/3)
%Yu=Yn*(L*u+16)/116)**3
%Yu=100*(65.50/116)**3
%  =100*0,5647**3
%  =100*0,1800=18.00
%Yn=100, Yu=18 L*u=49,50
%
%s*(Yu/Yn)**(1/3)=r*(Yu/Yu)**(1/3)=1
%r=s*(Yu/Yn)**(1/3)
% =116*(0.18)**(1/3)
% =116+0.5656
% = 65.50
%
/Yn 100 def
/L*u 50 def
/Yu L*u 16 add 116 div 3 exp 100 mul def
/dYu Yn e10D30 exp 116 div 3 mul Yu e20D30 exp mul def
/iu 18 def

/aCIE 3 116 div Yn e20D30 exp mul def
/bCIE aCIE iu e20D30 exp mul def

/cCIE 3 116 div Yn e10D30 exp mul def
/dCIE cCIE iu e20D30 exp mul def

/eCIE 116 3 div Yn e20D30 exp mul def
/fCIE eCIE iu e20D30 exp mul def

proc_Yi_L*i_dYi_C_0

} if %ifunc=1 END CIELAB

%*****
ifunc 2 eq {%ifunc=2 BEG IECsRGB

%L*=100(Y/Yn)**(1/2.4)
%  =100*(Yu/Yn)**(1/2.4)*(Y/Yu)**(1/2,4)
%  =g                   *(Y/Yu)**(1/2,4)
% g=100*(18/100)**(1/2,4)=100*(0,18)**0,4166
% g=48,95
 
%L*u=100(Yu/Yn)**(1/2.4)
%L*/L*u=(Y/Yu)**(1/2.4)
%log[L*/L*u]=(1/2,4)*log(Y/Yu)=0,4166*log(Y/Yu)
%ln [L*/L*n]=2.30258*0.4166*log(Y/Yu)=0,9593
%oder
%log[L*/L*u]=(1/2,3)*log(Y/Yu)=0,4347*log(Y/Yu)
%ln [L*/L*u]=2.30258*0.4347*log(Y/Yu)=1,001*log(Y/Yu)
%
%/Yn 100 def
%/L*u 50 def

%1: not used 50=100(Yu/100)**(1/2.4)
%0.5**(2.4)=(Yu/100)
%Yu=100*0.5**2.4=18.94

%2: 1/2,4=0.41667
%L*u=100(Yu/Yn)**(1/2.4)
%L*u=100(18/100)**(1/2.4)=48.94
%Yu=Yn*(Lu/100)**2.4
%Yu=100(Lu/100)**2.4
%Yn=100, Yu=18 L*u=48.95

%L*=100*(Y/Yn)**(1/2,4)
%dL*/dY=100*(1/2,4)*(1/Yn)*(Y/Yn)**(-1,4/2,4)
%fuer dL*=1:
%dY =(2,4*Yn)/100        *(Y/Yn)**(1,4/2,4)
%   =a                   *(Y/Yn)**(1,4/2,4)
%   =a*(Yu/Yn)**(1,4/2,4)*(Y/Yu)**(1,4/2,4)
%   =b                   *(Y/Yu)**(1,4/2,4)
%   =2,4*(Y/Yn)**(1.4/2,4)
%   =2,4*(1/Yn)**(1,4/2,4)*(Y)**(1,4/2,4)
%dYu=2,4*(Yu/Yn)**(1,4/2,4)
%   =2,4*(1/Yn)**(1,4/2,4)*(Yu)**(1,4/2,4)
%dY/dYu=(Y/Yu)**(1,4/2,4)

%dY/Y=2,4*(Y/Yn)**(1,4/2,4)*(1/Y)
%    =2,4*(1/Yn)**(1,4/2,4)*(Y)**(1,4/2,4)*(1/Y)
%    =2,4*(1/Yn)**(1,4/2,4)*(Y)**(-1/2,4)
%    =c*Y**(-1/2,4)

%a=(2,4*Yn)/100
% =2,4
%b=a*(Yu/Yn)**(1,4/2,4)
% =2,4*(18/100)**(1,4/2,4)
% =2,4*(18/100)**(0,583333)
% =2,4*0,36777=0,8862
%c=2,4(1/Yn)**(1,4/2,4)
% =2,4*0.01**0,5833=0,1635

/Yn 100 def
/L*u 50 def
/Yu L*u 100 div 2.4 exp 100 mul def
/dYu Yu 100 div e14D24 exp 2.4 mul def
/iu 18 def

/aCIE 2.4 def
/bCIE iu 100 div e14D24 exp aCIE mul def

/cCIE 2.4 100 div Yn e10D24 exp mul def
/dCIE cCIE iu e14D24 exp mul def

/eCIE 100 2.4 div Yn e14D24 exp mul def
/fCIE eCIE iu e14D24 exp mul def

proc_Yi_L*i_dYi_I_0

} if %ifunc=2 END IECsRGB

%******
ifunc 3 eq {%ifunc=3 BEG TUBsRGB

%L*=100(Y/Yn)**(1/2.3)
%L*u=100(Yu/Yn)**(1/2.3)
%/Yn 100 def
%/L*u 50 def

%1: not used 50=100(Yu/100)**(1/2.3)
%0.5**(2.3)=(Yu/100)
%Yu=100*0.5**2.3=20.31

%2: 1/2,3=0.4348
%L*u=100(Yu/Yn)**(1/2.3)
%L*u=100(18/100)**(1/2.3)=47.45
%Yu=Yn*(Lu/100)**2.3
%Yu=100(Lu/100)**2.3
%Yn=100, Yu=18 L*u=47.45

%L*=100*(Y/Yn)**(1/2,3)
%dL*/dY=100*(1/2,3)*1/Yn)*(Y/Yn)**(-1,3/2,3)
%dY=(2.3*Yn)/100*(Y/Yn)**(1,3/2,3)

%dYu=2.3*(Yu/Yn)**(1,3/2,3)

/Yn 100 def
/L*u 50 def

/Yu L*u 100 div 2.3 exp 100 mul def
/dYu Yu 100 div e13D23 exp 2.3 mul def
/iu 18 def

/aCIE 2.3 100 div Yn e13D23 exp mul def
/bCIE aCIE iu e13D23 exp mul def

/cCIE 2.3 100 div Yn e10D23 exp mul def
/dCIE cCIE iu e13D23 exp mul def

/eCIE 100 2.3 div Yn e13D23 exp mul def
/fCIE eCIE iu e13D23 exp mul def

} if %ifunc=3 END TUBsRGB

proc_Yi_L*i_dYi_T_0

} bind def %END proc_funcHAU_CIE_IEC_TUB

%$STOP03
%***********************************************
/ioute 0 def
/proc_cero_line {%BEG proc_cero_line
%1. log line = cero line
tfr
-2. MULX mul 1. log MULY mul moveto
 0. MULX mul 1. log MULY mul lineto stroke
tfn %tfw

%2. log line = +1 line
tfg
-2. MULX mul 10. log MULY mul moveto
 0. MULX mul 10. log MULY mul lineto stroke
tfn %tfw
} bind def %cero line

%***************************************************
/proc_ij_syij_dyij_Ykij_L*kij_Yxyk {%BEG proc_ij_syij_dyij_Ykij_L*kij_Yxyk 
%definition for 4 functions: L*kij, dYkij, dYkij/Ykij, Ykij/dYkij
%no log, 1 1 100 allways possible

/ij ichart 6 mul jchart add def
/L*u   50 def
/L*uij L*u def
/Yuij  L*u dyij ij get add syij ij get div 3.2258 exp 100 mul def
/dYuij Yn e10D32 exp syij ij get div 3.2258 mul Yuij e20D32 exp mul def
/Yu  Yuij  def
/dYu dYuij def
/iu 18 def

0 1 99 {/k exch def %k=1,99
         /kij ij 100 mul k add def
         X00k k Ykij  kij get put

         Y00k k L*kij kij get put
         Y0uk k L*kij kij get L*uij div put
         Y10k k dYkij kij get put
         Y1uk k dYkij kij get dYuij div put
         Y20k k dYkij kij get Ykij kij get div put
         Y2uk k dYkij kij get Ykij kij get div
                dYuij         Yuij         div div put
         Y30k k Ykij kij get dYkij kij get div put
         Y3uk k Ykij kij get dYkij kij get div
                Yuij         dYuij         div div put

         xchartl 0 eq {Yx0k k Y00k k get put
                       Yxuk k Y0uk k get put} if
         xchartl 1 eq {Yx0k k Y10k k get put
                       Yxuk k Y1uk k get put} if
         xchartl 2 eq {Yx0k k Y20k k get put
                       Yxuk k Y2uk k get put} if
         xchartl 3 eq {Yx0k k Y30k k get put
                       Yxuk k Y3uk k get put} if
        } for %k=1,99

} bind def %END proc_ij_syij_dyij_Ykij_L*kij_Yxyk

%***************************************************
/proc_Y_curve {%BEG proc_Y_curve
/ij ichart 6 mul jchart add def

iY_curve 1 eq {%iYcurve=1
/yinter jlog 0 eq {2200 def}{1200 def} ifelse
-1900 yinter moveto TBL (Y_curve, ij=) show ij cvishow
                        (, Yuij=) show Yuij cvishow
                        (, L*uij=) show L*uij cvishow
%                        (, Yk, Ykij, L*kij, X00k, Yx0k) show

0 1 3 {/ke exch def %ke=0,3
       ke 0 eq {/k 99 def} if
       ke 1 eq {/k Yuij cvi def} if
       ke 2 eq {/k 1 def} if
       ke 3 eq {/k 0 def} if
       /kij ij 100 mul k add def
tfn
-1900 yinter ke 1 add 200 mul sub moveto
                    (k=) show k cvishow (, ) show 
%                    (Yk=) show Yk k get      cvishow (, ) show
                    (Ykij=) show Ykij kij get  cvishow (, ) show
                    (L*kij=) show L*kij kij get cvsshow1x (, ) show
%jchart 1 eq {(Y/dY=) show  Yx0k  k   get cvsshow2x (, ) show} if
tfb
xchartl 00 eq {(L*/L*) jLs (u) ibLs} if

xchartl 01 eq {(D) sKs (Y) jLs (/) bLs
               (D) sKs (Y) jLs (u) ibLs} if

xchartl 02 eq {%(S) jLs (r)  ibLs (/) bLs (S) jLs (ru) ibLs
               (\050) bLs (D) sKs (Y/Y) jLs (\051/\050) bLs
               (D) sKs (Y/Y) jLs (\051) bLs (u) ibLs} if

xchartl 03 eq {%(C) jLs (r)  ibLs (/) bLs
               %(C) jLs (ru) ibLs
               (\050) bLs (Y/) jLs (D) sKs (Y) jLs (\051/\050) bLs
               (Y) jLs (/) bLs (D) sKs (Y) jLs (\051) bLs (u) ibLs} if

(=) show Yxuk k get    cvsshow2x
tfn
} for %ke=0,3
} if %iY_curve=1

50 setlinewidth
0 1 1 {/je exch def %je=0,1
je 0 eq {1 1 1 setrgbcolor} if
je 1 eq {0 0 0 setrgbcolor [100] 0 setdash} if
/k10 00 def
/k1u Yuij 0.5 add cvi def %rounded
/k20 99 def
0 1 99 {/k exch def %k=0,99
         X00k k get log MULX mul
         Yxuk k get jlog 1 eq {abs log} if MULY mul
         k k10 eq {moveto} if
         k k10 1 add ge
         k k20 1 sub le and {lineto} if
         k k20 eq {stroke} if
        } for %k=0,99
} for %je=0,1

50 setlinewidth
0 1 2 {/ki1i2 exch def %ki1i2=0,2 
       ki1i2 0 eq {/k k10 def} if
       ki1i2 1 eq {/k k1u def} if
       ki1i2 2 eq {/k k20 def} if
       tfb
       X00k k get log MULX mul
       Yxuk k get jlog 1 eq {abs log} if MULY mul 060 0 360 arc fill
       newpath
       X00k k get log i 1 eq {0.80 sub}{0.10 add} ifelse MULX mul
       Yxuk k get jlog 1 eq {abs log} if 0.10 sub MULY mul moveto
       TBK
       Yxuk k get jlog 1 eq {abs log} if cvsshow3x
       0 setgray
       newpath
      } for %ki1i2=0,2

%L*IEC=100(Y/Yn)**(1/ln(10))
%L*IEC/L*IEC,u = L*I/50 = 2(Y/Yn)**(1/ln(10)) = 1 (Y/Yu)**(1/ln(10))
tfg
/k10 00 def
/k1u Yuij cvi def
/k20 99 def
0 1 99 {/k exch def %k=0,99
        /Y k 1 add def
        Y log MULX mul       
        Y Yuij div 1 10 ln div exp MULY mul
        k k10 eq {moveto} if
        k k10 1 add ge
        k k20 1 sub le and {lineto} if
        k k20 eq {stroke} if
       } for %k=0,99 

tfn
X00k k get log 0.2 add MULX mul
Yxuk k get jlog 1 eq {abs log} if 0.3 sub MULY mul moveto
(L*) jLs (TUB) ibLs (/L*) jLs (TUB,u) ibLs

X00k k get log 0.2 add MULX mul
Yxuk k get jlog 1 eq {abs log} if 0.60 sub MULY mul moveto
(=) bLs 20rm ((Y/Y)) jLs 20rm (u) ibLs
-50 0 rmoveto (1/ln) ebLs 20rm ((10)) ebLs

tfn

newpath
tfb
/k k1u def
[100] 0 setdash
0.01       log MULX mul Yxuk k get MULY mul moveto
X00k k get log MULX mul Yxuk k get MULY mul lineto
X00k k get log MULY mul        0.0 MULY mul lineto stroke

newpath
15 log MULX mul -0.20 MULY mul moveto
(Y) jLs (u) ibLs TBL (=) show Yuij cvishow

[ ] 0 setdash
0 setgray

} bind def %END proc_Y_curve

%***************************************************
/proc_appli {%proc_appli
/x00a 4200 def
%y00a is to be defined in main program
tfn %tfw
x00a y00a moveto
1000 0 rlineto stroke
tfg
[100] 0 setdash
x00a y00a moveto
1000 0 rlineto stroke
[ ] 0 setdash

tfn %tfw
x00a y00a 0.8 ydel mul sub moveto
TBL (application) showen
(Anwendungs\255) showde
x00a y00a 1.5 ydel mul sub moveto
TBL (range) showen
(bereich) showde

/x00b x00a 000 add def
/y00b y00a 320 add def
/y00c y00a 100 add def
x00b 300 add y00b moveto
(\152) sLs (=) nLs phi ichart get cvishow (') show
%(120/90/30/10) nLs
x00b y00c moveto
(L) kLs (aw) iLs 20rm (=) nLs 20rm Laj cvishow 
20rm (cd/m) nLs -50 0 rmoveto (2) eLs 

} bind def %proc_appli

%***************************************************
/proc_toptext {%proc_toptext
%jlog 0:without log, 1:with log in main program
tfn %tfw
/ytr0t0 3750 ytr0 sub def
/ytr0t1 ytr0t0 250 sub def
/ytr0t2 ytr0t0 500 sub def
 
050 xtr0 sub 3725 ytr0 sub moveto
xchartl 00 eq {%xchartl=01
               jlog 1 eq {(log \050) bKs} if 
               (L*) jKs  ifunc 0 eq {(80) ibKs} if
               (/L*) jKs ifunc 0 eq {(80,) ibKs} if (u) ibKs
               jlog 1 eq {(\051 ) bKs} if

               2100 xtr0 sub ytr0t0 moveto
               TBK ifunc 0 eq {(HAULAB) show} if
                   ifunc 1 eq {(CIELAB) show} if
                   ifunc 2 eq {(IECsRGB) show} if
                   ifunc 3 eq {(TUBsRGB) show} if
               TBK ( lightness ) showen
               (\255Helligkeit ) showde
               (L*) jKs ifunc 0 eq {(80) ibKs} if
               TBK ( normalized) showen
               ( normiert) showde

               2100 xtr0 sub ytr0t1 moveto
               (to the background lightness ) showen
               (f\374r die UmgebungsHelligkeit ) showde
               (L*) jKs ifunc 0 eq {(80,) ibKs} if 
               (u) ibKs TBK
              } if %xchartl=00

xchartl 01 eq {%xchartl=01
               jlog 1 eq {(log \050) bKs} if
               (D) sMs 20 0 rmoveto
               (Y) jKs (/) bKs (D) sMs
               (Y) jKs (u) ibKs
               jlog 1 eq {(\051 ) bKs} if

               1800 xtr0 sub ytr0t0 moveto
               TBK ifunc 0 eq {(HAULAB) show} if
                   ifunc 1 eq {(CIELAB) show} if
                   ifunc 2 eq {(IECsRGB) show} if
                   ifunc 3 eq {(TUBsRGB) show} if
               TBK ( tristimulus value difference) showen
               (\255Normfarbwertdifferenz) showde

               1800 xtr0 sub ytr0t1 moveto
               (D) sMs 20rm (Y) jKs TBK
               ( normalized to ) showen
               ( normiert f\374r ) showde
               (D) sMs 20rm (Y) jKs (u) ibKs TBK

              } if %xchartl=01

xchartl 02 eq {%xchartl=02
               jlog 1 eq {(log [) bKs} if
               20 0 rmoveto (\050) bKs
               (D) sMs (Y/Y) jKs (\051 / \050) bKs
               (D) sMs (Y/Y) jKs (\051) bKs (u) ibKs 
               jlog 1 eq {(]) bKs} if               

               2800 xtr0 sub ytr0t0 moveto
               TBK ifunc 0 eq {(HAULAB) show} if
                   ifunc 1 eq {(CIELAB) show} if
                   ifunc 2 eq {(IECsRGB) show} if
                   ifunc 3 eq {(TUBsRGB) show} if
               (\255Y) jKs TBK
               ( sensitivity) showen
               (\255Empfindlichkeit) showde

               2800 xtr0 sub ytr0t1 moveto
               (normalized to ) showen
               (normiert f\374r ) showde
               (\050) bKs (D) sMs (Y/Y) jKs (\051) bKs (u) ibKs
              } if %xchartl=02


xchartl 03 eq {%xchartl=03
               jlog 1 eq {(log[) bKs} if
               20 0 rmoveto (\050) bKs
               (Y/) jKs (D) sMs (Y) jKs (\051 / \050) show
               (Y/) bKs (D) sMs (Y) jKs (\051) bKs (u) ibKs
               jlog 1 eq {(\051]) bKs} if

               2800 xtr0 sub ytr0t0 moveto
               TBK ifunc 0 eq {(HAULAB) show} if
                   ifunc 1 eq {(CIELAB) show} if
                   ifunc 2 eq {(IECsRGB) show} if
                   ifunc 3 eq {(TUBsRGB) show} if
               (\255Y) jKs TBK
               ( contrast) showen
               (\255Kontrast) showde

               2800 xtr0 sub ytr0t1 moveto
               (normalized to ) showen
               (normiert f\374r ) showde
               (\050) bKs (Y/) jKs (D) sMs (Y) jKs (\051) bKs (u) ibKs

              } if %xchartl=02

tfn %tfw
} bind def %proc_toptext

%***************************************************
/proc_L*top {%BEG proc_L*top ifunc=0,1,2,3
/20rm {20 0 rmoveto} def

%top-eq. BEG HAULAB, CIELAB, IECsRGB, TUBsRGB_proc_C02_C08
%for ifunc=0 to 3
ifunc 0 eq {/s1 syij ij get def /n1 0.31 def 
            /d1 dyij ij get def} if
ifunc 1 eq {/s1 116 def /n1 1 3     div def /d1 16 def} if
ifunc 2 eq {/s1 100 def /n1 1 2.4   div def /d1  0 def} if
ifunc 3 eq {/s1 100 def /n1 1 10 ln div def /d1  0 def} if
/r1 s1 0.18 n1 exp mul def
/g1 r1 r1 d1 sub div def
/h1 d1 r1 d1 sub div def

x00t y00t moveto
(L*) jLs 20rm
(=) bLs 20rm (s) show 20rm
(\050Y/Y) jLs (n) ibLs (\051) bLs
(n) ebLs
(-) bLs 20rm (d) bLs

x01t y00t moveto
(\050) nLs (Y) kLs (n) iLs (=100,) nLs 20rm
           (Y) kLs (u) iLs (=) nLs TL Yuij cvishow (,) nLs 20rm
TL (s=) show s1 cvsshow1x
ifunc 0 eq {(, n=0,31)     show} if
ifunc 1 eq {(, n=1/3)      show} if
ifunc 2 eq {(, n=1/2,4)    show} if
ifunc 3 eq {(, n=1/ln(10)) show} if
TL (, d=) show d1 cvsshow1x (\051) nLs

x00e y00t moveto
TL ([1a]) show

x00t y00t 250 sub moveto
(L*) jLs 20rm
(=) bLs 20rm (r \050) bLs
(Y/Y) jLs (u) ibLs (\051) bLs
(n) ebLs
(-) bLs 20rm (d) bLs

x01t y00t 250 sub moveto
(\050r = s ) nLs (\050Y) kLs (u) iLs
(/Y) kLs (n) iLs (\051) nLs (n) ebLs
(=) nLs TL r1 cvsshow2x (, ) nLs
(L*) kLs (u) iLs (= r-d =) nLs
TL r1 d1 sub cvsshow1x
(\051) nLs

x00e y00t 250 sub moveto
TL ([1b]) show

} bind def %END proc_L*top ifunc=1,2,3

%***************************************************
/proc_L*DL*u_C02 {%BEG proc_L*DL*u_C02
%for ifunc=0,1,2,3 HAULAB, CIELAB, IECsRGB, TUBsRGB
%ioutC02 0/1:no or with output of equations in main program

tfr %C02
/y00t 2990 def
/ydel 0270 def

proc_L*top %ifunc=0,1,2,3 ALL

%*****
ifunc 0 eq {%ifunc=0 special BEG HAULAB_C02

iequa 1 eq {%BEG 0/1 without/with main equations
x00t y00t ydel 2 mul sub moveto
(L*/L*) jLs (u) ibLs 
TBL (=) show 20rm (g) show 20rm
(\050Y/Y) jLs (u) ibLs (\051) bLs
(n) ebLs
TBL (-h) show

x01t 450 add y00t ydel 2 mul sub moveto
TL (\050g=r/(r-d)=) show r1 r1 d1 sub div cvsshow2x
TL (, h=d/(r-d)=) show d1 r1 d1 sub div cvsshow2x
TL (\051) show

x00e y00t ydel 2 mul sub moveto
TL ([1c]) show
} if %END 0/1 without/with main equations

iY_curve 0 eq {%BEG iY_curve=0
jlog 1 eq {%jlog=1
x00t y00t ydel 3 mul sub moveto
(log [\050) bLs
(L*/L*) jLs (u) ibLs
20rm (+) bLs 20rm (h) bLs 20rm
(\051 / g ] = n log \050) bLs
(Y/Y) jLs (u) ibLs (\051) bLs
( = ) bLs n1 cvsshow2x 20rm (log) bLs
(\050) show (Y/) jLs Yuij cvishow (\051) bLs

x00e y00t ydel 3 mul sub moveto
TL ([1d]) show

x00t y00t ydel 3.9 mul sub moveto
(ln [\050) bLs
(L*/L*) jLs (u) ibLs
( + h) bLs
(\051 / g] = n) bLs 20rm (ln(10)) bLs 20rm (log\050) bLs 20rm
(Y/Y) jLs (u) ibLs (\051) bLs
( = ) bLs n1 10 ln mul cvsshow2x 20rm (log \050) bLs
(Y/) jLs Yuij cvishow (\051) bLs

x00e y00t ydel 4.0 mul sub moveto
TL ([1e]) show

x00t y00t ydel 5 mul sub moveto
(\050) bLs (L*/L*) jLs (u) ibLs ( + h) bLs
(\051 / g ]) bLs
( = e) bLs 0 90 rmoveto
(n ln(10) log \050) bSs (Y/Y) jSs (u) ibSs (\051) bSs
0 -90 rmoveto
( = e) bLs 0 90 rmoveto
TBS n1 10 ln mul cvsshow2x 20rm %80 smaller
(log \050) bSs (Y/) jSs TBS Yuij cvishow (\051) bSs
0 -90 rmoveto

x00e y00t ydel 5 mul sub moveto
TL ([1f]) show
} if %jlog=1
} if %END iY_curve=0

} if %ifunc=0 special END HAULAB_C02

%*****
ifunc 1 eq {%ifunc=1 special BEG CIELAB_C02

iequa 1 eq {%BEG 0/1 without/with main equations
%2
x00t y00t ydel 2 mul sub moveto
(L*/L*) jLs (u) ibLs 
TBL (=) show 20rm (g) show 20rm
(\050Y/Y) jLs (u) ibLs (\051) bLs
(n) ebLs
TBL (-h) show

x01t 450 add y00t ydel 2 mul sub moveto
TL (\050g=r/(r-d)=) show r1 r1 d1 sub div cvsshow2x
TL (, h=d/(r-d)=) show d1 r1 d1 sub div cvsshow2x
TL (\051) show

x00e y00t ydel 2 mul sub moveto
TL ([1c]) show
} if %END 0/1 without/with main equations

iY_curve 0 eq {%BEG iY_curve=0
jlog 1 eq {%jlog=1
x00t y00t ydel 3 mul sub moveto
TBL (log [\050) show
(L*/L*) jLs (u) ibLs
TBL 20rm (+) show 20rm (h) show 20rm
TBL (\051 / g ] = n log \050) show
(Y/Y) jLs (u) ibLs (\051) bLs
x00e y00t ydel 3 mul sub moveto
TL ([1d]) show

x00t y00t ydel 3.9 mul sub moveto
TBL (ln [\050) show
(L*/L*) jLs (u) ibLs
TBL ( + h) show
TBL (\051 / g ] = ln(10) n log \050) show
(Y/Y) jLs (u) ibLs (\051) bLs
x00e y00t ydel 4.0 mul sub moveto
TL ([1e]) show

x00t y00t ydel 5 mul sub moveto
TBL (\050) show (L*/L*) jLs (u) ibLs
TBL ( + h) show
TBL (\051 / g ]) show
TBL ( = e) show (ln(10) n log \050) ebLs (Y/Y) jbLs (u) ebSs
(\051) ebLs
x00e y00t ydel 5 mul sub moveto
TL ([1f]) show
} if %jlog=1
} if %END iY_curve=0

} if %ifunc=1 special END CIELAB_C02

%*****
ifunc 2 eq {%ifunc=2 special BEG IECsRGB_C02

iequa 1 eq {%BEG 0/1 without/with main equations
%2
x00t y00t ydel 2 mul sub moveto
(L*/L*) jLs (u) ibLs 
TBL (=) show
(\050Y/Y) jLs (u) ibLs (\051) bLs
(n) ebLs
x00e y00t ydel 2 mul sub moveto
TL ([1c]) show
} if %END 0/1 without/with main equations

iY_curve 0 eq {%BEG iY_curve=0
jlog 1 eq {%jlog=1
x00t y00t ydel 3 mul sub moveto
TBL (log \050) show
(L*/L*) jLs (u) ibLs
TBL (\051 = n log \050) show
(Y/Y) jLs (u) ibLs (\051) bLs
x00e y00t ydel 3 mul sub moveto
TL ([1d]) show

x00t y00t ydel 3.9 mul sub moveto
TBL (ln \050) show
(L*/L*) jLs (u) ibLs
TBL (\051 = ln(10) n log \050) show
(Y/Y) jLs (u) ibLs (\051) bLs
x00e y00t ydel 4.0 mul sub moveto
TL ([1e]) show

x00t y00t ydel 5 mul sub moveto
(L*/L*) jLs (u) ibLs
TBL ( = e) show (ln(10) n log \050) ebLs (Y/Y) jbLs (u) ebSs
(\051) ebLs
x00e y00t ydel 5 mul sub moveto
TL ([1f]) show
} if %jlog=1
} if %END iY_curve=0

} if %ifunc=2 special END IECsRGB_C02

%*****
ifunc 3 eq {%ifunc=3 special BEG TUBsRGB_C02

iequa 1 eq {%BEG 0/1 without/with main equations
x00t y00t ydel 2 mul sub moveto
(L*/L*) jLs (u) ibLs 
TBL (=) show
(\050Y/Y) jLs (u) ibLs (\051) bLs
(1/ln(10)) ebLs
TBL ( \050ln(x)=ln(10) log(x)\051) show
x00e y00t ydel 2 mul sub moveto
TL ([1c]) show
} if %END 0/1 without/with main equations

iY_curve 0 eq {%BEG iY_curve=0
jlog 1 eq {%jlog=1
x00t y00t ydel 3 mul sub moveto
TBL (log\050) show
(L*/L*) jLs (u) ibLs
TBL (\051=(1/ln(10)) log\050) show
(Y/Y) jLs (u) ibLs (\051) bLs
x00e y00t ydel 3 mul sub moveto
TL ([1d]) show

x00t y00t ydel 3.9 mul sub moveto
TBL (ln\050) show
(L*/L*) jLs (u) ibLs
TBL (\051=log\050) show 
(Y/Y) jLs (u) ibLs (\051) bLs
x00e y00t ydel 3.9 mul sub moveto
TL ([1e]) show

x00t y00t ydel 5 mul sub moveto
(L*/L*) jLs (u) ibLs
TBL (= e) show (log\050) ebLs (Y/Y) jbLs (u) ebSs
(\051) ebLs
x00e y00t ydel 5 mul sub moveto
TL ([1f]) show
} if %jlog=1
} if %END iY_curve=0

} if %ifunc=3 special END TUBsRGB_C02

} bind def %END proc_L*DL*u_C02


%***************************************************
/proc_YDYu_C04 {%BEG proc_YDYu_C04
%for ifunc=1,2,3 CIELAB, IECsRGB, TUBsRGB
%ioutC04 0/1:no or with output of equations in main program

tfr %C04
/y00t 2990 def
/ydel 0270 def

proc_L*top %for ifunc=1,2,3

%*****
ifunc 0 eq {%ifunc=0 BEG special HAULAB_C04

iequa 1 eq {%BEG 0/1 without/with main equations
%2
x00t y00t ydel 2 mul sub moveto
(dY) jLs TBL ( = [) show
(Y) jLs (n) ibLs (/ \050 n s \051] ) bLs
(\050Y / Y) jLs (n) ibLs
(\051) bLs (1-n) ebLs
x00e y00t ydel 2 mul sub moveto
TL ([2c]) show
} if %END 0/1 without/with main equations

iY_curve 0 eq {%BEG iY_curve=0
x00t y00t ydel 3 mul sub moveto
(dY) jLs (u) ibLs
TBL ( = [) show
(Y) jLs (n) ibLs TBL (/ \050 n s \051] ) show
(\050Y) jLs (u) ibLs ( / Y) jLs (n) ibLs
(\051) bLs (1-n) ebLs
TBL ( = ) show
100 n1 s1 mul div 18 100 div n1 exp mul cvsshow4x
x00e y00t ydel 3 mul sub moveto
TL ([2d]) show

%4
x00t y00t ydel 4 mul sub moveto
(dY / dY) jLs (u) ibLs 
TBL ( = ) show
(\050Y / Y) jLs (u) ibLs
(\051) bLs (1-n) ebLs
x00e y00t ydel 4 mul sub moveto
TL ([2e]) show

%5
jlog 1 eq {%jlog=1
x00t y00t ydel 5 mul sub moveto
TBL (log\050) show (dY / dY) jLs (u) ibLs
TBL (\051 = (1-n) log) show
(\050Y / Y) jLs (u) ibLs
(\051) bLs
x00e y00t ydel 5 mul sub moveto
TL ([2f]) show
} if %jlog=1
} if %END iY_curve=0

} if %ifunc=0 special END HAULAB_C04

%*****
ifunc 1 eq {%ifunc=1 special CIELAB_C04

iequa 1 eq {%BEG 0/1 without/with main equations
%2
x00t y00t ydel 2 mul sub moveto
(dY) jLs TBL ( = [) show
(Y) jLs (n) ibLs (/ \050 n s \051] ) bLs
(\050Y / Y) jLs (n) ibLs
(\051) bLs (1-n) ebLs
x00e y00t ydel 2 mul sub moveto
TL ([2c]) show
} if %END 0/1 without/with main equations

iY_curve 0 eq {%BEG iY_curve=0
%3
x00t y00t ydel 3 mul sub moveto
(dY) jLs (u) ibLs
TBL ( = [) show
(Y) jLs (n) ibLs TBL (/ \050 n s \051] ) show
(\050Y) jLs (u) ibLs ( / Y) jLs (n) ibLs
(\051) bLs (1-n) ebLs
TBL ( = ) show
100 n1 s1 mul div 18 100 div n1 exp mul cvsshow4x
x00e y00t ydel 3 mul sub moveto
TL ([2d]) show

%4
x00t y00t ydel 4 mul sub moveto
(dY / dY) jLs (u) ibLs 
TBL ( = ) show
(\050Y / Y) jLs (u) ibLs
(\051) bLs (1-n) ebLs
x00e y00t ydel 4 mul sub moveto
TL ([2e]) show

%5
jlog 1 eq {%jlog=1
x00t y00t ydel 5 mul sub moveto
TBL (log\050) show (dY / dY) jLs (u) ibLs
TBL (\051 = (1-n) log) show
(\050Y / Y) jLs (u) ibLs
(\051) bLs
x00e y00t ydel 5 mul sub moveto
TL ([2f]) show
} if %jlog=1
} if %END iY_curve=0

} if %ifunc=1 special END CIELAB_C04

%*****
ifunc 2 eq 
ifunc 3 eq or {%ifunc=2,3 special IECsRGB/TUBsRGB_C04

iequa 1 eq {%BEG 0/1 without/with main equations
%2
x00t y00t ydel 2 mul sub moveto
(dY) jLs TBL ( = [) show
(Y) jLs (n) ibLs (/ \050 n s \051] ) bLs
(\050Y / Y) jLs (n) ibLs
(\051) bLs (1-n) ebLs
x00e y00t ydel 2 mul sub moveto
TL ([2c]) show
} if %END 0/1 without/with main equations

iY_curve 0 eq {%BEG iY_curve=0
%3
x00t y00t ydel 3 mul sub moveto
(dY) jLs (u) ibLs
TBL ( = [) show
(Y) jLs (n) ibLs TBL (/ \050 n s \051] ) show
(\050Y) jLs (u) ibLs ( / Y) jLs (n) ibLs
(\051) bLs (1-n) ebLs
TBL ( = ) show
100 n1 s1 mul div 18 100 div n1 exp mul cvsshow4x
x00e y00t ydel 3 mul sub moveto
TL ([2d]) show

%4
x00t y00t ydel 4 mul sub moveto
(dY / dY) jLs (u) ibLs 
TBL ( = ) show
(\050Y / Y) jLs (u) ibLs
(\051) bLs (1-n) ebLs
x00e y00t ydel 4 mul sub moveto
TL ([2e]) show

%5
jlog 1 eq {%jlog=1
x00t y00t ydel 5 mul sub moveto
TBL (log\050) show (dY / dY) jLs (u) ibLs
TBL (\051 = (1-n) log) show
(\050Y / Y) jLs (u) ibLs
(\051) bLs
x00e y00t ydel 5 mul sub moveto
TL ([2f]) show
} if %jlog=1
} if %END iY_curve=0

} if %ifunc=2,3 END IECsRGB/TUBsRGB_C04

} bind def %END proc_YDYu_C04

%***************************************************
/proc_dYDY_C06 {%BEG proc_dYDY_C06
%for ifunc=1,2,3 CIELAB, IECsRGB, TUBsRGB
%ioutC06 0/1:no or with output of equations in main program

tfr %C06

/y00t 2990 def
/ydel 0270 def

proc_L*top %for ifunc=0,1,2,3

%*****
ifunc 0 eq {%ifunc=0 special BEG HAULAB_C06

iequa 1 eq {%BEG 0/1 without/with main equations
%2
x00t y00t ydel 2 mul sub moveto
(dY / Y) jLs TBL ( = [ ) bLs
(\050) bLs (Y) jLs (n) ibLs (/ \050 n s \051 ] ) bLs
(\050Y / Y) jLs (n) ibLs
(\051) bLs (1-n) ebLs
( / ) bLs (Y) jLs
x00e y00t ydel 2 mul sub moveto
TL ([3c]) show
} if %END 0/1 without/with main equations

iY_curve 0 eq {%BEG iY_curve=0
%3
x00t y00t ydel 3 mul sub moveto
((dY / Y)) jLs (u) ibLs
( = [ ) bLs
(\050) bLs (Y) jLs (n) ibLs (/ \050 n s \051 ] ) bLs
(\050Y) jLs (u) ibLs ( / Y) jLs (n) ibLs
(\051) bLs (1-n) ebLs
( / ) bLs (Y) jLs (u) ibLs
x00e y00t ydel 3 mul sub moveto
TL ([3d]) show

%4
x00t y00t ydel 4 mul sub moveto
((dY / Y)) jLs ( / ) bLs ((dY / Y)) jLs (u) ibLs
( = ) bLs
(\050Y / Y) jLs (u) ibLs
(\051) bLs (-n) ebLs
x00e y00t ydel 4 mul sub moveto
TL ([3e]) show

%5
jlog 1 eq {%jlog=1
x00t y00t ydel 5 mul sub moveto
(log [) bLs
((dY / Y)) jLs ( / ) bLs ((dY / Y)) jLs (u) ibLs
(] = (-n) log) bLs
(\050Y / Y) jLs (u) ibLs
(\051) bLs
x00e y00t ydel 5 mul sub moveto
TL ([3f]) show
} if %jlog=1
} if %END iY_curve=0

} if %ifunc=0 special END HAULAB_C06

%*****
ifunc 1 eq {%ifunc=1 special BEG CIELAB_C06

iequa 1 eq {%BEG 0/1 without/with main equations
%2
x00t y00t ydel 2 mul sub moveto
(dY / Y) jLs TBL ( = [ ) bLs
(\050) bLs (Y) jLs (n) ibLs (/ \050 n s \051 ] ) bLs
(\050Y / Y) jLs (n) ibLs
(\051) bLs (1-n) ebLs
( / ) bLs (Y) jLs
x00e y00t ydel 2 mul sub moveto
TL ([3c]) show
} if %END 0/1 without/with main equations

iY_curve 0 eq {%BEG iY_curve=0
%3
x00t y00t ydel 3 mul sub moveto
((dY / Y)) jLs (u) ibLs
( = [ ) bLs
(\050) bLs (Y) jLs (n) ibLs (/ \050 n s \051 ] ) bLs
(\050Y) jLs (u) ibLs ( / Y) jLs (n) ibLs
(\051) bLs (1-n) ebLs
( / ) bLs (Y) jLs (u) ibLs
x00e y00t ydel 3 mul sub moveto
TL ([3d]) show

%4
x00t y00t ydel 4 mul sub moveto
((dY / Y)) jLs ( / ) bLs ((dY / Y)) jLs (u) ibLs
( = ) bLs
(\050Y / Y) jLs (u) ibLs
(\051) bLs (-n) ebLs
x00e y00t ydel 4 mul sub moveto
TL ([3e]) show

%5
jlog 1 eq {%jlog=1
x00t y00t ydel 5 mul sub moveto
(log [) bLs
((dY / Y)) jLs ( / ) bLs ((dY / Y)) jLs (u) ibLs
(] = (-n) log) bLs
(\050Y / Y) jLs (u) ibLs
(\051) bLs
x00e y00t ydel 5 mul sub moveto
TL ([3f]) show
} if %jlog=1
} if %END iY_curve=0

} if %ifunc=1 special END CIELAB_C06

%*****
ifunc 2 eq 
ifunc 3 eq or {%ifunc=2,3 special BEG IECsRGB/TUBsRGB_C06

iequa 1 eq {%BEG 0/1 without/with main equations
%2
x00t y00t ydel 2 mul sub moveto
(dY / Y) jLs TBL ( = [ ) bLs
(\050) bLs (Y) jLs (n) ibLs (/ \050 n s \051 ] ) bLs
(\050Y / Y) jLs (n) ibLs
(\051) bLs (1-n) ebLs
( / ) bLs (Y) jLs
x00e y00t ydel 2 mul sub moveto
TL ([3c]) show
} if %END 0/1 without/with main equations

iY_curve 0 eq {%BEG iY_curve=0
%3
x00t y00t ydel 3 mul sub moveto
((dY / Y)) jLs (u) ibLs
( = [ ) bLs
(\050) bLs (Y) jLs (n) ibLs (/ \050 n s \051 ] ) bLs
(\050Y) jLs (u) ibLs ( / Y) jLs (n) ibLs
(\051) bLs (1-n) ebLs
( / ) bLs (Y) jLs (u) ibLs
x00e y00t ydel 3 mul sub moveto
TL ([3d]) show

%4
x00t y00t ydel 4 mul sub moveto
((dY / Y)) jLs ( / ) bLs ((dY / Y)) jLs (u) ibLs
( = ) bLs
(\050Y / Y) jLs (u) ibLs
(\051) bLs (-n) ebLs
x00e y00t ydel 4 mul sub moveto
TL ([3e]) show

%5
jlog 1 eq {%jlog=1
x00t y00t ydel 5 mul sub moveto
(log [) bLs
((dY / Y)) jLs ( / ) bLs ((dY / Y)) jLs (u) ibLs
(] = (-n) log) bLs
(\050Y / Y) jLs (u) ibLs
(\051) bLs
x00e y00t ydel 5 mul sub moveto
TL ([3f]) show
} if %jlog=1
} if %END iY_curve=0

} if %ifunc=2,3 special END IECsRGB/TUBsRGB_C06

} bind def %END proc_dYDY_C06

%***************************************************
/proc_YDdY_C08 {%BEG proc_YDdY_C08
%for ifunc=1,2,3 CIELAB, IECsRGB, TUBsRGB
%ioutC08 0/1:no or with output of equations in main program

tfr %C08

/y00t 2990 def
/ydel 0270 def

proc_L*top %for ifunc=1,2,3

%*****
ifunc 0 eq {%ifunc=0 special BEG HAULAB_C08

iequa 1 eq {%BEG 0/1 without/with main equations
%2
x00t y00t ydel 2 mul sub moveto
(Y / dY) jLs ( = ) bLs (Y) jLs ( / { [ ) bLs
(\050) bLs (Y) jLs (n) ibLs (/ \050 n s \051 ] ) bLs
(\050Y / Y) jLs (n) ibLs
(\051) bLs (1-n) ebLs ( }) bLs
x00e y00t ydel 2 mul sub moveto
TL ([4c]) show
} if %END 0/1 without/with main equations

iY_curve 0 eq {%BEG iY_curve=0
%3
x00t y00t ydel 3 mul sub moveto
((Y / Y)) jLs (u) ibLs
( = ) bLs (Y) jLs (u) ibLs ( / { [ ) bLs
(\050) bLs (Y) jLs (n) ibLs (/ \050 n s \051 ] ) bLs
(\050Y) jLs (u) ibLs ( / Y) jLs (n) ibLs
(\051) bLs (1-n) ebLs ( }) bLs
x00e y00t ydel 3 mul sub moveto
TL ([4d]) show

%4
x00t y00t ydel 4 mul sub moveto
((Y / dY)) jLs ( / ) bLs ((Y / dY)) jLs (u) ibLs
( = ) bLs
(\050Y / Y) jLs (u) ibLs
(\051) bLs (n) ebLs
x00e y00t ydel 4 mul sub moveto
TL ([4e]) show

%5
jlog 1 eq {%jlog=1
x00t y00t ydel 5 mul sub moveto
(log [) bLs
((Y / dY)) jLs ( / ) bLs ((Y / dY)) jLs (u) ibLs
(] = (n) log) bLs
(\050Y / Y) jLs (u) ibLs
(\051) bLs
x00e y00t ydel 5 mul sub moveto
TL ([4f]) show
} if %jlog=1
} if %END iY_curve=0

} if %ifunc=0 special END HAULAB_C08

%*****
ifunc 1 eq {%ifunc=1 special BEG CIELAB_C08

iequa 1 eq {%BEG 0/1 without/with main equations
%2
x00t y00t ydel 2 mul sub moveto
(Y / dY) jLs ( = ) bLs (Y) jLs ( / { [ ) bLs
(\050) bLs (Y) jLs (n) ibLs (/ \050 n s \051 ] ) bLs
(\050Y / Y) jLs (n) ibLs
(\051) bLs (1-n) ebLs ( }) bLs
x00e y00t ydel 2 mul sub moveto
TL ([4c]) show
} if %END 0/1 without/with main equations

iY_curve 0 eq {%BEG iY_curve=0
%3
x00t y00t ydel 3 mul sub moveto
((Y / Y)) jLs (u) ibLs
( = ) bLs (Y) jLs (u) ibLs ( / { [ ) bLs
(\050) bLs (Y) jLs (n) ibLs (/ \050 n s \051 ] ) bLs
(\050Y) jLs (u) ibLs ( / Y) jLs (n) ibLs
(\051) bLs (1-n) ebLs ( }) bLs
x00e y00t ydel 3 mul sub moveto
TL ([4d]) show

%4
x00t y00t ydel 4 mul sub moveto
((Y / dY)) jLs ( / ) bLs ((Y / dY)) jLs (u) ibLs
( = ) bLs
(\050Y / Y) jLs (u) ibLs
(\051) bLs (n) ebLs
x00e y00t ydel 4 mul sub moveto
TL ([4e]) show

%5
jlog 1 eq {%jlog=1
x00t y00t ydel 5 mul sub moveto
(log [) bLs
((Y / dY)) jLs ( / ) bLs ((Y / dY)) jLs (u) ibLs
(] = (n) log) bLs
(\050Y / Y) jLs (u) ibLs
(\051) bLs
x00e y00t ydel 5 mul sub moveto
TL ([4f]) show
} if %jlog=1
} if %END iY_curve=0

} if %ifunc=1 special END CIELAB_C08

%*****
ifunc 2 eq 
ifunc 3 eq or {%ifunc=2,3 special BEG IECsRGB/TUBsRGB_C08

iequa 1 eq {%BEG 0/1 without/with main equations
%2
x00t y00t ydel 2 mul sub moveto
(Y / dY) jLs ( = ) bLs (Y) jLs ( / { [ ) bLs
(\050) bLs (Y) jLs (n) ibLs (/ \050 n s \051 ] ) bLs
(\050Y / Y) jLs (n) ibLs
(\051) bLs (1-n) ebLs ( }) bLs
x00e y00t ydel 2 mul sub moveto
TL ([4c]) show
} if %END 0/1 without/with main equations

iY_curve 0 eq {%BEG iY_curve=0
%3
x00t y00t ydel 3 mul sub moveto
((Y / Y)) jLs (u) ibLs
( = ) bLs (Y) jLs (u) ibLs ( / { [ ) bLs
(\050) bLs (Y) jLs (n) ibLs (/ \050 n s \051 ] ) bLs
(\050Y) jLs (u) ibLs ( / Y) jLs (n) ibLs
(\051) bLs (1-n) ebLs ( }) bLs
x00e y00t ydel 3 mul sub moveto
TL ([4d]) show

%4
x00t y00t ydel 4 mul sub moveto
((Y / dY)) jLs ( / ) bLs ((Y / dY)) jLs (u) ibLs
( = ) bLs
(\050Y / Y) jLs (u) ibLs
(\051) bLs (n) ebLs
x00e y00t ydel 4 mul sub moveto
TL ([4e]) show

%5
jlog 1 eq {%jlog=1
x00t y00t ydel 5 mul sub moveto
(log [) bLs
((Y / dY)) jLs ( / ) bLs ((Y / dY)) jLs (u) ibLs
(] = (n) log) bLs
(\050Y / Y) jLs (u) ibLs
(\051) bLs
x00e y00t ydel 5 mul sub moveto
TL ([4f]) show
} if %jlog=1
} if %END iY_curve=0

} if %ifunc=2,3 special END IECsRGB/TUBsRGB_C08

} bind def %END proc_YDdY_C08

%***************************************************
/proc_mdu {%BEG proc_mdu
%for ifunc=0,1,2,3 HAULAB, CIELAB, IECsRGB, TUBsRGB
%for C02, C04, C06, C08

xtr neg ytr neg translate %new cero point

%available Yx0k and Yxuk from proc_Yi_Yxyi
%for x: xchartl=0_C02, xchartl=1_C04, xchartl=2_C06, xchartl=3_C08

/n090 090 def
/n004 004 def
/t090 (90) def
/t004 (4) def
/x00x x00t 200 sub def

        x00x 1 MULY mul 120 add moveto
        jlog 0 eq {%jlog=0
                   (m) jLs (u) ibLs t090 ibLs (_) ibLs t004 ibLs TBL ( = ) show
                   Yx0k n090 get Yx0k n004 get sub
                   Yi   n090 get Yi   n004 get sub div cvsshow3x (, ) show
                   (f) jLs t090 ibLs (=) bLs TBL Yx0k n090 get cvishow (, ) bLs
                   (f) jLs t004 ibLs (=) bLs TBL Yx0k n004 get cvishow
                  } %jlog=0
                  { %jlog=1
                   (m) jLs (nu) ibLs TBL 
                   xchartl 0 eq {( = n = ) show n cvsshow3x} if
                   xchartl 1 eq {( = 1-n = ) show 1 n sub cvsshow3x} if
                   xchartl 2 eq {( = -n = ) show n neg cvsshow3x} if
                   xchartl 3 eq {( = n = ) show n cvsshow3x} if 
                  } ifelse %jlog=0,1
        x00x 1 MULY mul 200 sub moveto
        x00x 1 MULY mul 200 sub moveto
        /k1u Yuij 0.5 add cvi def
        /k3 k1u 1 add def
        /k2 k1u 1 sub def
        (m) jLs (u) ibLs TBL ( = ) show
        Yxuk k3 get jlog 1 eq {log} if
        Yxuk k2 get jlog 1 eq {log} if sub
        Yi k3 get log
        Yi k2 get log sub div cvsshow3x

xtr ytr translate %new cero point

} bind def %proc_mdu

%*********************************************************************
/proc_C02_ALOG_L*DL*u {%BEG proc_C02_ALOG_L*DTu*

jlog 0 eq {%jlog=0
/Fx0log -2.0 def
/Fy0lin  1.0 def
/xtr 2000 def
/ytr 0000 def
/iys 1000 def
/MULY iys 1 div def %scale=1
/ytrl ytr 1000 div def %lin shift
           } %jlog=0
           { %jlog=1
/Fx0log -2.0 def
/Fy0log -1.0 def
/xtr 2000 def
/ytr 1000 def
/ytrl ytr 1000 div def %log shift
           } ifelse %jlog=1

xtr ytr translate %new cero point
%0 not available

proc_Y_curve

[ ] 0 setdash
50 setlinewidth %50 setlinewidth
0 setgray

%C02 xchartl=0
proc_mdu

/i18 18 def
tfz %tfz
[100] 0 setdash
jlog 0 eq {%jlog=0,1
Fx0log MULX mul L*i i18 get L*u div MULY mul moveto
i18 log MULX mul L*i i18 get L*u div MULY mul lineto
iu log MULX mul 0                  MULY mul lineto stroke
          } %jlog=0
          { %jlog=1
Fx0log MULX mul L*i i18 get L*u div log MULY mul moveto
i18 log MULX mul L*i i18 get L*u div log MULY mul lineto
i18 log MULX mul Fy0log                 MULY mul lineto stroke
          } ifelse %jlog=0,1
[ ] 0 setdash
tfn

ioute 1 eq {proc_cero_line} if

xtr neg ytr neg translate %old cero point

tfn %tfw
/Y001DYu L*i  i1 get 
         L*i  i18 get div def
/Y100DYu L*i 100 get 
         L*i  i18 get div def
tfg
[100] 0 setdash
0 Y001DYu jlog 1 eq {log} if ytrl add MULY mul moveto
0 Y100DYu jlog 1 eq {log} if ytrl add MULY mul lineto stroke
[ ] 0 setdash
tfn %tfw

/y0 2900 def
/x1  800 def
/y1 2700 def
/xdel 800 def
/ydel 300 def

%for ifunc=0,1,2,3 HAULAB, CIELAB, IECsRGB, TUBsRGB
/ioutC02 1 def %0/1:no or with output of equations in main program
ioutC02 1 eq {proc_L*DL*u_C02} if

%/y00a 0850 def
/y00a 0600 def
proc_appli

} def %END proc_C02_ALOG_L*DL*u

%*********************************************************************
/proc_C04_ALOG_DLn {%BEG proc_C04_ALOG_DLn
jlog 0 eq {%jlog=0
/Fx0log -2.0 def
/Fy0lin  1.0 def
/xtr 2000 def
/ytr 0000 def
/iys 1000 def
/MULY iys 2.0 div def %scale=2.0
/ytrl ytr 1000 div def %lin shift
           } %jlog=0
           { %jlog=1
%/Fx0log -2.0 def
%/Fy0log -1.0 def
/xtr 2000 def
/ytr 1000 def
/ytrl ytr 1000 div def %log shift
           } ifelse %jlog=1

xtr ytr translate %new cero point
%0 not available

proc_Y_curve

%C04 xchartl=1
proc_mdu

tfz %tfz
[100] 0 setdash
jlog 0 eq {%jlog=0,1
/rYdY 1 def
-2.    MULX mul rYdY MULY mul moveto
iu log MULX mul rYdY MULY mul lineto
iu log MULX mul 0    MULY mul lineto stroke
          } %jlog=0
          { %jlog=1
/rYdY 1. def
-2.    MULX mul rYdY log MULY mul moveto
iu log MULX mul rYdY log MULY mul lineto
iu log MULX mul -1.      MULY mul lineto stroke
          } ifelse %jlog=0,1
[ ] 0 setdash
tfn

xtr neg ytr neg translate %new cero point

tfn %tfw
/Y001DYu dYi  i1 get dYu div def
/Y100DYu dYi 100 get dYu div def
tfg
[100] 0 setdash
0 Y001DYu jlog 1 eq {log} if ytrl add MULY mul moveto
0 Y100DYu jlog 1 eq {log} if ytrl add MULY mul lineto stroke
[ ] 0 setdash

tfn %tfw
/y0 2400 y0del sub def
/ydel 300 def

%C04
/x02t 0900 def
/x03t 2300 def
/x04t 3300 def

%for ifunc=0,1,2,3 HAULAB, CIELAB, IECsRGB, TUBsRGB
/ioutC04 1 def %0/1:no or with output of equations in main program
ioutC04 1 eq {proc_YDYu_C04} if

/y00a 0750 def
proc_appli

} def %END proc_C04_ALOG_DLn

%*********************************************************************
/proc_C06_ALOG_DL_Ln {%BEG proc_C06_ALOG_DL_Ln
jlog 0 eq {%jlog=0
/Fx0log -2.0 def
/Fy0lin  1.0 def
/xtr 2000 def
/ytr 0000 def
/iys 1000 def
/MULY iys 2.0 div def %scale=2.0
/ytrl ytr 1000 div def %lin shift
           } %jlog=0
           { %jlog=1
%/Fx0log -2.0 def
%/Fy0lin  1.0 def
/xtr 2000 def
/ytr 1000 def
/ytrl ytr 1000 div def %log shift
           } ifelse %jlog=1

xtr ytr translate %new cero point
%0 not available

proc_Y_curve

%C06 xchartl=2
proc_mdu


tfz %tfz
[100] 0 setdash
jlog 0 eq {%jlog=0,1
[100] 0 setdash
/rYdY 1 def
-2.    MULX mul rYdY MULY mul moveto
iu log MULX mul rYdY MULY mul lineto
iu log MULX mul 0    MULY mul lineto stroke
          } %jlog=0
          { %jlog=1
/rYdY 1 def
-2.    MULX mul rYdY log MULY mul moveto
iu log MULX mul rYdY log MULY mul lineto
iu log MULX mul -1.      MULY mul lineto stroke
          } ifelse %jlog=0,1
[ ] 0 setdash
tfn

%/iu 18 def
%/rYdY Yi i18 get dYi i18 get div
%      Yu        dYu        div div e10D30 exp def
%-2.    MULX mul rYdY log MULY mul moveto
%iu log MULX mul rYdY log MULY mul lineto
%iu log MULX mul -1.      MULY mul lineto stroke

[ ] 0 setdash
tfn

ioute 1 eq {proc_cero_line} if

xtr neg ytr neg translate %old cero point

tfn %tfw
/Y001DYu dYi  i1 get Yi  i1 get div 
         dYu         Yu         div div def
/Y100DYu dYi 100 get Yi 100 get div 
         dYu         Yu         div div def
tfg
[100] 0 setdash
0 Y001DYu jlog 1 eq {log} if ytrl add MULY mul moveto
0 Y100DYu jlog 1 eq {log} if ytrl add MULY mul lineto stroke
[ ] 0 setdash
tfn %tfw

/y0 2400 y0del sub def
/ydel 300 def

%C06
/x02t 0900 def
/x03t 2300 def
/x04t 3300 def

%for ifunc=0,1,2,3 HAULAB, CIELAB, IECsRGB, TUBsRGB
/ioutC06 1 def %0/1:no or with output of equations in main program

ioutC06 1 eq {proc_dYDY_C06} if

/y00a 01400 def
proc_appli

} def %END proc_C06_ALOG_DL_Ln

%*********************************************************************
/proc_C08_ALOG_L_DLn {%BEG proc_C08_ALOG_L_DLn
jlog 0 eq {%jlog=0
/Fx0log -2.0 def
/Fy0lin  1.0 def
/xtr 2000 def
/ytr 0000 def
/iys 1000 def
/MULY iys 1 div def %scale=1
/ytrl ytr 1000 div def %lin shift
           } %jlog=0
           { %jlog=1
%/Fx0log -2.0 def
%/Fy0log -1.0 def
/xtr 2000 def
/ytr 1000 def
/ytrl ytr 1000 div def %log shift
           } ifelse %jlog=1

xtr ytr translate %new cero point

proc_Y_curve

%C08 xchartl=3
proc_mdu

tfz %tfz
[100] 0 setdash
jlog 0 eq {%jlog=0,1
[100] 0 setdash
/rYdY 1 def
-2.    MULX mul rYdY MULY mul moveto
iu log MULX mul rYdY MULY mul lineto
iu log MULX mul 0    MULY mul lineto stroke
          } %jlog=0
          { %jlog=1
/rYdY 1 def
-2.    MULX mul rYdY log MULY mul moveto
iu log MULX mul rYdY log MULY mul lineto
iu log MULX mul -1.      MULY mul lineto stroke
          } ifelse %jlog=0,1
[ ] 0 setdash
tfn

ioute 1 eq {proc_cero_line} if

xtr neg ytr neg translate %old cero point

tfn %tfw
/Y001DYu Yi  i1 get dYi  i1 get div 
         Yu         dYu         div div def
/Y100DYu Yi 100 get dYi 100 get div 
         Yu         dYu         div div def
tfg
[100] 0 setdash
0 Y001DYu jlog 1 eq {log} if ytrl add MULY mul moveto
0 Y100DYu jlog 1 eq {log} if ytrl add MULY mul lineto stroke
[ ] 0 setdash

%C08
/y0 2400 y0del sub def
/ydel 300 def

%for ifunc=0,1,2,3 HAULAB, CIELAB, IECsRGB, TUBsRGB
/ioutC08 1 def %0/1:no or with output of equations in main program
ioutC08 1 eq {proc_YDdY_C08} if

/y00a 0850 def
proc_appli

} def %END proc_C08_ALOG_L_DL
%%EndProlog
gsave

/lanind 1 def
/lantex [(G) (E) (S) (F) (I) (J) (M)] def
/showde {0 lanind eq {show} {pop} ifelse} bind def
/showen {1 lanind eq {show} {pop} ifelse} bind def
/showes {2 lanind eq {show} {pop} ifelse} bind def
/showfr {3 lanind eq {show} {pop} ifelse} bind def
/showit {4 lanind eq {show} {pop} ifelse} bind def
/showjp {5 lanind eq {show} {pop} ifelse} bind def
/showea {1 lanind le {show} {pop} ifelse} bind def

/lanindf where {pop /lanind1 lanindf def /lanind2 lanindf def
                    /lanindd laninddf def}
               {/lanind1 1 def /lanind2 1 def} ifelse
/colormf where {pop /colorm1 colormf def /colorm2 colormf def
                    /colormd colormdf def}
               {/colorm1 0 def} ifelse
/deintpf where {pop /deintp1 deintpf def /deintp2 deintpf def
                    /deintpd deintpdf def}
               {/deintp1 0 def} ifelse
/xcolorf where {pop /xcolor1 xcolorf def /xcolor2 xcolorf def
                    /xcolord xcolordf def}
               {/xcolor1 3 def} ifelse
/xchartf where {pop /xchart1 xchartf def /xchart2 xchartf def
                    /xchartd xchartdf def
                    /xchartm xchart2f xchart1f sub 1 add def}
               {/xchart1 0 def /xchartm 1 def} ifelse
/xchart3f where {pop /xchart3 xchart3f def}
                {/xchart3 0 def} ifelse
/xchart4f where {pop /xchart4 xchart4f def}
                {/xchart4 0 def} ifelse
/pchartf where {pop /pchart1 pchartf def /pchart2 pchartf def
                    /pchartd pchartdf def}
               {/pchart1 3 def} ifelse
/colsepf where {pop /colsep1 colsepf def /colsep2 colsepf def
                    /colsepd colsepdf def}
               {/colsep1 0 def} ifelse
/pmetamf where {pop /pmetam1 pmetamf def /pmetam2 pmetamf def
                    /pmetamd pmetamdf def}
               {/pmetam1 0 def} ifelse

%either defaul values for xchart=0 or values for xchart=1
/lanind lanind1 def %
/colorm colorm1 def %
/deintp deintp1 def %
/xcolor xcolor1 def %
/xchart xchart1 def %
/pchart pchart1 def %
/colsep colsep1 def %
/pmetam pmetam1 def %

colorm 0 eq deintp 0 eq and {/Txx (d) def /Fxx (d) def} if %colorm=0, deintp=0
colorm 0 eq deintp 1 eq and {/Txx (e) def /Fxx (e) def} if %colorm=0, deintp=1
colorm 1 eq deintp 0 eq and {/Txx (dd) def /Fxx (d) def} if %colorm=1, deintp=0
colorm 1 eq deintp 1 eq and {/Txx (de) def /Fxx (e) def} if %colorm=1, deintp=1
xchart 0 eq {/Txx (-) def /Fxx (-) def} if %always independent of intended output

5 /Times-ISOL1 FS
/cvishow {cvi 6 string cvs show} def
%75 85 moveto
%lanind cvishow (-) show
%colorm cvishow
%deintp cvishow
%xcolor cvishow
%xchart cvishow
%pchart cvishow
%colsep cvishow (-L) show pmetam cvishow

gsave
%XCHA01.PS END

/cvishow0 {cvi 6 string cvs show} def

/kchartl 0 def %0:left page, 1:right page 
/pchartl 0 def %0:top  page, 4:down  page %not used
/jlog 0 def %0,1 without/with log

72 90 translate

0.010 MM dup scale

/xbtex0 0 def  %xbtex=0 for files Y1(0/1)-(3/7)n.EPS
xbtex0 1 eq {%xbtex0=1

40 setlinewidth
/ymax1 08550 def
/xmax1 12250 def
1.0 setgray
0 0  moveto xmax1 0 rlineto 0 ymax1 rlineto xmax1 neg 0 rlineto
closepath fill
0 setgray
0 0  moveto xmax1 0 rlineto 0 ymax1 rlineto xmax1 neg 0 rlineto
closepath stroke

TK
0 setgray
150  /Times-ISOL1 FS
150 -140 moveto
(heo80-1a) show
} if %xbtex0=1

/ifunc 0 def %0:HAULAB
ifunc 0 eq {/i1 002 def}        %HauLAB
           {/i1 001 def} ifelse %all others
/i2 99 def

/iequa 1 def %0,1 without/with equations
/iY_curve 0 def %0/1 without/with curve data

/xchartl 0 def
%0 1 3 {/xchartl exch def %xchartl=0,3

/ichartl 0 def
/ichart  0 def
/jchartl 0 def
0 1 0 {/jchartl exch def %1 jxhartl=0,3
       jchartl 0 eq {/jchart 0 def} if
       jchartl 1 eq {/jchart 1 def} if
       jchartl 2 eq {/jchart 2 def} if
       jchartl 3 eq {/jchart 3 def} if

/ij ichart 6 mul jchart add def %0<=kchart<48

proc_basdef

proc_funcHAU

proc_funcHAU_CIE_IEC_TUB
%uses:
%ifunc 0 eq {proc_Yi_L*i_dYi_H_0} if
%ifunc 1 eq {proc_Yi_L*i_dYi_C_0} if
%ifunc 2 eq {proc_Yi_L*i_dYi_I_0} if
%ifunc 3 eq {proc_Yi_L*i_dYi_T_0} if


/ij ichart 6 mul jchart add def %0<=kchart<48

proc_ij_syij_dyij_Ykij_L*kij_Yxyk
%input: kchart, Ykij, L*kij, ouput for plot Xk, Yk

} for %jchartl=0,3

%END Data creation

%$STOP04

/ichartl 0 def
/ichart  0 def
/jchartl 0 def
/jchart  0 def

/jchartl 0 def
0 1 0 {/jchartl exch def %2 jxhartl=0,3
       jchartl 0 eq {/jchart 0 def} if
       jchartl 1 eq {/jchart 1 def} if
       jchartl 2 eq {/jchart 2 def} if
       jchartl 3 eq {/jchart 3 def} if


proc_basdef

proc_funcHAU

proc_funcHAU_CIE_IEC_TUB

gsave
/ij ichart 6 mul jchart add def %0<=kchart<48

proc_ij_syij_dyij_Ykij_L*kij_Yxyk

20 setlinewidth
/xpos [00000 00000 00000 00000] def
/ypos [00000 00000 00000 00000] def

%xpos xchartl get ypos xchartl get translate
xpos jchartl get ypos jchartl get translate

0 setgray
150  /Times-ISOL1 FS
150 -140 moveto
(heo8) show kchartl cvishow0 (-) show
jchartl 1 add pchartl add cvishow0
(a) show %a

/xwidth 6000 def
/ywidth 4000 def
25 setlinewidth
1 1 1 setrgbcolor
0 0 moveto xwidth     0 rlineto 0 ywidth rlineto
           xwidth neg 0 rlineto closepath fill

0 setlinewidth
0 0 moveto xwidth     0 rlineto 0 ywidth rlineto
           xwidth neg 0 rlineto closepath clip

20 setlinewidth
0 setgray
0 0 moveto xwidth     0 rlineto 0 ywidth rlineto
           xwidth neg 0 rlineto closepath stroke


tfn %tfw
/xtr0 380 def
/ytr0 280 def

xtr0 ytr0 translate

%*********************************************************************
50 setlinewidth %50 setlinewidth
tfn
 0 0 moveto 5000 0 rlineto stroke
 0 0 moveto 0 3100 rlineto stroke

5000 100 add 0 moveto
-100 50 rlineto 0 -100 rlineto closepath fill
0 3100 100 add moveto
-50 -100 rlineto 100 0 rlineto closepath fill

TBL
/tx [(-2) (-1) (  0) (  1) (  2)] def
/txl [( ) (0,1) (  1) ( 10) (100)] def

%!x-Achse: 100 Einheiten = 0600 Skalen-Einheiten
0 1 4 {/i exch def
       /ixt {-150 i 1000 mul add} def
       /ixl { 000 i 1000 mul add} def
        ixt -230 moveto tx i get exec show
        tfb
        i 1 ge {ixt 100 moveto txl i get exec show} if
        tfn
        ixl   60 moveto 0 -120 rlineto stroke
     } for

tfn %tfw
3300  100 moveto (Y) jLs (u) ibLs TBL (=18) show
tfn

/ixtt 4.5 1000 mul def
/iytt -200 def
ixtt 200 add iytt moveto
(log) bLs 20rm (Y) jLs
/iytt 050 def
ixtt 200 add iytt moveto
tfb (Y) jLs tfn

tfn %tfw
2000 0 moveto 1900 0 rlineto stroke
tfg
[100] 0 setdash
2000 0 moveto 1900 0 rlineto stroke
[ ] 0 setdash

jlog 0 eq {%jlog=0,1
tfn
%!y-Achse: 100 S-Einheiten = 1000 Skalen-Einheiten
/j1y 2 def %default
/j2y 4 def
%ifunc 0 eq {%ifunc=0 HAULAB
%xchartl  0 eq {/j1y 4 def /j2y 6 def} if
%xchartl  2 eq {/j1y 1 def /j2y 3 def} if
%xchartl  4 eq {/j1y 0 def /j2y 2 def} if
%xchartl  6 eq {/j1y 4 def /j2y 6 def} if
%           } if %ifunc=0 HAULAB
%ifunc 1 eq {%ifunc=0 CIELAB
%xchartl  0 eq {/j1y 3 def /j2y 5 def} if
%xchartl  2 eq {/j1y 2 def /j2y 4 def} if
%xchartl  4 eq {/j1y 1 def /j2y 3 def} if
%xchartl  6 eq {/j1y 3 def /j2y 5 def} if
%           } if %ifunc=1 CIELAB
TBL
%yshift -1000  0   1000    2000    3000    4000
%        0     1      2      3       4       5       6       7       8
/ty [(  -3)(  -2)(  -1) (    0) (    1) (    2) (    3) (    4) (    5)] def
/tyl[(0,001)(0,01) (0,1)     (1)    (10)   (100)  (1000) (10000) (100000)] def

ifunc 0 eq
ifunc 2 eq or 
ifunc 3 eq or {%ifunc=0,2,3 HAULAB, IECsRGB, TUBsRGB 
/ty0[(    0)(  500)(1000)(1500)] def
/ty1[(  0)(  1)(  2)(  3)] def
/ty2[(0,0)(0,2)(0,4)(0,6)] def
/ty3[(  0)(  2)(  4)(  6)] def
/ty4[(0,00)(0,01)(0,02)(0,03)] def
/ty5[(  0)(  2)(  4)(  6)] def
/ty6[(    0)(200)(400)(600)] def
/ty7[(  0)(  1)(  2)(  3)] def
      } if %ifunc=0,2,3 HAULAB, IECsRGB, TUBsRGB
ifunc 1 eq {%ifunc=1 CIELAB
/ty0[(    0)(  50)(100)(150)] def
/ty1[(  0)(  1)(  2)(  3)] def
/ty2[(  0)(  2)(  4)(  6)] def
/ty3[(  0)(  2)(  4)(  6)] def
/ty4[(0,0)(0,1)(0,2)(0,3)] def
/ty5[(  0)(  2)(  4)(  6)] def
/ty6[(  0) (20) (40)(60) ] def
/ty7[(  0)(  1)(  2)(  3)] def
      } if %ifunc=1 CIELAB

/j1y 0 def
/j2y 3 def
j1y 1 j2y {/j exch def
           /jyt {-50 j j1y sub 1000 mul add} def
           /jyl {000 j j1y sub 1000 mul add} def
           -400
           jyt moveto
           xchartl 0 eq {ty1 j get show} if
           xchartl 1 eq {ty3 j get show} if
           xchartl 2 eq {ty5 j get show} if
           xchartl 3 eq {ty7 j get show} if
           tfn
           -60 jyl moveto 120 0 rlineto stroke
          } for
        } %jlog=0
        { %jlog=1
tfn
%!y-Achse: 100 S-Einheiten = 1000 Skalen-Einheiten
/j1y 2 def %default
/j2y 5 def
%ifunc 0 eq {%ifunc=0 HAULAB
%xchartl  0 eq {/j1y 4 def /j2y 6 def} if
%xchartl  2 eq {/j1y 1 def /j2y 4 def} if
%xchartl  4 eq {/j1y 0 def /j2y 3 def} if
%xchartl  6 eq {/j1y 4 def /j2y 6 def} if
%           } if %ifunc=0 HAULAB
%ifunc 1 eq {%ifunc=0 CIELAB
%xchartl  0 eq {/j1y 3 def /j2y 5 def} if
%xchartl  2 eq {/j1y 2 def /j2y 5 def} if
%xchartl  4 eq {/j1y 1 def /j2y 4 def} if
%xchartl  6 eq {/j1y 3 def /j2y 5 def} if
%           } if %ifunc=1 CIELAB
TBL
%yshift -1000  0   1000    2000    3000    4000
%        0     1      2      3       4       5       6       7       8
/ty [(  -3)(  -2)(  -1) (    0) (    1) (    2) (    3) (    4) (    5)] def
/tyl[(0,001)(0,01) (0,1)     (1)    (10)   (100)  (1000) (10000) (100000)] def
j1y 1 j2y {/j exch def
           /jyt {-50 j j1y sub 1000 mul add} def
           /jyl {000 j j1y sub 1000 mul add} def
           -400 jyt moveto ty j get show
           tfb
           j j1y 1 add ge {100 jyt moveto tyl j get show} if
           tfn
           -60 jyl moveto 120 0 rlineto stroke
          } for
        } ifelse %jlog=0,1

%********************************************************

%BEG C02, C04, C06, C08 ********************************************
%jlog 0:without log, 1:with log in main program

ifunc 0 eq {/n 0.3100 def} if %HAULAB
ifunc 1 eq {/n 1 3.0 div def} if
ifunc 2 eq {/n 1 2.4 div def} if
ifunc 3 eq {/n 1 10 ln div def} if

proc_toptext

/y0del 100 def
50 setlinewidth

%****************************************************************
tfb
/xtfb 00 def
xchartl 00 eq {100 3200 xtfb sub moveto
               (L*/L*) jLs ifunc 0 eq {(80,) ibLs} if (u) ibLs
              } if

xchartl 01 eq {100 3200 xtfb sub moveto
               (D) sKs (Y) jLs (/) bLs
               (D) sKs (Y) jLs (u) ibLs
              } if

xchartl 02 eq {100 3200 xtfb sub moveto
               (S) jLs (r)  ibLs (/) bLs (S) jLs (ru) ibLs
               (=\050) bLs (D) sKs (Y/Y) jLs (\051/\050) bLs
               (D) sKs (Y/Y) jLs (\051) bLs (u) ibLs
              } if

xchartl 03 eq {100 3200 xtfb sub moveto
               (C) jLs (r)  ibLs (/) bLs
               (C) jLs (ru) ibLs
               (=\050) bLs (Y/) jLs (D) sKs (Y) jLs (\051/\050) bLs
               (Y) jLs (/) bLs (D) sKs (Y) jLs (\051) bLs (u) ibLs
              } if
tfn

%**************************************************************
xchartl 00 eq {proc_C02_ALOG_L*DL*u} if
xchartl 01 eq {proc_C04_ALOG_DLn} if
xchartl 02 eq {proc_C06_ALOG_DL_Ln} if
xchartl 03 eq {proc_C08_ALOG_L_DLn} if

%END C01_C08**********************************************

%********************************************************

xtr0 neg ytr0 neg translate
%**************************************************************

%xpos xchartl get neg ypos xchartl get neg translate
xpos jchartl get neg ypos jchartl get neg translate

grestore

%} for %xchartl=0,3

} for %jchartl=0,3

showpage
grestore

%%Trailer