%!PS-Adobe-3.0 EPSF-3.0 http://farbe.li.tu-berlin.de/hgn0/hgn01-3n %%BoundingBox: 70 85 246 206 %START PDFDE011.EPS /pdfmark13 where {pop} {userdict /pdfmark13 /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/hgn0/hgn0.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 pdfmark13 [ /View [ /Fit ] /DOCVIEW pdfmark13 %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'Y11-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 TL 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 tfb xchartl 00 eq {(L*/L*) jLs ifunc 0 eq {(80,) ibLs} if (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 /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 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/60/30/10) nLs ichart 0 eq {(=2) nLs (o) eSs} if ichart 3 eq {(=1) nLs (o) eSs} if 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 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 iequa 1 eq {%BEG iequa=1 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 iequa=1 } if %ifunc=0 special END HAULAB_C02 %***** ifunc 1 eq {%ifunc=1 special BEG CIELAB_C02 %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 iequa 1 eq {%BEG iequa=1 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 iequa=1 } if %ifunc=1 special END CIELAB_C02 %***** ifunc 2 eq {%ifunc=2 special BEG IECsRGB_C02 %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 iequa 1 eq {%BEG iequa=1 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 iequa=1 } if %ifunc=2 special END IECsRGB_C02 %***** ifunc 3 eq {%ifunc=3 special BEG TUBsRGB_C02 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 iequa 1 eq {%BEG iequa=1 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 iequa=1 } 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 %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 iequa 1 eq {%BEG iequa=1 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 iequa=1 } if %ifunc=0 special END HAULAB_C04 %***** ifunc 1 eq {%ifunc=1 special CIELAB_C04 %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 iequa 1 eq {%BEG iequa=1 %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 iequa=1 } if %ifunc=1 special END CIELAB_C04 %***** ifunc 2 eq ifunc 3 eq or {%ifunc=2,3 special IECsRGB/TUBsRGB_C04 %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 iequa 1 eq {%BEG iequa=1 %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 iequa=1 } 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 %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 iequa 1 eq {%BEG iequa=1 %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 iequa=1 } if %ifunc=0 special END HAULAB_C06 %***** ifunc 1 eq {%ifunc=1 special BEG CIELAB_C06 %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 iequa 1 eq {%BEG iequa=1 %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 iequa=1 } if %ifunc=1 special END CIELAB_C06 %***** ifunc 2 eq ifunc 3 eq or {%ifunc=2,3 special BEG IECsRGB/TUBsRGB_C06 %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 iequa 1 eq {%BEG iequa=1 %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 iequa=1 } 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 %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 iequa 1 eq {%BEG iequa=1 %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 iequa=1 } if %ifunc=0 special END HAULAB_C08 %***** ifunc 1 eq {%ifunc=1 special BEG CIELAB_C08 %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 iequa 1 eq {%BEG iequa=1 %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 iequa=1 } if %ifunc=1 special END CIELAB_C08 %***** ifunc 2 eq ifunc 3 eq or {%ifunc=2,3 special BEG IECsRGB/TUBsRGB_C08 %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 iequa 1 eq {%BEG iequa=1 %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 iequa=1 } 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 log Yi n004 get log 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 /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 600 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 0 def /lanind2 0 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 1 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 (hgn01-3n) 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 0 def %0,1 without/with equations /iY_curve 1 def %0/1 without/with curve data /xchartl 2 def %0 1 3 {/xchartl exch def %xchartl=0,3 /jchartl 0 def /jchart 0 def /ichartl 0 def 1 1 1 {/ichartl exch def %1 ixhartl=0,3 ichartl 0 eq {/ichart 0 def} if ichartl 1 eq {/ichart 3 def} if ichartl 2 eq {/ichart 4 def} if ichartl 3 eq {/ichart 6 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 %ichartl=0,3 %END Data creation %$STOP04 /jchartl 0 def /jchart 0 def /ichartl 0 def /ichart 0 def /ichartl 0 def 1 1 1 {/ichartl exch def %2 ixhartl=0,3 ichartl 0 eq {/ichart 0 def} if ichartl 1 eq {/ichart 3 def} if ichartl 2 eq {/ichart 4 def} if ichartl 3 eq {/ichart 6 def} if 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 ichartl get ypos ichartl get translate 0 setgray 150 /Times-ISOL1 FS 150 -140 moveto (hgn0) show kchartl cvishow0 (-) show ichartl 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 ichartl get neg ypos ichartl get neg translate grestore %} for %xchartl=0,3 } for %ichartl=0,3 showpage grestore %%Trailer