%BEG DEH-0000.TXT *********************************2011-03-01 /Xrx089 729 array def /Yrx089 729 array def /Zrx089 729 array def /Xrx100 729 array def /Yrx100 729 array def /Zrx100 729 array def /R0 729 array def /G0 729 array def /B0 729 array def /RGB0_to_XYZ729 { %BEG procedure RGB0_to_XYZ729 %transfers standard sRGB data (IEC 61966-2-1) to XYZ data for 9x9x9=729 colours %normalized XYZ data with Y=88.59 for display white, compare ISO 9241-306:2008. %requires /(XYZ)rx089 729 array def % /(XYZ)rx100 729 array def %requires in addition /RGB0 1080 array def %row no.1 and 2: 9xrgb /imax 08 def /jmax 08 def /kmax 08 def 0 1 kmax {/k exch def %beg k=0,08 0 1 jmax {/j exch def %beg j=0,jmax 0 1 imax {/i exch def %beg i=0,imax /n i j 9 mul add k 81 mul add def R0 n k kmax div 1000 mul put G0 n j jmax div 1000 mul put B0 n i imax div 1000 mul put } for %end i=0,jmax } for %end j=0,jmax } for %end k=0,kmax /IM0 729 def /IM1 IM0 1 sub def 0 1 IM1 {/i exch def %i=0,IM1 R0 i get 0.04045 le %equations of IEC 61966-2-1:2003 {/RsRGB R0 i get 12.92 div def} {/RsRGB R0 i get 0.001 mul 0.055 add 1.055 div 2.4 exp def} ifelse G0 i get 0.04045 le {/GsRGB G0 i get 12.92 div def} {/GsRGB G0 i get 0.001 mul 0.055 add 1.055 div 2.4 exp def} ifelse B0 i get 0.04045 le {/BsRGB B0 i get 12.92 div def} {/BsRGB B0 i get 0.001 mul 0.055 add 1.055 div 2.4 exp def} ifelse Xrx100 i 0.4124 RsRGB mul 0.3576 GsRGB mul add 0.1805 BsRGB mul add 100 mul put Yrx100 i 0.2126 RsRGB mul 0.7152 GsRGB mul add 0.0722 BsRGB mul add 100 mul put Zrx100 i 0.0193 RsRGB mul 0.1192 GsRGB mul add 0.9505 BsRGB mul add 100 mul put } for %i=0,IM1 0 1 IM1 {/i exch def %i=0,IM1 Xrx089 i Xrx100 i get 0.8859 mul put Yrx089 i Yrx100 i get 0.8859 mul put Zrx089 i Zrx100 i get 0.8859 mul put } for %i=0,IM1 /iN 0 def /iW 728 def /XLN100 Xrx100 iN get def /YLN100 Yrx100 iN get def /ZLN100 Zrx100 iN get def /XLW100 Xrx100 iW get def /YLW100 Yrx100 iW get def /ZLW100 Zrx100 iW get def /XLN089 Xrx089 iN get def /YLN089 Yrx089 iN get def /ZLN089 Zrx089 iN get def /XLW089 Xrx089 iW get def /YLW089 Yrx089 iW get def /ZLW089 Zrx089 iW get def % achromatic (D65) colours /XLWD65100 95.04 def /YLWD65100 100.00 def /ZLWD65100 108.88 def /XLWD65089 95.04 0.8859 mul def /YLWD65089 100.00 0.8859 mul def /ZLWD65089 108.88 0.8859 mul def /XLN001 XLWD65100 100 div def /YLN001 YLWD65100 100 div def /ZLN001 ZLWD65100 100 div def } bind def %END procedure RGB0_to_XYZ729 %*********************************************************** /LAB*e 35 array def %7x5=35 /LAB*e[39.92 58.74 27.99 0.0 0.0 % 00_04 R CIE No.09 elementary colours in LAB, D65 81.26 -2.89 71.56 0.0 0.0 % 05_09 J CIE No.10 52.23 -42.42 13.60 0.0 0.0 % 10_14 G CIE No.11 0.0 0.0 0.0 0.0 0.0 % 15_19 Cgb 30.57 1.41 -46.47 0.0 0.0 % 20_24 B CIE No.12 0.0 0.0 0.0 0.0 0.0 % 25_29 Mbr 39.92 58.74 27.99 0.0 0.0 % 30_34 R+360 CIE No.09 elementary colours in LAB, D65 ] def /LAB*He_Hs { %BEG procedure LAB*He_Hs %calculation of CIELAB data of elementary colours %elemenatry colour data of colour RJGB of CIE R1-47:2009 used %requires /LAB*e 35 array def %7x5=35 %requires /LAB*e data of CIE R1-47 0 1 5 {/j exch def %j=0,5 j 0 eq {LAB*e 03 LAB*e 01 get dup mul LAB*e 02 get dup mul add sqrt put LAB*e 04 LAB*e 02 get LAB*e 01 get 0.0001 add atan put } if j 1 eq {LAB*e 08 LAB*e 06 get dup mul LAB*e 07 get dup mul add sqrt put LAB*e 09 LAB*e 07 get LAB*e 06 get 0.0001 add atan put } if j 2 eq {LAB*e 13 LAB*e 11 get dup mul LAB*e 12 get dup mul add sqrt put LAB*e 14 LAB*e 12 get LAB*e 11 get 0.0001 add atan put } if j 4 eq {LAB*e 23 LAB*e 21 get dup mul LAB*e 22 get dup mul add sqrt put LAB*e 24 LAB*e 22 get LAB*e 21 get 0.0001 add atan put } if } for %j=0,5 3 1 4 {/i exch def %i=3,4 30_34 R+360 LAB*e i 30 add LAB*e i get put i 4 eq {LAB*e i 30 add LAB*e i get 360 add put} if } for %i=3,4 3 2 5 {/i exch def %i=3,5,2 Cgb+Cbr i 3 eq {LAB*e 19 LAB*e 14 get LAB*e 24 get add 0.5 mul put %hab LAB*e 18 LAB*e 13 get LAB*e 23 get add 0.5 mul put %C*ab LAB*e 15 LAB*e 10 get LAB*e 20 get add 0.5 mul put %L* LAB*e 16 LAB*e 18 get LAB*e 19 get cos mul put %a* LAB*e 17 LAB*e 18 get LAB*e 19 get sin mul put %b* } if i 5 eq {LAB*e 29 LAB*e 24 get LAB*e 34 get add 0.5 mul put %hab LAB*e 28 LAB*e 23 get LAB*e 33 get add 0.5 mul put %C*ab LAB*e 25 LAB*e 20 get LAB*e 30 get add 0.5 mul put %L* LAB*e 26 LAB*e 28 get LAB*e 29 get cos mul put %a* LAB*e 27 LAB*e 28 get LAB*e 29 get sin mul put %b* } if } for %i=3,5,2 /LAB*He 7 array def 0 1 6 {/i exch def %i=0,5 LAB*He i LAB*e i 5 mul 4 add get put } for %i=0,5 /LAB*Hs 7 array def /LAB*Hs [30. 90. 150. 210. 270. 330. 390.] def } bind def %END procedure LAB*He_Hs %****************************************************************** /habsi 361 array def /habei 361 array def /hab*sM_to_hab*eM { %BEG Procedure hab*sM_to_hab*eM %transfer from hue angle hab*s of standard colours to hab*e of elementary colours %360 integer hue angles used %360 steps used for the range 0 <= hab*s <= 360 %requires /habsi 361 array def %requires /habei 361 array def 0 1 359 {/i exch def %i=0,359 /habs i def habsi i i put %alpha = [habs - LAB*Hs(h)]/[LAB*Hs(n+1) - LAB*Hs(n)] % = [habs - LAB*Hs(h)]/60 %habe = alpha [LAB*He(n+1) - LAB*He(n)] + LAB*He(n) i 000 ge i 029 le and {/ipan0 5 def /ipan1 6 def /habs habs 360 add def} if i 030 ge i 089 le and {/ipan0 0 def /ipan1 1 def} if i 090 ge i 149 le and {/ipan0 1 def /ipan1 2 def} if i 150 ge i 209 le and {/ipan0 2 def /ipan1 3 def} if i 210 ge i 269 le and {/ipan0 3 def /ipan1 4 def} if i 270 ge i 329 le and {/ipan0 4 def /ipan1 5 def} if i 330 ge i 359 le and {/ipan0 5 def /ipan1 6 def} if /alpha {habs LAB*Hs ipan0 get sub 60 div} bind def /habe {LAB*He ipan1 get LAB*He ipan0 get sub alpha mul LAB*He ipan0 get add} bind def habe 360 ge {/habe habe 360 sub def} if habei i habe round cvi put } for %i=0,359 habsi 360 360 put habei 360 habei 0 get put } bind def %END hab*sM_to_hab*eM %****************************************************************** /r*d361Mi 361 array def /g*d361Mi 361 array def /b*d361Mi 361 array def /hab*sM_to_rgb*d361Mi { %BEG Procedure hab*sM_to_rgb*d361Mi %transfer from hue angle hab*s of standard colours to rgb* data of elementary colours hab*e %360 integer hue angles used %360 steps used for the range 0 <= hab*s <= 360 %requires /habsi 361 array def % /habei 361 array def % /rgb*d361Mi 361 array def 0 1 359 {/i exch def %i=0,359 i 000 ge i 029 le and {r*d361Mi i 1.00 put %Mbr_R, part 2 g*d361Mi i 0.00 put b*d361Mi i 1.00 i 30 add 60 div sub put} if i 030 ge i 089 le and {r*d361Mi i 1.00 put %R_J g*d361Mi i 0.00 i 30 sub 60 div add put b*d361Mi i 0.00 put} if i 090 ge i 149 le and {r*d361Mi i 1.00 i 90 sub 60 div sub put %J_G g*d361Mi i 1.00 put b*d361Mi i 0.00 put} if i 150 ge i 209 le and {r*d361Mi i 0.00 put %G_Cgb g*d361Mi i 1.00 put b*d361Mi i 0.00 i 150 sub 60 div add put} if i 210 ge i 269 le and {r*d361Mi i 0.00 put %Cgb_B g*d361Mi i 1.00 i 210 sub 60 div sub put b*d361Mi i 1.00 put} if i 270 ge i 329 le and {r*d361Mi i 0.00 i 270 sub 60 div add put %B_Mbr g*d361Mi i 0.00 put b*d361Mi i 1.00 put} if i 330 ge i 359 le and {r*d361Mi i 1.00 put %Mbr_R, part 1 g*d361Mi i 0.00 put b*d361Mi i 1.00 i 330 sub 60 div sub put} if } for %i=0,359 r*d361Mi 360 r*d361Mi 0 get put g*d361Mi 360 g*d361Mi 0 get put b*d361Mi 360 b*d361Mi 0 get put } bind def %END hab*sM_to_rgb*d361Mi %****************************************************************** /XIEi 361 array def /x361i 361 array def /r*e361Mi 361 array def /g*e361Mi 361 array def /b*e361Mi 361 array def /LAB*L361Mi 361 array def /LAB*a361Mi 361 array def /LAB*b361Mi 361 array def /LAB*C361Mi 361 array def /LAB*h361Mi 361 array def /LAB*x50M_to_LAB*x361Mi_rgb*x361Mi { %BEG Procedure LAB*x50M_to_LAB*x361Mi_rgb*x361Mi %transfer from measured CIELAB data of a 48 step hue circle %to a 360 step integer hue circle %360 steps used for the range 0 <= LAb*50hM <= 360 %requires /LAB*x50M 50 array def (x=L,a,b,C,h) defined in LAB729a_to_LAB*x50M %requires /rgb*d50M 50 array def defined allways as table %both defined in LAB729a_to_LAB*x50M %requires /LAB*x361M 361 array def (x=L,a,b,C,h) %requires /rgb*e361Mi 361 array def /hmin LAB*h50M 0 get def /hmax LAB*h50M 48 get def /hmini LAB*h50M 0 get cvi def /hmaxi LAB*h50M 48 get cvi def 0 1 360 {/i0 exch def %i=0,360 %default /i1 i0 1 add def /XIE -1 def LAB*L361Mi i0 -1 put LAB*C361Mi i0 -1 put LAB*h361Mi i0 -1 put LAB*a361Mi i0 -1 put LAB*b361Mi i0 -1 put r*e361Mi i0 -1 put g*e361Mi i0 -1 put b*e361Mi i0 -1 put XIEi i0 -1 put x361i i0 -1 put } for %i=0,360 hmini 1 hmaxi {/i0 exch def %i=36,300 0 1 48 {/ix0 exch def %ix0=0,48 /ix1 ix0 1 add def i0 LAB*h50M ix0 get sub 0 ge i0 LAB*h50M ix1 get sub 0 lt and { /im i0 def i0 360 ge {/im i0 360 sub def} if XIEi im i0 LAB*h50M ix0 get sub LAB*h50M ix1 get LAB*h50M ix0 get sub div put /XIE XIEi im get def LAB*L361Mi im LAB*L50M ix0 get LAB*L50M ix1 get LAB*L50M ix0 get sub XIE mul add put LAB*C361Mi im LAB*C50M ix0 get LAB*C50M ix1 get LAB*C50M ix0 get sub XIE mul add put LAB*h361Mi im LAB*h50M ix0 get LAB*h50M ix1 get LAB*h50M ix0 get sub XIE mul add dup 360 ge {360 sub} if put LAB*a361Mi im LAB*C361Mi im get LAB*h361Mi im get cos mul put LAB*b361Mi im LAB*C361Mi im get LAB*h361Mi im get sin mul put r*e361Mi im r*d50M ix0 get r*d50M ix1 get r*d50M ix0 get sub XIE mul add put g*e361Mi im g*d50M ix0 get g*d50M ix1 get g*d50M ix0 get sub XIE mul add put b*e361Mi im b*d50M ix0 get b*d50M ix1 get b*d50M ix0 get sub XIE mul add put ix0 00 ge ix0 07 le and {x361i im 0 put} if ix0 08 ge ix0 15 le and {x361i im 1 put} if ix0 16 ge ix0 23 le and {x361i im 2 put} if ix0 24 ge ix0 31 le and {x361i im 3 put} if ix0 32 ge ix0 39 le and {x361i im 4 put} if ix0 40 ge ix0 47 le and {x361i im 5 put} if exit } if } for %ix0=0,48 } for %i=36,300 LAB*L361Mi 360 LAB*L361Mi 0 get put LAB*a361Mi 360 LAB*a361Mi 0 get put LAB*b361Mi 360 LAB*b361Mi 0 get put LAB*C361Mi 360 LAB*C361Mi 0 get put LAB*h361Mi 360 LAB*h361Mi 0 get 360 add put r*e361Mi 360 r*e361Mi 0 get put g*e361Mi 360 g*e361Mi 0 get put b*e361Mi 360 b*e361Mi 0 get put XIEi 360 XIEi 0 get put x361i 360 x361i 0 get put } bind def %END LAB*x50M_to_LAB*x361Mi_rgb*x361Mi %****************************************************************** /LAB*L50M 50 array def /LAB*a50M 50 array def /LAB*b50M 50 array def /LAB*C50M 50 array def /LAB*h50M 50 array def /LAB729a_to_LAB*x50M { %BEG Procedure LAB729a_to_LAB*x50M %selection of a 48 step hue circle of maximum chroma %out of measured CIELAB data of 9x9x9=729 colours %requires /LAB*x50M 50 array def %requires /LAB729a 729 array def %defined in /xcharti_XYZ729_LAB729a 0 1 5 {/xtonj exch def %xtonj=0,5 0 1 7 {/j exch def %j=0,7 /ja xtonj 8 mul j add def xtonj 0 eq {/jx 648 j 09 mul add def} if %see O00Y-O83Y, -0 xtonj 1 eq {/jx 720 j 81 mul sub def} if %see Y00L-Y83L, -81 xtonj 2 eq {/jx 072 j add def} if %see L00C-L83C, +01 xtonj 3 eq {/jx 080 j 09 mul sub def} if %see C00V-C83V, -09 xtonj 4 eq {/jx 008 j 81 mul add def} if %see V00M-V83M, -81 xtonj 5 eq {/jx 656 j sub def} if %see M00O-M83O, +01 LAB*L50M ja L729a jx get put LAB*a50M ja a729a jx get put LAB*b50M ja b729a jx get put LAB*C50M ja LAB*a50M ja get dup mul LAB*b50M ja get dup mul add sqrt put LAB*h50M ja LAB*b50M ja get LAB*a50M ja get 0.0001 add atan put xtonj 5 eq LAB*h50M ja get 90 le and {LAB*h50M ja LAB*h50M ja get 360 add put} if } for %j=0,7 } for %xtonj=0,5 LAB*L50M 48 LAB*L50M 0 get put LAB*a50M 48 LAB*a50M 0 get put LAB*b50M 48 LAB*b50M 0 get put LAB*C50M 48 LAB*C50M 0 get put LAB*h50M 48 LAB*h50M 0 get 360 add put LAB*L50M 49 LAB*L50M 1 get put LAB*a50M 49 LAB*a50M 1 get put LAB*b50M 49 LAB*b50M 1 get put LAB*C50M 49 LAB*C50M 1 get put LAB*h50M 49 LAB*h50M 1 get 360 add put } bind def %END LAB729a_to_LAB*x50M %************************************************************************ /Lrc089 729 array def /arc089 729 array def /brc089 729 array def /Xrc089 729 array def /Yrc089 729 array def /Zrc089 729 array def /Lra089 729 array def /ara089 729 array def /bra089 729 array def /Xra089 729 array def /Yra089 729 array def /Zra089 729 array def /Lna089 729 array def /ana089 729 array def /bna089 729 array def /Xna089 729 array def /Yna089 729 array def /Zna089 729 array def /Lla089 729 array def /ala089 729 array def /bla089 729 array def /Xla089 729 array def /Yla089 729 array def /Zla089 729 array def /X729 729 array def /Y729 729 array def /Z729 729 array def /L729 729 array def %not adapted /a729 729 array def /b729 729 array def /L729a 729 array def %adapted /a729a 729 array def /b729a 729 array def /ilf 8 array def /ilf [0.00 0.25 0.50 1.00 2.00 4.00 8.00 16.00] def /Lrefl 11 array def /Lrefl [(0%) (0%) (0%) (0%) (0,6%) (1,2%) (2,5%) (5%) (10%) (20%) (40%)] def /xcharti_XYZ729_LAB729a { %BEG Procedure xcharti_LAB729a %transfer from XYZ729 data to LAB729a CIELAB data for 9x9x9=729 colours %requires 0<= xcharti <=10 (11 luminance reflections) %requires /(XYZ)x089 3240 array def (x=rc,ra,na,la) %requires /(Lab)x089 3240 array def (x=rc,ra,na,la) %requires /x729 729 array def (x=X,Y,Z) %not adapted %requires /x729 729 array def (x=L,a,b) %not adapted %requires /x729a 729 array def (x=L,a,b) %adapted xcharti 2 le {/il 0 def} {/il xcharti 3 sub def} ifelse %Reference black and factors /YrN 2.52 def /Xtref089 YrN ilf il get mul XLN001 mul def /Ytref089 YrN ilf il get mul def /Ztref089 YrN ilf il get mul ZLN001 mul def /YNil Ytref089 def /YNil001 YNil 100 div def YNil001 6 29 div 3 exp ge {/FYYn YNil001 0.3333 exp def} {/FYYn 841 108 div YNil001 mul 4 29 div add def} ifelse /L*Nil 116 FYYn mul 16 sub def /IM1 728 def 0 1 IM1 {/i exch def %i=0,IM1 Xrc089 i Xrx089 i get put Yrc089 i Yrx089 i get put Zrc089 i Zrx089 i get put /XQ Xrc089 i get XLWD65100 div def /YQ Yrc089 i get YLWD65100 div def /ZQ Zrc089 i get ZLWD65100 div def XQ 0 lt {/XQ 0.00000001 def} if YQ 0 lt {/YQ 0.00000001 def} if ZQ 0 lt {/ZQ 0.00000001 def} if Lrc089 i YQ 0.008856 lt {903.3 YQ mul} {YQ 0.33333333 exp 116 mul 16 sub} ifelse put arc089 i XQ 0.008856 lt {7.787 XQ mul 16 116 div add} {XQ 0.33333333 exp} ifelse YQ 0.008856 lt {7.787 YQ mul 16 116 div add} {YQ 0.33333333 exp} ifelse sub 500 mul put brc089 i YQ 0.008856 lt {7.787 YQ mul 16 116 div add} {YQ 0.33333333 exp} ifelse ZQ 0.008856 lt {7.787 ZQ mul 16 116 div add} {ZQ 0.33333333 exp} ifelse sub 200 mul put } for %i=0,IM1 /L*N Lrc089 0 get def /A*N arc089 0 get def /B*N brc089 0 get def /L*W Lrc089 728 get def /A*W arc089 728 get def /B*W brc089 728 get def 0 1 IM1 {/i exch def %i=0,IM1 Lra089 i Lrc089 i get put /l*CIE Lrc089 i get L*N sub L*W L*N sub div def %system rel. lightn. /a*s A*W A*N sub l*CIE mul def /b*s B*W B*N sub l*CIE mul def ara089 i arc089 i get A*N sub a*s sub put bra089 i brc089 i get B*N sub b*s sub put } for %i=0,IM1 0 1 IM1 {/i exch def %i=0,IM1 /X* {Lra089 i get 16 add 116 div ara089 i get 500 div add} bind def /Y* {Lra089 i get 16 add 116 div} bind def /Z* {Lra089 i get 16 add 116 div bra089 i get 200 div sub} bind def Xra089 i X* DecodeXYZ* XLWD65100 mul put Yra089 i Y* DecodeXYZ* YLWD65100 mul put Zra089 i Z* DecodeXYZ* ZLWD65100 mul put } for %i=0,IM1 xcharti 2 ge {%xcharti>=2 %for white X data /Xwref089 Xra089 728 get def /Ywref089 Yra089 728 get def /Zwref089 Zra089 728 get def %for black X data /YrN Yra089 0 get def /Xnref089 YrN XLN001 mul def /Ynref089 YrN def /Znref089 YrN ZLN001 mul def /IM1 728 def 0 1 IM1 {/i exch def %i=1,IM1 Xna089 i Xra089 i get Xnref089 sub Xwref089 Xwref089 Xnref089 sub div mul put Yna089 i Yra089 i get Ynref089 sub Ywref089 Ywref089 Ynref089 sub div mul put Zna089 i Zra089 i get Znref089 sub Zwref089 Zwref089 Znref089 sub div mul put } for %i=1,IM1 0 1 IM1 {/i exch def %i=1,IM1 /XQ Xna089 i get XLWD65100 div def /YQ Yna089 i get YLWD65100 div def /ZQ Zna089 i get ZLWD65100 div def XQ 0 lt {/XQ 0.00000001 def} if YQ 0 lt {/YQ 0.00000001 def} if ZQ 0 lt {/ZQ 0.00000001 def} if Lna089 i YQ 0.008856 lt {903.3 YQ mul} {YQ 0.33333333 exp 116 mul 16 sub} ifelse put ana089 i XQ 0.008856 lt {7.787 XQ mul 16 116 div add} {XQ 0.33333333 exp} ifelse YQ 0.008856 lt {7.787 YQ mul 16 116 div add} {YQ 0.33333333 exp} ifelse sub 500 mul put bna089 i YQ 0.008856 lt {7.787 YQ mul 16 116 div add} {YQ 0.33333333 exp} ifelse ZQ 0.008856 lt {7.787 ZQ mul 16 116 div add} {ZQ 0.33333333 exp} ifelse sub 200 mul put } for %i=1,IM1 } if %xchart>=2 xcharti 3 ge {%xchart>=3 %for white X data /Xwref089 Xra089 728 get def /Ywref089 Yra089 728 get def /Zwref089 Zra089 728 get def /kn Ywref089 Ywref089 Ytref089 sub div def 0 1 IM1 {/i exch def %i=1,IM1 Xla089 i Xna089 i get kn div Xtref089 add put Yla089 i Yna089 i get kn div Ytref089 add put Zla089 i Zna089 i get kn div Ztref089 add put } for %i=1,IM1 0 1 IM1 {/i exch def %i=1,IM1 /XQ Xla089 i get XLWD65100 div def /YQ Yla089 i get YLWD65100 div def /ZQ Zla089 i get ZLWD65100 div def XQ 0 lt {/XQ 0.00000001 def} if YQ 0 lt {/YQ 0.00000001 def} if ZQ 0 lt {/ZQ 0.00000001 def} if Lla089 i YQ 0.008856 lt {903.3 YQ mul} {YQ 0.33333333 exp 116 mul 16 sub} ifelse put ala089 i XQ 0.008856 lt {7.787 XQ mul 16 116 div add} {XQ 0.33333333 exp} ifelse YQ 0.008856 lt {7.787 YQ mul 16 116 div add} {YQ 0.33333333 exp} ifelse sub 500 mul put bla089 i YQ 0.008856 lt {7.787 YQ mul 16 116 div add} {YQ 0.33333333 exp} ifelse ZQ 0.008856 lt {7.787 ZQ mul 16 116 div add} {ZQ 0.33333333 exp} ifelse sub 200 mul put } for %i=1,IM1 } if %xchart>=3 xcharti 0 eq {%xcharti=0 (1x) 0 1 IM1 {/i exch def %i=0,IM1 L729 i Lrc089 i get put a729 i arc089 i get put b729 i brc089 i get put X729 i Xrc089 i get put Y729 i Yrc089 i get put Z729 i Zrc089 i get put } for %i=0,IM1 } if %xcharti=0 (1x) xcharti 1 eq {%xcharti=1 (1x) 0 1 IM1 {/i exch def %i=0,IM1 L729 i Lra089 i get put a729 i ara089 i get put b729 i bra089 i get put X729 i Xra089 i get put Y729 i Yra089 i get put Z729 i Zra089 i get put } for %i=0,IM1 } if %xcharti=1 (1x) xcharti 2 eq {%xcharti=2 (1x) 0 1 IM1 {/i exch def %i=0,IM1 L729 i Lna089 i get put a729 i ana089 i get put b729 i bna089 i get put X729 i Xna089 i get put Y729 i Yna089 i get put Z729 i Zna089 i get put } for %i=0,IM1 } if %xcharti=2 (1x) xcharti 3 ge {%xcharti=3,4,5,6,7,8,9,10 (8x) 0 1 728 {/i exch def %i=0,IM1 L729 i Lla089 i get put a729 i ala089 i get put b729 i bla089 i get put X729 i Xla089 i get put Y729 i Yla089 i get put Z729 i Zla089 i get put } for %i=0,IM1 } if %xcharti=3,4,5,6,7,8,9,10 (8x) %Adaptation /L*Nio L729 000 get def /A*Nio a729 000 get def /B*Nio b729 000 get def /L*Wio L729 728 get def /A*Wio a729 728 get def /B*Wio b729 728 get def /A*Dio A*Wio A*Nio sub def /B*Dio B*Wio B*Nio sub def 0 1 728 {/j exch def %j=0,728 L729a j L729 j get put /l*CIE L729 j get L*Nio sub L*Wio L*Nio sub div def %system rel. lightn. /a*s A*Wio A*Nio sub l*CIE mul def /b*s B*Wio B*Nio sub l*CIE mul def a729a j a729 j get A*Nio sub a*s sub put b729a j b729 j get B*Nio sub b*s sub put } for %j=0,728 xcharti 0 eq {/Xprint 0 def /FileData (LAB*rc) def} if xcharti 1 eq {/Xprint 1 def /FileData (LAB*ra) def} if xcharti 2 eq {/Xprint 1 def /FileData (LAB*na) def} if xcharti 3 eq {/Xprint 1 def /FileData (LAB*la0) def} if xcharti 4 eq {/Xprint 1 def /FileData (LAB*la1) def} if xcharti 5 eq {/Xprint 1 def /FileData (LAB*la2) def} if xcharti 6 eq {/Xprint 1 def /FileData (LAB*la3) def} if xcharti 7 eq {/Xprint 1 def /FileData (LAB*la4) def} if xcharti 8 eq {/Xprint 1 def /FileData (LAB*la5) def} if xcharti 9 eq {/Xprint 1 def /FileData (LAB*la6) def} if xcharti 10 eq {/Xprint 1 def /FileData (LAB*la7) def} if } bind def %END xcharti_XYZ729_LAB729a %************************************************************************ /FFM_de_setrgbcolor {%BEG procedure FFM_de_setrgbcolor %transfer of device to elementary colors %requires /habsi 361 array def %defined in hab*sM_to_hab*eM %requires /habei 361 array def %defined in hab*sM_to_hab*eM %requires /rgb*e361Mi 361 array def %defined in LAB*x50M_to_LAB*x361Mi_rgb*x361Mi /FFM_bs exch def /FFM_gs exch def /FFM_rs exch def %test grey or color FFM_rs FFM_gs sub abs 0.002 le FFM_gs FFM_bs sub abs 0.002 le and {%grey or color FFM_rs dup dup FFM_setrgbcolor /r*d FFM_rs def /g*d FFM_gs def /b*d FFM_bs def /i*d r*d def /c*d 0 def /r*eM 1 def /g*eM 1 def /b*eM 1 def /r*eF r*d def /g*eF g*d def /b*eF b*d def } {%color /hsi FFM_rs 030 sin mul FFM_gs 150 sin mul add FFM_bs 270 sin mul add %y_e FFM_rs 030 cos mul FFM_gs 150 cos mul add %x_e 0.0001 add atan 0.5 add cvi def /hei habei hsi get def /r*d FFM_rs def /g*d FFM_gs def /b*d FFM_bs def %calculation of i* and c* of colour F /maxd r*d def maxd g*d lt {/maxd g*d def} if maxd b*d lt {/maxd b*d def} if /mind r*d def mind g*d gt {/mind g*d def} if mind b*d gt {/mind b*d def} if /i*d maxd def /c*d maxd mind sub def %calculation of rgb*e /r*eM r*e361Mi hei get def /g*eM g*e361Mi hei get def /b*eM b*e361Mi hei get def /heM r*eM 030 sin mul g*eM 150 sin mul add b*eM 270 sin mul add %y_e r*eM 030 cos mul g*eM 150 cos mul add %x_e 0.0001 add atan def %calculation of rgb*eF of colour F c*d 1 eq {%c*d=1,#1 /r*eF r*eM def /g*eF g*eM def /b*eF b*eM def} {%c*d#1 heM 030 ge heM 090 lt and {%r>g>b /r*eF r*eM i*d mul def /g*eF g*eM 1 g*eM sub 1 c*d sub mul add i*d mul def /b*eF b*eM 1 add c*d sub i*d mul def} if heM 090 ge heM 150 lt and {%g>r>b /r*eF r*eM 1 r*eM sub 1 c*d sub mul add i*d mul def /g*eF g*eM i*d mul def /b*eF b*eM 1 add c*d sub i*d mul def} if heM 150 ge heM 210 lt and {%g>b>r /r*eF r*eM 1 add c*d sub i*d mul def /g*eF g*eM i*d mul def /b*eF b*eM 1 b*eM sub 1 c*d sub mul add i*d mul def} if heM 210 ge heM 270 lt and {%b>g>r /r*eF r*eM 1 add c*d sub i*d mul def /g*eF g*eM 1 g*eM sub 1 c*d sub mul add i*d mul def /b*eF b*eM i*d mul def} if heM 270 ge heM 330 lt and {%b>r>g /r*eF r*eM 1 r*eM sub 1 c*d sub mul add i*d mul def /g*eF g*eM 1 add c*d sub i*d mul def /b*eF b*eM i*d mul def} if heM 330 ge heM 360 lt and heM 000 ge heM 030 lt and or {x%r>b>g /r*eF r*eM i*d mul def /g*eF g*eM 1 add c*d sub i*d mul def /b*eF b*eM 1 b*eM sub 1 c*d sub mul add i*d mul def} if } ifelse %c*d=1,#1 %STOP2 r*eF g*eF b*eF FFM_setrgbcolor } ifelse %grey or color } bind def %END procedure FFM_de_setrgbcolor.TXT %END DEH-0000.TXT ************************************2011-03-01